|
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 - download
Length: 7168 (0x1c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Strings, seg_05099a
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-- This package defines types and routines for manipulating
-- varying-length Ada strings. Similar to A_strings.
-- SFZ\x0910/26/91
with A_Strings;
package body Strings is
pragma Suppress (Length_Check);
pragma Suppress (Range_Check);
pragma Suppress (Index_Check);
function Insert (S : String; Into : String; At_Char : Natural)
return String is
begin
return Into (Into'First .. At_Char - 1) &
S & Into (At_Char .. Into'Last);
end Insert;
function Insert (S : Character; Into : String; At_Char : Natural)
return String is
begin
return Into (Into'First .. At_Char - 1) &
S & Into (At_Char .. Into'Last);
end Insert;
function Change (S : String; At_Char, To_Char : Natural; Into : String)
return String is
begin
return S (S'First .. At_Char - 1) & Into & S (To_Char + 1 .. S'Last);
end Change;
function Has (Pattern, S : String; Start : Natural := 1) return Integer is
Len_Less_One : Integer := Pattern'Length - 1;
Real_Start : Natural := Start;
begin
if Start < S'First then
Real_Start := S'First;
end if;
for I in Start .. S'Last - Len_Less_One loop
if S (I .. I + Len_Less_One) = Pattern then
return I;
end if;
end loop;
return 0;
end Has;
function Has (Pattern : Character; S : String; Start : Natural := 1)
return Integer is
Real_Start : Natural := Start;
begin
if Start < S'First then
Real_Start := S'First;
end if;
for I in Start .. S'Last loop
if S (I) = Pattern then
return I;
end if;
end loop;
return 0;
end Has;
function Next (Pattern, S : String; Start : Natural := 1) return Natural is
Index : Integer := Has (Pattern, S, Start);
begin
if Index = 0 then
raise Not_Found;
end if;
return Index;
end Next;
function Next (Pattern : Character; S : String; Start : Natural := 1)
return Natural is
Index : Integer := Has (Pattern, S, Start);
begin
if Index = 0 then
raise Not_Found;
end if;
return Index;
end Next;
function Last (Pattern, S : String; Start : Natural := 1) return Natural is
I : Integer := Start - 1;
begin
if I = 0 then
I := S'First - 1;
end if;
loop
I := Next (Pattern, S, I + 1);
end loop;
exception
when Not_Found =>
if I = Start - 1 then
raise Not_Found;
end if;
return I;
end Last;
function Last (Pattern : Character; S : String; Start : Natural := 1)
return Natural is
begin
return Last (String'(1 => Pattern), S, Start);
end Last;
function Substitute
(For_Pattern, To_Pattern : String; S : String) return String is
begin
raise Program_Error; -- not yet implemented
return ""; --WARNING
end Substitute;
function Reverse_Order (S : String) return String is
Result : String (S'Range);
begin
for I in S'Range loop
Result (I) := S (S'Last + S'First - I);
end loop;
return Result;
end Reverse_Order;
function Trim (S : String) return String is
begin
for I in reverse 1 .. S'Length loop
if S (I) /= ' ' then
return S (S'First .. I);
end if;
end loop;
return "";
end Trim;
procedure Pad_Left
(S : String; T : in out String; Pad_Char : Character := ' ') is
begin
if S'Length > T'Length then
raise Constraint_Error;
end if;
for I in T'First .. T'Last - S'Length loop
T (I) := Pad_Char;
end loop;
T (T'Last - S'Length + 1 .. T'Last) := S;
end Pad_Left;
procedure Pad_Right
(S : String; T : in out String; Pad_Char : Character := ' ') is
begin
if S'Length > T'Length then
raise Constraint_Error;
end if;
for I in T'First + S'Length .. T'Last loop
T (I) := Pad_Char;
end loop;
T (T'First .. T'First + S'Length - 1) := S;
end Pad_Right;
procedure Lower_To_Upper (S : in out String) is
begin
for I in S'Range loop
S (I) := A_Strings.To_Upper (S (I));
end loop;
end Lower_To_Upper;
procedure Upper_To_Lower (S : in out String) is
begin
for I in S'Range loop
S (I) := A_Strings.To_Lower (S (I));
end loop;
end Upper_To_Lower;
procedure Translate (From_Old, To_New : String; S : in out String) is
Trans : array (Character) of Character;
begin
if From_Old'First /= To_New'First or else
From_Old'Last /= To_New'Last then
raise Constraint_Error;
end if;
for C in Character loop
Trans (C) := C;
end loop;
for I in From_Old'Range loop
Trans (From_Old (I)) := To_New (I);
end loop;
for I in S'Range loop
S (I) := Trans (S (I));
end loop;
end Translate;
end Strings;
nblk1=6
nid=0
hdr6=c
[0x00] rec0=1f rec1=00 rec2=01 rec3=012
[0x01] rec0=20 rec1=00 rec2=02 rec3=082
[0x02] rec0=24 rec1=00 rec2=03 rec3=064
[0x03] rec0=21 rec1=00 rec2=04 rec3=092
[0x04] rec0=21 rec1=00 rec2=05 rec3=032
[0x05] rec0=17 rec1=00 rec2=06 rec3=000
tail 0x21758028e878e794cffaf 0x42a00088462060003