DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦a0061b728⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Bounded_String, seg_04473f

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

package body Bounded_String is
    procedure Copy (Target : in out Variable_String;
                    Source : Variable_String) is
    begin
        Target.Contents (1 .. Source.Length) :=
           Source.Contents (1 .. Source.Length);
        Target.Length := Source.Length;
    end Copy;


    procedure Copy (Target : in out Variable_String; Source : String) is
    begin
        Target.Contents (1 .. Source'Length) := Source;
        Target.Length := Source'Length;
    end Copy;

    procedure Copy (Target : in out Variable_String; Source : Character) is
    begin
        Target.Contents (1) := Source;
        Target.Length := 1;
    end Copy;


    procedure Move (Target : in out Variable_String;
                    Source : in out Variable_String) is
    begin
        Target.Contents (1 .. Source.Length) :=
           Source.Contents (1 .. Source.Length);
        Target.Length := Source.Length;
        Source.Length := 0;
    end Move;


    function Image (V : Variable_String) return String is
    begin
        return V.Contents (1 .. V.Length);
    end Image;


    function Value (S : String; Max_Length : Natural) return Variable_String is
        String_Value : String (1 .. Max_Length);
    begin
        String_Value (1 .. S'Length) := S;
        return Variable_String'(Maximum_Length => Max_Length,
                                Length => S'Length,
                                Contents => String_Value);
    end Value;


    function Value (S : String) return Variable_String is
    begin
        return Variable_String'(Maximum_Length => S'Length,
                                Length => S'Length,
                                Contents => S);

    end Value;


    procedure Free (V : in out Variable_String) is
    begin
        V.Length := 0;
    end Free;


    procedure Append (Target : in out Variable_String; Source : String) is
        Len : Natural := Target.Length + Source'Length;
    begin
        Target.Contents (Target.Length + 1 .. Len) := Source;
        Target.Length := Len;
    end Append;


    procedure Append (Target : in out Variable_String;
                      Source : Variable_String) is
    begin
        Append (Target, Image (Source));
    end Append;


    procedure Append (Target : in out Variable_String; Source : Character) is
        Len : Natural := Target.Length + 1;
    begin
        Target.Contents (Len) := Source;
        Target.Length := Len;
    end Append;


    procedure Append (Target : in out Variable_String;
                      Source : Character;
                      Count : Natural) is
        Value_String : String (1 .. Count) := String'(1 .. Count => Source);
    begin
        Append (Target, Value_String);
    end Append;


    procedure Insert (Target : in out Variable_String;
                      At_Pos : Positive;
                      Source : String) is
    begin
        if At_Pos = Target.Length + 1 then
            Append (Target, Source);
        elsif At_Pos <= Target.Length then
            declare
                Len : Natural := Target.Length + Source'Length;
            begin
                Target.Contents (At_Pos .. Len) :=
                   Source & Target.Contents (At_Pos .. Target.Length);
                Target.Length := Len;
            end;
        else
            raise Constraint_Error;
        end if;
    end Insert;


    procedure Insert (Target : in out Variable_String;
                      At_Pos : Positive;
                      Source : Variable_String) is
    begin
        Insert (Target, At_Pos, Source.Contents (1 .. Source.Length));
    end Insert;


    procedure Insert (Target : in out Variable_String;
                      At_Pos : Positive;
                      Source : Character) is
        New_Len : Natural := Target.Length + 1;
    begin
        if At_Pos = New_Len then
            Append (Target, Source);
        elsif At_Pos > New_Len then
            raise Constraint_Error;
        else
            Target.Contents (At_Pos + 1 .. New_Len) :=
               Target.Contents (At_Pos .. Target.Length);
            Target.Contents (At_Pos) := Source;
            Target.Length := New_Len;
        end if;
    end Insert;


    procedure Insert (Target : in out Variable_String;
                      At_Pos : Positive;
                      Source : Character;
                      Count : Natural) is
        Value_String : String (1 .. Count) := String'(1 .. Count => Source);
    begin
        Insert (Target, At_Pos, Value_String);
    end Insert;


    procedure Delete (Target : in out Variable_String;
                      At_Pos : Positive;
                      Count : Natural := 1) is
        Len : Natural := Target.Length - Count;
    begin
        if At_Pos - 1 > Len then
            raise Constraint_Error;
        end if;
        if At_Pos <= Len then
            Target.Contents (At_Pos .. Len) :=
               Target.Contents (At_Pos + Count .. Target.Length);
        end if;
        Target.Length := Len;
    end Delete;


    procedure Replace (Target : in out Variable_String;
                       At_Pos : Positive;
                       Source : Character) is
    begin
        if At_Pos > Target.Length then
            raise Constraint_Error;
        else
            Target.Contents (At_Pos) := Source;
        end if;
    end Replace;


    procedure Replace (Target : in out Variable_String;
                       At_Pos : Positive;
                       Source : String) is
        End_Pos : constant Positive := At_Pos + Source'Length - 1;
    begin
        if End_Pos > Target.Length then
            raise Constraint_Error;
        else
            Target.Contents (At_Pos .. End_Pos) := Source;
        end if;
    end Replace;

    procedure Replace (Target : in out Variable_String;
                       At_Pos : Positive;
                       Source : Character;
                       Count : Natural) is
        Value_String : String (1 .. Count) := String'(1 .. Count => Source);
    begin
        Replace (Target, At_Pos, Value_String);
    end Replace;

    procedure Replace (Target : in out Variable_String;
                       At_Pos : Positive;
                       Source : Variable_String) is
    begin
        Replace (Target, At_Pos, Image (Source));
    end Replace;


    procedure Set_Length (Target : in out Variable_String;
                          New_Length : Natural;
                          Fill_With : Character := ' ') is
        Current_Length : Natural := Target.Length;
    begin
        for I in Current_Length + 1 .. New_Length loop
            Target.Contents (I) := Fill_With;
        end loop;
        Target.Length := New_Length;
    end Set_Length;


    function Length (Source : Variable_String) return Natural is
    begin
        return Source.Length;
    end Length;


    function Max_Length (Source : Variable_String) return Natural is
    begin
        return Source.Maximum_Length;
    end Max_Length;


    function Char_At (Source : Variable_String; At_Pos : Positive)
                     return Character is
    begin
        if At_Pos > Source.Length then
            raise Constraint_Error;
        else
            return Source.Contents (At_Pos);
        end if;
    end Char_At;

    function Extract (Source : Variable_String;
                      Start_Pos : Positive;
                      End_Pos : Natural) return String is
    begin
        if End_Pos > Source.Length then
            raise Constraint_Error;
        else
            return Source.Contents (Start_Pos .. End_Pos);
        end if;
    end Extract;

end Bounded_String;

    nblk1=a
    nid=a
    hdr6=12
        [0x00] rec0=20 rec1=00 rec2=01 rec3=016
        [0x01] rec0=23 rec1=00 rec2=02 rec3=02a
        [0x02] rec0=21 rec1=00 rec2=03 rec3=02a
        [0x03] rec0=1e rec1=00 rec2=04 rec3=00c
        [0x04] rec0=1d rec1=00 rec2=05 rec3=040
        [0x05] rec0=20 rec1=00 rec2=06 rec3=00a
        [0x06] rec0=1c rec1=00 rec2=07 rec3=028
        [0x07] rec0=25 rec1=00 rec2=08 rec3=01e
        [0x08] rec0=02 rec1=00 rec2=09 rec3=000
        [0x09] rec0=0a rec1=00 rec2=0a rec3=000
    tail 0x215404eb8863e896f3af3 0x42a00088462060003
Free Block Chain:
  0xa: 0000  00 00 01 35 80 16 20 20 20 20 20 20 20 20 20 20  ┆   5            ┆