|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 9408 (0x24c0)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Text_Io, Io_Exceptions;
package body Lex is
package Input is
function Open (Filename : String) return Boolean;
function Atend return Boolean;
function Get return Character;
procedure Unget;
procedure Close;
function Getline return Positive;
end Input;
type State is (S_Start, S_Number, S_Str, S_Ok);
type Condition is (C_Separator, C_Letter, C_Letteraf,
C_Letterh, C_Digit, C_Unknown);
type Action is (A_Nothing, A_Car_String, A_Car_Number,
A_Number_Hex, A_Number_Dec, A_Error);
type Transition is
record
Next_State : State;
Next_Action : Action;
end record;
Max_Digit_Num : constant Integer := 4;
Max_Car_String : constant Integer := 20;
Min_Number_Value : constant Integer := 0;
Max_Number_Value : constant Integer := 256 * 256;
End_Found : Boolean := False;
Current_Symbol : Token;
type Chaine is access String;
Storage_String : Chaine;
Storage_Number : Integer;
Transition_Table : array (State, Condition) of Transition :=
(S_Start => ((S_Start, A_Nothing), (S_Str, A_Car_String),
(S_Str, A_Car_String), (S_Str, A_Car_String),
(S_Number, A_Car_Number), (S_Ok, A_Error)),
S_Number => ((S_Ok, A_Number_Dec), (S_Ok, A_Error),
(S_Number, A_Car_Number), (S_Ok, A_Number_Hex),
(S_Number, A_Car_Number), (S_Ok, A_Error)),
S_Str => ((S_Ok, A_Nothing), (S_Str, A_Car_String),
(S_Str, A_Car_String), (S_Str, A_Car_String),
(S_Str, A_Car_String), (S_Ok, A_Error)),
S_Ok => ((S_Ok, A_Error), (S_Ok, A_Error), (S_Ok, A_Error),
(S_Ok, A_Error), (S_Ok, A_Error), (S_Ok, A_Error)));
package body Input is
File : Text_Io.File_Type;
Look_Ahead : Boolean;
Endline : Boolean;
Endfile : Boolean;
Current_Char : Character;
Line_Number : Positive;
function Open (Filename : String) return Boolean is
begin
Text_Io.Open (File, Text_Io.In_File, Filename);
Look_Ahead := False;
Endline := False;
Endfile := False;
Line_Number := 1;
return True;
exception
when others =>
return False;
end Open;
procedure Next is
begin
if not Look_Ahead then
if Text_Io.End_Of_Line (File) then
if not Endline then
Current_Char := ' ';
Endline := True;
else
Endline := False;
Line_Number := Line_Number + 1;
Text_Io.Get (File, Current_Char);
end if;
else
Text_Io.Get (File, Current_Char);
end if;
else
Look_Ahead := False;
end if;
exception
when Io_Exceptions.End_Error =>
Endfile := True;
end Next;
function Value return Character is
begin
return Current_Char;
end Value;
function Atend return Boolean is
begin
if Look_Ahead then
return False;
else
return Endfile;
end if;
end Atend;
function Get return Character is
begin
Next;
return Value;
end Get;
procedure Unget is
begin
Look_Ahead := True;
end Unget;
procedure Close is
begin
Text_Io.Close (File);
exception
when others =>
null;
end Close;
function Getline return Positive is
begin
return Line_Number;
end Getline;
end Input;
function Conv_Strtoint (Str : String; Base : Integer) return Integer is
Int : Integer := 0;
Poids : Integer := 0;
begin
for I in reverse Str'First .. Str'Last loop
if Str (I) in '0' .. '9' then
Int := Int + (Character'Pos (Str (I)) - Character'Pos ('0')) *
Base ** Poids;
else
Int := Int + (Character'Pos (Str (I)) -
Character'Pos ('A') + 10) * Base ** Poids;
end if;
Poids := Poids + 1;
end loop;
return Int;
end Conv_Strtoint;
function Upper_Case (Car : Character) return Character is
begin
if Car in 'a' .. 'z' then
return Character'Val (Character'Pos (Car) -
(Character'Pos ('a') - Character'Pos ('A')));
else
return Car;
end if;
end Upper_Case;
function Add_Cartostr (Str : Chaine; Car : Character) return Chaine is
begin
return new String'(Str.all & Car);
end Add_Cartostr;
function Strcpy (Str : String) return Chaine is
begin
return new String'(Str);
end Strcpy;
function Open (Filename : String) return Boolean is
begin
return Input.Open (Filename);
end Open;
function Gettoken return Token is
begin
return Current_Symbol;
end Gettoken;
function Getvalue return String is
begin
return Storage_String.all;
end Getvalue;
function Getvalue return Integer is
begin
return Storage_Number;
end Getvalue;
function Evaluate_Condition (Char : Character) return Condition is
begin
case Char is
when '0' .. '9' =>
return C_Digit;
when 'A' .. 'F' =>
return C_Letteraf;
when 'H' =>
return C_Letterh;
when 'G' | 'I' .. 'Z' =>
return C_Letter;
when ' ' | ',' | '-' =>
return C_Separator;
when others =>
return C_Unknown;
end case;
end Evaluate_Condition;
function Evaluate_Numberdec return Token is
Int : Integer;
begin
Int := Conv_Strtoint (Storage_String.all, 10);
if Int >= Min_Number_Value and Int <= Max_Number_Value then
Storage_Number := Int;
return Number;
else
return Unknown;
end if;
end Evaluate_Numberdec;
function Evaluate_Numberhex return Token is
Int : Integer;
begin
Int := Conv_Strtoint (Storage_String.all, 16);
if Int >= Min_Number_Value and Int <= Max_Number_Value then
Storage_Number := Int;
return Number;
else
return Unknown;
end if;
end Evaluate_Numberhex;
function Car_String (Car : Character) return Token is
begin
if Storage_String'Length < Max_Car_String then
Storage_String := Add_Cartostr (Storage_String, Car);
return Str;
else
return Unknown;
end if;
end Car_String;
function Car_Number (Car : Character) return Token is
begin
if Storage_String'Length < Max_Digit_Num then
Storage_String := Add_Cartostr (Storage_String, Car);
return Number;
else
return Unknown;
end if;
end Car_Number;
procedure Getnext is
Current_Transition : Transition;
Current_Condition : Condition;
Current_Char : Character;
begin
if not Input.Atend then
Current_Transition.Next_State := S_Start;
Storage_String := Strcpy ("");
Storage_Number := 0;
while Current_Transition.Next_State /= S_Ok loop
Current_Char := Upper_Case (Input.Get);
Current_Condition := Evaluate_Condition (Current_Char);
Current_Transition :=
Transition_Table (Current_Transition.Next_State,
Current_Condition);
case Current_Transition.Next_Action is
when A_Nothing =>
null;
when A_Car_Number =>
Current_Symbol := Car_Number (Current_Char);
when A_Car_String =>
Current_Symbol := Car_String (Current_Char);
when A_Number_Hex =>
Current_Symbol := Evaluate_Numberhex;
when A_Number_Dec =>
Current_Symbol := Evaluate_Numberdec;
when A_Error =>
Current_Symbol := Unknown;
end case;
if Current_Symbol = Unknown then
Current_Transition.Next_State := S_Ok;
end if;
if Current_Transition.Next_State /= S_Ok and Input.Atend then
Current_Transition.Next_State := S_Ok;
Current_Symbol := File_End;
end if;
end loop;
else
Current_Symbol := File_End;
end if;
end Getnext;
function Getline return Positive is
begin
return Input.Getline;
end Getline;
procedure Close is
begin
Input.Close;
end Close;
end Lex;