diff options
author | Vincent Celier <celier@adacore.com> | 2006-10-31 18:57:54 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2006-10-31 18:57:54 +0100 |
commit | ac3b962ec3965793916eea80eab7f5dd42aa7570 (patch) | |
tree | d63b2085a31b18783fe0829d72ad65bbe59dc4ff /gcc/ada/krunch.adb | |
parent | 05350ac648924d81ebd552d045da2dfe71b72e24 (diff) | |
download | gcc-ac3b962ec3965793916eea80eab7f5dd42aa7570.zip gcc-ac3b962ec3965793916eea80eab7f5dd42aa7570.tar.gz gcc-ac3b962ec3965793916eea80eab7f5dd42aa7570.tar.bz2 |
krunch.ads, krunch.adb (Krunch): New Boolean parameter VMS_On_Target.
2006-10-31 Vincent Celier <celier@adacore.com>
* 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
Diffstat (limited to 'gcc/ada/krunch.adb')
-rw-r--r-- | gcc/ada/krunch.adb | 37 |
1 files changed, 28 insertions, 9 deletions
diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb index 53d6285..f15a7a6 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 |