|
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: 26624 (0x6800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Directory_Implementation, seg_0254a1, seg_027c5c, seg_027cf7
└─⟦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); ┆