|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 14771 (0x39b3)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦591c5b094⟧
└─⟦this⟧
with Vstring_Type;
use Vstring_Type;
package body Vstring_Query is
------------------------------------------------------------------------------
-- VString Query and SubString Functions
------------------------------------------------------------------------------
-- Copyright 1988 - 1991 by Rational, Santa Clara, California.
--
-- All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------
--\f
procedure Empty_Vstring (Vstr : in out Vstring_Data) is
----Sets the Vstring to be Empty; the null string.
begin
Vstr.Length := 0;
end Empty_Vstring;
--\f
procedure Empty_Vstring (Vstr : Vstring) is
----Sets the Vstring to be Empty; the null string.
begin
Vstr.Length := 0;
end Empty_Vstring;
--\f
function Length (Vstr : Vstring_Data) return S_Natural is
----Called to obtain the current length of the string.
begin
return Vstr.Length;
end Length;
--\f
function Length (Vstr : Vstring) return S_Natural is
----Called to obtain the current length of the string.
begin
return Vstr.Length;
end Length;
--\f
function Maximum_Length (Vstr : Vstring_Data) return S_Natural is
----Called to obtain the maximum number of characters a string may hold.
begin
return Vstr.Maximum_Length;
end Maximum_Length;
--\f
function Maximum_Length (Vstr : Vstring) return S_Natural is
----Called to obtain the maximum number of characters a string may hold.
begin
return Vstr.Maximum_Length;
end Maximum_Length;
--\f
function Length_Left (Vstr : Vstring_Data) return S_Natural is
----Called to obtain the amount of room remaining in a string.
begin
return Vstr.Maximum_Length - Vstr.Length;
end Length_Left;
--\f
function Length_Left (Vstr : Vstring) return S_Natural is
----Called to obtain the amount of room remaining in a string.
begin
return Vstr.Maximum_Length - Vstr.Length;
end Length_Left;
--\f
function Char_At (Vstr : Vstring_Data; Pos : S_Positive) return Character is
----Called to return character Pos in the string. Returns Ascii.Nul if
-- the character is not present.
begin
if Pos > Vstr.Length then
return Ascii.Nul;
end if;
return Vstr.Chars (Pos);
end Char_At;
--\f
function Char_At (Vstr : Vstring; Pos : S_Positive) return Character is
----Called to return character Pos in the string. Returns Ascii.Nul if
-- the character is not present.
begin
if Pos > Vstr.Length then
return Ascii.Nul;
end if;
return Vstr.Chars (Pos);
end Char_At;
--\f
function First (Vstr : Vstring_Data) return Character is
----Returns the first character in the Vstring; returns Ascii.Nul if the
-- string is empty.
begin
if Vstr.Length > 0 then
return Vstr.Chars (1);
else
return Ascii.Nul;
end if;
end First;
--\f
function First (Vstr : Vstring) return Character is
----Returns the first character in the Vstring; returns Ascii.Nul if the
-- string is empty.
begin
if Vstr.Length > 0 then
return Vstr.Chars (1);
else
return Ascii.Nul;
end if;
end First;
--\f
procedure Lop_First (Vstr : in out Vstring_Data; Char : out Character) is
----Just like First except that the character is removed from the Vstring.
begin
if Vstr.Length = 0 then
Char := Ascii.Nul;
return;
end if;
Char := Vstr.Chars (1);
Vstr.Length := Vstr.Length - 1;
Vstr.Chars (1 .. Vstr.Length) := Vstr.Chars (2 .. Vstr.Length + 1);
end Lop_First;
--\f
function Lop_First (Vstr : Vstring) return Character is
----Just like First except that the character is removed from the Vstring.
Char : Character;
begin
if Vstr.Length = 0 then
return Ascii.Nul;
end if;
Char := Vstr.Chars (1);
Vstr.Length := Vstr.Length - 1;
Vstr.Chars (1 .. Vstr.Length) := Vstr.Chars (2 .. Vstr.Length + 1);
return Char;
end Lop_First;
--\f
function Last (Vstr : Vstring_Data) return Character is
----Returns the last character in the Vstring; returns Ascii.Nul if the
-- string is empty.
begin
if Vstr.Length > 0 then
return Vstr.Chars (Vstr.Length);
else
return Ascii.Nul;
end if;
end Last;
--\f
function Last (Vstr : Vstring) return Character is
----Returns the last character in the Vstring; returns Ascii.Nul if the
-- string is empty.
begin
if Vstr.Length > 0 then
return Vstr.Chars (Vstr.Length);
else
return Ascii.Nul;
end if;
end Last;
--\f
procedure Lop_Last (Vstr : in out Vstring_Data; Char : out Character) is
----Just like Last except that the character is removed from the Vstring.
begin
if Vstr.Length = 0 then
Char := Ascii.Nul;
return;
end if;
Char := Vstr.Chars (Vstr.Length);
Vstr.Length := Vstr.Length - 1;
end Lop_Last;
--\f
function Lop_Last (Vstr : Vstring) return Character is
----Just like Last except that the character is removed from the Vstring.
begin
if Vstr.Length = 0 then
return Ascii.Nul;
end if;
Vstr.Length := Vstr.Length - 1;
return Vstr.Chars (Vstr.Length + 1);
end Lop_Last;
--\f
function Substring_To (Vstr : Vstring_Data;
Pos : S_Positive;
To : S_Positive) return E_String is
----Called to obtain the substring of a Vstring which is contained in
-- Vstr.Chars(Pos..To). If To > Vstr.Length then we return
-- Vstr.Chars(Pos..Vstr.Length). If Pos > Vstr.Length then we return
-- the null string.
begin
if To > Vstr.Length then
return Vstr.Chars (Pos .. Vstr.Length);
end if;
return Vstr.Chars (Pos .. To);
end Substring_To;
--\f
function Substring_To (Vstr : Vstring;
Pos : S_Positive;
To : S_Positive) return E_String is
----Called to obtain the substring of a Vstring which is contained in
-- Vstr.Chars(Pos..To). If To > Vstr.Length then we return
-- Vstr.Chars(Pos..Vstr.Length). If Pos > Vstr.Length then we return
-- the null string.
begin
if To > Vstr.Length then
return Vstr.Chars (Pos .. Vstr.Length);
end if;
return Vstr.Chars (Pos .. To);
end Substring_To;
--\f
procedure Truncstring_To (Vstr : in out Vstring_Data;
Pos : S_Positive;
To : S_Positive) is
----Called to truncate a string down to the substring contained in
-- Vstr.Chars(Pos..To). If To > Vstr.Length then we truncate it to
-- Vstr.Chars(Pos..Vstr.Length). If Pos > Vstr.Length then the string
-- is set to the null string.
Pos2 : S_Natural := To;
Length : S_Natural := To - Pos + 1;
begin
if Pos2 > Vstr.Length then -- Watch for index overflow
Pos2 := Vstr.Length; -- New 2nd index
Length := Vstr.Length - Pos + 1; -- New result length
end if;
if Pos = 1 then -- Simple case; no data motion
Vstr.Length := Length; -- Just set length and return
return;
end if;
Vstr.Chars (1 .. Length) := Vstr.Chars (Pos .. Pos2);
Vstr.Length := Length;
end Truncstring_To;
--\f
procedure Truncstring_To (Vstr : Vstring;
Pos : S_Positive;
To : S_Positive) is
----Called to truncate a string down to the substring contained in
-- Vstr.Chars(Pos..To). If To > Vstr.Length then we truncate it to
-- Vstr.Chars(Pos..Vstr.Length). If Pos > Vstr.Length then the string
-- is set to the null string.
Pos2 : S_Natural := To;
Length : S_Natural := To - Pos + 1;
begin
if Pos2 > Vstr.Length then -- Watch for index overflow
Pos2 := Vstr.Length; -- New 2nd index
Length := Vstr.Length - Pos + 1; -- New result length
end if;
if Pos = 1 then -- Simple case; no data motion
Vstr.Length := Length; -- Just set length and return
return;
end if;
Vstr.Chars (1 .. Length) := Vstr.Chars (Pos .. Pos2);
Vstr.Length := Length;
end Truncstring_To;
--\f
function Substring_For (Vstr : Vstring_Data;
Pos : S_Positive;
Cnt : S_Positive) return E_String is
----Called to obtain the substring of a Vstring which is contained in
-- Vstr.Chars(Pos..Pos+Cnt-1). If Pos+Cnt-1 > Vstr.Length then we return
-- Vstr.Chars(Pos..Vstr.Length). If Pos > Vstr.Length then we return
-- the null string.
Pos2 : S_Natural;
begin
----Since Pos+Cnt-1 can be > S_Natural'Last we check this way first.
if Cnt >= Vstr.Length then
return Vstr.Chars (Pos .. Vstr.Length);
end if;
----Now check to see if the For reaches past end-of-string.
Pos2 := Pos + Cnt - 1;
if Pos2 >= Vstr.Length then -- Watch for index overflow
return Vstr.Chars (Pos .. Vstr.Length);
end if;
----Return proper substring
return Vstr.Chars (Pos .. Pos2);
end Substring_For;
--\f
function Substring_For (Vstr : Vstring;
Pos : S_Positive;
Cnt : S_Positive) return E_String is
----Called to obtain the substring of a Vstring which is contained in
-- Vstr.Chars(Pos..Pos+Cnt-1). If Pos+Cnt-1 > Vstr.Length then we return
-- Vstr.Chars(Pos..Vstr.Length). If Pos > Vstr.Length then we return
-- the null string.
Pos2 : S_Natural;
begin
----Since Pos+Cnt-1 can be > S_Natural'Last we check this way first.
if Cnt >= Vstr.Length then
return Vstr.Chars (Pos .. Vstr.Length);
end if;
----Now check to see if the For reaches past end-of-string.
Pos2 := Pos + Cnt - 1;
if Pos2 >= Vstr.Length then -- Watch for index overflow
return Vstr.Chars (Pos .. Vstr.Length);
end if;
----Return proper substring
return Vstr.Chars (Pos .. Pos2);
end Substring_For;
--\f
procedure Truncstring_For (Vstr : in out Vstring_Data;
Pos : S_Positive;
Cnt : S_Positive) is
----Called to truncate a string down to the substring contained in
-- Vstr.Chars(Pos..Pos+Cnt-1). If Pos+Cnt-1 > Vstr.Length then we truncate it to
-- Vstr.Chars(Pos..Vstr.Length). If Pos > Vstr.Length then the string
-- is set to the null string.
Pos2 : S_Natural;
Length : S_Natural := Cnt;
begin
----Since Pos+Cnt-1 can be > S_Natural'Last we check this way first.
if Cnt >= Vstr.Length then
Pos2 := Vstr.Length;
Length := Vstr.Length - Pos + 1;
else
----Now check the other way since we know overflow cannot occur (on any machine
-- with less than 2**32 virtual bytes/words of memory).
Pos2 := Pos + Cnt - 1;
if Pos2 >= Vstr.Length then
Pos2 := Vstr.Length;
Length := Vstr.Length - Pos + 1;
end if;
end if;
----Watch for the simple no-data-motion case.
if Pos = 1 then
Vstr.Length := Length;
return;
end if;
----Move the data and set the length.
Vstr.Chars (1 .. Length) := Vstr.Chars (Pos .. Pos2);
Vstr.Length := Length;
end Truncstring_For;
--\f
procedure Truncstring_For (Vstr : Vstring;
Pos : S_Positive;
Cnt : S_Positive) is
----Called to truncate a string down to the substring contained in
-- Vstr.Chars(Pos..Pos+Cnt-1). If Pos+Cnt-1 > Vstr.Length then we truncate it to
-- Vstr.Chars(Pos..Vstr.Length). If Pos > Vstr.Length then the string
-- is set to the null string.
Pos2 : S_Natural;
Length : S_Natural := Cnt;
begin
----Since Pos+Cnt-1 can be > S_Natural'Last we check this way first.
if Cnt >= Vstr.Length then
Pos2 := Vstr.Length;
Length := Vstr.Length - Pos + 1;
else
----Now check the other way since we know overflow cannot occur (on any machine
-- with less than 2**32 virtual bytes/words of memory).
Pos2 := Pos + Cnt - 1;
if Pos2 >= Vstr.Length then
Pos2 := Vstr.Length;
Length := Vstr.Length - Pos + 1;
end if;
end if;
----Watch for the simple no-data-motion case.
if Pos = 1 then
Vstr.Length := Length;
return;
end if;
----Move the data and set the length.
Vstr.Chars (1 .. Length) := Vstr.Chars (Pos .. Pos2);
Vstr.Length := Length;
end Truncstring_For;
--\f
function To_String (Vstr : Vstring_Data) return E_String is
----Called to obtain the full string contained in a Vstring.
begin
return Vstr.Chars (1 .. Vstr.Length);
end To_String;
--\f
function To_String (Vstr : Vstring) return E_String is
----Called to obtain the full string contained in a Vstring.
begin
return Vstr.Chars (1 .. Vstr.Length);
end To_String;
--\f
end Vstring_Query;