diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/krunch.adb')
| -rw-r--r-- | gcc-4.8/gcc/ada/krunch.adb | 265 |
1 files changed, 0 insertions, 265 deletions
diff --git a/gcc-4.8/gcc/ada/krunch.adb b/gcc-4.8/gcc/ada/krunch.adb deleted file mode 100644 index f2bbf05dc..000000000 --- a/gcc-4.8/gcc/ada/krunch.adb +++ /dev/null @@ -1,265 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- K R U N C H -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2009, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Hostparm; - -procedure Krunch - (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; - Num_Seps : Natural; - Startloc : Natural; - J : Natural; - -begin - -- Deal with special predefined children cases. Startloc is the first - -- location for the krunch, set to 1, except for the predefined children - -- case, where it is set to 3, to start after the standard prefix. - - if No_Predef then - Startloc := 1; - Curlen := Len; - Krlen := Maxlen; - - elsif Len >= 18 - and then Buffer (1 .. 17) = "ada-wide_text_io-" - then - Startloc := 3; - Buffer (2 .. 5) := "-wt-"; - Buffer (6 .. Len - 12) := Buffer (18 .. Len); - Curlen := Len - 12; - Krlen := 8; - - elsif Len >= 23 - and then Buffer (1 .. 22) = "ada-wide_wide_text_io-" - then - Startloc := 3; - Buffer (2 .. 5) := "-zt-"; - Buffer (6 .. Len - 17) := Buffer (23 .. Len); - Curlen := Len - 17; - Krlen := 8; - - elsif Len >= 4 and then Buffer (1 .. 4) = "ada-" then - Startloc := 3; - Buffer (2 .. Len - 2) := Buffer (4 .. Len); - Curlen := Len - 2; - Krlen := 8; - - elsif Len >= 5 and then Buffer (1 .. 5) = "gnat-" then - Startloc := 3; - Buffer (2 .. Len - 3) := Buffer (5 .. Len); - Curlen := Len - 3; - Krlen := 8; - - elsif Len >= 7 and then Buffer (1 .. 7) = "system-" then - Startloc := 3; - Buffer (2 .. Len - 5) := Buffer (7 .. Len); - Curlen := Len - 5; - Krlen := 8; - - elsif Len >= 11 and then Buffer (1 .. 11) = "interfaces-" then - Startloc := 3; - Buffer (2 .. Len - 9) := Buffer (11 .. Len); - Curlen := Len - 9; - Krlen := 8; - - -- For the renamings in the obsolescent section, we also force krunching - -- to 8 characters, but no other special processing is required here. - -- Note that text_io and calendar are already short enough anyway. - - elsif (Len = 9 and then Buffer (1 .. 9) = "direct_io") - or else (Len = 10 and then Buffer (1 .. 10) = "interfaces") - or else (Len = 13 and then Buffer (1 .. 13) = "io_exceptions") - or else (Len = 12 and then Buffer (1 .. 12) = "machine_code") - or else (Len = 13 and then Buffer (1 .. 13) = "sequential_io") - or else (Len = 20 and then Buffer (1 .. 20) = "unchecked_conversion") - or else (Len = 22 and then Buffer (1 .. 22) = "unchecked_deallocation") - then - Startloc := 1; - Krlen := 8; - Curlen := Len; - - -- 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. - - 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 - -- 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; - - 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 - Startloc := 1; - Curlen := Len; - Krlen := Maxlen; - end if; - - -- Immediate return if file name is short enough now - - if Curlen <= Krlen then - Len := Curlen; - return; - end if; - - -- If string contains Wide_Wide, replace by a single z - - J := Startloc; - while J <= Curlen - 8 loop - if Buffer (J .. J + 8) = "wide_wide" - and then (J = Startloc - or else Buffer (J - 1) = '-' - or else Buffer (J - 1) = '_') - and then (J + 8 = Curlen - or else Buffer (J + 9) = '-' - or else Buffer (J + 9) = '_') - then - Buffer (J) := 'z'; - Buffer (J + 1 .. Curlen - 8) := Buffer (J + 9 .. Curlen); - Curlen := Curlen - 8; - end if; - - J := J + 1; - end loop; - - -- For now, refuse to krunch a name that contains an ESC character (wide - -- character sequence) since it's too much trouble to do this right ??? - - for J in 1 .. Curlen loop - if Buffer (J) = ASCII.ESC then - return; - end if; - end loop; - - -- Count number of separators (minus signs and underscores) and for now - -- replace them by spaces. We keep them around till the end to control - -- the krunching process, and then we eliminate them as the last step - - Num_Seps := 0; - for J in Startloc .. Curlen loop - if Buffer (J) = '-' or else Buffer (J) = '_' then - Buffer (J) := ' '; - Num_Seps := Num_Seps + 1; - end if; - end loop; - - -- Now we do the one character at a time krunch till we are short enough - - while Curlen - Num_Seps > Krlen loop - declare - Long_Length : Natural := 0; - Long_Last : Natural := 0; - Piece_Start : Natural; - Ptr : Natural; - - begin - Ptr := Startloc; - - -- Loop through pieces to find longest piece - - while Ptr <= Curlen loop - Piece_Start := Ptr; - - -- Loop through characters in one piece of name - - while Ptr <= Curlen and then Buffer (Ptr) /= ' ' loop - Ptr := Ptr + 1; - end loop; - - if Ptr - Piece_Start > Long_Length then - Long_Length := Ptr - Piece_Start; - Long_Last := Ptr - 1; - end if; - - Ptr := Ptr + 1; - end loop; - - -- Remove last character of longest piece - - if Long_Last < Curlen then - Buffer (Long_Last .. Curlen - 1) := - Buffer (Long_Last + 1 .. Curlen); - end if; - - Curlen := Curlen - 1; - end; - end loop; - - -- Final step, remove the spaces - - Len := 0; - - for J in 1 .. Curlen loop - if Buffer (J) /= ' ' then - Len := Len + 1; - Buffer (Len) := Buffer (J); - end if; - end loop; - - return; - -end Krunch; |