|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Any_Object, seg_027ab1, seg_027c63, seg_027cfe, separate Object_Management_System
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with String_Utilities;
separate (Object_Management_System)
package body Any_Object is
function Is_Library (Any_Object : Library_Object) return Boolean is
begin
return Any_Object.Subclass = Library_Subclass;
end Is_Library;
function Is_C_Unit (Any_Object : Library_Object) return Boolean is
begin
return Any_Object.Subclass = C_Unit_Subclass;
end Is_C_Unit;
function Is_Unix_File (Any_Object : Library_Object) return Boolean is
begin
return Any_Object.Subclass = Unix_File_Subclass;
end Is_Unix_File;
function Make_Library_Object
(The_Name : String;
The_Subclass : Subclass_Enumeration :=
Object_Management_System.Unix_File_Subclass)
return Library_Object is
Obj : Directory.Object;
begin
begin
Directory.Any_Object.Open (Obj, The_Name);
exception
when Directory.Non_Existent_Object_Error =>
return Nil;
end;
case The_Subclass is
when Library_Subclass =>
return Library_Object'
(Subclass => Library_Subclass,
Name => Gs.Value
(Directory.Naming.Simple_Name (Obj)),
Unix_Library => Obj,
Kind => Library.A_Directory);
when Unix_File_Subclass =>
return Library_Object'(Subclass => Unix_File_Subclass,
Name => Gs.Value (The_Name),
Unix_File => Obj);
when others =>
return Nil;
end case;
end Make_Library_Object;
procedure Create (The_Object : in out Library_Object;
The_Name : String;
The_Subclass : Subclass_Enumeration :=
Object_Management_System.Unix_File_Subclass) is
Obj : Directory.Object;
begin
case The_Subclass is
when Library_Subclass =>
Library.Create (The_Library => The_Object,
Name => The_Name,
Kind => Library.A_Directory);
when Unix_File_Subclass =>
begin
Directory.Any_Object.Create
(The_Object => Obj,
Object_Name => The_Name,
Object_Class => Directory.File_Class,
Object_Owner_Permissions =>
Directory.Statistics.R_W_Permission,
Object_Group_Permissions =>
Directory.Statistics.R_W_Permission,
Object_Other_Permissions =>
Directory.Statistics.R_W_Permission);
The_Object := Library_Object'
(Subclass => Unix_File_Subclass,
Name => Gs.Value (The_Name),
Unix_File => Obj);
exception
when Directory.Already_Existent_Object_Error =>
The_Object := Nil;
when Directory.System_Error =>
The_Object := Nil;
end;
when others =>
The_Object := Nil;
end case;
end Create;
procedure Move (The_Object : in out Library_Object; New_Name : String) is
begin
The_Object.Name := Gs.Value (New_Name);
case The_Object.Subclass is
when Library_Subclass =>
Directory.Any_Object.Rename (The_Object.Unix_Library, New_Name);
when Unix_File_Subclass =>
Directory.Any_Object.Rename (The_Object.Unix_File, New_Name);
when others =>
null;
end case;
end Move;
procedure Delete (The_Object : in out Library_Object) is
begin
case The_Object.Subclass is
when Library_Subclass =>
Directory.Any_Object.Delete (The_Object.Unix_Library);
when Unix_File_Subclass =>
Directory.Any_Object.Delete (The_Object.Unix_File);
when others =>
null;
end case;
The_Object := Nil;
end Delete;
function Enclosing_Library
(The_Object : Library_Object) return Library_Object is
Obj : Directory.Object;
begin
case The_Object.Subclass is
when Library_Subclass =>
Obj := Directory.Traversal.Parent
(Directory.Traversal.Parent
(The_Object.Unix_Library));
when Unix_File_Subclass =>
Obj := Directory.Traversal.Parent
(Directory.Traversal.Parent (The_Object.Unix_File));
when others =>
return Nil;
end case;
return Library_Object'
(Subclass => Library_Subclass,
Name => Gs.Value (Directory.Naming.Simple_Name (Obj)),
Unix_Library => Obj,
Kind => Library.A_Directory);
exception
when Directory.Non_Existent_Object_Error =>
return Nil;
end Enclosing_Library;
function Image (The_Object : Library_Object) return String is
begin
case The_Object.Subclass is
when Library_Subclass =>
return Normalise (Gs.Image (The_Object.Name), 30) &
" " & Image (The_Object.Subclass) & " (" &
Library.Image (Library.Kind (The_Object)) & ")";
when C_Unit_Subclass =>
return Normalise (Gs.Image (The_Object.Name), 30) & " " &
Normalise
(C_Unit.Image (C_Unit.State (The_Object)), 3) &
Image (The_Object.Subclass) & " (" &
C_Unit.Image (C_Unit.Kind (The_Object)) & ")";
when Unix_File_Subclass =>
return Normalise (Gs.Image (The_Object.Name), 30) &
" " & Image (The_Object.Subclass);
when others =>
return " ";
end case;
end Image;
function Value (The_String : String) return Library_Object is
Iter : Iterator;
I : constant Natural := String_Utilities.Locate
(' ', The_String, False);
Str : constant String := The_String (The_String'First .. I - 1);
Lib_Obj : Library_Object := Nil;
begin
Reset (Iter);
while not Done (Iter) loop
Lib_Obj := Value (Iter);
if Gs.Image (Lib_Obj.Name) = Str then
return Lib_Obj;
end if;
Next (Iter);
end loop;
return Nil;
end Value;
end Any_Object;
nblk1=a
nid=0
hdr6=14
[0x00] rec0=20 rec1=00 rec2=01 rec3=03a
[0x01] rec0=18 rec1=00 rec2=06 rec3=01c
[0x02] rec0=01 rec1=00 rec2=04 rec3=01e
[0x03] rec0=14 rec1=00 rec2=03 rec3=066
[0x04] rec0=19 rec1=00 rec2=02 rec3=020
[0x05] rec0=1d rec1=00 rec2=05 rec3=04a
[0x06] rec0=18 rec1=00 rec2=07 rec3=024
[0x07] rec0=02 rec1=00 rec2=08 rec3=058
[0x08] rec0=1c rec1=00 rec2=0a rec3=004
[0x09] rec0=03 rec1=00 rec2=09 rec3=001
tail 0x21721d20e83ad33f18d24 0x42a00088462060003