|
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 Enumeration_Io, seg_04ba77, 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 A_Strings;
separate (Text_Io)
package body Enumeration_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);
procedure Get (File : in File_Type; Item : out Enum) is
C : Character;
Str : String (1 .. Enum'Width + 3); -- insure 3 for 'a' enums
Len : Integer;
Fp : File_Ptr := File_Ptr (File);
begin
Safe_Support.File_Lock (File);
Must_Be_Input (File);
Skip_Blanks_And_Lines (Fp);
C := File.Buffer.Elem (File.In_Ptr);
if C /= ''' then
Len := 0;
if (C < 'A' or C > 'Z') and (C < 'a' or C > 'z') then
File.In_Ptr := File.In_Ptr - 1;
raise Data_Error;
end if;
loop
if Len <= Enum'Width then
Len := Len + 1;
end if;
Str (Len) := C;
exit when Tstfile (Fp) /= At_Char;
C := File.Buffer.Elem (File.In_Ptr + 1);
if C = '_' then
if Str (Len) = '_' then
raise Data_Error;
end if;
elsif (C < 'A' or C > 'Z') and (C < 'a' or C > 'z') and
(C < '0' or C > '9') then
exit;
end if;
C := Getchar (Fp); -- same "c" as lookahead; now read it
end loop;
if Len > Enum'Width then
raise Data_Error;
end if;
else
Str (1) := C;
if Tstfile (Fp) /= At_Char then
raise Data_Error;
end if;
Str (2) := Getchar (Fp);
if Tstfile (Fp) /= At_Char then
raise Data_Error;
end if;
if File.Buffer.Elem (File.In_Ptr + 1) /= ''' then
raise Data_Error;
end if;
Str (3) := Getchar (Fp);
Len := 3;
end if;
begin
Item := Enum'Value (Str (1 .. Len));
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 Enum) is
begin
-- Called get() does file_lock()/file_unlock()
Get (Current_Input, Item);
end Get;
procedure Put (File : in File_Type;
Item : in Enum;
Width : in Field := Default_Width;
Set : in Type_Set := Default_Setting) is
Str : constant String := Enum'Image (Item);
begin
Safe_Support.File_Lock (File);
Must_Be_Output (File);
if File.Linelength /= 0 then
if Width > File.Linelength or else Str'Length > File.Linelength then
raise Layout_Error;
end if;
end if;
if File.Linelength /= 0 and then
Natural (Get_Col (File)) + Str'Length - 1 > File.Linelength then
Putchar (File_Ptr (File), Ascii.Lf);
end if;
if Str (1) /= ''' and Set = Lower_Case then
for I in Str'Range loop
Putchar (File_Ptr (File), A_Strings.To_Lower (Str (I)));
end loop;
else
for I in Str'Range loop
Putchar (File_Ptr (File), Str (I));
end loop;
end if;
for I in Str'Length .. Integer (Width) - 1 loop
Putchar (File_Ptr (File), ' ');
end loop;
if File.Always_Flush then
Flush (File);
end if; Safe_Support.File_Unlock (File);
exception
when others =>
Safe_Support.File_Unlock (File);
raise;
end Put;
procedure Put (Item : in Enum;
Width : in Field := Default_Width;
Set : in Type_Set := Default_Setting) is
begin
-- Called put() does file_lock()/file_unlock()
Put (Current_Output, Item, Width, Set);
end Put;
procedure Get (From : in String; Item : out Enum; Last : out Positive) is
Index : Positive;
Start : Positive;
begin
Start := From'First;
while Start <= From'Last loop
case From (Start) is
when ' ' | Ascii.Ht | Ascii.Lf | Ascii.Ff =>
Start := Start + 1;
when others =>
exit;
end case;
end loop;
if Start > From'Last then
raise End_Error;
end if;
if From (Start) = ''' then
Index := Start + 2;
if Index > From'Last then
raise Data_Error;
end if;
begin
Item := Enum'Value (From (Start .. Index));
exception
when Constraint_Error =>
raise Data_Error;
end;
Last := Index;
else
Index := Start;
if From (Index) >= '0' and From (Index) <= '9' then
raise Data_Error;
end if;
while Index <= From'Last loop
case From (Index) is
when 'a' .. 'z' =>
Index := Index + 1;
when 'A' .. 'Z' =>
Index := Index + 1;
when '0' .. '9' =>
Index := Index + 1;
when '_' =>
Index := Index + 1;
when others =>
exit;
end case;
end loop;
if Index = Start then
raise Data_Error; -- First character non alpha
else
Index := Index - 1;
end if;
begin
Item := Enum'Value (From (Start .. Index));
exception
when Constraint_Error =>
raise Data_Error;
end;
Last := Index;
end if;
end Get;
procedure Put (To : out String;
Item : in Enum;
Set : in Type_Set := Default_Setting) is
Str : constant String := Enum'Image (Item);
Index : Integer;
begin
if Str'Length > To'Length then
raise Layout_Error;
end if;
Index := To'First;
for I in Str'Range loop
if Index <= To'Last then
if Str (1) /= ''' and Set = Lower_Case then
To (Index) := A_Strings.To_Lower (Str (I));
else
To (Index) := Str (I);
end if;
Index := Index + 1;
end if;
end loop;
for I in Index .. To'Last loop
To (I) := ' ';
end loop;
end Put;
end Enumeration_Io;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=1f rec1=00 rec2=01 rec3=016
[0x01] rec0=1a rec1=00 rec2=02 rec3=01a
[0x02] rec0=20 rec1=00 rec2=03 rec3=00c
[0x03] rec0=1b rec1=00 rec2=04 rec3=002
[0x04] rec0=1f rec1=00 rec2=05 rec3=00e
[0x05] rec0=1b rec1=00 rec2=06 rec3=032
[0x06] rec0=1f rec1=00 rec2=07 rec3=052
[0x07] rec0=0e rec1=00 rec2=08 rec3=000
tail 0x21548d62e86843c10b5b9 0x42a00088462060003