|
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: 20480 (0x5000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Scanner, seg_0385ba, seg_03860d, seg_038aa0
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Bounded_String;
with File;
with Msg_Report;
with String_Utilities;
with Text_Io;
package body Scanner is
function Is_Equal_String
(Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
return Boolean renames String_Utilities.Equal;
type State is (S_Found, S_Start, S_Integer, S_Identifier,
S_String, S_Minus, S_Less, S_Great, S_Comment);
Current_String : B_String;
Current_Token : Token;
Current_Line : Integer := 1;
-- ouverture du fichier
-- ====================
procedure Open (File_Name : String) is
begin
File.Open (File_Name);
exception
-- signaler l'erreur sur ouverture d'un fichier inexistant
when Text_Io.Name_Error =>
Msg_Report.Lexical_Error
("The file """ & File_Name & """ doesn't exist !!!", False);
raise Inexistant_File;
end Open;
-- fermeture du fichier
-- ====================
procedure Close is
begin
File.Close;
end Close;
-- renvoi VRAI si fin de l'analyse lexicale (avec fermeture du fichier)
-- ====================================================================
function Is_At_End return Boolean is
begin
if File.Is_At_End_File then
Close;
return True;
else
return False;
end if;
end Is_At_End;
-- retourne le type "token identificateur" de la chaine courante
-- =============================================================
function Eval_Identifier (Ident : String) return Token is
begin
if Is_Equal_String (Ident, "avec") then
return L_Avec;
elsif Is_Equal_String (Ident, "pour") then
return L_Pour;
elsif Is_Equal_String (Ident, "prendre") then
return L_Prendre;
elsif Is_Equal_String (Ident, "renvoyer") then
return L_Renvoyer;
else
return L_Identifier;
end if;
end Eval_Identifier;
-- analyse lexicale du symbole suivant
-- ===================================
procedure Next is
Current_Char : Character;
Current_State : State;
begin
if Is_At_End then
Current_Token := L_Eof;
else
-- initialiser la chaine a vide
Bounded_String.Free (Current_String);
-- initialiser l'etat de depart
Current_State := S_Start;
while (Current_State /= S_Found) loop
if File.Is_At_End_File then
case Current_State is
when S_Integer =>
Current_Token := L_Integer;
when S_Identifier =>
-- recherche sur l'identificateur (reserve ou non)
Current_Token := Eval_Identifier
(Bounded_String.Image
(Current_String));
when others =>
-- fermeture du fichier
Close;
Current_Token := L_Eof;
end case;
Current_State := S_Found;
else
if File.Is_At_End_Line then
-- caractere = CR, avancer d'une position dans le fichier
Current_Char := File.Get_Cr;
Current_Line := Current_Line + 1;
else
-- avancer dans le fichier et lire le caractere courant
Current_Char := File.Get;
end if;
case Current_State is
when S_Start =>
case Current_Char is
when ' ' | Ascii.Ht | Ascii.Cr =>
null;
when '0' .. '9' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Integer;
when 'A' .. 'Z' | 'a' .. 'z' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Identifier;
when '"' =>
Current_State := S_String;
when '{' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Open_Bracket;
Current_State := S_Found;
when '}' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Close_Bracket;
Current_State := S_Found;
when '.' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Dot;
Current_State := S_Found;
when '(' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Open_Parenthesis;
Current_State := S_Found;
when ')' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Close_Parenthesis;
Current_State := S_Found;
when '-' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Minus;
when '+' | '*' | '/' | '=' | '&' | '|' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Binary_Msg;
Current_State := S_Found;
when '<' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Less;
when '>' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Great;
when others =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Unknown;
Current_State := S_Found;
Msg_Report.Lexical_Error
(", undefined character -> ");
end case;
when S_Integer =>
case Current_Char is
when 'A' .. 'Z' | 'a' .. 'z' | '_' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Unknown;
Current_State := S_Found;
Msg_Report.Lexical_Error
(", alphabetic character not allowed in integer -> ");
when '0' .. '9' =>
Bounded_String.Append
(Current_String, Current_Char);
when others =>
File.Unget;
Current_Token := L_Integer;
Current_State := S_Found;
end case;
when S_Identifier =>
case Current_Char is
when 'A' .. 'Z' | 'a' .. 'z' | '_' =>
Bounded_String.Append
(Current_String, Current_Char);
when ':' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Key_Word;
Current_State := S_Found;
when '0' .. '9' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Unknown;
Current_State := S_Found;
Msg_Report.Lexical_Error
(", numeric character not allowed in identifier -> ");
when others =>
File.Unget;
-- recherche sur l'identificateur (reserve ou non)
Current_Token := Eval_Identifier
(Bounded_String.Image
(Current_String));
Current_State := S_Found;
end case;
when S_String =>
if Current_Char = '"' then
Current_Token := L_String;
Current_State := S_Found;
else
Bounded_String.Append
(Current_String, Current_Char);
end if;
when S_Minus =>
if Current_Char = '-' then
Current_State := S_Comment;
else
File.Unget;
Current_Token := L_Binary_Msg;
Current_State := S_Found;
end if;
when S_Less =>
case Current_Char is
when ' ' | Ascii.Ht | Ascii.Cr =>
null;
when '=' | '>' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Binary_Msg;
Current_State := S_Found;
when others =>
File.Unget;
Current_Token := L_Binary_Msg;
Current_State := S_Found;
end case;
when S_Great =>
case Current_Char is
when ' ' | Ascii.Ht | Ascii.Cr =>
null;
when '=' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Binary_Msg;
Current_State := S_Found;
when others =>
File.Unget;
Current_Token := L_Binary_Msg;
Current_State := S_Found;
end case;
when S_Comment =>
if (Current_Char = Ascii.Cr) then
-- fin de commentaire, retour a l'etat initial
Current_State := S_Start;
-- initialiser la chaine a vide
Bounded_String.Free (Current_String);
end if;
when S_Found =>
null;
end case;
end if;
end loop;
-- fermeture du fichier en cas d'erreur lexicale
if Current_Token = L_Unknown and then not Is_At_End then
Close;
end if;
end if;
Msg_Report.Information ("token: " & Token'Image (Current_Token));
end Next;
-- retourne la chaine courante
-- ===========================
function Value return String is
begin
return Bounded_String.Image (Current_String);
end Value;
-- retourne le token courant
-- =========================
function Symbol return Token is
begin
return Current_Token;
end Symbol;
-- retourne la ligne courante du fichier
-- =====================================
function Line_Number return Integer is
begin
return Current_Line;
end Line_Number;
end Scanner;
nblk1=13
nid=0
hdr6=26
[0x00] rec0=29 rec1=00 rec2=01 rec3=00a
[0x01] rec0=22 rec1=00 rec2=0d rec3=022
[0x02] rec0=0d rec1=00 rec2=0f rec3=028
[0x03] rec0=1c rec1=00 rec2=09 rec3=062
[0x04] rec0=1b rec1=00 rec2=05 rec3=06e
[0x05] rec0=0c rec1=00 rec2=02 rec3=02e
[0x06] rec0=13 rec1=00 rec2=06 rec3=066
[0x07] rec0=13 rec1=00 rec2=0a rec3=020
[0x08] rec0=00 rec1=00 rec2=08 rec3=018
[0x09] rec0=13 rec1=00 rec2=03 rec3=056
[0x0a] rec0=15 rec1=00 rec2=07 rec3=072
[0x0b] rec0=00 rec1=00 rec2=11 rec3=00c
[0x0c] rec0=16 rec1=00 rec2=0e rec3=042
[0x0d] rec0=13 rec1=00 rec2=10 rec3=048
[0x0e] rec0=05 rec1=00 rec2=0c rec3=014
[0x0f] rec0=16 rec1=00 rec2=12 rec3=03a
[0x10] rec0=19 rec1=00 rec2=0b rec3=026
[0x11] rec0=1f rec1=00 rec2=04 rec3=06a
[0x12] rec0=17 rec1=00 rec2=13 rec3=000
tail 0x215317db884e7562a5972 0x42a00088462060003