|
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: 8192 (0x2000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body File_Exists_F, package body File_Exists_R, seg_02507a
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Communications;
with Files;
with Interchange;
with Mac_Types;
with Mac_Text;
with Rational_Error;
with System;
with Talk_Utils;
with Text_Io;
use Text_Io;
with Unchecked_Conversion;
package body File_Exists_R is
package File_Exists_F is
procedure Of_Remote_File_In (Name : Mac_Text.Text);
procedure File_Exists_Out (Exists : out Boolean);
procedure End_File_Exists;
end File_Exists_F;
package body File_Exists_F is
Err : Mac_Types.Oserr := Mac_Types.Noerr;
Existence : Boolean := False;
function As_Stringptr is new Unchecked_Conversion
(Source => System.Address,
Target => Mac_Types.Stringptr);
function As_Hparmblkptr is
new Unchecked_Conversion (Source => System.Address,
Target => Files.Hparmblkptr);
procedure Of_Remote_File_In (Name : Mac_Text.Text) is
S : Mac_Types.Str255 := Mac_Text.Value (Name);
Pb : Files.Filehparamblockrec;
begin
Existence := False;
Pb.Iocompletion := null;
Pb.Ionameptr := As_Stringptr (S'Address);
Pb.Iovrefnum := 0;
Pb.Iofdirindex := 0;
Pb.Iodirid := 0;
Err := Files.Pbhgetfinfo (As_Hparmblkptr (Pb'Address), False);
Existence := Err = Mac_Types.Noerr;
end Of_Remote_File_In;
procedure File_Exists_Out (Exists : out Boolean) is
begin
Exists := Existence;
end File_Exists_Out;
procedure End_File_Exists is
begin
null;
end End_File_Exists;
end File_Exists_F;
procedure Read (A_Connection : in out Communications.Connection) is
I : Mac_Types.Longint;
T : Mac_Text.Text (256);
begin
Put_Line ("file_exists_r:read begin");
Interchange.Get_Int (A_Connection, I);
if I /= Talk_Utils.F_Of_Remote_File then
Rational_Error.Raise_Error (Rational_Error.Internal_Error);
end if;
Interchange.Get_Text (A_Connection, T);
File_Exists_F.Of_Remote_File_In (T);
Put ("file_exists_r:file '");
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_Delimitor then
Rational_Error.Raise_Error (Rational_Error.Internal_Error);
end if;
Interchange.Get_Int (A_Connection, I);
if I /= Talk_Utils.R_File_Exists then
Rational_Error.Raise_Error (Rational_Error.Internal_Error);
end if;
Put_Line ("file_exists_r:read end");
end Read;
procedure Write (A_Connection : in out Communications.Connection) is
begin
Put_Line ("file_exists_r:write begin");
declare
Exists : Boolean;
begin
File_Exists_F.File_Exists_Out (Exists);
Put ("file_exists_r:write exists : ");
Put_Line (Boolean'Image (Exists));
Interchange.Put_Int (A_Connection, Talk_Utils.F_Exists);
Interchange.Put_Bool (A_Connection, Exists);
File_Exists_F.End_File_Exists;
exception
when others =>
Rational_Error.Report
(A_Connection, Talk_Utils.R_File_Exists, Rational_Error.Get);
end;
Interchange.Put_Int (A_Connection, Talk_Utils.F_Delimitor);
Interchange.Put_Int (A_Connection, Talk_Utils.R_File_Exists);
Put_Line ("file_exists_r:write end");
end Write;
end File_Exists_R;
nblk1=7
nid=3
hdr6=8
[0x00] rec0=24 rec1=00 rec2=01 rec3=03a
[0x01] rec0=1e rec1=00 rec2=04 rec3=02e
[0x02] rec0=17 rec1=00 rec2=06 rec3=05a
[0x03] rec0=17 rec1=00 rec2=05 rec3=000
[0x04] rec0=0a rec1=00 rec2=04 rec3=000
[0x05] rec0=19 rec1=00 rec2=06 rec3=000
[0x06] rec0=04 rec1=00 rec2=02 rec3=000
tail 0x217200556839f4b022d80 0x42a00088462060003
Free Block Chain:
0x3: 0000 00 07 02 8c 80 02 29 3b 02 00 2e 20 20 20 20 20 ┆ ); . ┆
0x7: 0000 00 02 00 34 80 0a 43 6f 6e 76 65 72 73 69 6f 6e ┆ 4 Conversion┆
0x2: 0000 00 00 00 2b 80 1d 74 20 69 73 20 6e 65 77 20 55 ┆ + t is new U┆