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 - metrics - download

⟦6b9cecd9f⟧ Ada Source

    Length: 26624 (0x6800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Directory_Implementation, seg_0254a1, seg_027c5c, seg_027cf7

Derivation

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

with System;
with Ada_C;
with Calendar;
with String_Utilities;
with Text_Io;
package body Directory_Implementation is

    function Scandirectory_C
                (C_Path : System.Address; C_Pattern : System.Address)
                return Integer;
    pragma Interface (C, Scandirectory_C);
    pragma Interface_Information (Scandirectory_C, ".ScanDirectory");

    function Createfile_C (C_Path : System.Address;
                           C_Owner_Mode : Integer;
                           C_Group_Mode : Integer;
                           C_Other_Mode : Integer) return Integer;
    pragma Interface (C, Createfile_C);
    pragma Interface_Information (Createfile_C, ".CreateFile");

    function Createdirectory_C (C_Path : System.Address;
                                C_Owner_Mode : Integer;
                                C_Group_Mode : Integer;
                                C_Other_Mode : Integer) return Integer;
    pragma Interface (C, Createdirectory_C);
    pragma Interface_Information (Createdirectory_C, ".CreateDirectory");

    function Copydirectory_C
                (C_Path1 : System.Address; C_Path2 : System.Address)
                return Integer;
    pragma Interface (C, Copydirectory_C);
    pragma Interface_Information (Copydirectory_C, ".CopyDirectory");

    function Copyfile_C (C_Path1 : System.Address; C_Path2 : System.Address)
                        return Integer;
    pragma Interface (C, Copyfile_C);
    pragma Interface_Information (Copyfile_C, ".CopyFile");

    function Move_C (C_Path1 : System.Address; C_Path2 : System.Address)
                    return Integer;
    pragma Interface (C, Move_C);
    pragma Interface_Information (Move_C, ".Move");

    function Deletefile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Deletefile_C);
    pragma Interface_Information (Deletefile_C, ".DeleteFile");

    function Deletedirectory_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Deletedirectory_C);
    pragma Interface_Information (Deletedirectory_C, ".DeleteDirectory");

    function Directoryentryexistent_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Directoryentryexistent_C);
    pragma Interface_Information
       (Directoryentryexistent_C, ".DirectoryEntryExistent");

    function Directoryentryvalue_C (C_Iter : Integer) return System.Address;
    pragma Interface (C, Directoryentryvalue_C);
    pragma Interface_Information
       (Directoryentryvalue_C, ".DirectoryEntryValue");

    function Directoryentrysize_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Directoryentrysize_C);
    pragma Interface_Information (Directoryentrysize_C, ".DirectoryEntrySize");

    function Directoryentrynumberoflinks_C
                (C_Path : System.Address) return Integer;
    pragma Interface (C, Directoryentrynumberoflinks_C);
    pragma Interface_Information (Directoryentrynumberoflinks_C,
                                  ".DirectoryEntryNumberOfLinks");

    function Directoryentryusername_C
                (C_Path : System.Address) return System.Address;
    pragma Interface (C, Directoryentryusername_C);
    pragma Interface_Information
       (Directoryentryusername_C, ".DirectoryEntryUserName");

    function Directoryentrygroupname_C
                (C_Path : System.Address) return System.Address;
    pragma Interface (C, Directoryentrygroupname_C);
    pragma Interface_Information
       (Directoryentrygroupname_C, ".DirectoryEntryGroupName");

    function Dateoflastupdate_C (C_Path : System.Address) return System.Address;
    pragma Interface (C, Dateoflastupdate_C);
    pragma Interface_Information (Dateoflastupdate_C,
                                  ".DirectoryEntryDateOfLastUpdate");

    function Timeoflastupdate_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Timeoflastupdate_C);
    pragma Interface_Information (Timeoflastupdate_C,
                                  ".DirectoryEntryTimeOfLastUpdate");

    function Dateoflastaccess_C (C_Path : System.Address) return System.Address;
    pragma Interface (C, Dateoflastaccess_C);
    pragma Interface_Information (Dateoflastaccess_C,
                                  ".DirectoryEntryDateOfLastAccess");

    function Timeoflastaccess_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Timeoflastaccess_C);
    pragma Interface_Information (Timeoflastaccess_C,
                                  ".DirectoryEntryTimeOfLastAccess");

    function Isdirectory_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Isdirectory_C);
    pragma Interface_Information (Isdirectory_C, ".IsDirectory");

    function Isregularfile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Isregularfile_C);
    pragma Interface_Information (Isregularfile_C, ".IsRegularFile");

    function Isblocspecialfile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Isblocspecialfile_C);
    pragma Interface_Information (Isblocspecialfile_C, ".IsBlocSpecial");

    function Ischaracterspecialfile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Ischaracterspecialfile_C);
    pragma Interface_Information
       (Ischaracterspecialfile_C, ".IsCharacterSpecial");

    function Isfifo_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Isfifo_C);
    pragma Interface_Information (Isfifo_C, ".IsFifo");

    function Issocket_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Issocket_C);
    pragma Interface_Information (Issocket_C, ".IsSocket");

    function Issymboliclink_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Issymboliclink_C);
    pragma Interface_Information (Issymboliclink_C, ".IsSymbolicLink");

    function Ismultiplexfile_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Ismultiplexfile_C);
    pragma Interface_Information (Ismultiplexfile_C,
                                  ".IsMultiplexCharacterSpecial");

    function Entryownerpermissions_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Entryownerpermissions_C);
    pragma Interface_Information
       (Entryownerpermissions_C, ".EntryOwnerPermissions");

    function Entrygrouppermissions_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Entrygrouppermissions_C);
    pragma Interface_Information
       (Entrygrouppermissions_C, ".EntryGroupPermissions");

    function Entryotherpermissions_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Entryotherpermissions_C);
    pragma Interface_Information
       (Entryotherpermissions_C, ".EntryOtherPermissions");

    procedure Changeownerpermissions_C
                 (C_Path : System.Address; C_Mode : Integer);
    pragma Interface (C, Changeownerpermissions_C);
    pragma Interface_Information
       (Changeownerpermissions_C, ".ChangeOwnerPermissions");

    procedure Changegrouppermissions_C
                 (C_Path : System.Address; C_Mode : Integer);
    pragma Interface (C, Changegrouppermissions_C);
    pragma Interface_Information
       (Changegrouppermissions_C, ".ChangeGroupPermissions");

    procedure Changeotherpermissions_C
                 (C_Path : System.Address; C_Mode : Integer);
    pragma Interface (C, Changeotherpermissions_C);
    pragma Interface_Information
       (Changeotherpermissions_C, ".ChangeOtherPermissions");

    function Changedirectory_C (C_Path : System.Address) return Integer;
    pragma Interface (C, Changedirectory_C);
    pragma Interface_Information (Changedirectory_C, ".ChangeDirectory");

    function Gethomedirectory_C return System.Address;
    pragma Interface (C, Gethomedirectory_C);
    pragma Interface_Information (Gethomedirectory_C, ".GetHomeDirectory");

    function Getabsolutepath_C
                (C_Path1 : in System.Address) return System.Address;
    pragma Interface (C, Getabsolutepath_C);
    pragma Interface_Information (Getabsolutepath_C, ".GetAbsolutePath");

    function Geterrormessage_C return System.Address;
    pragma Interface (C, Geterrormessage_C);
    pragma Interface_Information (Geterrormessage_C, ".GetErrorMessage");



    function Scan_Directory (Path : in String; Pattern : in String := ".*")
                            return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
        C_Pattern : constant String := Ada_C.String_Ada_To_C (Pattern);
    begin
        return Scandirectory_C
                  (C_Path => C_Path (C_Path'First)'Address,
                   C_Pattern => C_Pattern (C_Pattern'First)'Address);
    end Scan_Directory;


    function Create_File (Path : in String;
                          Owner_Permissions : in Integer;
                          Group_Permissions : in Integer;
                          Other_Permissions : in Integer) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return (Createfile_C (C_Path => C_Path (C_Path'First)'Address,
                              C_Owner_Mode => Owner_Permissions,
                              C_Group_Mode => Group_Permissions,
                              C_Other_Mode => Other_Permissions) = 1);
    end Create_File;

    function Create_Directory (Path : in String;
                               Owner_Permissions : in Integer;
                               Group_Permissions : in Integer;
                               Other_Permissions : in Integer) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return (Createdirectory_C (C_Path => C_Path (C_Path'First)'Address,
                                   C_Owner_Mode => Owner_Permissions,
                                   C_Group_Mode => Group_Permissions,
                                   C_Other_Mode => Other_Permissions) = 0);
    end Create_Directory;


    function Copy_Directory
                (The_Path : in String; To_Path : in String) return Boolean is
        C_Path1 : constant String := Ada_C.String_Ada_To_C (The_Path);
        C_Path2 : constant String := Ada_C.String_Ada_To_C (To_Path);
    begin
        return
           (Copydirectory_C (C_Path1 => C_Path1 (C_Path1'First)'Address,
                             C_Path2 => C_Path2 (C_Path2'First)'Address) = 0);
    end Copy_Directory;

    function Copy_File
                (The_Path : in String; To_Path : in String) return Boolean is
        C_Path1 : constant String := Ada_C.String_Ada_To_C (The_Path);
        C_Path2 : constant String := Ada_C.String_Ada_To_C (To_Path);
    begin
        return (Copyfile_C (C_Path1 => C_Path1 (C_Path1'First)'Address,
                            C_Path2 => C_Path2 (C_Path2'First)'Address) = 0);
    end Copy_File;


    function Move (The_Path : in String; To_Path : in String) return Boolean is
        C_Path1 : constant String := Ada_C.String_Ada_To_C (The_Path);
        C_Path2 : constant String := Ada_C.String_Ada_To_C (To_Path);
    begin
        return (Move_C (C_Path1 => C_Path1 (C_Path1'First)'Address,
                        C_Path2 => C_Path2 (C_Path2'First)'Address) = 0);
    end Move;

    function Delete_File (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return (Deletefile_C (C_Path => C_Path (C_Path'First)'Address) = 0);
    end Delete_File;

    function Delete_Directory (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           (Deletedirectory_C (C_Path => C_Path (C_Path'First)'Address) = 0);
    end Delete_Directory;


    function Existent_Entry (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           (Directoryentryexistent_C (C_Path => C_Path (C_Path'First)'Address) =
            0);
    end Existent_Entry;


    function Entry_Value (Iter : in Integer) return String is
        S : System.Address;
    begin
        S := Directoryentryvalue_C (C_Iter => Iter);
        return Ada_C.String_C_To_Ada (S);
    end Entry_Value;


    function Entry_Size (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Directoryentrysize_C (C_Path => C_Path (C_Path'First)'Address);
    end Entry_Size;

    function Number_Of_Links (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Directoryentrynumberoflinks_C
                  (C_Path => C_Path (C_Path'First)'Address);
    end Number_Of_Links;


    function Entry_Username (Path : in String) return String is
        S : System.Address;  
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        S := Directoryentryusername_C (C_Path => C_Path (C_Path'First)'Address);
        return Ada_C.String_C_To_Ada (S);
    end Entry_Username;

    function Entry_Groupname (Path : in String) return String is
        S : System.Address;  
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        S := Directoryentrygroupname_C (C_Path =>
                                           C_Path (C_Path'First)'Address);
        return Ada_C.String_C_To_Ada (S);
    end Entry_Groupname;

    function Time_Of_Last_Update (Path : in String) return Calendar.Time is
        S : System.Address;
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
        Day : Calendar.Day_Number;
        Month : Calendar.Month_Number;
        Year : Calendar.Year_Number;
        Sec : Calendar.Day_Duration;
    begin
        S := Dateoflastupdate_C (C_Path => C_Path (C_Path'First)'Address);
        declare
            Str : constant String := Ada_C.String_C_To_Ada (S);
            Worked : Boolean := True;
        begin
            String_Utilities.String_To_Number
               (Str (Str'First .. Str'First + 1), Day, Worked);
            String_Utilities.String_To_Number
               (Str (Str'First + 2 .. Str'First + 3), Month, Worked);
            String_Utilities.String_To_Number
               (Str (Str'First + 4 .. Str'First + 7), Year, Worked);
        end;
        Sec := Duration (Timeoflastupdate_C
                            (C_Path => C_Path (C_Path'First)'Address));
        return Calendar.Time_Of (Year, Month, Day, Sec);
    end Time_Of_Last_Update;

    function Time_Of_Last_Read (Path : in String) return Calendar.Time is
        S : System.Address;
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
        Day : Calendar.Day_Number;
        Month : Calendar.Month_Number;
        Year : Calendar.Year_Number;
        Sec : Calendar.Day_Duration;
    begin
        S := Dateoflastaccess_C (C_Path => C_Path (C_Path'First)'Address);
        declare
            Str : constant String := Ada_C.String_C_To_Ada (S);
            Worked : Boolean := True;
        begin
            String_Utilities.String_To_Number
               (Str (Str'First .. Str'First + 1), Day, Worked);
            String_Utilities.String_To_Number
               (Str (Str'First + 2 .. Str'First + 3), Month, Worked);
            String_Utilities.String_To_Number
               (Str (Str'First + 4 .. Str'First + 7), Year, Worked);
        end;
        Sec := Duration (Timeoflastaccess_C
                            (C_Path => C_Path (C_Path'First)'Address));
        return Calendar.Time_Of (Year, Month, Day, Sec);
    end Time_Of_Last_Read;

    function Is_Directory (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return ((Isdirectory_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Directory;

    function Is_File (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           ((Isregularfile_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_File;

    function Is_Bloc_Special_File (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           ((Isblocspecialfile_C (C_Path => C_Path (C_Path'First)'Address)) =
            1);
    end Is_Bloc_Special_File;

    function Is_Character_Special_File (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return ((Ischaracterspecialfile_C
                    (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Character_Special_File;

    function Is_Fifo (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return ((Isfifo_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Fifo;

    function Is_Socket (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return ((Issocket_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Socket;

    function Is_Symbolic_Link (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           ((Issymboliclink_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Symbolic_Link;

    function Is_Multiplex_Character_Special_File
                (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           ((Ismultiplexfile_C (C_Path => C_Path (C_Path'First)'Address)) = 1);
    end Is_Multiplex_Character_Special_File;

    function Entry_Owner_Permissions (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Entryownerpermissions_C (C_Path =>
                                           C_Path (C_Path'First)'Address);
    end Entry_Owner_Permissions;

    function Entry_Group_Permissions (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Entrygrouppermissions_C (C_Path =>
                                           C_Path (C_Path'First)'Address);
    end Entry_Group_Permissions;

    function Entry_Other_Permissions (Path : in String) return Integer is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return Entryotherpermissions_C (C_Path =>
                                           C_Path (C_Path'First)'Address);
    end Entry_Other_Permissions;

    procedure Change_Owner_Permissions (Path : in String; Mode : in Integer) is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        Changeownerpermissions_C
           (C_Path => C_Path (C_Path'First)'Address, C_Mode => Mode);
    end Change_Owner_Permissions;

    procedure Change_Group_Permissions (Path : in String; Mode : in Integer) is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        Changegrouppermissions_C
           (C_Path => C_Path (C_Path'First)'Address, C_Mode => Mode);
    end Change_Group_Permissions;

    procedure Change_Other_Permissions (Path : in String; Mode : in Integer) is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        Changeotherpermissions_C
           (C_Path => C_Path (C_Path'First)'Address, C_Mode => Mode);
    end Change_Other_Permissions;


    function Change_Directory (Path : in String) return Boolean is
        C_Path : constant String := Ada_C.String_Ada_To_C (Path);
    begin
        return
           (Changedirectory_C (C_Path => C_Path (C_Path'First)'Address) = 0);
    end Change_Directory;

    function Get_Home_Directory return String is
    begin
        return Ada_C.String_C_To_Ada (Gethomedirectory_C);
    end Get_Home_Directory;

    function Get_Absolute_Path (The_Path : in String) return String is
        C_Path : constant String := Ada_C.String_Ada_To_C (The_Path);
        S : System.Address;
    begin  
        S := Getabsolutepath_C (C_Path1 => C_Path (C_Path'First)'Address);
        return Ada_C.String_C_To_Ada (S);
    end Get_Absolute_Path;

    function Get_Error_Message return String is
    begin
        return Ada_C.String_C_To_Ada (Geterrormessage_C);
    end Get_Error_Message;

end Directory_Implementation;

    nblk1=19
    nid=d
    hdr6=2c
        [0x00] rec0=1a rec1=00 rec2=01 rec3=046
        [0x01] rec0=17 rec1=00 rec2=0a rec3=072
        [0x02] rec0=15 rec1=00 rec2=03 rec3=040
        [0x03] rec0=15 rec1=00 rec2=19 rec3=054
        [0x04] rec0=14 rec1=00 rec2=15 rec3=078
        [0x05] rec0=17 rec1=00 rec2=13 rec3=038
        [0x06] rec0=15 rec1=00 rec2=0e rec3=06a
        [0x07] rec0=17 rec1=00 rec2=08 rec3=02c
        [0x08] rec0=19 rec1=00 rec2=09 rec3=01e
        [0x09] rec0=02 rec1=00 rec2=0b rec3=00e
        [0x0a] rec0=11 rec1=00 rec2=10 rec3=084
        [0x0b] rec0=16 rec1=00 rec2=14 rec3=01c
        [0x0c] rec0=1a rec1=00 rec2=05 rec3=008
        [0x0d] rec0=1e rec1=00 rec2=12 rec3=022
        [0x0e] rec0=17 rec1=00 rec2=07 rec3=032
        [0x0f] rec0=16 rec1=00 rec2=16 rec3=026
        [0x10] rec0=17 rec1=00 rec2=17 rec3=00e
        [0x11] rec0=18 rec1=00 rec2=06 rec3=088
        [0x12] rec0=1b rec1=00 rec2=02 rec3=018
        [0x13] rec0=15 rec1=00 rec2=04 rec3=056
        [0x14] rec0=19 rec1=00 rec2=0c rec3=024
        [0x15] rec0=1a rec1=00 rec2=0f rec3=000
        [0x16] rec0=05 rec1=00 rec2=0d rec3=000
        [0x17] rec0=16 rec1=00 rec2=0e rec3=000
        [0x18] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x217203cbe83a250f8c96b 0x42a00088462060003
Free Block Chain:
  0xd: 0000  00 11 00 09 80 03 6f 6e 3b 03 00 00 00 65 63 74  ┆      on;    ect┆
  0x11: 0000  00 18 00 de 80 0f 72 65 74 75 72 6e 20 49 6e 74  ┆      return Int┆
  0x18: 0000  00 00 03 fc 80 09 63 74 6f 72 79 5f 43 29 3b 09  ┆      ctory_C); ┆