|
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 - metrics - downloadIndex: B T
Length: 10484 (0x28f4)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦591c5b094⟧
└─⟦this⟧
with Ada_Parameterization;
with Error_Report;
use Error_Report;
with Lexemes;
use Lexemes;
with Arithmetic;
use Arithmetic;
with Vstring_Assign;
use Vstring_Assign;
with Vstring_Heap;
use Vstring_Heap;
with Vstring_Query;
use Vstring_Query;
with Vstring_Type;
use Vstring_Type;
package body Symbol_Table is
------------------------------------------------------------------------------
-- Recognition and value storage for keywords and parameters.
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
--
-- All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------
procedure Define (M : in Symbol_Map.Map;
Key : in E_String;
Rt : in Symbol_Value;
Dups_Ok : in Boolean := False) renames Symbol_Map.Insert;
procedure Parse_A_Name (Parms : Vstring;
Name_Required : Boolean;
Name_Value : out Symbol_Value);
--\f
procedure Define_Keywords is
------------------------------------------------------------------------------
-- Called to enter all of our lexical keywords into the symbol map. eg. "IF"
------------------------------------------------------------------------------
begin
----Define the keywords that we recognize in control constructs.
Define (Sym_Map, "IF", (Sk_Keyword, True, Kwd => Lk_If));
Define (Sym_Map, "THEN", (Sk_Keyword, True, Kwd => Lk_Then));
Define (Sym_Map, "ELSIF", (Sk_Keyword, True, Kwd => Lk_Elsif));
Define (Sym_Map, "ELSE", (Sk_Keyword, True, Kwd => Lk_Else));
Define (Sym_Map, "END", (Sk_Keyword, True, Kwd => Lk_End));
----Define the keywords that we recognize in expressions.
Define (Sym_Map, "NOT", (Sk_Keyword, True, Kwd => Lk_Not));
Define (Sym_Map, "AND", (Sk_Keyword, True, Kwd => Lk_And));
Define (Sym_Map, "OR", (Sk_Keyword, True, Kwd => Lk_Or));
Define (Sym_Map, "XOR", (Sk_Keyword, True, Kwd => Lk_Xor));
----Define TRUE and FALSE.
Define (Sym_Map, "FALSE", (Sk_Boolean, True, Bool => False));
Define (Sym_Map, "TRUE", (Sk_Boolean, True, Bool => True));
end Define_Keywords;
--\f
procedure Define_Predefineds is separate;
--\f
procedure Parse_After_Name (Parms : Vstring;
Name_Value : out Symbol_Value) is
------------------------------------------------------------------------------
-- Called with a partially eaten parameter string after our caller had
-- read a symbol name from it. We check for EOL, ',', '|', and '=>'.
------------------------------------------------------------------------------
Cur_Lexeme : Lexeme_Kind;
Cur_Text : Vstring := New_Vstring (64);
Cur_Text2 : Vstring;
Cur_Value : Symbol_Value;
begin
Empty_Vstring (Cur_Text);
Next_Lexeme (Parms, Cur_Lexeme, Cur_Text, Cur_Value);
----If we hit end-of-string or a comma then the default parameter setting is
-- True.
if Cur_Lexeme = Lk_Eol or else
Cur_Lexeme = Lk_Comma then
Name_Value := (Sk_Boolean, Permanent => False, Bool => True);
----If we hit a | then we recurse and get another parameter name.
elsif Cur_Lexeme = Lk_Vbar then
Parse_A_Name (Parms, True, Cur_Value);
Symbol_Map.Insert
(Sym_Map, To_String (Cur_Text), Cur_Value, Dups_Ok => True);
Name_Value := Cur_Value;
----If we find a => then we grab the symbol that follows it as the parameter
-- value.
elsif Cur_Lexeme = Lk_Arrow then
Cur_Text2 := New_Vstring (64);
Next_Lexeme (Parms, Cur_Lexeme, Cur_Text2, Cur_Value);
Free_Vstring (Cur_Text2);
if Cur_Lexeme = Lk_Identifier then
if Cur_Value.Kind = Sk_Keyword then
Error ("The keyword " &
String (Substring_To (Cur_Text, 1, 512)) &
" is not the name of a parameter.");
Cur_Value := (Sk_Boolean,
Permanent => False,
Bool => False);
end if;
Cur_Value.Permanent := False;
else
declare
Str : constant String := Lexeme_Kind'Image (Cur_Lexeme);
begin
Error ("Found a " &
Str (Str'First + 3 .. Str'Last) & " after " &
String (Substring_To (Cur_Text, 1, 512)) &
"=> in Additonal_Parameters argument?");
end;
Cur_Value := (Sk_Boolean, Permanent => False, Bool => False);
end if;
Name_Value := Cur_Value;
----Anything else is an error.
else
declare
Str : constant String := Lexeme_Kind'Image (Cur_Lexeme);
begin
Error ("Found a " & Str (Str'First + 3 .. Str'Last) &
" (" & String (Substring_To (Cur_Text, 1, 512)) &
") in the Additional_Parameters argument?");
end;
end if;
Free_Vstring (Cur_Text);
end Parse_After_Name;
--\f
procedure Parse_A_Name (Parms : Vstring;
Name_Required : Boolean;
Name_Value : out Symbol_Value) is
------------------------------------------------------------------------------
-- Called with a partially eaten parameter string; we expect to have a name
-- at the beginning
------------------------------------------------------------------------------
Cur_Lexeme : Lexeme_Kind;
Cur_Text : Vstring := New_Vstring (64);
Cur_Value : Symbol_Value;
begin
Empty_Vstring (Cur_Text);
Next_Lexeme (Parms, Cur_Lexeme, Cur_Text, Cur_Value);
if Cur_Lexeme = Lk_Eol or else
Cur_Lexeme = Lk_Comma then
if Name_Required then
Error ("Expected another parameter name at end of " &
"Additonal_Parameters string.");
end if;
Name_Value := (Sk_Boolean, Permanent => False, Bool => True);
else
if Cur_Lexeme = Lk_Identifier and then
Cur_Value.Permanent then
Error ("Not allowed to change the value for symbol: " &
String (Substring_To (Cur_Text, 1, 512)));
end if;
if Cur_Lexeme = Lk_Identifier or else
Cur_Lexeme = Lk_Unknown then
Parse_After_Name (Parms, Cur_Value);
Symbol_Map.Insert
(Sym_Map, To_String (Cur_Text), Cur_Value, Dups_Ok => True);
Name_Value := Cur_Value;
else
declare
Str : constant String := Lexeme_Kind'Image (Cur_Lexeme);
begin
Error ("Found a " & Str (Str'First + 3 .. Str'Last) &
" (" & String (Substring_To (Cur_Text, 1, 512)) &
") in the Additional_Parameters argument?");
end;
end if;
end if;
Free_Vstring (Cur_Text);
end Parse_A_Name;
--\f
procedure Do_The_Parameter (Parms : Vstring) is
------------------------------------------------------------------------------
-- Called with a partially eaten parameter string. We eat it with recursion.
------------------------------------------------------------------------------
Cur_Value : Symbol_Value;
begin
while Length (Parms) > 0 loop
Parse_A_Name (Parms, False, Cur_Value);
end loop;
end Do_The_Parameter;
--\f
procedure Parameter_Definition (Additional_Parameters : String) is
------------------------------------------------------------------------------
-- Additional_Parameters - Specifies additional/different parameter values
-- than the default set
--
-- Called as an initialization procedure. Sets up all of the default
-- parameter values and additionally adds or modifies any parameters that
-- are specified by the argument.
--
-- Specify parameter values with strings with these forms:
--
-- "Sun=>TRUE" -- any number of blanks are optional
-- "Sun => TRUE" -- any number of blanks are optional
-- "Sun" -- same as "Sun=>TRUE"
-- "Sun|Unix=>FALSE" -- set several to one value
-- "Sun=>TRUE,Unix=>TRUE" -- set several to several values
--
-- Blanks are allowed anywhere and are optional. Each parameter must be
-- mentioned by name.
------------------------------------------------------------------------------
Tmpstr : Vstring;
begin
----First, keywords.
Define_Keywords;
----Second, parameters and values already in use.
Define_Predefineds;
----Third, new parameter values and/or new parameters.
Assign_New (Tmpstr, E_String (Additional_Parameters));
Do_The_Parameter (Tmpstr);
Free_Vstring (Tmpstr);
if There_Were_Errors then
raise Ada_Parameterization.Ada_Parameterization_Errors;
end if;
end Parameter_Definition;
--\f
begin
Symbol_Map.New_Map (Sym_Map);
end Symbol_Table;