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

⟦a04f515ec⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Mac_Text, seg_024570

Derivation

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

with Mac_Types;
with System;
with Unchecked_Conversion;
package body Mac_Text is

    function Length (T : Text) return Index is
    begin
        return T.Length;
    end Length;

    procedure Set_Length (T : in out Text; L : Index) is
    begin
        T.Length := L;
    end Set_Length;

    function Maximum_Length (T : Text) return Index is
    begin
        return T.Maximum_Length;
    end Maximum_Length;

    function Value (T : Text) return String is

    begin
        if T.Length > 0 then
            declare
                S : String (0 .. T.Length - 1);
            begin
                S (S'Range) := T.Value (1 .. T.Length);
                return S;
            end;
        else
            return "";
        end if;
    end Value;

    function Value (T : Text) return Mac_Types.Str255 is
        S : Mac_Types.Str255;
    begin
        for Index in 1 .. T.Length loop
            S (Index) := T.Value (Index);
        end loop;
        S (0) := Mac_Types.Char'Val (T.Length);
        return S;
    end Value;

    function Value (Where : Index; T : Text) return Mac_Types.Char is
    begin
        if Where <= T.Length then
            return T.Value (Where);
        else
            raise Constraint_Error;
        end if;
    end Value;

    function Empty (T : Text) return Boolean is
    begin
        return T.Length = 0;
    end Empty;

    procedure Set_Empty (T : in out Text) is
    begin
        T.Length := 0;
    end Set_Empty;

    function To_Text (S : String; Max : Index) return Text is
        T : Text (Max);
    begin
        T.Value (1 .. S'Length) := S (S'Range);
        T.Length := S'Length;
        return T;
    end To_Text;

    function To_Text (C : Mac_Types.Char; Max : Index) return Text is
        T : Text (Max);
    begin
        T.Value (1) := C;
        T.Length := 1;
        return T;
    end To_Text;

    function To_Text (S : String) return Text is
    begin
        return To_Text (S, S'Length);
    end To_Text;

    function To_Text (C : Mac_Types.Char) return Text is
    begin
        return To_Text (C, 1);
    end To_Text;

    procedure Set (T : in out Text; Value : Text) is
    begin
        if Value.Length > 0 then
            T.Value (Value.Value'Range) := Value.Value;
        end if;
        T.Length := Value.Length;
    end Set;

    procedure Set (T : in out Text; Value : String) is
    begin
        if Value'Length > 0 then
            T.Value (1 .. Value'Length) := Value;
        end if;
        T.Length := Value'Length;
    end Set;

    procedure Set (T : in out Text; Value : Mac_Types.Char) is
    begin
        T.Value (1) := Value;
        T.Length := 1;
    end Set;

    procedure Append (Tail : Text; To : in out Text) is
    begin
        if Tail.Length > 0 then
            To.Value (To.Length + 1 .. To.Length + Tail.Length) := Tail.Value;
            To.Length := To.Length + Tail.Length;
        end if;
    end Append;

    procedure Append (Tail : String; To : in out Text) is
    begin
        if Tail'Length > 0 then
            To.Value (To.Length + 1 .. To.Length + Tail'Length) := Tail;
            To.Length := To.Length + Tail'Length;
        end if;
    end Append;

    procedure Append (Tail : Mac_Types.Char; To : in out Text) is
    begin
        To.Value (To.Length + 1) := Tail;
        To.Length := To.Length + 1;
    end Append;

    function As_Ptr (T : Text) return Mac_Types.Ptr is
        function As_Ptr is new Unchecked_Conversion (Source => System.Address,
                                                     Target => Mac_Types.Ptr);
    begin
        return As_Ptr (T.Value (T.Value'First)'Address);
    end As_Ptr;

end Mac_Text;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=29 rec1=00 rec2=01 rec3=052
        [0x01] rec0=06 rec1=00 rec2=05 rec3=06e
        [0x02] rec0=28 rec1=00 rec2=02 rec3=05c
        [0x03] rec0=23 rec1=00 rec2=03 rec3=062
        [0x04] rec0=16 rec1=00 rec2=04 rec3=000
    tail 0x2151ee0de839c72aea15c 0x42a00088462060003