|
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: 27249 (0x6a71)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─ ⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦4c85d69e2⟧
└─⟦this⟧
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1988 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054-3197
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1988. ALL RIGHTS RESERVED.
--
--
with Primitive_Io; -- For debugging only
package body Literal_Parser is
-- procedure Trace
-- (S : String;
-- Absorb_Output : Boolean := Primitive_Io.Global_Absorb_Output)
-- renames Primitive_Io.Put_Line;
-- Should these constants be here???
Line_Terminator : constant Character := Ascii.Cr;
--*** Line_Terminator : constant Character := Ascii.Lf;
Page_Terminator : constant Character := Ascii.Ff;
-- u
-- +-----------\
-- | \ D
-- . v d \ / e
-- +----------> 10 ---------> 11* -----------------------+
-- B | | D
-- | d | # x . x # e v d |
-- 1 -----> 2 -----> 3 -----> 4 -----> 5 -----> 6 -----> 7* ----> 8 -----> 9*
-- |s / ^ \ ^ / \ ^ / \ | / ^
-- | u/ | D | u / D | u / X s| u / |
-- v / | +------ +------ | / |
-- +<--- | v / |
-- | | +<-- |
-- v d | | |
-- 12 ------+ v d |
-- 13 -------+
-- The diagram above defines a finite state machine to recognize Ada real
-- constants in TEXT_IO. There are 13 states, numbered 1-13. The start state
-- is 1; accept states are marked with an asterisk. The characters that cause
-- state transitions are:
--
-- d,D a decimal digit, one of 0123456789
-- x,X an extended digit, either a decimal digit or a letter (either case)
-- u an underscore
-- s a sign, either + or -
-- # a pound sign or a colon
-- . a radix point
-- e either E or e
-- B a space, tab, line terminator, or page terminator
--
-- The letters D, B, and X are used to indicate self-loops, which are difficult
-- to draw in this medium. Pounds signs can be replaced with colons, but the
-- replacement must be uniform; you can't have one of each.
--
-- e
-- +------------------------------------+
-- B | | D
-- | d | # x # e v s d |
-- 1 ------> 2* -----> 3 ----> 4 ------> 5* ----> 6 -----> 7 -----> 8*
-- | / ^ \ ^ / \ | ^ /^
-- |s u/ | D | u / X | | u / |
-- | / | +------ | +------ |
-- v / | | d |
-- +<--- | +-----------------+
-- | |
-- v d |
-- 9 --------+
--
-- This diagram defines the syntax of an Ada integer literal. The same
-- conventions are used. The difference between an integer and real literal
-- is that a radix point is required in a real constant and forbidden in
-- an integer constant. Also, integer literals may not have negative
-- exponents, but that is considered by the AJPO Language Laywers to be a
-- "semantic restriction" that should not effect how things are parsed.
-- B X
-- | a | u
-- 1 ------> 2* -------> 3
-- | ^ |
-- |q | x |
-- | +-----------+
-- |
-- v g q
-- 4 ------> 5 ----------> 6*
-- The above is a machine to recognize enumeration literals, which are either
-- identifers or character literals. The new notation used is:
--
-- a an alphabetic (letter)
-- q a quote
-- g any graphic character
S01 : constant := 1;
S02 : constant := S01 + 2;
S03 : constant := S02 + 4;
S04 : constant := S03 + 4;
S05 : constant := S04 + 6;
S06 : constant := S05 + 4;
S07 : constant := S06 + 6;
S08 : constant := S07 + 1;
S09 : constant := S08 + 2;
S10 : constant := S09 + 2;
S11 : constant := S10 + 1;
S12 : constant := S11 + 3;
S13 : constant := S12 + 1;
Szz : constant := S13 + 1;
T01 : constant := Szz;
T02 : constant := T01 + 2;
T03 : constant := T02 + 4;
T04 : constant := T03 + 4;
T05 : constant := T04 + 6;
T06 : constant := T05 + 1;
T07 : constant := T06 + 2;
T08 : constant := T07 + 1;
T09 : constant := T08 + 2;
Tzz : constant := T09 + 1;
-- These constants are used to define the states of the three machines.
-- Notes that in each expression Xnn + mm, mm is the number of
-- different arcs coming out of state nn.
type State is range S01 .. Tzz - 1;
type Character_Class is (Upper_Case_Extended,-- Must be in this order
Lower_Case_Extended,--
Upper_Case_Letter, --
Lower_Case_Letter, --
Letter_E, --
Digit, -- End of must be in this order
Underscore,
Sign,
Pound,
Point,
Separator, Terminator, Irrelevant_Character);
subtype Alphabetic is Character_Class range Upper_Case_Extended .. Letter_E;
subtype Alphanumeric is Character_Class range Upper_Case_Extended .. Digit;
type Class_Map_Type is array (Character) of Character_Class;
Class_Map : constant Class_Map_Type :=
Class_Map_Type'('0' .. '9' => Digit,
'a' .. 'd' => Lower_Case_Extended,
'e' => Letter_E,
'f' => Lower_Case_Extended,
'g' .. 'z' => Lower_Case_Letter,
'A' .. 'D' => Upper_Case_Extended,
'E' => Letter_E,
'F' => Upper_Case_Extended,
'G' .. 'Z' => Upper_Case_Letter,
'#' | ':' => Pound,
'+' | '-' => Sign,
'_' => Underscore,
'.' => Point,
' ' | Ascii.Ht => Separator,
Line_Terminator | Page_Terminator => Terminator,
others => Irrelevant_Character);
-- The state table consists of triples:
-- If_Class_Is: Character_Class;
-- Then_New_State_Is: State;
-- Last_Rule: Boolean;
If_Class_Is : constant array (State) of Character_Class :=
-- The machine to recognize Real Literals
(S01 + 0 => Digit,
S01 + 1 => Sign,
S02 + 0 => Digit,
S02 + 1 => Point,
S02 + 2 => Pound,
S02 + 3 => Underscore,
S03 + 0 => Digit,
S03 + 1 => Upper_Case_Extended,
S03 + 2 => Lower_Case_Extended,
S03 + 3 => Letter_E,
S04 + 0 => Digit,
S04 + 1 => Upper_Case_Extended,
S04 + 2 => Lower_Case_Extended,
S04 + 3 => Letter_E,
S04 + 4 => Point,
S04 + 5 => Underscore,
S05 + 0 => Digit,
S05 + 1 => Upper_Case_Extended,
S05 + 2 => Lower_Case_Extended,
S05 + 3 => Letter_E,
S06 + 0 => Digit,
S06 + 1 => Upper_Case_Extended,
S06 + 2 => Lower_Case_Extended,
S06 + 3 => Letter_E,
S06 + 4 => Pound,
S06 + 5 => Underscore,
S07 + 0 => Letter_E,
S08 + 0 => Digit,
S08 + 1 => Sign,
S09 + 0 => Digit,
S09 + 1 => Underscore,
S10 + 0 => Digit,
S11 + 0 => Digit,
S11 + 1 => Letter_E,
S11 + 2 => Underscore,
S12 + 0 => Digit,
S13 + 0 => Digit,
-- The Machine that recognizes an Integer
T01 + 0 => Digit,
T01 + 1 => Sign,
T02 + 0 => Digit,
T02 + 1 => Letter_E,
T02 + 2 => Pound,
T02 + 3 => Underscore,
T03 + 0 => Digit,
T03 + 1 => Upper_Case_Extended,
T03 + 2 => Lower_Case_Extended,
T03 + 3 => Letter_E,
T04 + 0 => Digit,
T04 + 1 => Upper_Case_Extended,
T04 + 2 => Lower_Case_Extended,
T04 + 3 => Letter_E,
T04 + 4 => Pound,
T04 + 5 => Underscore,
T05 + 0 => Letter_E,
T06 + 0 => Digit,
T06 + 1 => Sign,
T07 + 0 => Digit,
T08 + 0 => Digit,
T08 + 1 => Underscore,
T09 + 0 => Digit);
Then_New_State_Is : constant array (State) of State :=
-- The machine to recognize Real Literals
(S01 + 0 => S02,
S01 + 1 => S12,
S02 + 0 => S02,
S02 + 1 => S10,
S02 + 2 => S03,
S02 + 3 => S12,
S03 + 0 => S04,
S03 + 1 => S04,
S03 + 2 => S04,
S03 + 3 => S04,
S04 + 0 => S04,
S04 + 1 => S04,
S04 + 2 => S04,
S04 + 3 => S04,
S04 + 4 => S05,
S04 + 5 => S03,
S05 + 0 => S06,
S05 + 1 => S06,
S05 + 2 => S06,
S05 + 3 => S06,
S06 + 0 => S06,
S06 + 1 => S06,
S06 + 2 => S06,
S06 + 3 => S06,
S06 + 4 => S07,
S06 + 5 => S05,
S07 + 0 => S08,
S08 + 0 => S09,
S08 + 1 => S13,
S09 + 0 => S09,
S09 + 1 => S13,
S10 + 0 => S11,
S11 + 0 => S11,
S11 + 1 => S08,
S11 + 2 => S10,
S12 + 0 => S02,
S13 + 0 => S09,
-- The Machine that recognizes an Integer
T01 + 0 => T02,
T01 + 1 => T09,
T02 + 0 => T02,
T02 + 1 => T06,
T02 + 2 => T03,
T02 + 3 => T09,
T03 + 0 => T04,
T03 + 1 => T04,
T03 + 2 => T04,
T03 + 3 => T04,
T04 + 0 => T04,
T04 + 1 => T04,
T04 + 2 => T04,
T04 + 3 => T04,
T04 + 4 => T05,
T04 + 5 => T03,
T05 + 0 => T06,
T06 + 0 => T08,
T06 + 1 => T07,
T07 + 0 => T08,
T08 + 0 => T08,
T08 + 1 => T07,
T09 + 0 => T02);
Last_Rule : constant array (State) of Boolean :=
-- The machine to recognize Real Literals
(S01 + 0 => False,
S01 + 1 => True,
S02 + 0 => False,
S02 + 1 => False,
S02 + 2 => False,
S02 + 3 => True,
S03 + 0 => False,
S03 + 1 => False,
S03 + 2 => False,
S03 + 3 => True,
S04 + 0 => False,
S04 + 1 => False,
S04 + 2 => False,
S04 + 3 => False,
S04 + 4 => False,
S04 + 5 => True,
S05 + 0 => False,
S05 + 1 => False,
S05 + 2 => False,
S05 + 3 => True,
S06 + 0 => False,
S06 + 1 => False,
S06 + 2 => False,
S06 + 3 => False,
S06 + 4 => False,
S06 + 5 => True,
S07 + 0 => True,
S08 + 0 => False,
S08 + 1 => True,
S09 + 0 => False,
S09 + 1 => True,
S10 + 0 => True,
S11 + 0 => False,
S11 + 1 => False,
S11 + 2 => True,
S12 + 0 => True,
S13 + 0 => True,
-- The Machine that recognizes an Integer
T01 + 0 => False,
T01 + 1 => True,
T02 + 0 => False,
T02 + 1 => False,
T02 + 2 => False,
T02 + 3 => True,
T03 + 0 => False,
T03 + 1 => False,
T03 + 2 => False,
T03 + 3 => True,
T04 + 0 => False,
T04 + 1 => False,
T04 + 2 => False,
T04 + 3 => False,
T04 + 4 => False,
T04 + 5 => True,
T05 + 0 => True,
T06 + 0 => False,
T06 + 1 => True,
T07 + 0 => True,
T08 + 0 => False,
T08 + 1 => True,
T09 + 0 => True);
-------------------------------------------------------------
procedure Parse_Numeric_Literal (Source : in String;
Integral : in Boolean;
Result : in out Numeric_Literal;
Status : out Parse_Status;
Last_Of_Source : out Natural) is
Source_First : Natural; -- Not Source'First, but 1st char of the numlit
Source_Index : Natural := Source'First;
Source_Last : constant Natural := Source'Last;
Current_State : State;
-- The state of the finite-state machine
Pound_Info : Character;
-- If we are between pound signs, Pound_Info contains the character
-- being used to represent a pound sign ('#' or ':'). If we are not
-- between pound signs, Pound_Info contains a blank.
Current_Char : Character;
Current_Class : Character_Class;
Rule : State;
-- These are work variables used to update the state
subtype Sign_Type is Numeric_Literals.Sign_Type;
Plus : constant Sign_Type := Numeric_Literals.Plus;
Minus : constant Sign_Type := Numeric_Literals.Minus;
Sign : Sign_Type;
-- Having parsed a numeric literal, put it away in the parameter
-- that the caller provided. The only problem is that the caller
-- may have provided too small of a place to put it. In that
-- case, an error status is returned, and Result.V is set so that
-- the caller knows how much space is needed and can allocate the
-- proper amount.
procedure Set_Result is
Result_Length : constant Integer := Source_Index - Source_First + 1;
begin
-- Trace ("Lp returning literal of length " &
-- Integer'Image (Result_Length));
-- Report the exact length required
Result.L := Result_Length;
if Result.Max_Length < Result_Length then
-- Trace ("Lp literal is too short");
Status := Numeric_Literal_Too_Short;
else
--Trace ("Lp literal is " &
-- Source (Source_First ..
-- Source_First + Result_Length - 1));
-- Result.V (1 .. Result_Length) :=
-- Source (Source_First .. Source_First + Result_Length - 1);
for I in 1 .. Result_Length loop
Result.V (I) := Source (Source_First + I - 1);
end loop;
Status := Ok;
end if;
end Set_Result;
begin
-- Trace ("Lp.Parse_Numeric_Literal from " & Source);
-- First, skip whitespace
-- Whitespace = blanks, tabs, line and page terminators
Last_Of_Source := Source_Last; -- anticipate all blanks or tabs
for I in Source'Range loop
if Class_Map (Source (I)) /= Separator then
if Class_Map (Source (I)) = Terminator then
Last_Of_Source := I - 1;
exit;
else
-- Found non-whitespace
Source_Index := I;
goto E1;
end if;
end if;
end loop;
-- If here, either source is empty or searched the entire string
-- and found nothing but whitespace
Status := Empty_Field;
-- Trace ("Lp empty field - 1");
return;
<<E1>> null;
-- Record the first character found of the numeric literal.
Source_First := Source_Index;
-- This will be the mantissa or the base, though right now we don't
-- know which. Assume not based as default.
Sign := Plus;
Result.Is_Based := False;
if Integral then
Current_State := T01;
else
Current_State := S01;
end if;
Pound_Info := ' ';
State_Machine:
loop
if Source_Index > Source_Last then
Current_Class := Irrelevant_Character;
exit State_Machine;
end if;
Current_Char := Source (Source_Index);
-- We don't increment Source_Index here because we haven't
-- yet decided that we want to "keep" the character.
Current_Class := Class_Map (Current_Char);
case Current_Class is
when Letter_E =>
-- The meaning of an E depends on whether it is between
-- pound signs. Either it is an extended digit or the
-- beginning of an exponent.
if Pound_Info = ' ' then
Sign := Plus;
-- This will be the exponent
end if;
when Pound =>
if Pound_Info = ' ' then
-- This is the first pound sign.
Pound_Info := Current_Char;
Sign := Plus;
elsif Pound_Info /= Current_Char then
-- Oops! We really shouldn't have considered this
-- character to be a pound sign, because it doesn't
-- match the first one. Treat it as if it were
-- something else.
Current_Class := Irrelevant_Character;
else
-- This is the second pound sign
Pound_Info := ' ';
Result.Is_Based := True;
end if;
when Literal_Parser.Sign =>
if Current_Char = '-' then
Sign := Minus;
-- The default value is Plus
end if;
when others =>
null;
end case;
Rule := Current_State;
Find_Rule:
loop
if If_Class_Is (Rule) = Current_Class then
Current_State := Then_New_State_Is (Rule);
exit Find_Rule;
elsif Last_Rule (Rule) then
exit State_Machine;
end if;
Rule := Rule + 1;
end loop Find_Rule;
-- If there is a transition for the current character and state,
-- then the character gets "read".
Source_Index := Source_Index + 1;
end loop State_Machine;
-- Let Source_Index point to the last character of the numlit now.
Source_Index := Source_Index - 1;
-- Record the last character used in reading the numeric literal
Last_Of_Source := Source_Index;
case Current_State is
when S01 | T01 =>
-- In this state we have seen only whitespace
Status := Syntax_Error;
when S07 | S11 | T02 | T05 =>
-- Accept states in which no exponent was given.
-- Simply return the result
Set_Result;
when S09 | T08 =>
-- Return a bad status if an integer has a negative exponent.
if Integral and Numeric_Literals."=" (Sign, Minus) then
Status := Syntax_Error;
else
Set_Result;
end if;
when others =>
-- Nonaccept states
Status := Syntax_Error;
end case;
end Parse_Numeric_Literal;
-------------------------------------------------------
procedure Parse_Enumeration (Source : in String;
Unprintable_Terminators : in Boolean;
Result : out String;
Last : out Natural;
Status : out Parse_Status;
Last_Of_Source : out Natural) is
Source_First_Nonblank : Natural;
Source_Index : Natural := Source'First;
Source_Last : constant Natural := Source'Last;
Id_Length : Natural;
Result_First : constant Natural := Result'First;
Result_Length : constant Natural := Result'Length;
begin
-- First, skip whitespace
-- Whitespace = blanks, tabs, line and page terminators
Last_Of_Source := Source_Last; -- anticipate all blanks or tabs
for I in Source'Range loop
if Class_Map (Source (I)) /= Separator then
if Class_Map (Source (I)) = Terminator then
Last_Of_Source := I - 1;
exit;
else
-- Found non-whitespace
Source_Index := I;
goto E1;
end if;
end if;
end loop;
-- If here, we searched the entire string and found nothing but
-- whitespace
Last := 0;
Status := Empty_Field;
return;
<<E1>> null;
-- Now there are two possibilities. First, we could be looking
-- at an identifier. Second, we could be looking at a character
-- constant.
if Source (Source_Index) /= ''' then
-- We're scanning for an identifier
Source_First_Nonblank := Source_Index;
-- First character must be a letter
if Class_Map (Source (Source_Index)) not in Alphabetic then
goto E2;
end if;
-- We must have letters or digits next, possibly with
-- interspersed single underscores.
loop
Source_Index := Source_Index + 1;
exit when Source_Index > Source_Last;
declare
C : constant Character_Class :=
Class_Map (Source (Source_Index));
begin
if C = Underscore then
-- Eat the '_', and there must be something
-- following, and it must not be '_'
Source_Index := Source_Index + 1;
if Source_Index > Source_Last then
goto E2;
end if;
if Class_Map (Source (Source_Index)) not in
Alphanumeric then
goto E2;
end if;
elsif C not in Alphanumeric then
exit;
end if;
end;
end loop;
-- Here, we have eaten a full identifier, and Source_Index
-- is either past the end of the source, or pointing at the
-- first character past the identifier.
Id_Length := Source_Index - Source_First_Nonblank;
if Result_Length >= Id_Length then
-- The Result will hold the identifier
-- Result (Result_First .. Result_First - 1 + Id_Length) :=
-- Source (Source_First_Nonblank .. Source_Index - 1);
declare
Src_Indx_Kludge : Natural := Source_First_Nonblank;
begin
for I in Result_First .. Result_First - 1 + Id_Length loop
Result (I) := Source (Src_Indx_Kludge);
Src_Indx_Kludge := Src_Indx_Kludge + 1;
end loop;
end;
Last := Result_First + Id_Length - 1;
Status := Ok;
else
-- The Result won't hold the identifier
Last := 0;
Status := Syntax_Error;
end if;
Last_Of_Source := Source_Index - 1;
goto E3;
<<E2>> null;
-- Here there has been some screw-up. Source_Index is pointing
-- at some bad character, or past the end of the string.
Last := 0;
Last_Of_Source := Source_Index - 1;
Status := Syntax_Error;
<<E3>> null;
else
-- Here we have a character constant
-- We know Source (Source_Index) = '''
if Source_Index + 1 > Source_Last or else
Source (Source_Index + 1) not in ' ' .. '~' then
Last := 0;
Last_Of_Source := Source_Index;
Status := Syntax_Error;
elsif Source_Index + 2 > Source_Last or else
Source (Source_Index + 2) /= ''' then
Last := 0;
Last_Of_Source := Source_Index + 1;
Status := Syntax_Error;
else
-- Here we have parsed a character constant
if Result_Length >= 3 then
-- The Result will hold the character constant
Result (Result_First .. Result_First + 2) :=
Source (Source_Index .. Source_Index + 2);
Last := Result_First + 2;
Status := Ok;
else
-- The Result won't hold the character constant
Last := 0;
Status := Syntax_Error;
end if;
Last_Of_Source := Source_Index + 2;
end if;
end if;
end Parse_Enumeration;
end Literal_Parser;