|
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: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Ls_F, package body Ls_R, seg_02519c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Bit_Ops;
with Communications;
with Errors;
with Files;
with Files;
with Interchange;
with Mac_Files;
with Mac_Path;
with Mac_Types;
with Mac_Text;
with Memory;
with Osutils;
with Rational_Error;
with System;
with Talk_Utils;
with Text_Io;
use Text_Io;
with Unchecked_Conversion;
package body Ls_R is
package Ls_F is
procedure From_Remote_Directory_In (Name : Mac_Text.Text);
procedure Level_In (From_Level : Mac_Types.Longint);
procedure End_Ls (A_Connection : in out Communications.Connection);
end Ls_F;
procedure Write_A_Line (A_Connection : in out Communications.Connection;
T : Mac_Text.Text) is
begin
Interchange.Put_Int (A_Connection, Talk_Utils.F_A_Line);
Interchange.Put_Text (A_Connection, T);
end Write_A_Line;
package body Ls_F is
Err : Mac_Types.Oserr := Mac_Types.Noerr;
Level : Mac_Types.Longint;
From_Directory : Mac_Types.Str255;
function As_Varinteger is new Unchecked_Conversion
(Source => System.Address,
Target => Mac_Types.Varinteger);
function As_Varlongint is new Unchecked_Conversion
(Source => System.Address,
Target => Mac_Types.Varlongint);
procedure From_Remote_Directory_In (Name : Mac_Text.Text) is
begin
Err := Mac_Types.Noerr;
Level := 0;
From_Directory := Mac_Text.Value (Name);
end From_Remote_Directory_In;
procedure Level_In (From_Level : Mac_Types.Longint) is
begin
Level := From_Level;
end Level_In;
procedure Print_Directories
(A_Connection : in out Communications.Connection;
Name : Mac_Types.Str255;
Level : Mac_Types.Longint) is
use Mac_Types;
type Dircinfopbptr is access Files.Dircinfopbrec;
type Hfilecinfopbptr is access Files.Hfilecinfopbrec;
function As_Stringptr is new Unchecked_Conversion
(Source => System.Address,
Target => Mac_Types.Stringptr);
function As_Cinfopbptr is new Unchecked_Conversion
(Source => System.Address,
Target => Files.Cinfopbptr);
function As_Hfilecinfopbptr is
new Unchecked_Conversion (Source => System.Address,
Target => Hfilecinfopbptr);
function As_Dircinfopbptr is
new Unchecked_Conversion (Source => System.Address,
Target => Dircinfopbptr);
Err : Mac_Types.Oserr;
S : Mac_Types.Str255 := Name;
Pb : Files.Cinfopbrec;
Filepb : Hfilecinfopbptr := As_Hfilecinfopbptr (Pb'Address);
Dirpb : Dircinfopbptr := As_Dircinfopbptr (Pb'Address);
T : Mac_Text.Text (256);
Unaccessible : constant Mac_Text.String := " unaccessible";
procedure Enumerate_Catalog (Dirid : Mac_Types.Longint;
Current_Level : Mac_Types.Longint) is
Folder_Bit : constant Byte_Integer := 2#00001000#;
Index : Mac_Types.Integer;
begin
if Current_Level >= Level then
return;
end if;
Index := 1;
loop
Pb.Iofdirindex := Index;
Dirpb.Iodrdirid := Dirid;
Err := Files.Pbgetcatinfo
(As_Cinfopbptr (Pb'Address), False);
if Err = Mac_Types.Noerr then
if Bit_Ops."and"
(Byte_Integer (Pb.Ioflattrib), Folder_Bit) /=
0 then
Mac_Text.Set_Empty (T);
for I in 1 .. Current_Level loop
Mac_Text.Append (' ', T);
end loop;
Mac_Text.Append (Mac_Text.String (S), T);
Write_A_Line (A_Connection, T);
Enumerate_Catalog (Dirpb.Iodrdirid,
Current_Level + 1);
else
Mac_Text.Set_Empty (T);
for I in 1 .. Current_Level loop
Mac_Text.Append (' ', T);
end loop;
Mac_Text.Append (Mac_Text.String (S), T);
Write_A_Line (A_Connection, T);
end if;
end if;
Index := Index + 1;
exit when Err /= Mac_Types.Noerr;
end loop;
end Enumerate_Catalog;
begin
Pb.Iocompletion := null;
Pb.Ionameptr := As_Stringptr (S'Address);
Pb.Iovrefnum := 0;
Pb.Iofdirindex := 0;
Dirpb.Iodrdirid := 0;
Err := Files.Pbgetcatinfo (As_Cinfopbptr (Pb'Address), False);
if Err = Mac_Types.Noerr then
Enumerate_Catalog (Dirpb.Iodrdirid, 0);
else
Mac_Text.Set (T, Mac_Text.String (S));
Mac_Text.Append (Tail => Unaccessible, To => T);
Write_A_Line (A_Connection, T);
end if;
end Print_Directories;
procedure End_Ls (A_Connection : in out Communications.Connection) is
begin
Print_Directories (A_Connection, From_Directory, Level);
Mac_Files.Set_Current_User_Home;
if Err /= Mac_Types.Noerr then
Rational_Error.Raise_Mac_Error (Err);
end if;
end End_Ls;
end Ls_F;
procedure Read (A_Connection : in out Communications.Connection) is
I : Mac_Types.Longint;
B : Boolean;
T : Mac_Text.Text (256);
begin
Put_Line ("ls_r:read begin");
Interchange.Get_Int (A_Connection, I);
if I /= Talk_Utils.F_From_Remote_Directory then
Rational_Error.Raise_Error (Rational_Error.Internal_Error);
end if;
Interchange.Get_Text (A_Connection, T);
Ls_F.From_Remote_Directory_In (T);
Put ("ls_r:directory '");
for I in 1 .. Mac_Text.Length (T) loop
Put (Character'Val (Mac_Types.Char'Pos (Mac_Text.Value (I, T))));
end loop;
Put_Line ("'");
Interchange.Get_Int (A_Connection, I);
if I /= Talk_Utils.F_Level then
Rational_Error.Raise_Error (Rational_Error.Internal_Error);
end if;
Interchange.Get_Int (A_Connection, I);
Ls_F.Level_In (I);
Put ("ls_r:level: ");
Put_Line (Mac_Types.Longint'Image (I));
Interchange.Get_Int (A_Connection, I);
if I /= Talk_Utils.F_Delimitor then
Rational_Error.Raise_Error (Rational_Error.Internal_Error);
end if;
Interchange.Get_Int (A_Connection, I);
if I /= Talk_Utils.R_Ls then
Rational_Error.Raise_Error (Rational_Error.Internal_Error);
end if;
Put_Line ("ls_r:read end");
end Read;
procedure Write (A_Connection : in out Communications.Connection) is
begin
Put_Line ("ls_r:write begin");
begin
Ls_F.End_Ls (A_Connection);
exception
when others =>
Rational_Error.Report
(A_Connection, Talk_Utils.R_Ls, Rational_Error.Get);
end;
Interchange.Put_Int (A_Connection, Talk_Utils.F_Delimitor);
Interchange.Put_Int (A_Connection, Talk_Utils.R_Ls);
Put_Line ("ls_r:write end");
end Write;
end Ls_R;
nblk1=c
nid=8
hdr6=16
[0x00] rec0=27 rec1=00 rec2=01 rec3=048
[0x01] rec0=01 rec1=00 rec2=09 rec3=03e
[0x02] rec0=1a rec1=00 rec2=06 rec3=026
[0x03] rec0=15 rec1=00 rec2=03 rec3=00c
[0x04] rec0=01 rec1=00 rec2=0b rec3=048
[0x05] rec0=15 rec1=00 rec2=05 rec3=062
[0x06] rec0=12 rec1=00 rec2=07 rec3=068
[0x07] rec0=1b rec1=00 rec2=0c rec3=03a
[0x08] rec0=1a rec1=00 rec2=04 rec3=040
[0x09] rec0=1b rec1=00 rec2=0a rec3=00a
[0x0a] rec0=08 rec1=00 rec2=02 rec3=000
[0x0b] rec0=0e rec1=00 rec2=09 rec3=000
tail 0x217200ed2839f594ae675 0x42a00088462060003
Free Block Chain:
0x8: 0000 00 00 00 cf 00 43 20 20 20 20 20 20 20 20 49 6e ┆ C In┆