From: Vincent Celier Date: Tue, 31 Oct 2006 17:57:54 +0000 (+0100) Subject: krunch.ads, krunch.adb (Krunch): New Boolean parameter VMS_On_Target. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ac3b962ec3965793916eea80eab7f5dd42aa7570;p=gcc.git krunch.ads, krunch.adb (Krunch): New Boolean parameter VMS_On_Target. 2006-10-31 Vincent Celier * krunch.ads, krunch.adb (Krunch): New Boolean parameter VMS_On_Target. When True, apply VMS treatment to children of packages A, G, I and S. For F320-016 * fname-uf.adb (Get_File_Name): Call Krunch with OpenVMS_On_Target From-SVN: r118270 --- diff --git a/gcc/ada/fname-uf.adb b/gcc/ada/fname-uf.adb index 35f2bd6ba61..0ec94050b71 100644 --- a/gcc/ada/fname-uf.adb +++ b/gcc/ada/fname-uf.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,6 +32,7 @@ with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Table; +with Targparm; use Targparm; with Uname; use Uname; with Widechar; use Widechar; @@ -412,7 +413,8 @@ package body Fname.UF is (Name_Buffer, Name_Len, Integer (Maximum_File_Name_Length), - Debug_Flag_4); + Debug_Flag_4, + OpenVMS_On_Target); -- Replace extension diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb index 53d6285f410..f15a7a6bdda 100644 --- a/gcc/ada/krunch.adb +++ b/gcc/ada/krunch.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -34,12 +34,16 @@ with Hostparm; procedure Krunch - (Buffer : in out String; - Len : in out Natural; - Maxlen : Natural; - No_Predef : Boolean) + (Buffer : in out String; + Len : in out Natural; + Maxlen : Natural; + No_Predef : Boolean; + VMS_On_Target : Boolean := False) is + pragma Assert (Buffer'First = 1); + -- This is a documented requirement; the assert turns off index warnings + B1 : Character renames Buffer (1); Curlen : Natural; Krlen : Natural; @@ -119,20 +123,35 @@ begin -- 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, so a dollar_sign is used instead. + -- in a file name, two consecutive underlines ("__") are used instead. 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 Hostparm.OpenVMS then - Buffer (2) := '$'; + -- When VMS is the host, it is always also the target. + + if Hostparm.OpenVMS or else VMS_On_Target then + Len := Len + 1; + Buffer (4 .. Len) := Buffer (3 .. Len - 1); + Buffer (2) := '_'; + Buffer (3) := '_'; else Buffer (2) := '~'; end if; - 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 diff --git a/gcc/ada/krunch.ads b/gcc/ada/krunch.ads index f5dbdb9a876..33f9908467f 100644 --- a/gcc/ada/krunch.ads +++ b/gcc/ada/krunch.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -120,10 +120,11 @@ -- unique in the standard predefined libraries. procedure Krunch - (Buffer : in out String; - Len : in out Natural; - Maxlen : Natural; - No_Predef : Boolean); + (Buffer : in out String; + Len : in out Natural; + Maxlen : Natural; + No_Predef : Boolean; + VMS_On_Target : Boolean := False); 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 @@ -132,6 +133,8 @@ pragma Elaborate_Body (Krunch); -- 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. +-- VMS_On_Target, when True, indicates to Krunch to apply the VMS treatment +-- to the children of package A, G,I or S. -- -- 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).