===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2008-2014, 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- --
@@ -37,11 +37,10 @@
package Ada.Calendar.Conversions is
function To_Ada_Time (Unix_Time : Interfaces.C.long) return Time;
- -- Convert a time value represented as number of seconds since the Unix
- -- Epoch to a time value relative to an Ada implementation-defined Epoch.
- -- The units of the result are 100 nanoseconds on VMS and nanoseconds on
- -- all other targets. Raises Time_Error if the result cannot fit into a
- -- Time value.
+ -- Convert a time value represented as number of seconds since the
+ -- Unix Epoch to a time value relative to an Ada implementation-defined
+ -- Epoch. The units of the result are nanoseconds on all targets. Raises
+ -- Time_Error if the result cannot fit into a Time value.
function To_Ada_Time
(tm_year : Interfaces.C.int;
===================================================================
@@ -982,7 +982,6 @@
Hour : Hour_Type;
Minute : Minute_Type;
Second : Second_Type;
- Result : Time;
begin
-- First, the invalid cases
@@ -999,25 +998,11 @@
GM_Split (Date, Year, Month, Day, Hour, Minute, Second);
- -- On OpenVMS, the resulting time value must be in the local time
- -- zone. Ada.Calendar.Time_Of is exactly what we need. Note that
- -- in both cases, the sub seconds are set to zero (0.0) because the
- -- time stamp does not store them in its value.
-
- if OpenVMS then
- Result :=
- Ada.Calendar.Time_Of
- (Year, Month, Day, Seconds_Of (Hour, Minute, Second, 0.0));
-
- -- On Unix and Windows, the result must be in GMT. Ada.Calendar.
+ -- The result must be in GMT. Ada.Calendar.
-- Formatting.Time_Of with default time zone of zero (0) is the
-- routine of choice.
- else
- Result := Time_Of (Year, Month, Day, Hour, Minute, Second, 0.0);
- end if;
-
- return Result;
+ return Time_Of (Year, Month, Day, Hour, Minute, Second, 0.0);
end if;
end Modification_Time;
===================================================================
@@ -7,7 +7,7 @@
-- B o d y --
-- (Windows Version) --
-- --
+-- Copyright (C) 2004-2014, 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- --
@@ -162,15 +162,6 @@
end Is_Valid_Simple_Name;
-------------
- -- OpenVMS --
- -------------
-
- function OpenVMS return Boolean is
- begin
- return False;
- end OpenVMS;
-
- -------------
-- Windows --
-------------
===================================================================
@@ -7,7 +7,7 @@
-- B o d y --
-- (POSIX Version) --
-- --
+-- Copyright (C) 2004-2014, 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- --
@@ -93,15 +93,6 @@
end Is_Valid_Simple_Name;
-------------
- -- OpenVMS --
- -------------
-
- function OpenVMS return Boolean is
- begin
- return False;
- end OpenVMS;
-
- -------------
-- Windows --
-------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2004-2014, 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- --
@@ -43,9 +43,6 @@
function Is_Path_Name_Case_Sensitive return Boolean;
-- Returns True if file and path names are case-sensitive
- function OpenVMS return Boolean;
- -- Return True when OS is OpenVMS
-
function Windows return Boolean;
-- Return True when OS is Windows
===================================================================
@@ -672,24 +672,23 @@
-- perform periodic but not systematic operations.
procedure Poll is separate;
- -- The actual polling routine is separate, so that it can easily
- -- be replaced with a target dependent version.
+ -- The actual polling routine is separate, so that it can easily be
+ -- replaced with a target dependent version.
--------------------------
-- Code_Address_For_AAA --
--------------------------
- -- This function gives us the start of the PC range for addresses
- -- within the exception unit itself. We hope that gigi/gcc keep all the
- -- procedures in their original order.
+ -- This function gives us the start of the PC range for addresses within
+ -- the exception unit itself. We hope that gigi/gcc keep all the procedures
+ -- in their original order.
function Code_Address_For_AAA return System.Address is
begin
- -- We are using a label instead of merely using
- -- Code_Address_For_AAA'Address because on some platforms the latter
- -- does not yield the address we want, but the address of a stub or of
- -- a descriptor instead. This is the case at least on Alpha-VMS and
- -- PA-HPUX.
+ -- We are using a label instead of Code_Address_For_AAA'Address because
+ -- on some platforms the latter does not yield the address we want, but
+ -- the address of a stub or of a descriptor instead. This is the case at
+ -- least on PA-HPUX.
<<Start_Of_AAA>>
return Start_Of_AAA'Address;
===================================================================
@@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -35,7 +35,7 @@
-- that activates periodic polling. Then in the body of the polling routine
-- we test for asynchronous abort.
+-- Windows and HPUX 10 currently use this file
pragma Warnings (Off);
-- Allow withing of non-Preelaborated units in Ada 2005 mode where this
===================================================================
@@ -7,7 +7,7 @@
-- S p e c --
-- (Apple OS X Version) --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -31,12 +31,11 @@
------------------------------------------------------------------------------
-- This version is for use with normal Unix math functions, except for
+-- sine/cosine which have been implemented directly in Ada to get the required
+-- accuracy in OS X. Alternative packages are used on VxWorks (no need for the
+-- -lm Linker_Options), and on the x86 (where we have two versions one using
+-- inline ASM, and one importing from the C long routines that take 80-bit
+-- arguments).
package Ada.Numerics.Aux is
pragma Pure;
===================================================================
@@ -7,7 +7,7 @@
-- S p e c --
-- (C Library Version, non-x86) --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -37,11 +37,10 @@
-- One advantage of using this package is that it will interface directly to
-- hardware instructions, such as the those provided on the Intel x86.
+-- This version here is for use with normal Unix math functions. Alternative
+-- packages are used VxWorks (no need for the -lm Linker_Options), and on the
+-- x86 (where we have two versions one using inline ASM, and one importing
+-- from the C long routines that take 80-bit arguments).
package Ada.Numerics.Aux is
pragma Pure;
===================================================================
@@ -159,13 +159,10 @@
-- A value of zero indicates that time slicing should be suppressed. If no
-- pragma is present, and no -T switch was used, the value is -1.
- -- Heap_Size is the heap to use for memory allocations set by use of a
- -- -Hnn parameter for the binder or by the GNAT$NO_MALLOC_64 logical.
- -- Valid values are 32 and 64. This switch is only effective on VMS.
+ -- Float_Format is the float representation in use. Currently the only
+ -- valid value is 'I' for IEEE. We needed this field in the past for other
+ -- floating-point formats, and it is retained for possible future use.
- -- Float_Format is the float representation in use. Valid values are
- -- 'I' for IEEE and 'V' for VAX Float. This is only for VMS.
-
-- WC_Encoding shows the wide character encoding method used for the main
-- program. This is one of the encoding letters defined in
-- System.WCh_Con.WC_Encoding_Letters.
@@ -2046,10 +2043,10 @@
-- files. The reason for this decision is that libraries referenced
-- by internal routines may reference these standard library entries.
- -- Note that we do not insert anything when pragma No_Run_Time has been
- -- specified or when the standard libraries are not to be used,
- -- otherwise on some platforms, such as VMS, we may get duplicate
- -- symbols when linking.
+ -- Note that we do not insert anything when pragma No_Run_Time has
+ -- been specified or when the standard libraries are not to be used,
+ -- otherwise on some platforms, we may get duplicate symbols when
+ -- linking (not clear if this is still the case, but it is harmless).
if not (Opt.No_Run_Time_Mode or else Opt.No_Stdlib) then
Name_Len := 0;
@@ -2212,8 +2209,7 @@
Resolve_Binder_Options;
- -- Usually, adafinal is called using a pragma Import C. Since Import C
- -- doesn't have the same semantics for VMs or CodePeer use standard Ada.
+ -- Generate standard with's
if not Suppress_Standard_Library_On_Target then
if CodePeer_Mode then
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -120,11 +120,6 @@
Write_Line (" -h Output this usage (help) information");
- -- Line for -H switch
-
- Write_Line (" -Hnn Use nn bit heap where nn is 32 or 64 " &
- "(VMS Only)");
-
-- Lines for -I switch
Write_Line (" -Idir Specify library and source files search path");
===================================================================
@@ -411,7 +411,6 @@
-- Is_Generic_Instance Flag130
-- No_Pool_Assigned Flag131
- -- Is_Optional_Parameter Flag134
-- Has_Aliased_Components Flag135
-- No_Strict_Aliasing Flag136
-- Is_Machine_Code_Subprogram Flag137
@@ -573,6 +572,12 @@
-- (unused) Flag2
-- (unused) Flag3
+ -- (unused) Flag132
+ -- (unused) Flag133
+ -- (unused) Flag134
+
+ -- (unused) Flag275
+ -- (unused) Flag276
-- (unused) Flag277
-- (unused) Flag278
-- (unused) Flag279
@@ -2202,12 +2207,6 @@
return Flag226 (Id);
end Is_Only_Out_Parameter;
- function Is_Optional_Parameter (Id : E) return B is
- begin
- pragma Assert (Is_Formal (Id));
- return Flag134 (Id);
- end Is_Optional_Parameter;
-
function Is_Package_Body_Entity (Id : E) return B is
begin
return Flag160 (Id);
@@ -4993,12 +4992,6 @@
Set_Flag226 (Id, V);
end Set_Is_Only_Out_Parameter;
- procedure Set_Is_Optional_Parameter (Id : E; V : B := True) is
- begin
- pragma Assert (Is_Formal (Id));
- Set_Flag134 (Id, V);
- end Set_Is_Optional_Parameter;
-
procedure Set_Is_Package_Body_Entity (Id : E; V : B := True) is
begin
Set_Flag160 (Id, V);
@@ -8405,7 +8398,6 @@
W ("Is_Null_Init_Proc", Flag178 (Id));
W ("Is_Obsolescent", Flag153 (Id));
W ("Is_Only_Out_Parameter", Flag226 (Id));
- W ("Is_Optional_Parameter", Flag134 (Id));
W ("Is_Package_Body_Entity", Flag160 (Id));
W ("Is_Packed", Flag51 (Id));
W ("Is_Packed_Array_Impl_Type", Flag138 (Id));
===================================================================
@@ -2328,7 +2328,7 @@
-- Defined in all entities. Set if the entity is exported. For now we
-- only allow the export of constants, exceptions, functions, procedures
-- and variables, but that may well change later on. Exceptions can only
+-- be exported in the Java VM implementation of GNAT.
-- Is_External_State (synthesized)
-- Applies to all entities, true for abstract states that are subject to
@@ -2447,9 +2447,8 @@
-- Is_Imported (Flag24)
-- Defined in all entities. Set if the entity is imported. For now we
-- only allow the import of exceptions, functions, procedures, packages.
+-- and variables. Exceptions, packages and types can only be imported in
+-- the Java VM implementation.
-- Is_Incomplete_Or_Private_Type (synthesized)
-- Applies to all entities, true for private and incomplete types
@@ -2697,11 +2696,6 @@
-- out parameter, or if there is some other IN OUT parameter then this
-- flag is not set in any of them. Used in generation of warnings.
-
-- Is_Ordinary_Fixed_Point_Type (synthesized)
-- Applies to all entities, true for ordinary fixed point types and
-- subtypes.
@@ -3348,8 +3342,9 @@
-- types which have a convention of C, C++ or Fortran.
-- No_Dynamic_Predicate_On_Actual (Flag276)
+-- Defined in discrete types. Set for generic formal types that are used
+-- in loops and quantified expressions. The corresponing actual cannot
+-- have dynamic predicates.
-- No_Pool_Assigned (Flag131) [root type only]
-- Defined in access types. Set if a storage size clause applies to the
@@ -3359,8 +3354,9 @@
-- derived types must have the same pool.
-- No_Predicate_On_Actual (Flag275)
+-- Defined in discrete types. Set for generic formal types that are used
+-- in the spec of a generic package, in constructs that forbid discrete
+-- types with predicates.
-- No_Return (Flag113)
-- Defined in all entities. Always false except in the case of procedures
@@ -5751,7 +5747,6 @@
-- Has_Initial_Value (Flag219)
-- Is_Controlling_Formal (Flag97)
-- Is_Only_Out_Parameter (Flag226)
- -- Is_Optional_Parameter (Flag134)
-- Low_Bound_Tested (Flag205)
-- Is_Return_Object (Flag209)
-- Parameter_Mode (synth)
@@ -6703,7 +6698,6 @@
function Is_Null_Init_Proc (Id : E) return B;
function Is_Obsolescent (Id : E) return B;
function Is_Only_Out_Parameter (Id : E) return B;
- function Is_Optional_Parameter (Id : E) return B;
function Is_Package_Body_Entity (Id : E) return B;
function Is_Packed (Id : E) return B;
function Is_Packed_Array_Impl_Type (Id : E) return B;
@@ -7343,7 +7337,6 @@
procedure Set_Is_Null_Init_Proc (Id : E; V : B := True);
procedure Set_Is_Obsolescent (Id : E; V : B := True);
procedure Set_Is_Only_Out_Parameter (Id : E; V : B := True);
- procedure Set_Is_Optional_Parameter (Id : E; V : B := True);
procedure Set_Is_Package_Body_Entity (Id : E; V : B := True);
procedure Set_Is_Packed (Id : E; V : B := True);
procedure Set_Is_Packed_Array_Impl_Type (Id : E; V : B := True);
@@ -8119,7 +8112,6 @@
pragma Inline (Is_Object);
pragma Inline (Is_Obsolescent);
pragma Inline (Is_Only_Out_Parameter);
- pragma Inline (Is_Optional_Parameter);
pragma Inline (Is_Ordinary_Fixed_Point_Type);
pragma Inline (Is_Overloadable);
pragma Inline (Is_Package_Body_Entity);
@@ -8570,7 +8562,6 @@
pragma Inline (Set_Is_Null_Init_Proc);
pragma Inline (Set_Is_Obsolescent);
pragma Inline (Set_Is_Only_Out_Parameter);
- pragma Inline (Set_Is_Optional_Parameter);
pragma Inline (Set_Is_Package_Body_Entity);
pragma Inline (Set_Is_Packed);
pragma Inline (Set_Is_Packed_Array_Impl_Type);
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -93,7 +93,6 @@
-- are active (see errout.ads for details). If this switch is False, then
-- these sequences are ignored (i.e. simply equivalent to a single ?). The
-- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
- -- Note: always ignored on VMS, where we do not provide this capability.
----------------------------------------
-- Error Message Insertion Parameters --
===================================================================
@@ -413,68 +413,6 @@
-- are continuations that are not printed using the -gnatj switch they
-- will also have this prefix.
- ----------------------------------------
- -- Specialization of Messages for VMS --
- ----------------------------------------
-
- -- Some messages mention gcc-style switch names. When using an OpenVMS
- -- host, such switch names must be converted to their corresponding VMS
- -- qualifer. The following table controls this translation. In each case
- -- the original message must contain the string "-xxx switch", where xxx
- -- is the Gname? entry from below, and this string will be replaced by
- -- "/yyy qualifier", where yyy is the corresponding Vname? entry.
-
- Gname1 : aliased constant String := "fno-strict-aliasing";
- Vname1 : aliased constant String := "OPTIMIZE=NO_STRICT_ALIASING";
-
- Gname2 : aliased constant String := "gnatX";
- Vname2 : aliased constant String := "EXTENSIONS_ALLOWED";
-
- Gname3 : aliased constant String := "gnatW";
- Vname3 : aliased constant String := "WIDE_CHARACTER_ENCODING";
-
- Gname4 : aliased constant String := "gnatf";
- Vname4 : aliased constant String := "REPORT_ERRORS=FULL";
-
- Gname5 : aliased constant String := "gnat05";
- Vname5 : aliased constant String := "05";
-
- Gname6 : aliased constant String := "gnat2005";
- Vname6 : aliased constant String := "2005";
-
- Gname7 : aliased constant String := "gnat12";
- Vname7 : aliased constant String := "12";
-
- Gname8 : aliased constant String := "gnat2012";
- Vname8 : aliased constant String := "2012";
-
- Gname9 : aliased constant String := "gnateinn";
- Vname9 : aliased constant String := "MAX_INSTANTIATIONS=nn";
-
- type Cstring_Ptr is access constant String;
-
- Gnames : array (Nat range <>) of Cstring_Ptr :=
- (Gname1'Access,
- Gname2'Access,
- Gname3'Access,
- Gname4'Access,
- Gname5'Access,
- Gname6'Access,
- Gname7'Access,
- Gname8'Access,
- Gname9'Access);
-
- Vnames : array (Nat range <>) of Cstring_Ptr :=
- (Vname1'Access,
- Vname2'Access,
- Vname3'Access,
- Vname4'Access,
- Vname5'Access,
- Vname6'Access,
- Vname7'Access,
- Vname8'Access,
- Vname9'Access);
-
-----------------------------------------------------
-- Global Values Used for Error Message Insertions --
-----------------------------------------------------
===================================================================
@@ -502,10 +502,10 @@
-- error to make sure that *something* appears on standard error in
-- an error situation.
- -- Formerly, only the "# errors" suffix was sent to stderr, whereas
- -- "# lines:" appeared on stdout. This caused problems on VMS when
- -- the stdout buffer was flushed, giving an extra line feed after
- -- the prefix.
+ -- Historical note: Formerly, only the "# errors" suffix was sent
+ -- to stderr, whereas "# lines:" appeared on stdout. This caused
+ -- some problems on now-obsolete ports, but there seems to be no
+ -- reason to revert this page since it would be incompatible.
if Total_Errors_Detected + Warnings_Detected /= 0
and then not Brief_Output
===================================================================
@@ -1701,18 +1701,6 @@
end if;
end if;
- -- When the object is either protected or a task, create static strings
- -- which denote the names of entries and families. Associate the strings
- -- with the concurrent object's Protection_Entries or ATCB. This is a
- -- VMS Debug feature.
-
- if OpenVMS_On_Target
- and then Is_Concurrent_Type (Typ)
- and then Entry_Names_OK
- then
- Build_Entry_Names (Id_Ref, Typ, Res);
- end if;
-
return Res;
exception
@@ -7212,8 +7200,8 @@
-- All anonymous access-to-controlled types allocate
-- on the global pool.
- Set_Associated_Storage_Pool (Comp_Typ,
- Get_Global_Pool_For_Access_Type (Comp_Typ));
+ Set_Associated_Storage_Pool
+ (Comp_Typ, RTE (RE_Global_Pool_Object));
Build_Finalization_Master
(Typ => Comp_Typ,
@@ -7229,8 +7217,8 @@
-- All anonymous access-to-controlled types allocate
-- on the global pool.
- Set_Associated_Storage_Pool (Comp_Typ,
- Get_Global_Pool_For_Access_Type (Comp_Typ));
+ Set_Associated_Storage_Pool
+ (Comp_Typ, RTE (RE_Global_Pool_Object));
-- Shared the master among multiple components
===================================================================
@@ -4313,11 +4313,11 @@
if No (Associated_Storage_Pool (PtrT)) and then VM_Target = No_VM then
if Present (Rel_Typ) then
- Set_Associated_Storage_Pool (PtrT,
- Associated_Storage_Pool (Rel_Typ));
+ Set_Associated_Storage_Pool
+ (PtrT, Associated_Storage_Pool (Rel_Typ));
else
- Set_Associated_Storage_Pool (PtrT,
- Get_Global_Pool_For_Access_Type (PtrT));
+ Set_Associated_Storage_Pool
+ (PtrT, RTE (RE_Global_Pool_Object));
end if;
end if;
@@ -8537,17 +8537,18 @@
---------------------
-- If the argument is other than a Boolean array type, there is no special
- -- expansion required, except for VMS operations on signed integers.
+ -- expansion required, except for dealing with validity checks, and non-
+ -- standard boolean representations.
- -- For the packed case, we call the special routine in Exp_Pakd, except
- -- that if the component size is greater than one, we use the standard
- -- routine generating a gruesome loop (it is so peculiar to have packed
- -- arrays with non-standard Boolean representations anyway, so it does not
- -- matter that we do not handle this case efficiently).
+ -- For the packed array case, we call the special routine in Exp_Pakd,
+ -- except that if the component size is greater than one, we use the
+ -- standard routine generating a gruesome loop (it is so peculiar to have
+ -- packed arrays with non-standard Boolean representations anyway, so it
+ -- does not matter that we do not handle this case efficiently).
- -- For the unpacked case (and for the special packed case where we have non
- -- standard Booleans, as discussed above), we generate and insert into the
- -- tree the following function definition:
+ -- For the unpacked array case (and for the special packed case where we
+ -- have non standard Booleans, as discussed above), we generate and insert
+ -- into the tree the following function definition:
-- function Nnnn (A : arr) is
-- B : arr;
@@ -8587,49 +8588,6 @@
return;
end if;
- -- For the VMS "not" on signed integer types, use conversion to and from
- -- a predefined modular type.
-
- if Is_VMS_Operator (Entity (N)) then
- declare
- Rtyp : Entity_Id;
- Utyp : Entity_Id;
-
- begin
- -- If this is a derived type, retrieve original VMS type so that
- -- the proper sized type is used for intermediate values.
-
- if Is_Derived_Type (Typ) then
- Rtyp := First_Subtype (Etype (Typ));
- else
- Rtyp := Typ;
- end if;
-
- -- The proper unsigned type must have a size compatible with the
- -- operand, to prevent misalignment.
-
- if RM_Size (Rtyp) <= 8 then
- Utyp := RTE (RE_Unsigned_8);
-
- elsif RM_Size (Rtyp) <= 16 then
- Utyp := RTE (RE_Unsigned_16);
-
- elsif RM_Size (Rtyp) = RM_Size (Standard_Unsigned) then
- Utyp := RTE (RE_Unsigned_32);
-
- else
- Utyp := RTE (RE_Long_Long_Unsigned);
- end if;
-
- Rewrite (N,
- Unchecked_Convert_To (Typ,
- Make_Op_Not (Loc,
- Unchecked_Convert_To (Utyp, Right_Opnd (N)))));
- Analyze_And_Resolve (N, Typ);
- return;
- end;
- end if;
-
-- Only array types need any other processing
if not Is_Array_Type (Typ) then
===================================================================
@@ -936,7 +936,7 @@
-- The default choice is the global pool
else
- Pool_Id := Get_Global_Pool_For_Access_Type (Ptr_Typ);
+ Pool_Id := RTE (RE_Global_Pool_Object);
Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
end if;
@@ -4486,25 +4486,6 @@
end loop;
end Find_Node_To_Be_Wrapped;
- -------------------------------------
- -- Get_Global_Pool_For_Access_Type --
- -------------------------------------
-
- function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id is
- begin
- -- Access types whose size is smaller than System.Address size can exist
- -- only on VMS. We can't use the usual global pool which returns an
- -- object of type Address as truncation will make it invalid. To handle
- -- this case, VMS has a dedicated global pool that returns addresses
- -- that fit into 32 bit accesses.
-
- if Opt.True_VMS_Target and then Esize (T) = 32 then
- return RTE (RE_Global_Pool_32_Object);
- else
- return RTE (RE_Global_Pool_Object);
- end if;
- end Get_Global_Pool_For_Access_Type;
-
----------------------------------
-- Has_New_Controlled_Component --
----------------------------------
===================================================================
@@ -151,11 +151,6 @@
-- when pragma Restrictions (No_Finalization) applies, in which case we
-- know that class-wide objects do not contain controlled parts.
- function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id;
- -- Return the pool id for access type T. This is generally the node
- -- corresponding to System.Global_Pool.Global_Pool_Object except on
- -- VMS if the access size is 32.
-
function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
-- E is a type entity. Give the same result as Has_Controlled_Component
-- except for tagged extensions where the result is True only if the
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -30,7 +30,6 @@
with Opt; use Opt;
with Osint; use Osint;
with Table;
-with Targparm; use Targparm;
with Uname; use Uname;
with Widechar; use Widechar;
@@ -410,8 +409,7 @@
(Name_Buffer,
Name_Len,
Integer (Maximum_File_Name_Length),
- Debug_Flag_4,
- OpenVMS_On_Target);
+ Debug_Flag_4);
-- Replace extension
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -30,9 +30,8 @@
------------------------------------------------------------------------------
with Alloc;
-with Hostparm; use Hostparm;
with Table;
-with Types; use Types;
+with Types; use Types;
package body Fname is
@@ -78,13 +77,6 @@
then
return True;
- elsif OpenVMS
- and then
- (Name_Buffer (1 .. 4) = "dec-"
- or else Name_Buffer (1 .. 8) = "dec ")
- then
- return True;
-
else
return False;
end if;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -83,8 +83,7 @@
(Fname : File_Name_Type;
Renamings_Included : Boolean := True) return Boolean;
-- Similar to Is_Predefined_File_Name. The internal file set is a superset
- -- of the predefined file set including children of GNAT, and also children
- -- of DEC for the VMS case.
+ -- of the predefined file set including children of GNAT.
procedure Tree_Read;
-- Dummy procedure (reads dummy table values from tree file)
===================================================================
@@ -7038,12 +7038,8 @@
else
Set_Mechanisms (E);
- -- For foreign conventions, warn about return of an
- -- unconstrained array.
+ -- For foreign conventions, warn about return of unconstrained array
- -- Note: we *do* allow a return by descriptor for the VMS case,
- -- though here there is probably more to be done ???
-
if Ekind (E) = E_Function then
Retype := Underlying_Type (Etype (E));
@@ -7065,11 +7061,6 @@
elsif Is_Array_Type (Retype)
and then not Is_Constrained (Retype)
- -- Exclude cases where descriptor mechanism is set, since the
- -- VMS descriptor mechanisms allow such unconstrained returns.
-
- and then Mechanism (E) not in Descriptor_Codes
-
-- Check appropriate warning is enabled (should we check for
-- Warnings (Off) on specific entities here, probably so???)
@@ -7107,39 +7098,6 @@
end if;
end if;
- -- For VMS, descriptor mechanisms for parameters are allowed only for
- -- imported/exported subprograms. Moreover, the NCA descriptor is not
- -- allowed for parameters of exported subprograms.
-
- if OpenVMS_On_Target then
- if Is_Exported (E) then
- F := First_Formal (E);
- while Present (F) loop
- if Mechanism (F) = By_Descriptor_NCA then
- Error_Msg_N
- ("'N'C'A' descriptor for parameter not permitted", F);
- Error_Msg_N
- ("\can only be used for imported subprogram", F);
- end if;
-
- Next_Formal (F);
- end loop;
-
- elsif not Is_Imported (E) then
- F := First_Formal (E);
- while Present (F) loop
- if Mechanism (F) in Descriptor_Codes then
- Error_Msg_N
- ("descriptor mechanism for parameter not permitted", F);
- Error_Msg_N
- ("\can only be used for imported/exported subprogram", F);
- end if;
-
- Next_Formal (F);
- end loop;
- end if;
- end if;
-
-- Pragma Inline_Always is disallowed for dispatching subprograms
-- because the address of such subprograms is saved in the dispatch
-- table to support dispatching calls, and dispatching calls cannot
===================================================================
@@ -305,8 +305,8 @@
Code_Address_For_Deallocate_End : System.Address;
Code_Address_For_Dereference_End : System.Address;
-- Taking the address of the above procedures will not work on some
- -- architectures (HPUX and VMS for instance). Thus we do the same thing
- -- that is done in a-except.adb, and get the address of labels instead
+ -- architectures (HPUX for instance). Thus we do the same thing that
+ -- is done in a-except.adb, and get the address of labels instead.
procedure Skip_Levels
(Depth : Natural;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1998-2014, 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- --
@@ -37,10 +37,6 @@
-- See also child package GNAT.Directory_Operations.Iteration
-
with System;
with Ada.Strings.Maps;
@@ -54,8 +50,6 @@
-- '\' character. It can also include drive letters if the operating
-- system provides for this. The final '/' or '\' in a Dir_Name_Str is
-- optional when passed as a procedure or function in parameter.
- -- On OpenVMS, only Unix style path names are supported, not VMS style,
- -- but the directory and file names are not case sensitive.
type Dir_Type is limited private;
-- A value used to reference a directory. Conceptually this value includes
@@ -117,7 +111,7 @@
-- returned. Note that the contents of Path is case-sensitive on
-- systems that have case-sensitive file names (like Unix), and
-- non-case-sensitive on systems where the file system is also non-
- -- case-sensitive (such as Windows, and OpenVMS).
+ -- case-sensitive (such as Windows).
function Base_Name
(Path : Path_Name;
@@ -133,8 +127,8 @@
-- 'Path' and 'Dir_Name (Path) & Dir_Separator & Base_Name (Path)'
-- represent the same file.
--
- -- The comparison of Suffix is case-insensitive on systems such as Windows
- -- and VMS where the file search is case-insensitive (e.g. on such systems,
+ -- The comparison of Suffix is case-insensitive on systems like Windows
+ -- where the file search is case-insensitive (e.g. on such systems,
-- Base_Name ("/Users/AdaCore/BB12.patch", ".Patch") returns "BB12").
--
-- Note that the index bounds of the result match the corresponding indexes
@@ -165,13 +159,12 @@
--
-- The Style argument indicates the syntax to be used for path names:
--
- -- UNIX
- -- Use '/' as the directory separator. The default on Unix systems
- -- and on OpenVMS.
- --
-- DOS
- -- Use '\' as the directory separator. The default on Windows.
+ -- Use '\' as the directory separator (default on Windows)
--
+ -- UNIX
+ -- Use '/' as the directory separator (default on all other systems)
+ --
-- System_Default
-- Use the default style for the current system
@@ -179,24 +172,24 @@
function Expand_Path
(Path : Path_Name;
Mode : Environment_Style := System_Default) return Path_Name;
- -- Returns Path with environment variables (or logical names on OpenVMS)
- -- replaced by the current environment variable value. For example,
- -- $HOME/mydir will be replaced by /home/joe/mydir if $HOME environment
- -- variable is set to /home/joe and Mode is UNIX. If an environment
- -- variable does not exists the variable will be replaced by the empty
- -- string. Two dollar or percent signs are replaced by a single
- -- dollar/percent sign. Note that a variable must start with a letter.
+ -- Returns Path with environment variables replaced by the current
+ -- environment variable value. For example, $HOME/mydir will be replaced
+ -- by /home/joe/mydir if $HOME environment variable is set to /home/joe and
+ -- Mode is UNIX. If an environment variable does not exists the variable
+ -- will be replaced by the empty string. Two dollar or percent signs are
+ -- replaced by a single dollar/percent sign. Note that a variable must
+ -- start with a letter.
--
-- The Mode argument indicates the recognized syntax for environment
-- variables as follows:
--
-- UNIX
- -- Environment variables and OpenVMS logical names use $ as prefix and
- -- can use curly brackets as in ${HOME}/mydir. If there is no closing
- -- curly bracket for an opening one then no translation is done, so for
- -- example ${VAR/toto is returned as ${VAR/toto. The use of {} brackets
- -- is required if the environment variable name contains other than
- -- alphanumeric characters.
+ -- Environment variables use $ as prefix and can use curly brackets
+ -- as in ${HOME}/mydir. If there is no closing curly bracket for an
+ -- opening one then no translation is done, so for example ${VAR/toto
+ -- is returned as ${VAR/toto. The use of {} brackets is required if
+ -- the environment variable name contains other than alphanumeric
+ -- characters.
--
-- DOS
-- Environment variables uses % as prefix and suffix (e.g. %HOME%/dir).
@@ -207,8 +200,8 @@
-- Recognize both forms described above.
--
-- System_Default
- -- Uses either UNIX on Unix and OpenVMS systems, or DOS on Windows,
- -- depending on the running environment. What about other OS's???
+ -- Uses either DOS on Windows, and UNIX on all other systems, depending
+ -- on the running environment.
---------------
-- Iterators --
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2002-2014, 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- --
@@ -111,8 +111,8 @@
procedure Core_Dump (Occurrence : Exception_Occurrence);
-- Dump memory (called a core dump in some systems) if supported by the
- -- OS (most unix systems and VMS), and abort execution of the application.
- -- Under Windows this procedure will not dump the memory, it will only
- -- abort execution.
+ -- OS (most unix systems), and abort execution of the application. Under
+ -- Windows this procedure will not dump the memory, it will only abort
+ -- execution.
end GNAT.Exception_Actions;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2000-2014, 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- --
@@ -29,9 +29,9 @@
-- --
------------------------------------------------------------------------------
+-- Currently this package is implemented on all native GNAT ports. It is not
+-- yet implemented for any of the cross-ports (e.g. it is not available for
+-- VxWorks or LynxOS).
-- -----------
-- -- Usage --
===================================================================
@@ -172,8 +172,7 @@
-- Conversion function
function Value (S : System.Address) return String;
- -- Same as Interfaces.C.Strings.Value but taking a System.Address (on VMS,
- -- chars_ptr is a 32-bit pointer, and here we need a 64-bit version).
+ -- Same as Interfaces.C.Strings.Value but taking a System.Address
function To_Timeval (Val : Timeval_Duration) return Timeval;
-- Separate Val in seconds and microseconds
===================================================================
@@ -39,9 +39,6 @@
-- feature, so it is not available if Multicast is not supported, or not
-- installed.
-
-- VxWorks cross ports fully implement this package
-- This package is not yet implemented on LynxOS or other cross ports
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2008-2014, 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- --
@@ -212,11 +212,6 @@
pragma Convention (C, Hostent_Access);
-- Access to host entry
- -- Note: the hostent and servent accessors that return char*
- -- values are compiled with GCC, and on VMS they always return
- -- 64-bit pointers, so we can't use C.Strings.chars_ptr, which
- -- on VMS is 32 bits.
-
function Hostent_H_Name
(E : Hostent_Access) return System.Address;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1999-2014, 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- --
@@ -63,8 +63,6 @@
-- LynxOS x86
-- Solaris x86
-- Solaris sparc
-- VxWorks PowerPC
-- VxWorks x86
-- Windows NT/XP
===================================================================
@@ -3633,10 +3633,6 @@
MECHANISM_NAME ::=
Value
| Reference
-| Descriptor [([Class =>] CLASS_NAME)]
-| Short_Descriptor [([Class =>] CLASS_NAME)]
-
-CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
@end smallexample
@noindent
@@ -3665,21 +3661,6 @@
notation. If the mechanism is not specified, the default mechanism
is used.
-@cindex OpenVMS
-@cindex Passing by descriptor
-Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
-The default behavior for Import_Function is to pass a 64bit descriptor
-unless short_descriptor is specified, then a 32bit descriptor is passed.
-
-@code{First_Optional_Parameter} applies only to OpenVMS ports of GNAT@.
-It specifies that the designated parameter and all following parameters
-are optional, meaning that they are not passed at the generated code
-level (this is distinct from the notion of optional parameters in Ada
-where the parameters are passed anyway with the designated optional
-parameters). All optional parameters must be of mode @code{IN} and have
-default parameter values that are either known at compile time
-expressions, or uses of the @code{'Null_Parameter} attribute.
-
@node Pragma Import_Object
@unnumberedsec Pragma Import_Object
@findex Import_Object
@@ -3739,13 +3720,7 @@
MECHANISM_ASSOCIATION ::=
[formal_parameter_NAME =>] MECHANISM_NAME
-MECHANISM_NAME ::=
- Value
-| Reference
-| Descriptor [([Class =>] CLASS_NAME)]
-| Short_Descriptor [([Class =>] CLASS_NAME)]
-
-CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
+MECHANISM_NAME ::= Value | Reference
@end smallexample
@noindent
@@ -3786,15 +3761,8 @@
MECHANISM_ASSOCIATION ::=
[formal_parameter_NAME =>] MECHANISM_NAME
-MECHANISM_NAME ::=
- Value
-| Reference
-| Descriptor [([Class =>] CLASS_NAME)]
-| Short_Descriptor [([Class =>] CLASS_NAME)]
+MECHANISM_NAME ::= Value | Reference
-CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-@end smallexample
-
@noindent
This pragma is identical to @code{Import_Procedure} except that the
first parameter of @var{LOCAL_NAME}, which must be present, must be of
@@ -9260,28 +9228,8 @@
by copy (value)
@item 2
by reference
-@item 3
-by descriptor (default descriptor class)
-@item 4
-by descriptor (UBS: unaligned bit string)
-@item 5
-by descriptor (UBSB: aligned bit string with arbitrary bounds)
-@item 6
-by descriptor (UBA: unaligned bit array)
-@item 7
-by descriptor (S: string, also scalar access type parameter)
-@item 8
-by descriptor (SB: string with arbitrary bounds)
-@item 9
-by descriptor (A: contiguous array)
-@item 10
-by descriptor (NCA: non-contiguous array)
@end table
-@noindent
-Values from 3 through 10 are only relevant to Digital OpenVMS implementations.
-@cindex OpenVMS
-
@node Attribute Null_Parameter
@unnumberedsec Attribute Null_Parameter
@cindex Zero address, passing
===================================================================
@@ -630,8 +630,7 @@
Linker_Objects.Table (Linker_Objects.Last) :=
new String'(Arg);
- -- If host object file, record object file e.g. accept foo.o
- -- as well as foo.obj on VMS target.
+ -- If host object file, record object file
elsif Arg'Length > Get_Object_Suffix.all'Length
and then Arg
@@ -730,18 +729,17 @@
-- Save state of -shared option
Xlinker_Was_Previous : Boolean := False;
- -- Indicate that "-Xlinker" was the option preceding the current
- -- option. If True, then the current option is never suppressed.
+ -- Indicate that "-Xlinker" was the option preceding the current option.
+ -- If True, then the current option is never suppressed.
-- Rollback data
- -- These data items are used to store current binder file context.
- -- The context is composed of the file descriptor position and the
- -- current line together with the slice indexes (first and last
- -- position) for this line. The rollback data are used by the
- -- Store_File_Context and Rollback_File_Context routines below.
- -- The file context mechanism interact only with the Get_Next_Line
- -- call. For example:
+ -- These data items are used to store current binder file context. The
+ -- context is composed of the file descriptor position and the current
+ -- line together with the slice indexes (first and last position) for
+ -- this line. The rollback data are used by the Store_File_Context and
+ -- Rollback_File_Context routines below. The file context mechanism
+ -- interact only with the Get_Next_Line call. For example:
-- Store_File_Context;
-- Get_Next_Line;
@@ -772,7 +770,7 @@
pragma Import
(C, Object_Library_Ext_Ptr, "__gnat_object_library_extension");
-- Pointer to string specifying the default extension for
- -- object libraries, e.g. Unix uses ".a", VMS uses ".olb".
+ -- object libraries, e.g. Unix uses ".a".
Separate_Run_Path_Options : Boolean;
for Separate_Run_Path_Options'Size use Character'Size;
===================================================================
@@ -1627,7 +1627,7 @@
Osint.Add_Default_Search_Dirs;
-- Get the target parameters, but only if switch -nostdinc was not
- -- specified. Likely not strictly needed now that VMS is baselined???
+ -- specified. May not be needed any more, but is harmless.
if not Opt.No_Stdinc then
Get_Target_Parameters;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1996-2014, 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- --
@@ -29,10 +29,6 @@
-- --
------------------------------------------------------------------------------
-
with Ada.Unchecked_Conversion;
package body Interfaces.C_Streams is
===================================================================
@@ -33,9 +33,7 @@
(Buffer : in out String;
Len : in out Natural;
Maxlen : Natural;
- No_Predef : Boolean;
- VMS_On_Target : Boolean := False)
-
+ No_Predef : Boolean)
is
pragma Assert (Buffer'First = 1);
-- This is a documented requirement; the assert turns off index warnings
@@ -118,35 +116,16 @@
-- Special case of a child unit whose parent unit is a single letter that
-- is A, G, I, or S. In order to prevent confusion with krunched names
-- of predefined units use a tilde rather than a minus as the second
- -- character of the file name. On VMS a tilde is an illegal character
- -- in a file name, two consecutive underlines ("__") are used instead.
+ -- character of the file name.
elsif Len > 1
and then Buffer (2) = '-'
and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
and then Len <= Maxlen
then
- if VMS_On_Target then
- Len := Len + 1;
- Buffer (4 .. Len) := Buffer (3 .. Len - 1);
- Buffer (2) := '_';
- Buffer (3) := '_';
- else
- Buffer (2) := '~';
- end if;
+ Buffer (2) := '~';
+ return;
- if Len <= Maxlen then
- return;
-
- else
- -- Case of VMS when the buffer had exactly the length Maxlen and now
- -- has the length Maxlen + 1: krunching after "__" is needed.
-
- Startloc := 4;
- Curlen := Len;
- Krlen := Maxlen;
- end if;
-
-- Normal case, not a predefined file
else
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -121,8 +121,7 @@
(Buffer : in out String;
Len : in out Natural;
Maxlen : Natural;
- No_Predef : Boolean;
- VMS_On_Target : Boolean := False);
+ No_Predef : Boolean);
pragma Elaborate_Body (Krunch);
-- The full file name is stored in Buffer (1 .. Len) on entry. The file
-- name is crunched in place and on return Len is updated, so that the
@@ -131,8 +130,6 @@
-- case it may be possible that Krunch does not modify Buffer. The fourth
-- parameter, No_Predef, is a switch which, if set to True, disables the
-- normal special treatment of predefined library unit file names.
--
-- Note: the string Buffer must have a lower bound of 1, and may not
-- contain any blanks (in particular, it must not have leading blanks).
===================================================================
@@ -2526,31 +2526,6 @@
Init_Size (E, System_Address_Size);
end if;
- -- On VMS, reset size to 32 for convention C access type if no
- -- explicit size clause is given and the default size is 64. Really
- -- we do not know the size, since depending on options for the VMS
- -- compiler, the size of a pointer type can be 32 or 64, but choosing
- -- 32 as the default improves compatibility with legacy VMS code.
-
- -- Note: we do not use Has_Size_Clause in the test below, because we
- -- want to catch the case of a derived type inheriting a size clause.
- -- We want to consider this to be an explicit size clause for this
- -- purpose, since it would be weird not to inherit the size in this
- -- case.
-
- -- We do NOT do this if we are in -gnatdm mode on a non-VMS target
- -- since in that case we want the normal pointer representation.
-
- if Opt.True_VMS_Target
- and then (Convention (E) = Convention_C
- or else
- Convention (E) = Convention_CPP)
- and then No (Get_Attribute_Definition_Clause (E, Attribute_Size))
- and then Esize (E) = 64
- then
- Init_Size (E, 32);
- end if;
-
Set_Elem_Alignment (E);
-- Scalar types: set size and alignment
@@ -3022,8 +2997,7 @@
-- If Optimize_Alignment is set to Time, then we reset for odd
-- "in between sizes", for example a 17 bit record is given an
- -- alignment of 4. Note that this matches the old VMS behavior
- -- in versions of GNAT prior to 6.1.1.
+ -- alignment of 4.
elsif Optimize_Alignment_Time (E)
and then Siz > System_Storage_Unit
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -100,10 +100,9 @@
procedure Write_Info_EOL is
begin
- if Hostparm.OpenVMS
- or else Info_Buffer_Len + Max_Line + 1 > Max_Buffer
- then
+ if Info_Buffer_Len + Max_Line + 1 > Max_Buffer then
Write_Info_Terminate;
+
else
-- Delete any trailing blanks
===================================================================
@@ -2626,65 +2626,58 @@
Data := No_Compilation_Data;
OK := False;
- -- The loop here is a work-around for a problem on VMS; in some
- -- circumstances (shared library and several executables, for
- -- example), there are child processes other than compilation
- -- processes that are received. ??? Revisit now that VMS is no
- -- longer supported.
+ Wait_Process (Pid, OK);
- loop
- Wait_Process (Pid, OK);
+ if Pid = Invalid_Pid then
+ return;
+ end if;
- if Pid = Invalid_Pid then
- return;
- end if;
+ -- Look into the running compilation processes for this PID
- for J in Running_Compile'First .. Outstanding_Compiles loop
- if Pid = Running_Compile (J).Pid then
- Data := Running_Compile (J);
- Project := Running_Compile (J).Project;
+ for J in Running_Compile'First .. Outstanding_Compiles loop
+ if Pid = Running_Compile (J).Pid then
+ Data := Running_Compile (J);
+ Project := Running_Compile (J).Project;
- if Project /= No_Project then
- Queue.Set_Obj_Dir_Free (Project.Object_Directory.Name);
- end if;
+ if Project /= No_Project then
+ Queue.Set_Obj_Dir_Free (Project.Object_Directory.Name);
+ end if;
- -- If a mapping file was used by this compilation, get its
- -- file name for reuse by a subsequent compilation.
+ -- If a mapping file was used by this compilation, get its file
+ -- name for reuse by a subsequent compilation.
- if Running_Compile (J).Mapping_File /= No_Mapping_File then
- Comp_Data :=
- Project_Compilation_Htable.Get
- (Project_Compilation, Project);
- Comp_Data.Last_Free_Indexes :=
- Comp_Data.Last_Free_Indexes + 1;
- Comp_Data.Free_Mapping_File_Indexes
- (Comp_Data.Last_Free_Indexes) :=
- Running_Compile (J).Mapping_File;
- end if;
+ if Running_Compile (J).Mapping_File /= No_Mapping_File then
+ Comp_Data :=
+ Project_Compilation_Htable.Get
+ (Project_Compilation, Project);
+ Comp_Data.Last_Free_Indexes :=
+ Comp_Data.Last_Free_Indexes + 1;
+ Comp_Data.Free_Mapping_File_Indexes
+ (Comp_Data.Last_Free_Indexes) :=
+ Running_Compile (J).Mapping_File;
+ end if;
- -- To actually remove this Pid and related info from
- -- Running_Compile replace its entry with the last valid
- -- entry in Running_Compile.
+ -- To actually remove this Pid and related info from
+ -- Running_Compile replace its entry with the last valid
+ -- entry in Running_Compile.
- if J = Outstanding_Compiles then
- null;
- else
- Running_Compile (J) :=
- Running_Compile (Outstanding_Compiles);
- end if;
-
- Outstanding_Compiles := Outstanding_Compiles - 1;
- return;
+ if J = Outstanding_Compiles then
+ null;
+ else
+ Running_Compile (J) :=
+ Running_Compile (Outstanding_Compiles);
end if;
- end loop;
- -- This child process was not one of our compilation processes;
- -- just ignore it for now.
+ Outstanding_Compiles := Outstanding_Compiles - 1;
+ exit;
+ end if;
+ end loop;
- -- Why is this commented out code sitting here???
+ -- If the PID was not found, return with OK set to False
- -- raise Program_Error;
- end loop;
+ if Data = No_Compilation_Data then
+ OK := False;
+ end if;
end Await_Compile;
---------------------------
@@ -4638,11 +4631,13 @@
Library_Projs.Table (Current) := Proj;
end Add_To_Library_Projs;
+ -- Start of processing for Library_Phase
+
begin
Library_Projs.Init;
- -- Put in Library_Projs table all library project file
- -- ids when the library need to be rebuilt.
+ -- Put in Library_Projs table all library project file ids when the
+ -- library need to be rebuilt.
Proj1 := Project_Tree.Projects;
while Proj1 /= null loop
===================================================================
@@ -205,8 +205,11 @@
S := new String (1 .. Len + 3);
- -- Read the file. Note that the loop is not necessary
- -- since the whole file is read at once except on VMS.
+ -- Read the file. This loop is probably not necessary
+ -- since on most (all?) targets, the whole file is
+ -- read in at once, but we have encountered systems
+ -- in the past where this was not true, and we retain
+ -- this loop in case we encounter that in the future.
Curr := S'First;
while Curr <= Len loop
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -25,7 +25,6 @@
with Opt; use Opt;
with Output; use Output;
-with Targparm; use Targparm;
package body Osint.B is
@@ -75,9 +74,8 @@
Findex2 : Natural;
Flength : Natural;
- Bind_File_Prefix_Len : Natural := 2;
- -- Length of binder file prefix (normally set to 2 for b~, but gets
- -- reset to 3 for VMS for b__).
+ Bind_File_Prefix_Len : constant Natural := 2;
+ -- Length of binder file prefix (2 for b~)
begin
if Output_File_Name /= "" then
@@ -120,10 +118,6 @@
if Maximum_File_Name_Length > 0 then
- if OpenVMS_On_Target and then Typ /= 'c' then
- Bind_File_Prefix_Len := 3;
- end if;
-
-- Make room for the extra two characters in "b?"
while Int (Flength) >
@@ -139,31 +133,15 @@
File_Name (Findex1 .. Findex2 - 1);
Name_Buffer (Flength + Bind_File_Prefix_Len + 1) := '.';
- -- C bind file, name is b_xxx.c
-
- if Typ = 'c' then
- Name_Buffer (2) := '_';
- Name_Buffer (Flength + 4) := 'c';
- Name_Buffer (Flength + 5) := ASCII.NUL;
- Name_Len := Flength + 4;
-
-- Ada bind file, name is b~xxx.adb or b~xxx.ads
- -- (with __ instead of ~ in VMS)
- else
- if OpenVMS_On_Target then
- Name_Buffer (2) := '_';
- Name_Buffer (3) := '_';
- else
- Name_Buffer (2) := '~';
- end if;
+ Name_Buffer (2) := '~';
- Name_Buffer (Flength + Bind_File_Prefix_Len + 2) := 'a';
- Name_Buffer (Flength + Bind_File_Prefix_Len + 3) := 'd';
- Name_Buffer (Flength + Bind_File_Prefix_Len + 4) := Typ;
- Name_Buffer (Flength + Bind_File_Prefix_Len + 5) := ASCII.NUL;
- Name_Len := Flength + Bind_File_Prefix_Len + 4;
- end if;
+ Name_Buffer (Flength + Bind_File_Prefix_Len + 2) := 'a';
+ Name_Buffer (Flength + Bind_File_Prefix_Len + 3) := 'd';
+ Name_Buffer (Flength + Bind_File_Prefix_Len + 4) := Typ;
+ Name_Buffer (Flength + Bind_File_Prefix_Len + 5) := ASCII.NUL;
+ Name_Len := Flength + Bind_File_Prefix_Len + 4;
end if;
Bfile := Name_Find;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2001-2014, 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- --
@@ -44,17 +44,15 @@
-- Binder Output --
-------------------
- -- These routines are used by the binder to generate the C or Ada source
- -- files containing the binder output. The format of these files is
- -- described in package Bindgen.
+ -- These routines are used by the binder to generate the Ada source files
+ -- containing the binder output. The format of these files is described in
+ -- package Bindgen.
procedure Create_Binder_Output
(Output_File_Name : String;
Typ : Character;
Bfile : out Name_Id);
-- Creates the binder output file. Typ is one of
- --
- -- 'c' create output file for case of generating C
-- 'b' create body file for case of generating Ada
-- 's' create spec file for case of generating Ada
--
===================================================================
@@ -23,9 +23,8 @@
-- --
------------------------------------------------------------------------------
-with Hostparm;
-with Opt; use Opt;
-with Tree_IO; use Tree_IO;
+with Opt; use Opt;
+with Tree_IO; use Tree_IO;
package body Osint.C is
@@ -127,12 +126,7 @@
begin
Get_Name_String (Src);
- if Hostparm.OpenVMS then
- Name_Buffer (Name_Len + 1) := '_';
- else
- Name_Buffer (Name_Len + 1) := '.';
- end if;
-
+ Name_Buffer (Name_Len + 1) := '.';
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
Name_Len := Name_Len + Suffix'Length;
===================================================================
@@ -365,8 +365,9 @@
S := new String (1 .. Len);
- -- Read the file. Note that the loop is not necessary since the
- -- whole file is read at once except on VMS.
+ -- Read the file. Note that the loop is probably not necessary any
+ -- more since the whole file is read in at once on all targets. But
+ -- it is harmless and might be needed in future.
Curr := 1;
Actual_Len := Len;
@@ -473,31 +474,21 @@
Get_Dirs_From_File (Additional_Source_Dir => False);
end if;
- -- On VMS, don't expand the logical name (e.g. environment variable),
- -- just put it into Unix (e.g. canonical) format. System services
- -- will handle the expansion as part of the file processing.
+ -- Put path name in canonical form
for Additional_Source_Dir in False .. True loop
if Additional_Source_Dir then
Search_Path := Getenv (Ada_Include_Path);
if Search_Path'Length > 0 then
- if Hostparm.OpenVMS then
- Search_Path := To_Canonical_Path_Spec ("ADA_INCLUDE_PATH:");
- else
- Search_Path := To_Canonical_Path_Spec (Search_Path.all);
- end if;
+ Search_Path := To_Canonical_Path_Spec (Search_Path.all);
end if;
else
Search_Path := Getenv (Ada_Objects_Path);
if Search_Path'Length > 0 then
- if Hostparm.OpenVMS then
- Search_Path := To_Canonical_Path_Spec ("ADA_OBJECTS_PATH:");
- else
- Search_Path := To_Canonical_Path_Spec (Search_Path.all);
- end if;
+ Search_Path := To_Canonical_Path_Spec (Search_Path.all);
end if;
end if;
@@ -512,9 +503,7 @@
-- For the compiler, if --RTS= was specified, add the runtime
-- directories.
- if RTS_Src_Path_Name /= null
- and then RTS_Lib_Path_Name /= null
- then
+ if RTS_Src_Path_Name /= null and then RTS_Lib_Path_Name /= null then
Add_Search_Dirs (RTS_Src_Path_Name, Include);
Add_Search_Dirs (RTS_Lib_Path_Name, Objects);
@@ -853,13 +842,12 @@
Buffer : String := Name_Buffer (1 .. Name_Len);
begin
- -- Get the file name in canonical case to accept as is names
- -- ending with ".EXE" on VMS and Windows.
+ -- Get the file name in canonical case to accept as is. Names
+ -- end with ".EXE" on Windows.
Canonical_Case_File_Name (Buffer);
- -- If Executable does not end with the executable suffix, add
- -- it.
+ -- If Executable doesn't end with the executable suffix, add it
if Buffer'Length <= Exec_Suffix'Length
or else
@@ -1183,12 +1171,8 @@
if T = Config
or else (Debug_Generated_Code
- and then Name_Len > 3
- and then
- (Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg"
- or else
- (Hostparm.OpenVMS and then
- Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg")))
+ and then Name_Len > 3
+ and then Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg")
then
Found := N;
Attr.all := Unknown_Attributes;
@@ -1292,9 +1276,9 @@
-- Command_Name(Cindex1 .. Cindex2) is now the equivalent of the
-- POSIX command "basename argv[0]"
- -- Strip off any versioning information such as found on VMS.
- -- This would take the form of TOOL.exe followed by a ";" or "."
- -- and a sequence of one or more numbers.
+ -- Strip off any versioning information found on some systems. This
+ -- would take the form of TOOL.exe followed by a ";" or "." and a
+ -- sequence of one or more numbers.
if Command_Name (Cindex2) in '0' .. '9' then
for J in reverse Cindex1 .. Cindex2 loop
@@ -1702,15 +1686,9 @@
function Is_Directory_Separator (C : Character) return Boolean is
begin
-- In addition to the default directory_separator allow the '/' to
- -- act as separator since this is allowed in MS-DOS, Windows 95/NT,
- -- and OS2 ports. On VMS, the situation is more complicated because
- -- there are two characters to check for.
+ -- act as separator since this is allowed in MS-DOS and Windows.
- return
- C = Directory_Separator
- or else C = '/'
- or else (Hostparm.OpenVMS
- and then (C = ']' or else C = ':'));
+ return C = Directory_Separator or else C = '/';
end Is_Directory_Separator;
-------------------------
@@ -2202,11 +2180,7 @@
function Prep_Suffix return String is
begin
- if Hostparm.OpenVMS then
- return "_prep";
- else
- return ".prep";
- end if;
+ return ".prep";
end Prep_Suffix;
------------------
@@ -2344,8 +2318,9 @@
S := new String (1 .. Len + 1);
S (Len + 1) := Path_Separator;
- -- Read the file. Note that the loop is not necessary since the
- -- whole file is read at once except on VMS.
+ -- Read the file. Note that the loop is probably not necessary since the
+ -- whole file is read at once but the loop is harmless and that way we
+ -- are sure to accomodate systems where this is not the case.
Curr := 1;
Actual_Len := Len;
@@ -2565,9 +2540,9 @@
Text := new Text_Buffer (Lo .. Hi);
- -- Some systems (e.g. VMS) have file types that require one
- -- read per line, so read until we get the Len bytes or until
- -- there are no more characters.
+ -- Some systems have file types that require one read per line,
+ -- so read until we get the Len bytes or until there are no more
+ -- characters.
Hi := Lo;
loop
@@ -2698,9 +2673,9 @@
begin
-- Allocate source buffer, allowing extra character at end for EOF
- -- Some systems (e.g. VMS) have file types that require one read per
- -- line, so read until we get the Len bytes or until there are no
- -- more characters.
+ -- Some systems have file types that require one read per line,
+ -- so read until we get the Len bytes or until there are no more
+ -- characters.
Hi := Lo;
loop
@@ -2806,15 +2781,6 @@
Library (3 .. 2 + Name'Length) := Name;
Library (3 + Name'Length) := '-';
Library (4 + Name'Length .. Library'Last) := Library_Version;
-
- if OpenVMS_On_Target then
- for K in Library'First + 2 .. Library'Last loop
- if Library (K) = '.' or else Library (K) = '-' then
- Library (K) := '_';
- end if;
- end loop;
- end if;
-
return Library;
end Shared_Lib;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -43,9 +43,9 @@
package Osint is
- Multi_Unit_Index_Character : Character := '~';
+ Multi_Unit_Index_Character : constant Character := '~';
-- The character before the index of the unit in a multi-unit source in ALI
- -- and object file names. Changed to '$' on VMS.
+ -- and object file names.
Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";
@@ -201,33 +201,27 @@
function To_Canonical_File_List
(Wildcard_Host_File : String;
Only_Dirs : Boolean) return String_Access_List_Access;
- -- Expand a wildcard host syntax file or directory specification (e.g. on
- -- a VMS host, any file or directory spec that contains: "*", or "%", or
- -- "...") and return a list of valid Unix syntax file or directory specs.
- -- If Only_Dirs is True, then only return directories.
+ -- Expand a wildcard host syntax file or directory specification and return
+ -- a list of valid Unix syntax file or directory specs. If Only_Dirs is
+ -- True, then only return directories.
function To_Canonical_Dir_Spec
(Host_Dir : String;
Prefix_Style : Boolean) return String_Access;
- -- Convert a host syntax directory specification (e.g. on a VMS host:
- -- "SYS$DEVICE:[DIR]") to canonical (Unix) syntax (e.g. "/sys$device/dir").
- -- If Prefix_Style then make it a valid file specification prefix. A file
- -- specification prefix is a directory specification that can be appended
- -- with a simple file specification to yield a valid absolute or relative
- -- path to a file. On a conversion to Unix syntax this simply means the
- -- spec has a trailing slash ("/").
+ -- Convert a host syntax directory specification to canonical (Unix)
+ -- syntax. If Prefix_Style then make it a valid file specification prefix.
+ -- A file specification prefix is a directory specification that can be
+ -- appended with a simple file specification to yield a valid absolute
+ -- or relative path to a file. On a conversion to Unix syntax this simply
+ -- means the spec has a trailing slash ("/").
function To_Canonical_File_Spec
(Host_File : String) return String_Access;
- -- Convert a host syntax file specification (e.g. on a VMS host:
- -- "SYS$DEVICE:[DIR]FILE.EXT;69 to canonical (Unix) syntax (e.g.
- -- "/sys$device/dir/file.ext.69").
+ -- Convert a host syntax file specification to canonical (Unix) syntax
function To_Canonical_Path_Spec
(Host_Path : String) return String_Access;
- -- Convert a host syntax Path specification (e.g. on a VMS host:
- -- "SYS$DEVICE:[BAR],DISK$USER:[FOO] to canonical (Unix) syntax (e.g.
- -- "/sys$device/foo:disk$user/foo").
+ -- Convert a host syntax Path specification to canonical (Unix) syntax
function To_Host_Dir_Spec
(Canonical_Dir : String;
@@ -254,7 +248,7 @@
-- Returns the runtime shared library in the form -l<name>-<version> where
-- version is the GNAT runtime library option for the platform. For example
-- this routine called with Name set to "gnat" will return "-lgnat-5.02"
- -- on UNIX and Windows and -lgnat_5_02 on VMS.
+ -- on UNIX and Windows.
---------------------
-- File attributes --
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -209,11 +209,8 @@
Buffer : String (1 .. Buffer_Max + 1) := (others => '*');
for Buffer'Alignment use 4;
- -- Buffer used to build output line. We do line buffering because it
- -- is needed for the support of the debug-generated-code option (-gnatD).
- -- Historically it was first added because on VMS, line buffering is
- -- needed with certain file formats. So in any case line buffering must
- -- be retained for this purpose, even if other reasons disappear. Note
+ -- Buffer used to build output line. We do line buffering because it is
+ -- needed for the support of the debug-generated-code option (-gnatD). Note
-- any attempt to write more output to a line than can fit in the buffer
-- will be silently ignored. The alignment clause improves the efficiency
-- of the save/restore procedures.
===================================================================
@@ -1564,9 +1564,7 @@
-- mode, check that language-defined units are compiled in GNAT
-- mode. For this purpose we do NOT consider renamings in annex
-- J as predefined. That allows users to compile their own
- -- versions of these files, and in particular, in the VMS
- -- implementation, the DEC versions can be substituted for the
- -- standard Ada 95 versions. Another exception is System.RPC
+ -- versions of these files. Another exception is System.RPC
-- and its children. This allows a user to supply their own
-- communication layer.
===================================================================
@@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
-with Hostparm;
with Makeutl; use Makeutl;
with MLib.Tgt;
with Opt; use Opt;
@@ -1416,18 +1415,10 @@
<<Process_Config_File>>
if Automatically_Generated then
- if Hostparm.OpenVMS then
- -- There is no gprconfig on VMS
+ -- This might raise an Invalid_Config exception
- Raise_Invalid_Config
- ("could not locate any configuration project file");
-
- else
- -- This might raise an Invalid_Config exception
-
Do_Autoconf;
- end if;
-- If the config file is not auto-generated, warn if there is any --RTS
-- switch, but not when the config file is generated in memory.
===================================================================
@@ -24,7 +24,6 @@
------------------------------------------------------------------------------
with Fmap;
-with Hostparm;
with Makeutl; use Makeutl;
with Opt;
with Osint; use Osint;
@@ -1905,8 +1904,6 @@
Add_Default_Dir : Boolean := True;
First : Positive;
Last : Positive;
- New_Len : Positive;
- New_Last : Positive;
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
@@ -2043,35 +2040,6 @@
-- directory correctly.
Last := Last - 1;
-
- elsif not Hostparm.OpenVMS
- or else not Is_Absolute_Path (Name_Buffer (First .. Last))
- then
- -- On VMS, only expand relative path names, as absolute paths
- -- may correspond to multi-valued VMS logical names.
-
- declare
- New_Dir : constant String :=
- Normalize_Pathname
- (Name_Buffer (First .. Last),
- Resolve_Links => Opt.Follow_Links_For_Dirs);
-
- begin
- -- If the absolute path was resolved and is different from
- -- the original, replace original with the resolved path.
-
- if New_Dir /= Name_Buffer (First .. Last)
- and then New_Dir'Length /= 0
- then
- New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
- New_Last := First + New_Dir'Length - 1;
- Name_Buffer (New_Last + 1 .. New_Len) :=
- Name_Buffer (Last + 1 .. Name_Len);
- Name_Buffer (First .. New_Last) := New_Dir;
- Name_Len := New_Len;
- Last := New_Last;
- end if;
- end;
end if;
First := Last + 1;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2001-2014, 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- --
@@ -24,7 +24,6 @@
------------------------------------------------------------------------------
with Csets;
-with Hostparm;
with Makeutl; use Makeutl;
with Opt;
with Output;
@@ -1058,11 +1057,9 @@
Project_File_Extension;
Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
- -- Back up project file if it already exists (not needed in VMS since
- -- versioning of files takes care of this requirement on VMS).
+ -- Back up project file if it already exists
- if not Hostparm.OpenVMS
- and then not Opt.No_Backup
+ if not Opt.No_Backup
and then Is_Regular_File (Path_Name (1 .. Path_Last))
then
declare
@@ -1280,15 +1277,6 @@
new String'(Get_Name_String (Tmp_File));
end if;
- -- On VMS, a file created with Create_Temp_File cannot
- -- be used to redirect output.
-
- if Hostparm.OpenVMS then
- Close (FD);
- Delete_File (Temp_File_Name.all, Success);
- FD := Create_Output_Text_File (Temp_File_Name.all);
- end if;
-
Args (Args'Last) := new String'
(Dir_Name &
Directory_Separator &
===================================================================
@@ -34,7 +34,6 @@
with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
-with Targparm; use Targparm;
with Ada; use Ada;
with Ada.Characters.Handling; use Ada.Characters.Handling;
@@ -5222,22 +5221,6 @@
Name_Len := The_Name'Length;
Name_Buffer (1 .. Name_Len) := The_Name;
- -- Special cases of children of packages A, G, I and S on VMS
-
- if OpenVMS_On_Target
- and then Name_Len > 3
- and then Name_Buffer (2 .. 3) = "__"
- and then
- (Name_Buffer (1) = 'a' or else
- Name_Buffer (1) = 'g' or else
- Name_Buffer (1) = 'i' or else
- Name_Buffer (1) = 's')
- then
- Name_Buffer (2) := '.';
- Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
- Name_Len := Name_Len - 1;
- end if;
-
Real_Name := Name_Find;
if Is_Reserved (Real_Name) then
===================================================================
@@ -276,8 +276,7 @@
-- If any of the environment variables ADA_PRJ_INCLUDE_FILE or
-- ADA_PRJ_OBJECTS_FILE has been set, then reset their value to
- -- the empty string. On VMS, this has the effect of deassigning
- -- the logical names.
+ -- the empty string.
if Shared.Private_Part.Current_Source_Path_File /= No_Path then
Setenv (Project_Include_Path_File, "");
===================================================================
@@ -441,10 +441,8 @@
No_Source : constant Source_Id := null;
type Path_Syntax_Kind is
- (Canonical,
- -- Unix style
- Host);
- -- Host specific syntax, for example on VMS (the default)
+ (Canonical, -- Unix style
+ Host); -- Host specific syntax
-- The following record describes the configuration of a language
@@ -484,8 +482,7 @@
-- unit in a multi-source file, in the object file name.
Path_Syntax : Path_Syntax_Kind := Host;
- -- Value may be Canonical (Unix style) or Host (host syntax, for example
- -- on VMS for DEC C).
+ -- Value may be Canonical (Unix style) or Host (host syntax)
Source_File_Switches : Name_List_Index := No_Name_List;
-- Optional switches to be put before the source file. The source file
@@ -2012,9 +2009,8 @@
Current_Source_Path_File : Path_Name_Type := No_Path;
-- Current value of project source path file env var. Used to avoid
-- setting the env var to the same value. When different from No_Path,
- -- this indicates that logical names (VMS) or environment variables were
- -- created and should be deassigned to avoid polluting the environment
- -- on VMS. This is for gnatmake only.
+ -- this indicates that environment variables were created and should be
+ -- deassigned to avoid polluting the environment. For gnatmake only.
Current_Object_Path_File : Path_Name_Type := No_Path;
-- Current value of project object path file env var. Used to avoid
===================================================================
@@ -1477,30 +1477,6 @@
when -2 =>
Write_Str ("reference");
- when -3 =>
- Write_Str ("descriptor");
-
- when -4 =>
- Write_Str ("descriptor (UBS)");
-
- when -5 =>
- Write_Str ("descriptor (UBSB)");
-
- when -6 =>
- Write_Str ("descriptor (UBA)");
-
- when -7 =>
- Write_Str ("descriptor (S)");
-
- when -8 =>
- Write_Str ("descriptor (SB)");
-
- when -9 =>
- Write_Str ("descriptor (A)");
-
- when -10 =>
- Write_Str ("descriptor (NCA)");
-
when others =>
raise Program_Error;
end case;
===================================================================
@@ -1126,10 +1126,10 @@
procedure Check_RPC;
-- Reject programs that make use of distribution features not supported
- -- on the current target. Also check that the PCS is compatible with
- -- the code generator version. On such targets (VMS, Vxworks, others?)
- -- we provide a minimal body for System.Rpc that only supplies an
- -- implementation of Partition_Id.
+ -- on the current target. Also check that the PCS is compatible with the
+ -- code generator version. On such targets (Vxworks, others?) we provide
+ -- a minimal body for System.Rpc that only supplies an implementation of
+ -- Partition_Id.
function Find_Local_Entity (E : RE_Id) return Entity_Id;
-- This function is used when entity E is in this compilation's main
===================================================================
@@ -376,7 +376,6 @@
System_Val_WChar,
System_Vax_Float_Operations,
System_Version_Control,
- System_VMS_Exception_Table,
System_WCh_StW,
System_WCh_WtS,
System_Wid_Bool,
@@ -1690,8 +1689,6 @@
RE_Version_String, -- System.Version_Control
RE_Get_Version_String, -- System.Version_Control
- RE_Register_VMS_Exception, -- System.VMS_Exception_Table
-
RE_String_To_Wide_String, -- System.WCh_StW
RE_String_To_Wide_Wide_String, -- System.WCh_StW
@@ -2977,8 +2974,6 @@
RE_Version_String => System_Version_Control,
RE_Get_Version_String => System_Version_Control,
- RE_Register_VMS_Exception => System_VMS_Exception_Table,
-
RE_String_To_Wide_String => System_WCh_StW,
RE_String_To_Wide_Wide_String => System_WCh_StW,
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2013-2014, 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- --
@@ -147,8 +147,7 @@
-- maintain anyway.
type GCC_Exception_Access is access all Unwind_Exception;
- -- Pointer to a GCC exception. Do not use convention C as on VMS this
- -- would imply the use of 32-bits pointers.
+ -- Pointer to a GCC exception
procedure Unwind_DeleteException (Excp : not null GCC_Exception_Access);
pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException");
===================================================================
@@ -823,8 +823,7 @@
Most_Significant_Word : constant Rep_Index :=
Rep_Last * Standard'Default_Bit_Order;
-- Finding the location of the Exponent_Word is a bit tricky. In general
- -- we assume Word_Order = Bit_Order. This expression needs to be refined
- -- for VMS.
+ -- we assume Word_Order = Bit_Order.
Exponent_Factor : constant Float_Word :=
2**(Float_Word'Size - 1) /
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1999-2014, 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- --
@@ -40,10 +40,10 @@
package System.Machine_State_Operations is
subtype Code_Loc is System.Address;
- -- Code location used in building exception tables and for call
- -- addresses when propagating an exception (also traceback table)
- -- Values of this type are created by using Label'Address or
- -- extracted from machine states using Get_Code_Loc.
+ -- Code location used in building exception tables and for call addresses
+ -- when propagating an exception (also traceback table) Values of this
+ -- type are created by using Label'Address or extracted from machine
+ -- states using Get_Code_Loc.
type Machine_State is new System.Address;
-- The table based exception handling approach (see a-except.adb) isolates
@@ -66,31 +66,28 @@
-- The initial value of type Machine_State is created by the low level
-- routine that actually raises an exception using the special builtin
- -- _builtin_machine_state. This value will typically encode the value
- -- of the program counter, and relevant registers. The following
- -- operations are defined on Machine_State values:
+ -- _builtin_machine_state. This value will typically encode the value of
+ -- the program counter, and relevant registers. The following operations
+ -- are defined on Machine_State values:
function Get_Code_Loc (M : Machine_State) return Code_Loc;
- -- This function extracts the program counter value from a machine
- -- state, which the caller uses for searching the exception tables,
- -- and also for recording entries in the traceback table. The call
- -- returns a value of Null_Loc if the machine state represents the
- -- outer level, or some other frame for which no information can be
- -- provided.
+ -- This function extracts the program counter value from a machine state,
+ -- which the caller uses for searching the exception tables, and also for
+ -- recording entries in the traceback table. The call returns a value of
+ -- Null_Loc if the machine state represents the outer level, or some other
+ -- frame for which no information can be provided.
procedure Pop_Frame (M : Machine_State);
-- This procedure pops the machine state M so that it represents the
- -- call point, as though the current subprogram had returned. It
- -- changes only the value referenced by M, and does not affect
- -- the current stack environment.
+ -- call point, as though the current subprogram had returned. It changes
+ -- only the value referenced by M, and does not affect the current stack
+ -- environment.
function Fetch_Code (Loc : Code_Loc) return Code_Loc;
- -- Some architectures (notably VMS) use a descriptor to describe
- -- a subprogram address. This function computes the actual starting
+ -- Some architectures (notably HPUX) use a descriptor to describe a
+ -- subprogram address. This function computes the actual starting
-- address of the code from Loc.
--
- -- ??? This function will go away when 'Code_Address is fixed on VMS.
- --
-- Do not add pragma Inline to this function: there is a curious
-- interaction between rtsfind and front-end inlining. The exception
-- declaration in s-auxdec calls rtsfind, which forces several other system
@@ -98,10 +95,10 @@
-- compile the corresponding bodies so that inlining can take place. One
-- of these packages is s-mastop, which depends on s-auxdec, which is still
-- being compiled: we have not seen all the declarations in it yet, so we
- -- get confused semantic errors.
+ -- get confused semantic errors ???
procedure Set_Machine_State (M : Machine_State);
- -- This routine sets M from the current machine state. It is called
- -- when an exception is initially signalled to initialize the state.
+ -- This routine sets M from the current machine state. It is called when an
+ -- exception is initially signalled to initialize the state.
end System.Machine_State_Operations;
===================================================================
@@ -109,14 +109,12 @@
long_bits : constant := Long_Integer'Size;
-- Number of bits in type long and unsigned_long. The normal convention
- -- is that this is the same as type Long_Integer, but this is not true
- -- of all targets. For example, in OpenVMS long /= Long_Integer.
+ -- is that this is the same as type Long_Integer, but this may not be true
+ -- of all targets.
ptr_bits : constant := Standard'Address_Size;
subtype C_Address is System.Address;
- -- Number of bits in Interfaces.C pointers, normally a standard address,
- -- except on 64-bit VMS where they are 32-bit addresses, for compatibility
- -- with legacy code.
+ -- Number of bits in Interfaces.C pointers, normally a standard address
C_Malloc_Linkname : constant String := "__gnat_malloc";
-- Name of runtime function used to allocate such a pointer
===================================================================
@@ -107,14 +107,12 @@
long_bits : constant := Long_Integer'Size;
-- Number of bits in type long and unsigned_long. The normal convention
- -- is that this is the same as type Long_Integer, but this is not true
- -- of all targets. For example, in OpenVMS long /= Long_Integer.
+ -- is that this is the same as type Long_Integer, but this may not be true
+ -- of all targets.
ptr_bits : constant := Standard'Address_Size;
subtype C_Address is System.Address;
- -- Number of bits in Interfaces.C pointers, normally a standard address,
- -- except on 64-bit VMS where they are 32-bit addresses, for compatibility
- -- with legacy code.
+ -- Number of bits in Interfaces.C pointers, normally a standard address
C_Malloc_Linkname : constant String := "__gnat_malloc";
-- Name of runtime function used to allocate such a pointer
===================================================================
@@ -109,14 +109,12 @@
long_bits : constant := Long_Integer'Size;
-- Number of bits in type long and unsigned_long. The normal convention
- -- is that this is the same as type Long_Integer, but this is not true
- -- of all targets. For example, in OpenVMS long /= Long_Integer.
+ -- is that this is the same as type Long_Integer, but this may not be true
+ -- of all targets.
ptr_bits : constant := Standard'Address_Size;
subtype C_Address is System.Address;
- -- Number of bits in Interfaces.C pointers, normally a standard address,
- -- except on 64-bit VMS where they are 32-bit addresses, for compatibility
- -- with legacy code.
+ -- Number of bits in Interfaces.C pointers, normally a standard address
C_Malloc_Linkname : constant String := "__gnat_malloc";
-- Name of runtime function used to allocate such a pointer
===================================================================
@@ -109,14 +109,12 @@
long_bits : constant := Long_Integer'Size;
-- Number of bits in type long and unsigned_long. The normal convention
- -- is that this is the same as type Long_Integer, but this is not true
- -- of all targets. For example, in OpenVMS long /= Long_Integer.
+ -- is that this is the same as type Long_Integer, but this may not be true
+ -- of all targets.
ptr_bits : constant := Standard'Address_Size;
subtype C_Address is System.Address;
- -- Number of bits in Interfaces.C pointers, normally a standard address,
- -- except on 64-bit VMS where they are 32-bit addresses, for compatibility
- -- with legacy code.
+ -- Number of bits in Interfaces.C pointers, normally a standard address
C_Malloc_Linkname : constant String := "__gnat_malloc";
-- Name of runtime function used to allocate such a pointer
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -140,8 +140,8 @@
-- Undefer task abort (non-tasking case, does nothing)
procedure Abort_Handler_NT;
- -- Handle task abort (non-tasking case, does nothing). Currently, only VMS
- -- uses this.
+ -- Handle task abort (non-tasking case, does nothing). Currently, no port
+ -- makes use of this, but we retain the interface for possible future use.
procedure Update_Exception_NT (X : EO := Current_Target_Exception);
-- Handle exception setting. This routine is provided for targets that
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -39,7 +39,8 @@
-- Conversion to/from address
- -- Note qualification below of To_Address to avoid ambiguities on VMS
+ -- Note qualification below of To_Address to avoid ambiguities systems
+ -- where Address is a visible integer type.
function To_Address is
new Ada.Unchecked_Conversion (Storage_Offset, Address);
===================================================================
@@ -510,7 +510,7 @@
-- The task is blocked on a system call waiting for the
-- completion event. In this case Abort_Task may need to take
- -- special action in order to succeed. Example system: VMS.
+ -- special action in order to succeed.
then
Abort_Task (T);
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1991-2014, 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- --
@@ -53,13 +53,8 @@
end record;
subtype Task_Address is System.Address;
- -- In some versions of Task_Primitives, notably for VMS, Task_Address is
- -- the short version of address defined in System.Aux_DEC. To avoid
- -- dragging Aux_DEC into tasking packages a tasking specific subtype is
- -- defined here.
-
Task_Address_Size : constant := Standard'Address_Size;
- -- The size of Task_Address
+ -- Type used for task addresses and its size
Alternate_Stack_Size : constant := 0;
-- No alternate signal stack is used on this platform
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1991-2014, 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- --
@@ -63,13 +63,8 @@
-- Ada_Task_Control_Block.
subtype Task_Address is System.Address;
- -- In some versions of Task_Primitives, notably for VMS, Task_Address is
- -- the short version of address defined in System.Aux_DEC. To avoid
- -- dragging Aux_DEC into tasking packages a tasking specific subtype is
- -- defined here.
-
Task_Address_Size : constant := Standard'Address_Size;
- -- The size of Task_Address
+ -- Type used for task addresses and its size
Alternate_Stack_Size : constant := 0;
-- No alternate signal stack is used on this platform
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1991-2014, 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- --
@@ -62,13 +62,8 @@
-- Ada_Task_Control_Block.
subtype Task_Address is System.Address;
- -- In some versions of Task_Primitives, notably for VMS, Task_Address is
- -- the short version of address defined in System.Aux_DEC. To avoid
- -- dragging Aux_DEC into tasking packages a tasking specific subtype is
- -- defined here.
-
Task_Address_Size : constant := Standard'Address_Size;
- -- The size of Task_Address
+ -- Type used for task addresses and its size
Alternate_Stack_Size : constant := 0;
-- No alternate signal stack is used on this platform
===================================================================
@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
+-- Copyright (C) 1995-2014, 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- --
@@ -65,13 +65,8 @@
-- Ada_Task_Control_Block.
subtype Task_Address is System.Address;
- -- In some versions of Task_Primitives, notably for VMS, Task_Address is
- -- the short version of address defined in System.Aux_DEC. To avoid
- -- dragging Aux_DEC into tasking packages a tasking specific subtype is
- -- defined here.
-
Task_Address_Size : constant := Standard'Address_Size;
- -- The size of Task_Address
+ -- Type used for task addresses and its size
Alternate_Stack_Size : constant := 0;
-- No alternate signal stack is used on this platform
===================================================================
@@ -64,13 +64,8 @@
-- Ada_Task_Control_Block.
subtype Task_Address is System.Address;
- -- In some versions of Task_Primitives, notably for VMS, Task_Address is
- -- the short version of address defined in System.Aux_DEC. To avoid
- -- dragging Aux_DEC into tasking packages a tasking specific subtype is
- -- defined here.
-
Task_Address_Size : constant := Standard'Address_Size;
- -- The size of Task_Address
+ -- Type used for task addresses and its size
Alternate_Stack_Size : constant := System.OS_Interface.Alternate_Stack_Size;
-- Import value from System.OS_Interface
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -70,13 +70,8 @@
-- Ada_Task_Control_Block.
subtype Task_Address is System.Address;
- -- In some versions of Task_Primitives, notably for VMS, Task_Address is
- -- the short version of address defined in System.Aux_DEC. To avoid
- -- dragging Aux_DEC into tasking packages a tasking specific subtype is
- -- defined here.
-
Task_Address_Size : constant := Standard'Address_Size;
- -- The size of Task_Address
+ -- Type used for task addresses and its size
Alternate_Stack_Size : constant := 0;
-- No alternate signal stack is used on this platform
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2001-2014, 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- --
@@ -61,13 +61,8 @@
-- Ada_Task_Control_Block.
subtype Task_Address is System.Address;
- -- In some versions of Task_Primitives, notably for VMS, Task_Address is
- -- the short version of address defined in System.Aux_DEC. To avoid
- -- dragging Aux_DEC into tasking packages a tasking specific subtype is
- -- defined here.
-
Task_Address_Size : constant := Standard'Address_Size;
- -- The size of Task_Address
+ -- Type used for task addresses and its size
Alternate_Stack_Size : constant := 0;
-- No alternate signal stack is used on this platform
===================================================================
@@ -1140,9 +1140,7 @@
-- Propagate visible entity to operator node, either from a
-- given actual or from a default.
- if Is_Entity_Name (Actual)
- and then Nkind (Expr) in N_Op
- then
+ if Is_Entity_Name (Actual) and then Nkind (Expr) in N_Op then
Set_Entity (Expr, Entity (Actual));
end if;
@@ -1681,7 +1679,6 @@
if Present (Match)
and then Nkind (Match) = N_Operator_Symbol
then
-
-- If the name is a default, find its visible
-- entity at the point of instantiation.
@@ -10400,8 +10397,7 @@
-- to be compiled with checks off.
-- Note that we do NOT apply this criterion to children of GNAT
- -- (or on VMS, children of DEC). The latter units must suppress
- -- checks explicitly if this is needed.
+ -- The latter units must suppress checks explicitly if needed.
if Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Gen_Decl)))
===================================================================
@@ -3187,10 +3187,9 @@
then
-- The actual can be compatible with the formal, but we must
-- also check that the context is not an address type that is
- -- visibly an integer type, as is the case in VMS_64. In this
- -- case the use of literals is illegal, except in the body of
- -- descendents of system, where arithmetic operations on
- -- address are of course used.
+ -- visibly an integer type. In this case the use of literals is
+ -- illegal, except in the body of descendents of system, where
+ -- arithmetic operations on address are of course used.
if Has_Compatible_Type (Actual, Etype (Formal))
and then
@@ -6807,9 +6806,8 @@
-- Remove interpretations that treat literals as addresses. This
-- is never appropriate, even when Address is defined as a visible
-- Integer type. The reason is that we would really prefer Address
- -- to behave as a private type, even in this case, which is there
- -- only to accommodate oddities of VMS address sizes. If Address
- -- is a visible integer type, we get lots of overload ambiguities.
+ -- to behave as a private type, even in this case. If Address is a
+ -- visible integer type, we get lots of overload ambiguities.
if Nkind (N) in N_Binary_Op then
declare
===================================================================
@@ -1668,13 +1668,6 @@
N_Null)
then
return True;
-
- -- Any reference to Null_Parameter is known at compile time. No
- -- other attribute references (that have not already been folded)
- -- are known at compile time.
-
- elsif K = N_Attribute_Reference then
- return Attribute_Name (Op) = Name_Null_Parameter;
end if;
end if;
@@ -2657,11 +2650,7 @@
Right_Int : constant Uint := Expr_Value (Right);
begin
- -- VMS includes bitwise operations on signed types
-
- if Is_Modular_Integer_Type (Etype (N))
- or else Is_VMS_Operator (Entity (N))
- then
+ if Is_Modular_Integer_Type (Etype (N)) then
declare
Left_Bits : Bits (0 .. UI_To_Int (Esize (Etype (N))) - 1);
Right_Bits : Bits (0 .. UI_To_Int (Esize (Etype (N))) - 1);
@@ -4035,13 +4024,6 @@
pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N))));
return Corresponding_Integer_Value (N);
- -- Peculiar VMS case, if we have xxx'Null_Parameter, return zero
-
- elsif Kind = N_Attribute_Reference
- and then Attribute_Name (N) = Name_Null_Parameter
- then
- return Uint_0;
-
-- Otherwise must be character literal
else
@@ -4114,13 +4096,6 @@
pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N))));
Val := Corresponding_Integer_Value (N);
- -- Peculiar VMS case, if we have xxx'Null_Parameter, return zero
-
- elsif Kind = N_Attribute_Reference
- and then Attribute_Name (N) = Name_Null_Parameter
- then
- Val := Uint_0;
-
-- Otherwise must be character literal
else
@@ -4182,18 +4157,12 @@
elsif Kind = N_Integer_Literal then
return UR_From_Uint (Expr_Value (N));
- -- Peculiar VMS case, if we have xxx'Null_Parameter, return 0.0
+ -- Here, we have a node that cannot be interpreted as a compile time
+ -- constant. That is definitely an error.
- elsif Kind = N_Attribute_Reference
- and then Attribute_Name (N) = Name_Null_Parameter
- then
- return Ureal_0;
+ else
+ raise Program_Error;
end if;
-
- -- If we fall through, we have a node that cannot be interpreted as a
- -- compile time constant. That is definitely an error.
-
- raise Program_Error;
end Expr_Value_R;
------------------
===================================================================
@@ -38,7 +38,6 @@
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
-with Targparm; use Targparm;
with Uintp; use Uintp;
package body Sem_Intr is
@@ -146,12 +145,6 @@
elsif String_Length (Strval (Expr_Value_S (Arg1))) = 0 then
Error_Msg_NE
("call to & does not permit null string", N, Nam);
-
- elsif OpenVMS_On_Target
- and then String_Length (Strval (Expr_Value_S (Arg1))) > 31
- then
- Error_Msg_NE
- ("argument in call to & must be 31 characters or less", N, Nam);
end if;
-- Check for the case of freeing a non-null object which will raise
===================================================================
@@ -23,16 +23,14 @@
-- --
------------------------------------------------------------------------------
-with Atree; use Atree;
-with Einfo; use Einfo;
-with Errout; use Errout;
-with Namet; use Namet;
-with Sem; use Sem;
-with Sem_Aux; use Sem_Aux;
-with Sinfo; use Sinfo;
-with Snames; use Snames;
-with Stand; use Stand;
-with Targparm; use Targparm;
+with Atree; use Atree;
+with Einfo; use Einfo;
+with Errout; use Errout;
+with Namet; use Namet;
+with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
+with Sinfo; use Sinfo;
+with Snames; use Snames;
package body Sem_Mech is
@@ -93,19 +91,11 @@
Mech : Mechanism_Type;
Enod : Node_Id)
is
+ pragma Unreferenced (Enod);
+
begin
- -- Right now we only do some checks for functions returning arguments
- -- by descriptor. Probably mode checks need to be added here ???
+ -- Right now we don't do any checks, should we do more ???
- if Mech in Descriptor_Codes and then not Is_Formal (Ent) then
- if Is_Record_Type (Etype (Ent)) then
- Error_Msg_N ("??records cannot be returned by Descriptor", Enod);
- return;
- end if;
- end if;
-
- -- If we fall through, all checks have passed
-
Set_Mechanism (Ent, Mech);
end Set_Mechanism_With_Checks;
@@ -314,23 +304,10 @@
when Convention_Fortran =>
- -- In OpenVMS, pass character and string types using
- -- Short_Descriptor(S)
-
- if OpenVMS_On_Target
- and then (Root_Type (Typ) = Standard_Character
- or else
- (Is_Array_Type (Typ)
- and then
- Root_Type (Component_Type (Typ)) =
- Standard_Character))
- then
- Set_Mechanism (Formal, By_Short_Descriptor_S);
-
-- Access types are passed by default (presumably this
-- will mean they are passed by copy)
- elsif Is_Access_Type (Typ) then
+ if Is_Access_Type (Typ) then
null;
-- For now, we pass all other parameters by reference.
===================================================================
@@ -87,46 +87,9 @@
-- special information) is determined by the backend in accordance with
-- requirements imposed by the ABI as interpreted for Ada.
- By_Descriptor : constant Mechanism_Type := -3;
- By_Descriptor_UBS : constant Mechanism_Type := -4;
- By_Descriptor_UBSB : constant Mechanism_Type := -5;
- By_Descriptor_UBA : constant Mechanism_Type := -6;
- By_Descriptor_S : constant Mechanism_Type := -7;
- By_Descriptor_SB : constant Mechanism_Type := -8;
- By_Descriptor_A : constant Mechanism_Type := -9;
- By_Descriptor_NCA : constant Mechanism_Type := -10;
- By_Short_Descriptor : constant Mechanism_Type := -11;
- By_Short_Descriptor_UBS : constant Mechanism_Type := -12;
- By_Short_Descriptor_UBSB : constant Mechanism_Type := -13;
- By_Short_Descriptor_UBA : constant Mechanism_Type := -14;
- By_Short_Descriptor_S : constant Mechanism_Type := -15;
- By_Short_Descriptor_SB : constant Mechanism_Type := -16;
- By_Short_Descriptor_A : constant Mechanism_Type := -17;
- By_Short_Descriptor_NCA : constant Mechanism_Type := -18;
- -- These values are used only in OpenVMS ports of GNAT. Pass by descriptor
- -- is forced, as described in the OpenVMS ABI. The suffix indicates the
- -- descriptor type:
- --
- -- UBS unaligned bit string
- -- UBSB aligned bit string with arbitrary bounds
- -- UBA unaligned bit array
- -- S string, also a scalar or access type parameter
- -- SB string with arbitrary bounds
- -- A contiguous array
- -- NCA non-contiguous array
- --
- -- Note: the form with no suffix is used if the Import/Export pragma uses
- -- the simple form of the mechanism name (no descriptor type is supplied).
- -- In this case the back end assigns a descriptor type based on the Ada
- -- type in accordance with the OpenVMS ABI.
-
- pragma Assert (Mechanism_Type'First = -18);
+ pragma Assert (Mechanism_Type'First = -2);
-- Check definition in types is right!
- subtype Descriptor_Codes is Mechanism_Type
- range By_Short_Descriptor_NCA .. By_Descriptor;
- -- Subtype including all descriptor mechanisms
-
-- All the above special values are non-positive. Positive values for
-- Mechanism_Type values have a special meaning. They are used only in
-- the case of records, as a result of the use of the C_Pass_By_Copy
===================================================================
@@ -7312,13 +7312,16 @@
Arg_Result_Mechanism : Node_Id := Empty;
Arg_First_Optional_Parameter : Node_Id := Empty)
is
+ pragma Unreferenced (Arg_First_Optional_Parameter);
+ -- We ignore the First_Optional_Parameter argument. It was only
+ -- relevant for VMS anyway, and otherwise ignored.
+
Ent : Entity_Id;
Def_Id : Entity_Id;
Hom_Id : Entity_Id;
Formal : Entity_Id;
Ambiguous : Boolean;
Match : Boolean;
- Dval : Node_Id;
function Same_Base_Type
(Ptype : Node_Id;
@@ -7699,63 +7702,6 @@
end if;
end;
end if;
-
- -- Process First_Optional_Parameter argument if present. We have
- -- already checked that this is only allowed for the Import case.
-
- if Present (Arg_First_Optional_Parameter) then
- if Nkind (Arg_First_Optional_Parameter) /= N_Identifier then
- Error_Pragma_Arg
- ("first optional parameter must be formal parameter name",
- Arg_First_Optional_Parameter);
- end if;
-
- Formal := First_Formal (Ent);
- loop
- if No (Formal) then
- Error_Pragma_Arg
- ("specified formal parameter& not found",
- Arg_First_Optional_Parameter);
- end if;
-
- exit when Chars (Formal) =
- Chars (Arg_First_Optional_Parameter);
-
- Next_Formal (Formal);
- end loop;
-
- Set_First_Optional_Parameter (Ent, Formal);
-
- -- Check specified and all remaining formals have right form
-
- while Present (Formal) loop
- if Ekind (Formal) /= E_In_Parameter then
- Error_Msg_NE
- ("optional formal& is not of mode in!",
- Arg_First_Optional_Parameter, Formal);
-
- else
- Dval := Default_Value (Formal);
-
- if No (Dval) then
- Error_Msg_NE
- ("optional formal& does not have default value!",
- Arg_First_Optional_Parameter, Formal);
-
- elsif Compile_Time_Known_Value_Or_Aggr (Dval) then
- null;
-
- else
- Error_Msg_FE
- ("default value for optional formal& is non-static!",
- Arg_First_Optional_Parameter, Formal);
- end if;
- end if;
-
- Set_Is_Optional_Parameter (Formal);
- Next_Formal (Formal);
- end loop;
- end if;
end Process_Extended_Import_Export_Subprogram_Pragma;
--------------------------
@@ -10847,10 +10793,9 @@
Check_Arg_Count (0);
-- If Address is a private type, then set the flag to allow
- -- integer address values. If Address is not private, then
- -- this pragma has no purpose, so it is simply ignored. Not
- -- clear if there are any such targets now (VMS used to be
- -- one such, but leave test in for the future anyway).
+ -- integer address values. If Address is not private, then this
+ -- pragma has no purpose, so it is simply ignored. Not clear if
+ -- there are any such targets now.
if Opt.Address_Is_Private then
Opt.Allow_Integer_Address := True;
===================================================================
@@ -225,8 +225,7 @@
-- operators, not ones that are intrinsic imports of back-end builtins.
procedure Resolve_Intrinsic_Unary_Operator (N : Node_Id; Typ : Entity_Id);
- -- Ditto, for unary operators (arithmetic ones and "not" on signed
- -- integer types for VMS).
+ -- Ditto, for arithmetic unary operators
procedure Rewrite_Operator_As_Call (N : Node_Id; Nam : Entity_Id);
-- If an operator node resolves to a call to a user-defined operator,
@@ -7990,11 +7989,10 @@
--------------------------------
procedure Resolve_Intrinsic_Operator (N : Node_Id; Typ : Entity_Id) is
- Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ));
- Op : Entity_Id;
- Orig_Op : constant Entity_Id := Entity (N);
- Arg1 : Node_Id;
- Arg2 : Node_Id;
+ Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ));
+ Op : Entity_Id;
+ Arg1 : Node_Id;
+ Arg2 : Node_Id;
function Convert_Operand (Opnd : Node_Id) return Node_Id;
-- If the operand is a literal, it cannot be the expression in a
@@ -8074,31 +8072,19 @@
or else Typ /= Etype (Right_Opnd (N))
then
-- Add explicit conversion where needed, and save interpretations in
- -- case operands are overloaded. If the context is a VMS operation,
- -- assert that the conversion is legal (the operands have the proper
- -- types to select the VMS intrinsic). Note that in rare cases the
- -- VMS operators may be visible, but the default System is being used
- -- and Address is a private type.
+ -- case operands are overloaded.
Arg1 := Convert_To (Typ, Left_Opnd (N));
Arg2 := Convert_To (Typ, Right_Opnd (N));
if Nkind (Arg1) = N_Type_Conversion then
Save_Interps (Left_Opnd (N), Expression (Arg1));
-
- if Is_VMS_Operator (Orig_Op) then
- Set_Conversion_OK (Arg1);
- end if;
else
Save_Interps (Left_Opnd (N), Arg1);
end if;
if Nkind (Arg2) = N_Type_Conversion then
Save_Interps (Right_Opnd (N), Expression (Arg2));
-
- if Is_VMS_Operator (Orig_Op) then
- Set_Conversion_OK (Arg2);
- end if;
else
Save_Interps (Right_Opnd (N), Arg2);
end if;
@@ -8170,18 +8156,13 @@
B_Typ := Base_Type (Typ);
end if;
- -- OK if this is a VMS-specific intrinsic operation
-
- if Is_VMS_Operator (Entity (N)) then
- null;
-
-- The following test is required because the operands of the operation
-- may be literals, in which case the resulting type appears to be
-- compatible with a signed integer type, when in fact it is compatible
-- only with modular types. If the context itself is universal, the
-- operation is illegal.
- elsif not Valid_Boolean_Arg (Typ) then
+ if not Valid_Boolean_Arg (Typ) then
Error_Msg_N ("invalid context for logical operation", N);
Set_Etype (N, Any_Type);
return;
@@ -8934,12 +8915,9 @@
B_Typ := Base_Type (Typ);
end if;
- if Is_VMS_Operator (Entity (N)) then
- null;
-
-- Straightforward case of incorrect arguments
- elsif not Valid_Boolean_Arg (Typ) then
+ if not Valid_Boolean_Arg (Typ) then
Error_Msg_N ("invalid operand type for operator&", N);
Set_Etype (N, Any_Type);
return;
@@ -11098,15 +11076,15 @@
if Is_Floating_Point_Type (Opnd_Typ)
and then
(Is_Integer_Type (Target_Typ)
- or else (Is_Fixed_Point_Type (Target_Typ)
- and then Conversion_OK (N)))
+ or else (Is_Fixed_Point_Type (Target_Typ)
+ and then Conversion_OK (N)))
and then Nkind (Operand) = N_Attribute_Reference
- and then (Attribute_Name (Operand) = Name_Rounding
- or else Attribute_Name (Operand) = Name_Truncation)
+ and then Nam_In (Attribute_Name (Operand), Name_Rounding,
+ Name_Truncation)
then
declare
Truncate : constant Boolean :=
- Attribute_Name (Operand) = Name_Truncation;
+ Attribute_Name (Operand) = Name_Truncation;
begin
Rewrite (Operand,
Relocate_Node (First (Expressions (Operand))));
@@ -11515,13 +11493,6 @@
-- this context, but which cannot be removed by type checking,
-- because the context does not impose a type.
- -- When compiling for VMS, spurious ambiguities can be produced
- -- when arithmetic operations have a literal operand and return
- -- System.Address or a descendant of it. These ambiguities are
- -- otherwise resolved by the context, but for conversions there
- -- is no context type and the removal of the spurious operations
- -- must be done explicitly here.
-
-- The node may be labelled overloaded, but still contain only one
-- interpretation because others were discarded earlier. If this
-- is the case, retain the single interpretation if legal.
===================================================================
@@ -6022,8 +6022,7 @@
-- be a static subtype, since otherwise it would have
-- been diagnosed as illegal.
- elsif Is_Entity_Name (Choice) and then
- Is_Type (Entity (Choice))
+ elsif Is_Entity_Name (Choice) and then Is_Type (Entity (Choice))
then
exit Search when Is_In_Range (Expr, Etype (Choice),
Assume_Valid => False);
@@ -11798,25 +11797,6 @@
return False;
end Is_Variable_Size_Record;
- ---------------------
- -- Is_VMS_Operator --
- ---------------------
-
- function Is_VMS_Operator (Op : Entity_Id) return Boolean is
- begin
- -- The VMS operators are declared in a child of System that is loaded
- -- through pragma Extend_System. In some rare cases a program is run
- -- with this extension but without indicating that the target is VMS.
-
- return Ekind (Op) = E_Function
- and then Is_Intrinsic_Subprogram (Op)
- and then
- ((Present_System_Aux and then Scope (Op) = System_Aux_Id)
- or else
- (True_VMS_Target
- and then Scope (Scope (Op)) = RTU_Entity (System)));
- end Is_VMS_Operator;
-
-----------------
-- Is_Variable --
-----------------
===================================================================
@@ -1359,10 +1359,6 @@
function Is_Variable_Size_Record (E : Entity_Id) return Boolean;
-- Returns true if E has variable size components
- function Is_VMS_Operator (Op : Entity_Id) return Boolean;
- -- Determine whether an operator is one of the intrinsics defined
- -- in the DEC system extension.
-
function Is_Variable
(N : Node_Id;
Use_Original_Node : Boolean := True) return Boolean;
===================================================================
@@ -2488,15 +2488,6 @@
return List3 (N);
end Parameter_Associations;
- function Parameter_List_Truncated
- (N : Node_Id) return Boolean is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Function_Call
- or else NT (N).Nkind = N_Procedure_Call_Statement);
- return Flag17 (N);
- end Parameter_List_Truncated;
-
function Parameter_Specifications
(N : Node_Id) return List_Id is
begin
@@ -5695,15 +5686,6 @@
Set_List3_With_Parent (N, Val);
end Set_Parameter_Associations;
- procedure Set_Parameter_List_Truncated
- (N : Node_Id; Val : Boolean := True) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Function_Call
- or else NT (N).Nkind = N_Procedure_Call_Statement);
- Set_Flag17 (N, Val);
- end Set_Parameter_List_Truncated;
-
procedure Set_Parameter_Specifications
(N : Node_Id; Val : List_Id) is
begin
===================================================================
@@ -1888,21 +1888,6 @@
-- list of discrete choices, except that of course it cannot contain an
-- N_Others_Choice entry.
- -- Parameter_List_Truncated (Flag17-Sem)
- -- Present in N_Function_Call and N_Procedure_Call_Statement nodes. Set
- -- (for OpenVMS ports of GNAT only) if the parameter list is truncated
- -- as a result of a First_Optional_Parameter specification in one of the
- -- pragmas Import_Function, Import_Procedure, or Import_Valued_Procedure.
- -- The truncation is done by the expander by removing trailing parameters
- -- from the argument list, in accordance with the set of rules allowing
- -- such parameter removal. In particular, parameters can be removed
- -- working from the end of the parameter list backwards up to and
- -- including the entry designated by First_Optional_Parameter in the
- -- Import pragma. Parameters can be removed if they are implicit and the
- -- default value is known at compile time value, including the use of
- -- the Null_Parameter attribute, or if explicit parameter values are
- -- present that match the corresponding defaults.
-
-- Parent_Spec (Node4-Sem)
-- For a library unit that is a child unit spec (package or subprogram
-- declaration, generic declaration or instantiation, or library level
@@ -5156,7 +5141,6 @@
-- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
-- Do_Tag_Check (Flag13-Sem)
-- No_Elaboration_Check (Flag14-Sem)
- -- Parameter_List_Truncated (Flag17-Sem)
-- ABE_Is_Certain (Flag18-Sem)
-- plus fields for expression
@@ -5188,7 +5172,6 @@
-- Is_Expanded_Build_In_Place_Call (Flag11-Sem)
-- Do_Tag_Check (Flag13-Sem)
-- No_Elaboration_Check (Flag14-Sem)
- -- Parameter_List_Truncated (Flag17-Sem)
-- ABE_Is_Certain (Flag18-Sem)
-- plus fields for expression
@@ -9433,9 +9416,6 @@
function Parameter_Associations
(N : Node_Id) return List_Id; -- List3
- function Parameter_List_Truncated
- (N : Node_Id) return Boolean; -- Flag17
-
function Parameter_Specifications
(N : Node_Id) return List_Id; -- List3
@@ -10456,9 +10436,6 @@
procedure Set_Parameter_Associations
(N : Node_Id; Val : List_Id); -- List3
- procedure Set_Parameter_List_Truncated
- (N : Node_Id; Val : Boolean := True); -- Flag17
-
procedure Set_Parameter_Specifications
(N : Node_Id; Val : List_Id); -- List3
@@ -12719,7 +12696,6 @@
pragma Inline (Out_Present);
pragma Inline (Parameter_Associations);
pragma Inline (Parameter_Specifications);
- pragma Inline (Parameter_List_Truncated);
pragma Inline (Parameter_Type);
pragma Inline (Parent_Spec);
pragma Inline (Position);
@@ -13055,7 +13031,6 @@
pragma Inline (Set_Others_Discrete_Choices);
pragma Inline (Set_Out_Present);
pragma Inline (Set_Parameter_Associations);
- pragma Inline (Set_Parameter_List_Truncated);
pragma Inline (Set_Parameter_Specifications);
pragma Inline (Set_Parameter_Type);
pragma Inline (Set_Parent_Spec);
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, 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- --
@@ -92,8 +92,8 @@
Len := Integer (File_Length (Source_File_FD));
- -- Set Hi so that length is one more than the physical length,
- -- allowing for the extra EOF character at the end of the buffer
+ -- Set Hi so that length is one more than the physical length, allowing
+ -- for the extra EOF character at the end of the buffer
Hi := Lo + Source_Ptr (Len);
@@ -112,9 +112,9 @@
begin
-- Allocate source buffer, allowing extra character at end for EOF
- -- Some systems (e.g. VMS) have file types that require one
- -- read per line, so read until we get the Len bytes or until
- -- there are no more characters.
+ -- Some systems have file types that require one read per line,
+ -- so read until we get the Len bytes or until there are no more
+ -- characters.
Hi := Lo;
loop
@@ -126,8 +126,8 @@
Actual_Ptr (Hi) := EOF;
-- Now we need to work out the proper virtual origin pointer to
- -- return. This is exactly Actual_Ptr (0)'Address, but we have
- -- to be careful to suppress checks to compute this address.
+ -- return. This is exactly Actual_Ptr (0)'Address, but we have to
+ -- be careful to suppress checks to compute this address.
declare
pragma Suppress (All_Checks);
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 2003-2014, 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- --
@@ -91,10 +91,9 @@
package Processing is
- -- This package, containing a single visible procedure Process, exists so
- -- that it can be a subunits, for some platforms (such as VMS Alpha and
- -- IA64), the body of package Symbols is common, while the subunit
- -- Processing is not.
+ -- This package, containing a single visible procedure Process, exists
+ -- so that it can be a subunits, for some platforms, the body of package
+ -- Symbols is common, while the subunit Processing is not.
procedure Process
(Object_File : String;
===================================================================
@@ -716,13 +716,6 @@
end if;
end loop Line_Loop;
- -- Now that OpenVMS_On_Target has been given its definitive value,
- -- change the multi-unit index character from '~' to '$' for OpenVMS.
-
- if OpenVMS_On_Target then
- Multi_Unit_Index_Character := '$';
- end if;
-
if Fatal then
raise Unrecoverable_Error;
end if;
===================================================================
@@ -603,49 +603,18 @@
begin
case M is
- when Default_Mechanism
- => Write_Str ("Default");
- when By_Copy
- => Write_Str ("By_Copy");
- when By_Reference
- => Write_Str ("By_Reference");
- when By_Descriptor
- => Write_Str ("By_Descriptor");
- when By_Descriptor_UBS
- => Write_Str ("By_Descriptor_UBS");
- when By_Descriptor_UBSB
- => Write_Str ("By_Descriptor_UBSB");
- when By_Descriptor_UBA
- => Write_Str ("By_Descriptor_UBA");
- when By_Descriptor_S
- => Write_Str ("By_Descriptor_S");
- when By_Descriptor_SB
- => Write_Str ("By_Descriptor_SB");
- when By_Descriptor_A
- => Write_Str ("By_Descriptor_A");
- when By_Descriptor_NCA
- => Write_Str ("By_Descriptor_NCA");
- when By_Short_Descriptor
- => Write_Str ("By_Short_Descriptor");
- when By_Short_Descriptor_UBS
- => Write_Str ("By_Short_Descriptor_UBS");
- when By_Short_Descriptor_UBSB
- => Write_Str ("By_Short_Descriptor_UBSB");
- when By_Short_Descriptor_UBA
- => Write_Str ("By_Short_Descriptor_UBA");
- when By_Short_Descriptor_S
- => Write_Str ("By_Short_Descriptor_S");
- when By_Short_Descriptor_SB
- => Write_Str ("By_Short_Descriptor_SB");
- when By_Short_Descriptor_A
- => Write_Str ("By_Short_Descriptor_A");
- when By_Short_Descriptor_NCA
- => Write_Str ("By_Short_Descriptor_NCA");
+ when Default_Mechanism =>
+ Write_Str ("Default");
+ when By_Copy =>
+ Write_Str ("By_Copy");
+
+ when By_Reference =>
+ Write_Str ("By_Reference");
+
when 1 .. Mechanism_Type'Last =>
Write_Str ("By_Copy if size <= ");
Write_Int (Int (M));
-
end case;
end;
===================================================================
@@ -795,11 +795,11 @@
-- mechanism. See specification of Sem_Mech for full details. The following
-- subtype is used to represent values of this type:
- subtype Mechanism_Type is Int range -18 .. Int'Last;
+ subtype Mechanism_Type is Int range -2 .. Int'Last;
-- Type used to represent a mechanism value. This is a subtype rather than
-- a type to avoid some annoying processing problems with certain routines
-- in Einfo (processing them to create the corresponding C). The values in
- -- the range -18 .. 0 are used to represent mechanism types declared as
+ -- the range -2 .. 0 are used to represent mechanism types declared as
-- named constants in the spec of Sem_Mech. Positive values are used for
-- the case of a pragma C_Pass_By_Copy that sets a threshold value for the
-- mechanism to be used. For example if pragma C_Pass_By_Copy (32) is given
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -25,7 +25,6 @@
with Types; use Types;
with Osint;
-with Hostparm;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
@@ -1136,17 +1135,6 @@
Buffer (Read_Ptr) := EOF;
Contents := new String'(Buffer (1 .. Read_Ptr));
-
- -- Things are not simple on VMS due to the plethora of file types
- -- and organizations. It seems clear that there shouldn't be more
- -- bytes read than are contained in the file though.
-
- if (Hostparm.OpenVMS and then Read_Ptr > Length + 1)
- or else (not Hostparm.OpenVMS and then Read_Ptr /= Length + 1)
- then
- raise Ada.Text_IO.End_Error;
- end if;
-
Close (FD);
end;
end Read_File;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1998-2014, 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- --
@@ -288,9 +288,7 @@
-- character will be added to the returned Contents to simplify parsing.
-- Name_Error is raised if the file was not found. End_Error is raised if
-- the file could not be read correctly. For most systems correct reading
- -- means that the number of bytes read is equal to the file size. The
- -- exception is OpenVMS where correct reading means that the number of
- -- bytes read is less than or equal to the file size.
+ -- means that the number of bytes read is equal to the file size.
private
type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record