|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 25600 (0x6400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Vstring_Query, seg_005841
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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.
------------------------------------------------------------------------------
--\x0c
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;
--\x0c
procedure Empty_Vstring (Vstr : Vstring) is
----Sets the Vstring to be Empty; the null string.
begin
Vstr.Length := 0;
end Empty_Vstring;
--\x0c
function Length (Vstr : Vstring_Data) return S_Natural is
----Called to obtain the current length of the string.
begin
return Vstr.Length;
end Length;
--\x0c
function Length (Vstr : Vstring) return S_Natural is
----Called to obtain the current length of the string.
begin
return Vstr.Length;
end Length;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
-\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
end Vstring_Query;
nblk1=18
nid=0
hdr6=30
[0x00] rec0=16 rec1=00 rec2=01 rec3=04a
[0x01] rec0=1d rec1=00 rec2=02 rec3=028
[0x02] rec0=21 rec1=00 rec2=03 rec3=020
[0x03] rec0=24 rec1=00 rec2=04 rec3=030
[0x04] rec0=21 rec1=00 rec2=05 rec3=004
[0x05] rec0=00 rec1=00 rec2=18 rec3=056
[0x06] rec0=20 rec1=00 rec2=06 rec3=00e
[0x07] rec0=01 rec1=00 rec2=17 rec3=01e
[0x08] rec0=1f rec1=00 rec2=07 rec3=008
[0x09] rec0=00 rec1=00 rec2=16 rec3=00e
[0x0a] rec0=1f rec1=00 rec2=08 rec3=01c
[0x0b] rec0=15 rec1=00 rec2=09 rec3=01a
[0x0c] rec0=02 rec1=00 rec2=15 rec3=002
[0x0d] rec0=15 rec1=00 rec2=0a rec3=00e
[0x0e] rec0=00 rec1=00 rec2=14 rec3=008
[0x0f] rec0=1e rec1=00 rec2=0b rec3=016
[0x10] rec0=00 rec1=00 rec2=13 rec3=01a
[0x11] rec0=1e rec1=00 rec2=0c rec3=042
[0x12] rec0=1c rec1=00 rec2=0d rec3=00a
[0x13] rec0=00 rec1=00 rec2=12 rec3=008
[0x14] rec0=1f rec1=00 rec2=0e rec3=042
[0x15] rec0=00 rec1=00 rec2=11 rec3=022
[0x16] rec0=22 rec1=00 rec2=0f rec3=012
[0x17] rec0=0d rec1=00 rec2=10 rec3=000
tail 0x21500afd081978f1edda9 0x42a00088462063203