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

⟦524ba3d51⟧ Ada Source

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

Derivation

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

with Text_Io;
package body Unix is

    Unique_Str : String (1 .. 3) := "aa`";

    procedure Getwd (Path : System.Address);
    pragma Interface (C, Getwd);

    procedure Getcwd (Path : in out String) is
        Name : C_String_Buf;
        Len : Integer;
    begin
        loop
            Getwd (Name'Address);
            Len := C_Length (To_C (Name'Address));
            Path (Path'First .. Path'First + Len) := Name (1 .. Len + 1);
            exit when Len /= 0;
            exit when Errnum /= Eintr;
        end loop;
    end Getcwd;

    function Get_Temp_Name (Root : String := "/tmp/adatmp") return String is
        Pid : constant String := Integer'Image (Getpid);
        Len : Integer := Pid'Length;
    begin
        if Unique_Str (3) = 'z' then
            if Unique_Str (2) = 'z' then
                if Unique_Str (1) = 'z' then
                    -- temporary file limit has been reached; cannot
                    -- make any more unique temp names
                    raise Text_Io.Name_Error;
                else
                    Unique_Str (1) := Character'Succ (Unique_Str (1));
                    Unique_Str (2) := 'a';
                    Unique_Str (3) := 'a';
                end if;
            else
                Unique_Str (2) := Character'Succ (Unique_Str (2));
                Unique_Str (3) := 'a';
            end if;
        else
            Unique_Str (3) := Character'Succ (Unique_Str (3));
        end if;

        return Root & Unique_Str & Pid (2 .. Len) & Ascii.Nul;
    end Get_Temp_Name;

    function Sys_Access (Filename : String; Mode : Access_Mode)
                        return Status_Code is
        C_Name : C_String_Buf;
    begin
        return Sys_Access (To_C (Filename, C_Name'Address), Mode);
    end Sys_Access;

    function Chdir (Filename : String) return Status_Code is
        C_Name : C_String_Buf;
    begin
        return Chdir (To_C (Filename, C_Name'Address));
    end Chdir;

    function Chmod (Filename : String; Perm : Permission) return Status_Code is
        C_Name : C_String_Buf;
    begin
        return Chmod (To_C (Filename, C_Name'Address), Perm);
    end Chmod;

    function Chown (Filename : String; User, Group : Integer)
                   return Status_Code is
        C_Name : C_String_Buf;
    begin
        return Chown (To_C (Filename, C_Name'Address), User, Group);
    end Chown;

    function Open (Filename : String;
                   Mode : Os_Files.Open_Flags :=
                      Os_Files."+" (Os_Files.O_Rdwr,
                                    Os_Files."+" (Os_Files.O_Creat,
                                                  Os_Files.O_Excl));
                   Perm : Permission := Allow_Read_Write)
                  return Os_Files.File_Descriptor is
        C_Name : C_String_Buf;
    begin
        return Open (To_C (Filename, C_Name'Address), Mode, Perm);
    end Open;

    function Stat (Filename : String; Statbuf : A_Status_Buffer)
                  return Status_Code is
        C_Name : C_String_Buf;
    begin
        return Stat (To_C (Filename, C_Name'Address), Statbuf);
    end Stat;

    function Truncate (Filename : String; Length : Offset) return Status_Code is
        C_Name : C_String_Buf;
    begin
        return Truncate (To_C (Filename, C_Name'Address), Length);
    end Truncate;

    function Unlink (Linkname : String) return Status_Code is
        C_Name : C_String_Buf;
    begin
        return Unlink (To_C (Linkname, C_Name'Address));
    end Unlink;

    function Link (Filename, Linkname : String) return Status_Code is
        C_Fname, C_Lname : C_String_Buf;
    begin
        return Link (To_C (Filename, C_Fname'Address),
                     To_C (Linkname, C_Lname'Address));
    end Link;

    function Symlink (Filename, Linkname : String) return Status_Code is
        C_Fname, C_Lname : C_String_Buf;
    begin
        return Symlink (To_C (Filename, C_Fname'Address),
                        To_C (Linkname, C_Lname'Address));
    end Symlink;

    function Readlink (Path : String; Buffer : Address; Bufsiz : Integer)
                      return Io_Count is
        C_Name : C_String_Buf;
    begin
        return Readlink (To_C (Path, C_Name'Address), Buffer, Bufsiz);
    end Readlink;

    function Rename (From_Name, To_Name : String) return Status_Code is
        C_From_Name, C_To_Name : C_String_Buf;
    begin
        return Rename (To_C (From_Name, C_From_Name'Address),
                       To_C (To_Name, C_To_Name'Address));
    end Rename;

end Unix;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=1f rec1=00 rec2=01 rec3=04a
        [0x01] rec0=1c rec1=00 rec2=02 rec3=03e
        [0x02] rec0=19 rec1=00 rec2=03 rec3=084
        [0x03] rec0=1e rec1=00 rec2=04 rec3=01c
        [0x04] rec0=15 rec1=00 rec2=05 rec3=000
    tail 0x21750bca486843795420e 0x42a00088462060003