|
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: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Integer_Io, seg_050950, separate Text_Io
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Number_Io;
use Number_Io;
separate (Text_Io)
package body Integer_Io is
pragma Suppress (Access_Check);
pragma Suppress (Discriminant_Check);
pragma Suppress (Index_Check);
pragma Suppress (Length_Check);
pragma Suppress (Division_Check);
pragma Suppress (Overflow_Check);
pragma Suppress (Elaboration_Check);
Numbers : constant String (1 .. 16) := "0123456789ABCDEF";
procedure Get (File : in File_Type;
Item : out Num;
Width : in Field := 0) is
Result : Integer;
Fp : File_Ptr := File_Ptr (File);
End_Ptr : Integer;
Error : Boolean := False;
begin
Safe_Support.File_Lock (File);
Must_Be_Input (File);
if Width /= 0 then
if Tstfile (Fp) /= At_Char then
raise Data_Error;
end if;
End_Ptr := Fp.In_Ptr + Width;
if End_Ptr > Fp.Last then
-- We need to get width characters into the buffer,
-- but since they may not all fit we'll stick the next
-- width characters into an array, and getnum on that.
declare
Str : String (1 .. Width);
Len : Integer := 0;
Last : Integer;
begin
while Len < Width loop
Len := Len + 1;
Str (Len) := Getchar (Fp);
exit when Tstfile (Fp) /= At_Char;
end loop;
Getnum (Str (1 .. Len), Result, Last, Error);
if Error or else Last /= Len then
raise Data_Error;
end if;
end;
else
Getnum (String (Fp.Buffer.Elem (Fp.In_Ptr + 1 .. End_Ptr)),
Result, Fp.In_Ptr, Error);
if End_Ptr /= Fp.In_Ptr and then Tstfile (Fp) = At_Char then
while Fp.In_Ptr < End_Ptr loop
exit when Tstfile (Fp) /= At_Char;
Fp.In_Ptr := Fp.In_Ptr + 1;
end loop;
raise Data_Error;
elsif Error then
raise Data_Error;
end if;
end if;
else
Getnum (File, Result);
end if;
begin
Item := Num (Result);
exception
when Constraint_Error =>
raise Data_Error;
end;
Safe_Support.File_Unlock (File);
exception
when others =>
Safe_Support.File_Unlock (File);
raise;
end Get;
procedure Get (Item : out Num; Width : in Field := 0) is
begin
-- Called get() does file_lock()/file_unlock()
Get (Current_Input, Item, Width);
end Get;
procedure Put (File : in File_Type;
Item : in Num;
Width : in Field := Default_Width;
Base : in Number_Base := Default_Base) is
Last : Integer := 68;
First : Integer := Last;
Len : Integer;
Str : String (1 .. Last);
begin
Safe_Support.File_Lock (File);
Must_Be_Output (File);
Put (Str, Item, Base);
while First > 1 loop
if Str (First) = ' ' then
exit;
end if;
First := First - 1;
end loop;
Len := Width;
if Width < Last - First then
Len := Last - First;
end if;
if File.Linelength /= 0 and then Len > File.Linelength then
raise Layout_Error;
end if;
if File.Linelength /= 0 and then
Natural (Get_Col (File)) + Len - 1 > File.Linelength then
Putchar (File_Ptr (File), Ascii.Lf);
end if;
for I in Last - First + 1 .. Width loop
Putchar (File_Ptr (File), ' ');
end loop;
for I in First + 1 .. Last loop
Putchar (File_Ptr (File), Str (I));
end loop;
if File.Always_Flush then
Flush (File_Ptr (File));
end if;
Safe_Support.File_Unlock (File);
exception
when others =>
Safe_Support.File_Unlock (File);
raise;
end Put;
procedure Put (Item : in Num;
Width : in Field := Default_Width;
Base : in Number_Base := Default_Base) is
begin
-- Called put() does file_lock()/file_unlock()
Put (Current_Output, Item, Width, Base);
end Put;
procedure Get (From : in String; Item : out Num; Last : out Positive) is
Result : Integer;
Error : Boolean := False;
I : Integer;
Int_Last : Integer; -- In case getnum returns a last of 0
begin
--
-- test for end_error
--
I := From'First;
loop
if I > From'Last then
raise End_Error;
end if;
exit when From (I) /= ' ' and then From (I) /= Ascii.Ht;
I := I + 1;
end loop;
Getnum (From, Result, Int_Last, Error);
if Error or Int_Last = 0 then
raise Data_Error;
else
Last := Int_Last;
end if;
begin
Item := Num (Result);
exception
when Constraint_Error =>
raise Data_Error;
end;
end Get;
procedure Put (To : out String;
Item : in Num;
Base : in Number_Base := Default_Base) is
Val : Integer := Integer (Item);
Sign : Character := '-';
First : Boolean := True;
Done : Boolean := False;
Last : Integer := To'Last;
Pos : Integer := -1;
Cbase : Number_Base := Base;
begin
if Base /= 10 then
Last := To'Last - 1;
if (Last < To'First) then
raise Layout_Error;
end if;
To (To'Last) := '#';
end if;
if Val >= 0 then
Sign := ' ';
Val := -Val;
end if;
for I in reverse To'First .. Last loop
if Val /= 0 then
To (I) := Numbers (-(Val rem Cbase) + 1);
Val := Val / Cbase;
else
if First then
To (I) := '0';
elsif not Done and Base /= 10 then
To (I) := '#';
Val := -Base;
Done := True;
Cbase := 10;
else
To (I) := Sign;
Sign := ' ';
end if;
end if; First := False;
end loop;
if Val /= 0 or else Sign = '-' then
raise Layout_Error;
end if;
if Base /= 10 and not Done then
raise Layout_Error;
end if;
end Put;
end Integer_Io;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=21 rec1=00 rec2=01 rec3=014
[0x01] rec0=15 rec1=00 rec2=02 rec3=038
[0x02] rec0=20 rec1=00 rec2=03 rec3=00e
[0x03] rec0=1c rec1=00 rec2=04 rec3=00c
[0x04] rec0=1d rec1=00 rec2=05 rec3=06e
[0x05] rec0=23 rec1=00 rec2=06 rec3=034
[0x06] rec0=20 rec1=00 rec2=07 rec3=002
[0x07] rec0=0b rec1=00 rec2=08 rec3=000
tail 0x2154af656878e78875f44 0x42a00088462060003