|
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 Os_Files, seg_05098c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-- for UNIX versions
with Io_Exceptions;
use Io_Exceptions;
with File_Support;
use File_Support;
with Os_Variant;
with Unix;
with Libc;
with Unchecked_Conversion;
with Unchecked_Deallocation;
with Strlen;
with A_Strings;
with C_Strings;
with V_I_Bits;
package body Os_Files is
type File_Id_Type is new Os_Variant.File_Id_Type;
Last_Dir_Id : File_Id_Type := (others => 16#FF#);
Last_Dir : C_Strings.C_String_Buf;
Last_Dir_Len : Integer := 0;
Max_Fails : constant Integer := 30;
function To_File_Ptr is new Unchecked_Conversion
(System.Long_Address, File_Ptr);
function "+" (Left, Right : Open_Flags) return Open_Flags is
L : Integer := Integer (Left);
R : Integer := Integer (Right);
T : Integer := 1;
begin
T := V_I_Bits.Bit_Or (L, R);
return Open_Flags (T);
end "+";
function "-" (Left, Right : Open_Flags) return Open_Flags is
L : Integer := Integer (Left);
R : Integer := Integer (Right);
T : Integer := 1;
begin
T := V_I_Bits.Bit_And (L, V_I_Bits.Bit_Neg (R));
return Open_Flags (T);
end "-";
function At_End_Of_File (Fd : File_Descriptor) return Boolean is
Offset : Integer;
Size : Integer := Os_Variant.Get_File_Size (Fd);
begin
Offset := Unix.Lseek (Fd, 0, Unix.L_Incr); -- get current offset
if Offset < 0 then
raise Device_Error;
end if;
return Offset >= Size;
end At_End_Of_File;
function Get_File_Id (Fd : File_Descriptor) return File_Id_Ptr is
begin
return new File_Id_Type'(File_Id_Type
(Os_Variant.Get_File_Id (Fd, "")));
end Get_File_Id;
function Same_Id (F1, F2 : File_Id_Ptr) return Boolean is
begin
if F1 = null or F2 = null then
return False;
end if;
return F1.all = F2.all;
end Same_Id;
function File_Size
(Fd : File_Descriptor; Elem_Size : Integer) return Integer is
begin
return ((Os_Variant.Get_File_Size (Fd) + Elem_Size - 1) / Elem_Size);
end File_Size;
function Is_Interactive (Fd : File_Descriptor) return Boolean is
begin
return Os_Variant.Is_A_Tty (Fd);
end Is_Interactive;
procedure Position_File (Fd : File_Descriptor; To, Size : Integer) is
Result : Unix.Offset;
begin
Result := Unix.Lseek (Fd, (To - 1) * Size, Unix.L_Set);
end Position_File;
procedure Skip_In_File (Fd : File_Descriptor; To : Integer) is
Result : Unix.Offset;
begin
Result := Unix.Lseek (Fd, To, Unix.L_Incr);
end Skip_In_File;
function Read (Fd : File_Descriptor;
Addr : System.Long_Address;
Cnt : Integer) return Integer is
Count : Integer;
Local_Addr : System.Address := System.Localize
(Addr, Cnt * System.Storage_Unit);
begin
loop
Count := Unix.Read (Fd, Local_Addr, Cnt);
exit when Count /= Unix.Error;
exit when Unix."/=" (Unix.Errnum, Unix.Eintr);
end loop;
return Count;
end Read;
procedure Sleep (Seconds : Integer);
pragma Interface (C, Sleep);
procedure Write (Fd : File_Descriptor;
Addr : System.Long_Address;
Cnt : Integer) is
Max_Fails : constant Integer := 30;
Actual : Integer;
Remaining : Integer := Cnt;
Buf : System.Address := System.Localize
(Addr, Cnt * System.Storage_Unit);
Fails : Integer := 0;
begin
loop
loop
Actual := Unix.Write (Fd, Buf, Remaining);
exit when Actual /= Unix.Error;
exit when Unix."/=" (Unix.Errnum, Unix.Eintr);
end loop;
exit when Actual = Remaining or else Remaining <= 0;
Os_Variant.Try_Waiting (Fails, Fd);
if not Is_Interactive (Fd) or Fails > Max_Fails then
raise Device_Error;
end if;
Remaining := Remaining - Actual;
Buf := Buf + Actual;
end loop;
end Write;
procedure Open (File : System.Long_Address;
Style : File_Styles;
Mode : Open_Flags) is
This_File : File_Ptr := To_File_Ptr (File);
Fd : File_Descriptor;
C_Name : C_Strings.C_String_Buf;
C_File_Name : C_Strings.C_String;
Cvt_Mode : Os_Variant.Open_Flags := Os_Variant.Cvt_Open_Flags (Mode);
begin
if Style = Special then
if This_File.Name.S = "stdin" then
Fd := File_Descriptor (0);
Os_Variant.Condition_Stdin (Stdin_Fd, Cvt_Mode);
elsif This_File.Name.S = "stdout" then
Fd := File_Descriptor (1);
else
Fd := File_Descriptor (2);
end if;
else
C_File_Name := C_Strings.To_C (This_File.Name, C_Name'Address);
loop
Fd := Unix.Open (C_File_Name, Cvt_Mode);
exit when Fd /= File_Descriptor (-1);
case Unix.Errnum is
when Unix.Eintr =>
null; -- try again.
when Unix.Enoent | Unix.Enotdir | Unix.Enametoolong =>
raise Name_Error;
when others =>
raise Use_Error;
end case;
end loop;
end if;
This_File.Fd := Fd;
This_File.File_Id :=
new File_Id_Type'(File_Id_Type (Get_File_Id (Fd, This_File.Name.S))); end Open;
procedure Close (Fd : File_Descriptor) is
Ignore : Unix.Status_Code;
begin
Ignore := Unix.Close (Fd);
end Close;
procedure Truncate (Fd : File_Descriptor) is
begin
if Unix.Ftruncate (Fd, 0) /= 0 then
raise Device_Error;
end if;
end Truncate;
procedure Delete (Fd : File_Descriptor; Name : A_Strings.A_String) is
Ignore : Unix.Status_Code;
C_Name : String (1 .. 1024);
begin
Ignore := Unix.Unlink (C_Strings.To_C (Name, C_Name'Address));
end Delete;
procedure Getdir (Path : in out String; Length : out Integer) is
Cwd_Id : Os_Variant.File_Id_Type;
begin
-- check to see if we're in the same dir, so no heap will be used
Cwd_Id := Os_Variant.Get_File_Id
(File_Descriptor (-1), "." & Ascii.Nul);
if File_Id_Type (Cwd_Id) /= Last_Dir_Id then
Last_Dir_Id := File_Id_Type (Cwd_Id);
Unix.Getcwd (Last_Dir);
Last_Dir_Len := Strlen (Last_Dir'Address) + 1;
Last_Dir (Last_Dir_Len) := '/';
end if;
if Last_Dir_Len > Path'Length then
Length := -1;
else
Length := Last_Dir_Len;
Path (1 .. Last_Dir_Len) := Last_Dir (1 .. Last_Dir_Len);
end if;
end Getdir;
function Get_Tempname (Root : String) return A_Strings.A_String is
Tname : constant String := Unix.Get_Temp_Name ("/tmp/" & Root);
begin
return A_Strings.To_A (Tname (Tname'First .. Tname'Last - 1));
end Get_Tempname;
function Get_Full_Name (Name : String; Style : File_Styles)
return A_Strings.A_String is
Name_Length : Integer := Name'Length;
Length : Integer;
Temp : Name_String;
Result : A_Strings.A_String;
begin
if Name_Length = 0 then
return Get_Tempname ("adatmp");
elsif Name (Name'First) /= '/' and then Style /= Special then
Getdir (Temp, Length);
Temp (Temp'First + Length ..
Temp'First + Length + Name_Length - 1) := Name;
Length := Length + Name_Length;
else
Temp (1 .. Name_Length) := Name;
Length := Name_Length;
end if;
Result := new A_Strings.String_Rec (Length);
Result.S (1 .. Length) := Temp (1 .. Length);
return Result;
end Get_Full_Name;
function Std_Input_Name return String is
begin
return "stdin";
end Std_Input_Name;
function Std_Output_Name return String is
begin
return "stdout";
end Std_Output_Name;
function Std_Error_Name return String is
begin
return "stderr";
end Std_Error_Name;
procedure Fix_End_Of_Record
(File : System.Long_Address; Actual : in out Integer) is
begin
null;
end Fix_End_Of_Record;
function Ok_To_Write (File : System.Long_Address) return Boolean is
begin
return True;
end Ok_To_Write;
procedure Free is new Unchecked_Deallocation (File_Id_Type, File_Id_Ptr);
procedure Free_File_Id (Id_Ptr : in out File_Id_Ptr) is
begin
Free (Id_Ptr);
end Free_File_Id;
function Flushable (Fd : File_Descriptor) return Boolean is
begin
return True;
end Flushable;
begin
Stdin_Fd := File_Descriptor (0);
Stdout_Fd := File_Descriptor (1);
Stderr_Fd := File_Descriptor (2);
Always_Flush_Files := False;
end Os_Files;
nblk1=a
nid=0
hdr6=14
[0x00] rec0=28 rec1=00 rec2=01 rec3=066
[0x01] rec0=1d rec1=00 rec2=02 rec3=034
[0x02] rec0=1f rec1=00 rec2=03 rec3=012
[0x03] rec0=1c rec1=00 rec2=04 rec3=028
[0x04] rec0=19 rec1=00 rec2=05 rec3=004
[0x05] rec0=18 rec1=00 rec2=06 rec3=002
[0x06] rec0=1d rec1=00 rec2=07 rec3=04c
[0x07] rec0=1b rec1=00 rec2=08 rec3=03a
[0x08] rec0=1f rec1=00 rec2=09 rec3=08c
[0x09] rec0=1b rec1=00 rec2=0a rec3=000
tail 0x217580150878e792a8f64 0x42a00088462060003