|
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: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Scanner, seg_036692, seg_036719, seg_0368f1
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with File;
with Object;
with Integer_Class;
with String_Class;
with Bounded_String;
with String_Utilities;
with Bug;
package body Scanner is
function Look_For_Token return Token;
New_Reference : Object.Reference := Object.Void_Reference;
Current_Token : Token := Token'(T_Unknown);
Current_String : Message.Tiny_String;
Current_Message : Message.Selector := Message.Sans_Parametre;
Current_Line_Number : Natural := 1;
Tmp_Line_Number : Natural := 1;
procedure Open (Fichier_Name : String) is
begin
File.Open (Fichier_Name => Fichier_Name);
end Open;
procedure Close is
begin
File.Close;
end Close;
function At_End return Boolean is
begin
return File.At_End;
end At_End;
function Get_Line_Number return Natural is
begin
return Current_Line_Number;
end Get_Line_Number;
procedure Set_Line_Number (To : Natural) is
begin
Current_Line_Number := To;
end Set_Line_Number;
function Get_Value return Message.Tiny_String is
begin
return Current_String;
end Get_Value;
function Get_Value return Object.Reference is
begin
return New_Reference;
end Get_Value;
function Get_Token return Token is
begin
return Current_Token;
end Get_Token;
function Get_Value return Message.Selector is
begin
return Current_Message;
end Get_Value;
function Look_For_Special
(The_String : Message.Tiny_String) return Special is
Index : Special := Non_Special;
begin
for I in Special'First .. Special'Last loop
if String_Utilities.Equal
(Str1 => Special'Image (I),
Str2 => Bounded_String.Image (V => The_String),
Ignore_Case => True) then
Index := I;
end if;
end loop;
return Index;
end Look_For_Special;
function State_Integer (The_Character : Character) return Token is
Current_Char : Character;
Current_Value : Integer;
begin
Bounded_String.Append (Target => Current_String,
Source => The_Character);
Current_Char := File.Get;
case Current_Char is
when '0' .. '9' =>
return State_Integer (Current_Char);
when others =>
File.Unget;
Current_Value := Standard.Integer'Value
(Bounded_String.Image (Current_String));
New_Reference := Integer_Class.Create (Value => Current_Value);
return Token'(T_Integer);
end case;
end State_Integer;
function State_Identifier (The_Character : Character) return Token is
Current_Char : Character;
begin
Bounded_String.Append (Target => Current_String,
Source => The_Character);
Current_Char := File.Get;
case Current_Char is
when 'a' .. 'z' | 'A' .. 'Z' =>
return State_Identifier (Current_Char);
when ':' =>
return Token'(T_Keyword);
when others =>
File.Unget;
case Look_For_Special (Current_String) is
when Pour =>
return Token'(T_Pour);
when Avec =>
return Token'(T_Avec);
when Renvoyer =>
return Token'(T_Renvoyer);
when Prendre =>
return Token'(T_Prendre);
when Non_Special =>
return Token'(T_Identifier);
end case;
end case;
end State_Identifier;
function State_String return Token is
Current_Char : Character;
begin
Current_Char := File.Get;
case Current_Char is
when '"' =>
New_Reference := String_Class.Create (Current_String);
return Token'(T_String);
when Ascii.Cr =>
Current_Line_Number := Current_Line_Number + 1;
Bounded_String.Append (Target => Current_String,
Source => Current_Char);
return State_String;
when Ascii.Eot =>
return Token'(T_Eof);
when others =>
Bounded_String.Append (Target => Current_String,
Source => Current_Char);
return State_String;
end case;
end State_String;
function State_Less return Token is
Current_Char : Character;
begin
Current_Char := File.Get;
case Current_Char is
when '=' =>
Current_Message := Message.Inferieur_Egal;
return Token'(T_Binary_Message);
when others =>
File.Unget;
Current_Message := Message.Inferieur;
return Token'(T_Binary_Message);
end case;
end State_Less;
function State_Great return Token is
Current_Char : Character;
begin
Current_Char := File.Get;
case Current_Char is
when '=' =>
Current_Message := Message.Superieur_Egal;
return Token'(T_Binary_Message);
when others =>
File.Unget;
Current_Message := Message.Superieur;
return Token'(T_Binary_Message);
end case;
end State_Great;
function State_Include return Token is
Current_Char : Character;
begin
Current_Char := File.Get;
case Current_Char is
when 'a' .. 'z' | 'A' .. 'Z' | '_' | '0' .. '9' =>
Bounded_String.Append (Target => Current_String,
Source => Current_Char);
return State_Include;
when '.' =>
Open (Bounded_String.Image (Current_String));
Tmp_Line_Number := Current_Line_Number;
Current_Line_Number := 1;
Current_Message := Message.Sans_Parametre;
Bounded_String.Free (Current_String);
New_Reference := Object.Void_Reference;
return Look_For_Token;
when others =>
raise Bug.Unexpected_Include_File_Name;
end case;
end State_Include;
function Look_For_Token return Token is
Current_Char : Character;
begin
Current_Char := File.Get;
case Current_Char is
when ' ' | Ascii.Ht =>
return Look_For_Token;
when Ascii.Cr =>
Current_Line_Number := Current_Line_Number + 1;
return Look_For_Token;
when '0' .. '9' =>
return State_Integer (Current_Char);
when 'a' .. 'z' | 'A' .. 'Z' =>
return State_Identifier (Current_Char);
when '{' =>
return Token'(T_Block_Open);
when '}' =>
return Token'(T_Block_End);
when '#' =>
return State_Include;
when '.' =>
return Token'(T_Dot);
when '(' =>
return Token'(T_Parenthese_Open);
when ')' =>
return Token'(T_Parenthese_End);
when '+' =>
Current_Message := Message.Plus;
return Token'(T_Binary_Message);
when '-' =>
Current_Message := Message.Moins;
return Token'(T_Binary_Message);
when '*' =>
Current_Message := Message.Multiplier;
return Token'(T_Binary_Message);
when '/' =>
Current_Message := Message.Diviser;
return Token'(T_Binary_Message);
when '<' =>
return State_Less;
when '>' =>
return State_Great;
when '=' =>
Current_Message := Message.Egal;
return Token'(T_Binary_Message);
when '"' =>
return State_String;
when '&' =>
Current_Message := Message.Et;
return Token'(T_Binary_Message);
when '|' =>
Current_Message := Message.Ou;
return Token'(T_Binary_Message);
when '[' =>
Current_Char := File.Get;
while Current_Char /= ']' loop
Current_Char := File.Get;
if Current_Char = Ascii.Cr then
Current_Line_Number := Current_Line_Number + 1;
end if;
end loop;
return Look_For_Token;
when others =>
return Token'(T_Unknown);
end case;
end Look_For_Token;
procedure Next is
begin
Current_Message := Message.Sans_Parametre;
Bounded_String.Free (Current_String);
New_Reference := Object.Void_Reference;
if not At_End then
Current_Token := Look_For_Token;
else
if File.Is_Include_Open then
File.Close;
Current_Line_Number := Tmp_Line_Number;
Tmp_Line_Number := 1;
Current_Token := Look_For_Token;
else
Current_Token := Token'(T_Eof);
end if;
end if;
end Next;
end Scanner;
nblk1=10
nid=5
hdr6=16
[0x00] rec0=28 rec1=00 rec2=01 rec3=00c
[0x01] rec0=22 rec1=00 rec2=04 rec3=00a
[0x02] rec0=1c rec1=00 rec2=02 rec3=008
[0x03] rec0=1a rec1=00 rec2=09 rec3=032
[0x04] rec0=20 rec1=00 rec2=08 rec3=022
[0x05] rec0=21 rec1=00 rec2=0c rec3=010
[0x06] rec0=1c rec1=00 rec2=03 rec3=004
[0x07] rec0=1e rec1=00 rec2=10 rec3=010
[0x08] rec0=19 rec1=00 rec2=07 rec3=016
[0x09] rec0=1c rec1=00 rec2=06 rec3=008
[0x0a] rec0=07 rec1=00 rec2=0b rec3=000
[0x0b] rec0=02 rec1=00 rec2=10 rec3=01a
[0x0c] rec0=19 rec1=00 rec2=07 rec3=03e
[0x0d] rec0=1c rec1=00 rec2=06 rec3=058
[0x0e] rec0=14 rec1=00 rec2=0b rec3=001
[0x0f] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21733652a84df4f862e2c 0x42a00088462060003
Free Block Chain:
0x5: 0000 00 0f 00 0d 80 02 49 3b 02 00 05 20 20 20 20 20 ┆ I; ┆
0xf: 0000 00 0d 03 7e 80 16 6d 62 65 72 20 28 54 6f 20 3a ┆ ~ mber (To :┆
0xd: 0000 00 0e 03 fc 80 09 65 66 65 72 65 6e 63 65 3b 09 ┆ eference; ┆
0xe: 0000 00 0a 00 1b 00 18 20 20 20 20 20 20 20 20 20 20 ┆ ┆
0xa: 0000 00 00 00 34 80 07 54 5f 44 6f 74 29 3b 07 00 17 ┆ 4 T_Dot); ┆