Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/debug/sd.src

Text File | 1988-05-03 | 868.2 KB | 23,053 lines

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--lists.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

generic
  type ITEMTYPE is private;  --| This is the data being manipulated.

  with function EQUAL(X, Y : in ITEMTYPE) return BOOLEAN is "=";
  --| This allows the user to define
  --| equality on ItemType.  For instance
  --| if ItemType is an abstract type
  --| then equality is defined in terms of
  --| the abstract type.  If this function
  --| is not provided equality defaults to
  --| =.
package LISTS is

--| This package provides singly linked lists with elements of type
--| ItemType, where ItemType is specified by a generic parameter.

--| Overview
--| When this package is instantiated, it provides a linked list type for
--| lists of objects of type ItemType, which can be any desired type.  A
--| complete set of operations for manipulation, and releasing
--| those lists is also provided.  For instance, to make lists of strings,
--| all that is necessary is:
--|
--| type StringType is string(1..10);
--|
--| package Str_List is new Lists(StringType); use Str_List;
--|
--|    L:List;
--|    S:StringType;
--|
--| Then to add a string S, to the list L, all that is necessary is
--|
--|    L := Create;
--|    Attach(S,L);
--|
--|
--| This package provides basic list operations.
--|
--| Attach          append an object to an object, an object to a list,
--|                 or a list to an object, or a list to a list.
--| Copy            copy a list using := on elements
--| CopyDeep        copy a list by copying the elements using a copy
--|                 operation provided by the user
--| Create          Creates an empty list
--| DeleteHead      removes the head of a list
--| DeleteItem      delete the first occurrence of an element from a list
--| DeleteItems     delete all occurrences of an element from a list
--| Destroy         remove a list
--| Equal           are two lists equal
--| FirstValue      get the information from the first element of a list
--| IsInList        determines whether a given element is in a given list
--| IsEmpty         returns true if the list is empty
--| LastValue       return the last value of a list
--| Length          Returns the length of a list
--| MakeListIter    prepares for an iteration over a list
--| More            are there any more items in the list
--| Next            get the next item in a list
--| ReplaceHead     replace the information at the head of the list
--| ReplaceTail     replace the tail of a list with a new list
--| Tail            get the tail of a list
--|

--| N/A: Effects, Requires, Modifies, and Raises.

--| Notes
--| Programmer Buddy Altus

--|                           Types
--|                           -----

  type LIST is private;
  type LISTITER is private;


  --|                           Exceptions
  --|                           ----------

  CIRCULARLIST   : exception;  --| Raised if an attemp is made to
  --| create a circular list.  This
  --| results when a list is attempted
  --| to be attached to itself.

  EMPTYLIST      : exception;  --| Raised if an attemp is made to
  --| manipulate an empty list.

  ITEMNOTPRESENT : exception;  --| Raised if an attempt is made to
  --| remove an element from a list in
  --| which it does not exist.

  NOMORE         : exception;  --| Raised if an attemp is made to
  --| get the next element from a list
  --| after iteration is complete.



  --|                           Operations
  --|                           ----------

  ----------------------------------------------------------------------------

  procedure ATTACH( --| appends List2 to List1
                   LIST1 : in out LIST;  --| The list being appended to.
                   LIST2 : in LIST --| The list being appended.
                   );

  --| Raises
  --| CircularList

  --| Effects
  --| Appends List1 to List2.  This makes the next field of the last element
  --| of List1 refer to List2.  This can possibly change the value of List1
  --| if List1 is an empty list.  This causes sharing of lists.  Thus if
  --| user Destroys List1 then List2 will be a dangling reference.
  --| This procedure raises CircularList if List1 equals List2.  If it is
  --| necessary to Attach a list to itself first make a copy of the list and
  --| attach the copy.

  --| Modifies
  --| Changes the next field of the last element in List1 to be List2.

-------------------------------------------------------------------------------

  function ATTACH( --| Creates a new list containing the two
  --| Elements.
                  ELEMENT1 : in ITEMTYPE;
                                 --| This will be first element in list.
                  ELEMENT2 : in ITEMTYPE
                                 --| This will be second element in list.
                  ) return LIST;

  --| Effects
  --| This creates a list containing the two elements in the order
  --| specified.

-------------------------------------------------------------------------------
  procedure ATTACH( --| List L is appended with Element.
                   L       : in out LIST;  --| List being appended to.
                   ELEMENT : in ITEMTYPE
                                    --| This will be last element in l    ist.
                   );

  --| Effects
  --| Appends Element onto the end of the list L.  If L is empty then this
  --| may change the value of L.
  --|
  --| Modifies
  --| This appends List L with Element by changing the next field in List.

--------------------------------------------------------------------------------
  procedure ATTACH( --| Makes Element first item in list L.
                   ELEMENT : in ITEMTYPE;
                                    --| This will be the first element in list.
                   L       : in out LIST --| The List which Element is being
                   --| prepended to.
                   );

  --| Effects
  --| This prepends list L with Element.
  --|
  --| Modifies
  --| This modifies the list L.

  --------------------------------------------------------------------------

  function ATTACH( --| attaches two lists
                  LIST1 : in LIST;  --| first list
                  LIST2 : in LIST --| second list
                  ) return LIST;

  --| Raises
  --| CircularList

  --| Effects
  --| This returns a list which is List1 attached to List2.  If it is desired
  --| to make List1 be the new attached list the following ada code should be
  --| used.
  --|
  --| List1 := Attach (List1, List2);
  --| This procedure raises CircularList if List1 equals List2.  If it is
  --| necessary to Attach a list to itself first make a copy of the list and
  --| attach the copy.

  -------------------------------------------------------------------------

  function ATTACH( --| prepends an element onto a list
                  ELEMENT : in ITEMTYPE;  --| element being prepended to list
                  L       : in LIST --| List which element is being added
                  --| to
                  ) return LIST;

  --| Effects
  --| Returns a new list which is headed by Element and followed by L.

  ------------------------------------------------------------------------

  function ATTACH( --| Adds an element to the end of a list
                  L       : in LIST;
                                   --| The list which element is being added to.
                  ELEMENT : in ITEMTYPE
                                   --| The element being added to the end of
                  --| the list.
                  ) return LIST;

  --| Effects
  --| Returns a new list which is L followed by Element.

  --------------------------------------------------------------------------


  function COPY( --| returns a copy of list1
                L : in LIST --| list being copied
                ) return LIST;

  --| Effects
  --| Returns a copy of L.

  --------------------------------------------------------------------------

  generic
    with function COPY(I : in ITEMTYPE) return ITEMTYPE;


  function COPYDEEP( --| returns a copy of list using a user supplied
  --| copy function.  This is helpful if the type
  --| of a list is an abstract data type.
                    L : in LIST --| List being copied.
                    ) return LIST;

  --| Effects
  --| This produces a new list whose elements have been duplicated using
  --| the Copy function provided by the user.

------------------------------------------------------------------------------

  function CREATE --| Returns an empty List

  return LIST;

------------------------------------------------------------------------------

  procedure DELETEHEAD( --| Remove the head element from a list.
                       L : in out LIST --| The list whose head is being removed.
                       );

  --| Raises
  --| EmptyList
  --|
  --| Effects
  --| This will return the space occupied by the first element in the list
  --| to the heap.  If sharing exists between lists this procedure
  --| could leave a dangling reference.  If L is empty EmptyList will be
  --| raised.

------------------------------------------------------------------------------

  procedure DELETEITEM( --| remove the first occurrence of Element
  --| from L
                       L       : in out LIST;
                                --| list element is being  removed from
                       ELEMENT : in ITEMTYPE --| element being removed
                       );

  --| Raises
  --| ItemNotPresent

  --| Effects
  --| Removes the first element of the list equal to Element.  If there is
  --| not an element equal to Element than ItemNotPresent is raised.

  --| Modifies
  --| This operation is destructive, it returns the storage occupied by
  --| the elements being deleted.

------------------------------------------------------------------------------

  procedure DELETEITEMS( --| remove all occurrences of Element
  --| from  L.
                        L       : in out LIST;
                                --| The List element is being removed from
                        ELEMENT : in ITEMTYPE --| element being removed
                        );

  --| Raises
  --| ItemNotPresent
  --|
  --| Effects
  --| This procedure walks down the list L and removes all elements of the
  --| list equal to Element.  If there are not any elements equal to Element
  --| then raise ItemNotPresent.

  --| Modifies
  --| This operation is destructive the storage occupied by the items
  --| removed is returned.

------------------------------------------------------------------------------

  procedure DESTROY( --| removes the list
                    L : in out LIST --| the list being removed
                    );

  --| Effects
  --| This returns to the heap all the storage that a list occupies.  Keep in
  --| mind if there exists sharing between lists then this operation can leave
  --| dangling references.

------------------------------------------------------------------------------

  function FIRSTVALUE( --| returns the contents of the first record of the
  --| list
                      L : in LIST --| the list whose first element is being
                      --| returned

                      ) return ITEMTYPE;

  --| Raises
  --| EmptyList
  --|
  --| Effects
  --| This returns the Item in the first position in the list.  If the list
  --| is empty EmptyList is raised.

-------------------------------------------------------------------------------

  function ISEMPTY( --| Checks if a list is empty.
                   L : in LIST --| List being checked.
                   ) return BOOLEAN;

  --------------------------------------------------------------------------

  function ISINLIST( --| Checks if element is an element of
  --| list.
                    L       : in LIST;  --| list being scanned for element
                    ELEMENT : in ITEMTYPE --| element being searched for
                    ) return BOOLEAN;

  --| Effects
  --| Walks down the list L looking for an element whose value is Element.

------------------------------------------------------------------------------

  function LASTVALUE( --| Returns the contents of the last record of
  --| the list.
                     L : in LIST --| The list whose first element is being
                     --| returned.
                     ) return ITEMTYPE;

  --| Raises
  --| EmptyList
  --|
  --| Effects
  --| Returns the last element in a list.  If the list is empty EmptyList is
  --| raised.


------------------------------------------------------------------------------

  function LENGTH( --| count the number of elements on a list
                  L : in LIST --| list whose length is being computed
                  ) return INTEGER;

------------------------------------------------------------------------------

  function MAKELISTITER( --| Sets a variable to point to  the head
  --| of the list.  This will be used to
  --| prepare for iteration over a list.
                        L : in LIST --| The list being iterated over.
                        ) return LISTITER;


--| This prepares a user for iteration operation over a list.  The iterater is
  --| an operation which returns successive elements of the list on successive
  --| calls to the iterator.  There needs to be a mechanism which marks the
  --| position in the list, so on successive calls to the Next operation the
  --| next item in the list can be returned.  This is the function of the
  --| MakeListIter and the type ListIter.  MakeIter just sets the Iter to the
  --| the beginning  of the list. On subsequent calls to Next the Iter
  --| is updated with each call.

  -----------------------------------------------------------------------------

  function MORE( --| Returns true if there are more elements in
  --| the and false if there aren't any more
  --| the in the list.
                L : in LISTITER --| List being checked for elements.
                ) return BOOLEAN;

------------------------------------------------------------------------------

  procedure NEXT( --| This is the iterator operation.  Given
  --| a ListIter in the list it returns the
  --| current item and updates the ListIter.
  --| If ListIter is at the end of the list,
  --| More returns false otherwise it
  --| returns true.
                 PLACE : in out LISTITER;
                                --| The Iter which marks the position in
                 --| the list.
                 INFO  : out ITEMTYPE --| The element being returned.

                 );

  --| The iterators subprograms MakeListIter, More, and Next should be used
  --| in the following way:
  --|
  --|         L:        List;
  --|         Place:    ListIter;
  --|         Info:     SomeType;
  --|
  --|
  --|         Place := MakeListIter(L);
  --|
  --|         while ( More(Place) ) loop
  --|               Next(Place, Info);
  --|               process each element of list L;
  --|               end loop;


  ----------------------------------------------------------------------------

  procedure REPLACEHEAD( --| Replace the Item at the head of the list
  --| with the parameter Item.
                        L    : in out LIST;  --| The list being modified.
                        INFO : in ITEMTYPE --| The information being entered.
                        );
  --| Raises
  --| EmptyList

  --| Effects
  --| Replaces the information in the first element in the list.  Raises
  --| EmptyList if the list is empty.

------------------------------------------------------------------------------

  procedure REPLACETAIL( --| Replace the Tail of a list
  --| with a new list.
                        L       : in out LIST;  --| List whose Tail is replaced.
                        NEWTAIL : in LIST --| The list which will become the
                        --| tail of Oldlist.
                        );
  --| Raises
  --| EmptyList
  --|
  --| Effects
  --| Replaces the tail of a list with a new list.  If the list whose tail
  --| is being replaced is null EmptyList is raised.

-------------------------------------------------------------------------------

  function TAIL( --| returns the tail of a list L
                L : in LIST --| the list whose tail is being returned
                ) return LIST;

  --| Raises
  --| EmptyList
  --|
  --| Effects
  --| Returns a list which is the tail of the list L.  Raises EmptyList if
  --| L is empty.  If L only has one element then Tail returns the Empty
  --| list.

------------------------------------------------------------------------------

  function EQUAL( --| compares list1 and list2 for equality
                 LIST1 : in LIST;  --| first list
                 LIST2 : in LIST --| second list
                 ) return BOOLEAN;

  --| Effects
  --| Returns true if for all elements of List1 the corresponding element
  --| of List2 has the same value.  This function uses the Equal operation
  --| provided by the user.  If one is not provided then = is used.

------------------------------------------------------------------------------
private
  type CELL;

  type LIST is access CELL;  --| pointer added by this package
  --| in order to make a list


  type CELL is  --| Cell for the lists being created
    record
      INFO : ITEMTYPE;
      NEXT : LIST;
    end record;


  type LISTITER is new LIST;  --| This prevents Lists being assigned to
  --| iterators and vice versa

end LISTS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--lists.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with UNCHECKED_DEALLOCATION;

package body LISTS is

  procedure FREE is
    new UNCHECKED_DEALLOCATION(CELL, LIST);

    --------------------------------------------------------------------------

  function LAST(L : in LIST) return LIST is

    PLACE_IN_L      : LIST;
    TEMP_PLACE_IN_L : LIST;

    --|  Link down the list L and return the pointer to the last element
    --| of L.  If L is null raise the EmptyList exception.

  begin
    if L = null then
      raise EMPTYLIST;
    else

      --|  Link down L saving the pointer to the previous element in
      --|  Temp_Place_In_L.  After the last iteration Temp_Place_In_L
      --|  points to the last element in the list.
      PLACE_IN_L := L;
      while PLACE_IN_L /= null loop
        TEMP_PLACE_IN_L := PLACE_IN_L;
        PLACE_IN_L := PLACE_IN_L.NEXT;
      end loop;
      return TEMP_PLACE_IN_L;
    end if;
  end LAST;


  --------------------------------------------------------------------------

  procedure ATTACH(LIST1 : in out LIST;
                   LIST2 : in LIST) is
    ENDOFLIST1 : LIST;

    --| Attach List2 to List1.
    --| If List1 is null return List2
    --| If List1 equals List2 then raise CircularList
    --| Otherwise get the pointer to the last element of List1 and change
    --| its Next field to be List2.

  begin
    if LIST1 = null then
      LIST1 := LIST2;
      return;
    elsif LIST1 = LIST2 then
      raise CIRCULARLIST;
    else
      ENDOFLIST1 := LAST(LIST1);
      ENDOFLIST1.NEXT := LIST2;
    end if;
  end ATTACH;

  --------------------------------------------------------------------------

  procedure ATTACH(L       : in out LIST;
                   ELEMENT : in ITEMTYPE) is

    NEWEND : LIST;

    --| Create a list containing Element and attach it to the end of L

  begin
    NEWEND := new CELL'(INFO => ELEMENT, NEXT => null);
    ATTACH(L, NEWEND);
  end ATTACH;

  --------------------------------------------------------------------------

  function ATTACH(ELEMENT1 : in ITEMTYPE;
                  ELEMENT2 : in ITEMTYPE) return LIST is
    NEWLIST : LIST;

    --| Create a new list containing the information in Element1 and
    --| attach Element2 to that list.

  begin
    NEWLIST := new CELL'(INFO => ELEMENT1, NEXT => null);
    ATTACH(NEWLIST, ELEMENT2);
    return NEWLIST;
  end ATTACH;

  --------------------------------------------------------------------------

  procedure ATTACH(ELEMENT : in ITEMTYPE;
                   L       : in out LIST) is

  --|  Create a new cell whose information is Element and whose Next
  --|  field is the list L.  This prepends Element to the List L.

  begin
    L := new CELL'(INFO => ELEMENT, NEXT => L);
  end ATTACH;

  --------------------------------------------------------------------------

  function ATTACH(LIST1 : in LIST;
                  LIST2 : in LIST) return LIST is

    LAST_OF_LIST1 : LIST;

  begin
    if LIST1 = null then
      return LIST2;
    elsif LIST1 = LIST2 then
      raise CIRCULARLIST;
    else
      LAST_OF_LIST1 := LAST(LIST1);
      LAST_OF_LIST1.NEXT := LIST2;
      return LIST1;
    end if;
  end ATTACH;

  -------------------------------------------------------------------------

  function ATTACH(L       : in LIST;
                  ELEMENT : in ITEMTYPE) return LIST is

    NEWEND    : LIST;
    LAST_OF_L : LIST;

    --| Create a list called NewEnd and attach it to the end of L.
    --| If L is null return NewEnd
    --| Otherwise get the last element in L and make its Next field
    --| NewEnd.

  begin
    NEWEND := new CELL'(INFO => ELEMENT, NEXT => null);
    if L = null then
      return NEWEND;
    else
      LAST_OF_L := LAST(L);
      LAST_OF_L.NEXT := NEWEND;
      return L;
    end if;
  end ATTACH;

  --------------------------------------------------------------------------

  function ATTACH(ELEMENT : in ITEMTYPE;
                  L       : in LIST) return LIST is

  begin
    return (new CELL'(INFO => ELEMENT, NEXT => L));
  end ATTACH;

  --------------------------------------------------------------------------

  function COPY(L : in LIST) return LIST is

  --| If L is null return null
  --| Otherwise recursively copy the list by first copying the information
  --| at the head of the list and then making the Next field point to
  --| a copy of the tail of the list.

  begin
    if L = null then
      return null;
    else
      return new CELL'(INFO => L.INFO, NEXT => COPY(L.NEXT));
    end if;
  end COPY;


  --------------------------------------------------------------------------

  function COPYDEEP(L : in LIST) return LIST is

  --|  If L is null then return null.
  --|  Otherwise copy the first element of the list into the head of the
  --|  new list and copy the tail of the list recursively using CopyDeep.

  begin
    if L = null then
      return null;
    else
      return new CELL'(INFO => COPY(L.INFO), NEXT => COPYDEEP(L.NEXT));
    end if;
  end COPYDEEP;

  --------------------------------------------------------------------------

  function CREATE return LIST is

  --| Return the empty list.

  begin
    return null;
  end CREATE;

  --------------------------------------------------------------------------
  procedure DELETEHEAD(L : in out LIST) is

    TEMPLIST : LIST;

    --| Remove the element of the head of the list and return it to the heap.
    --| If L is null EmptyList.
    --| Otherwise save the Next field of the first element, remove the first
    --| element and then assign to L the Next field of the first element.

  begin
    if L = null then
      raise EMPTYLIST;
    else
      TEMPLIST := L.NEXT;
      FREE(L);
      L := TEMPLIST;
    end if;
  end DELETEHEAD;

  --------------------------------------------------------------------------

  procedure DELETEITEM(L       : in out LIST;
                       ELEMENT : in ITEMTYPE) is

    TEMP_L : LIST;

    --| Remove the first element in the list with the value Element.
    --| If the first element of the list is equal to element then
    --| remove it.  Otherwise, recurse on the tail of the list.

  begin
    if EQUAL(L.INFO, ELEMENT) then
      DELETEHEAD(L);
    else
      DELETEITEM(L.NEXT, ELEMENT);
    end if;
  exception
    when CONSTRAINT_ERROR =>
      raise ITEMNOTPRESENT;
  end DELETEITEM;

  --------------------------------------------------------------------------

  procedure DELETEITEMS(L       : in out LIST;
                        ELEMENT : in ITEMTYPE) is

    PLACE_IN_L      : LIST;  --| Current place in L.
    LAST_PLACE_IN_L : LIST;  --| Last place in L.
    TEMP_PLACE_IN_L : LIST;  --| Holds a place in L to be removed.
    FOUND           : BOOLEAN := FALSE;  --| Indicates if an element with
    --| the correct value was found.

    --| Walk over the list removing all elements with the value Element.

  begin
    PLACE_IN_L := L;
    LAST_PLACE_IN_L := null;
    while (PLACE_IN_L /= null) loop

      --| Found an element equal to Element
      if EQUAL(PLACE_IN_L.INFO, ELEMENT) then
        FOUND := TRUE;

        --| If Last_Place_In_L is null then we are at first element
        --| in L.
        if LAST_PLACE_IN_L = null then
          TEMP_PLACE_IN_L := PLACE_IN_L;
          L := PLACE_IN_L.NEXT;
        else
          TEMP_PLACE_IN_L := PLACE_IN_L;

          --| Relink the list Last's Next gets Place's Next
          LAST_PLACE_IN_L.NEXT := PLACE_IN_L.NEXT;
        end if;

        --| Move Place_In_L to the next position in the list.
        --| Free the element.
        --| Do not update the last element in the list it remains the
        --| same.
        PLACE_IN_L := PLACE_IN_L.NEXT;
        FREE(TEMP_PLACE_IN_L);
      else

        --| Update the last place in L and the place in L.
        LAST_PLACE_IN_L := PLACE_IN_L;
        PLACE_IN_L := PLACE_IN_L.NEXT;
      end if;
    end loop;

    --| If we have not found an element raise an exception.
    if not FOUND then
      raise ITEMNOTPRESENT;
    end if;

  end DELETEITEMS;

  --------------------------------------------------------------------------

  procedure DESTROY(L : in out LIST) is

    PLACE_IN_L : LIST;
    HOLDPLACE  : LIST;

    --| Walk down the list removing all the elements and set the list to
    --| the empty list.

  begin
    PLACE_IN_L := L;
    while PLACE_IN_L /= null loop
      HOLDPLACE := PLACE_IN_L;
      PLACE_IN_L := PLACE_IN_L.NEXT;
      FREE(HOLDPLACE);
    end loop;
    L := null;
  end DESTROY;

  --------------------------------------------------------------------------

  function FIRSTVALUE(L : in LIST) return ITEMTYPE is

  --| Return the first value in the list.

  begin
    if L = null then
      raise EMPTYLIST;
    else
      return (L.INFO);
    end if;
  end FIRSTVALUE;

  --------------------------------------------------------------------------

  procedure FORWORD(I : in out LISTITER) is

  --| Return the pointer to the next member of the list.

  begin
    I := LISTITER(I.NEXT);
  end FORWORD;

  --------------------------------------------------------------------------

  function ISINLIST(L       : in LIST;
                    ELEMENT : in ITEMTYPE) return BOOLEAN is

    PLACE_IN_L : LIST;

    --| Check if Element is in L.  If it is return true otherwise return false.

  begin
    PLACE_IN_L := L;
    while PLACE_IN_L /= null loop
      if EQUAL(PLACE_IN_L.INFO, ELEMENT) then
        return TRUE;
      end if;
      PLACE_IN_L := PLACE_IN_L.NEXT;
    end loop;
    return FALSE;
  end ISINLIST;

  --------------------------------------------------------------------------

  function ISEMPTY(L : in LIST) return BOOLEAN is

  --| Is the list L empty.

  begin
    return (L = null);
  end ISEMPTY;

  --------------------------------------------------------------------------

  function LASTVALUE(L : in LIST) return ITEMTYPE is

    LASTELEMENT : LIST;

    --| Return the value of the last element of the list. Get the pointer
    --| to the last element of L and then return its information.

  begin
    LASTELEMENT := LAST(L);
    return LASTELEMENT.INFO;
  end LASTVALUE;

  --------------------------------------------------------------------------

  function LENGTH(L : in LIST) return INTEGER is

  --| Recursively compute the length of L.  The length of a list is
  --| 0 if it is null or  1 + the length of the tail.

  begin
    if L = null then
      return (0);
    else
      return (1 + LENGTH(TAIL(L)));
    end if;
  end LENGTH;

  --------------------------------------------------------------------------

  function MAKELISTITER(L : in LIST) return LISTITER is

  --| Start an iteration operation on the list L.  Do a type conversion
  --| from List to ListIter.

  begin
    return LISTITER(L);
  end MAKELISTITER;

  --------------------------------------------------------------------------

  function MORE(L : in LISTITER) return BOOLEAN is

  --| This is a test to see whether an iteration is complete.

  begin
    return L /= null;
  end MORE;

  --------------------------------------------------------------------------

  procedure NEXT(PLACE : in out LISTITER;
                 INFO  : out ITEMTYPE) is
    PLACEINLIST : LIST;

    --| This procedure gets the information at the current place in the List
    --| and moves the ListIter to the next postion in the list.
    --| If we are at the end of a list then exception NoMore is raised.

  begin
    if PLACE = null then
      raise NOMORE;
    else
      PLACEINLIST := LIST(PLACE);
      INFO := PLACEINLIST.INFO;
      PLACE := LISTITER(PLACEINLIST.NEXT);
    end if;
  end NEXT;

  --------------------------------------------------------------------------

  procedure REPLACEHEAD(L    : in out LIST;
                        INFO : in ITEMTYPE) is

  --| This procedure replaces the information at the head of a list
  --| with the given information. If the list is empty the exception
  --| EmptyList is raised.

  begin
    if L = null then
      raise EMPTYLIST;
    else
      L.INFO := INFO;
    end if;
  end REPLACEHEAD;

  --------------------------------------------------------------------------

  procedure REPLACETAIL(L       : in out LIST;
                        NEWTAIL : in LIST) is
    TEMP_L : LIST;

    --| This destroys the tail of a list and replaces the tail with
    --| NewTail.  If L is empty EmptyList is raised.

  begin
    DESTROY(L.NEXT);
    L.NEXT := NEWTAIL;
  exception
    when CONSTRAINT_ERROR =>
      raise EMPTYLIST;
  end REPLACETAIL;

  --------------------------------------------------------------------------

  function TAIL(L : in LIST) return LIST is

  --| This returns the list which is the tail of L.  If L is null Empty
  --| List is raised.

  begin
    if L = null then
      raise EMPTYLIST;
    else
      return L.NEXT;
    end if;
  end TAIL;

  --------------------------------------------------------------------------
  function EQUAL(LIST1 : in LIST;
                 LIST2 : in LIST) return BOOLEAN is

    PLACEINLIST1 : LIST;
    PLACEINLIST2 : LIST;
    CONTENTS1    : ITEMTYPE;
    CONTENTS2    : ITEMTYPE;

    --| This function tests to see if two lists are equal.  Two lists
    --| are equal if for all the elements of List1 the corresponding
    --| element of List2 has the same value.  Thus if the 1st elements
    --| are equal and the second elements are equal and so up to n.
    --|  Thus a necessary condition for two lists to be equal is that
    --| they have the same number of elements.

    --| This function walks over the two list and checks that the
    --| corresponding elements are equal.  As soon as we reach
    --| the end of a list (PlaceInList = null) we fall out of the loop.
    --| If both PlaceInList1 and PlaceInList2 are null after exiting the loop
    --| then the lists are equal.  If they both are not null the lists aren't
    --| equal.  Note that equality on elements is based on a user supplied
    --| function Equal which is used to test for item equality.

  begin
    PLACEINLIST1 := LIST1;
    PLACEINLIST2 := LIST2;
    while (PLACEINLIST1 /= null) and (PLACEINLIST2 /= null) loop
      if not EQUAL(PLACEINLIST1.INFO, PLACEINLIST2.INFO) then
        return FALSE;
      end if;
      PLACEINLIST1 := PLACEINLIST1.NEXT;
      PLACEINLIST2 := PLACEINLIST2.NEXT;
    end loop;
    return ((PLACEINLIST1 = null) and (PLACEINLIST2 = null));
  end EQUAL;
end LISTS;

--------------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--stack.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with LISTS;  --| Implementation uses lists.  (private)

generic
  type ELEM_TYPE is private;  --| Component element type.

package STACK_PKG is

--| Overview:
--| This package provides the stack abstract data type.  Element type is
--| a generic formal parameter to the package.  There are no explicit
--| bounds on the number of objects that can be pushed onto a given stack.
--| All standard stack operations are provided.
--|
--| The following is a complete list of operations, written in the order
--| in which they appear in the spec.  Overloaded subprograms are followed
--| by (n), where n is the number of subprograms of that name.
--|
--| Constructors:
--|        create
--|        push
--|        pop (2)
--|        copy
--| Query Operations:
--|        top
--|        size
--|        is_empty
--| Heap Management:
--|        destroy


--| Notes:
--| Programmer: Ron Kownacki

  type STACK is private;  --| The stack abstract data type.

  -- Exceptions:

  UNINITIALIZED_STACK : exception;
  --| Raised on attempt to manipulate an uninitialized stack object.
  --| The initialization operations are create and copy.

  EMPTY_STACK         : exception;
  --| Raised by some operations when empty.


  -- Constructors:

  function CREATE return STACK;

  --| Effects:
  --| Return the empty stack.

  procedure PUSH(S : in out STACK;
                 E : in ELEM_TYPE);

  --| Raises: uninitialized_stack
  --| Effects:
  --| Push e onto the top of s.
  --| Raises uninitialized_stack iff s has not been initialized.

  procedure POP(S : in out STACK);

  --| Raises: empty_stack, uninitialized_stack
  --| Effects:
  --| Pops the top element from s, and throws it away.
  --| Raises empty_stack iff s is empty.
  --| Raises uninitialized_stack iff s has not been initialized.

  procedure POP(S : in out STACK;
                E : out ELEM_TYPE);

  --| Raises: empty_stack, uninitialized_stack
  --| Effects:
  --| Pops the top element from s, returns it as the e parameter.
  --| Raises empty_stack iff s is empty.
  --| Raises uninitialized_stack iff s has not been initialized.

  function COPY(S : in STACK) return STACK;

  --| Raises: uninitialized_stack
  --| Return a copy of s.
  --| Stack assignment and passing stacks as subprogram parameters
  --| result in the sharing of a single stack value by two stack
  --| objects; changes to one will be visible through the others.
  --| copy can be used to prevent this sharing.
  --| Raises uninitialized_stack iff s has not been initialized.


  -- Queries:

  function TOP(S : in STACK) return ELEM_TYPE;

  --| Raises: empty_stack, uninitialized_stack
  --| Effects:
  --| Return the element on the top of s.  Raises empty_stack iff s is
  --| empty.
  --| Raises uninitialized_stack iff s has not been initialized.

  function SIZE(S : in STACK) return NATURAL;

  --| Raises: uninitialized_stack
  --| Effects:
  --| Return the current number of elements in s.
  --| Raises uninitialized_stack iff s has not been initialized.

  function IS_EMPTY(S : in STACK) return BOOLEAN;

  --| Raises: uninitialized_stack
  --| Effects:
  --| Return true iff s is empty.
  --| Raises uninitialized_stack iff s has not been initialized.


  -- Heap Management:

  procedure DESTROY(S : in out STACK);

  --| Effects:
  --| Return the space consumed by s to the heap.  No effect if s is
  --| uninitialized.  In any case, leaves s in uninitialized state.


private

  package ELEM_LIST_PKG is
    new LISTS(ELEM_TYPE);
  subtype ELEM_LIST is ELEM_LIST_PKG.LIST;

  type STACK_REC is
    record
      SIZE : NATURAL := 0;
      ELTS : ELEM_LIST := ELEM_LIST_PKG.CREATE;
    end record;

  type STACK is access STACK_REC;

  --| Let an instance of the representation type, r, be denoted by the
  --| pair, <size, elts>.  Dot selection is used to refer to these
  --| components.
  --|
  --| Representation Invariants:
  --|     r /= null
  --|     elem_list_pkg.length(r.elts) = r.size.
  --|
  --| Abstraction Function:
  --|     A(<size, elem_list_pkg.create>) = stack_pkg.create.
  --|     A(<size, elem_list_pkg.attach(e, l)>) = push(A(<size, l>), e).

end STACK_PKG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--stack.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with UNCHECKED_DEALLOCATION;

package body STACK_PKG is

--| Overview:
--| Implementation scheme is totally described by the statements of the
--| representation invariants and abstraction function that appears in
--| the package specification.  The implementation is so trivial that
--| further documentation is unnecessary.

  use ELEM_LIST_PKG;


  -- Constructors:

  function CREATE return STACK is
  begin
    return new STACK_REC'(SIZE => 0, ELTS => CREATE);
  end CREATE;

  procedure PUSH(S : in out STACK;
                 E : in ELEM_TYPE) is
  begin
    S.SIZE := S.SIZE + 1;
    S.ELTS := ATTACH(E, S.ELTS);
  exception
    when CONSTRAINT_ERROR =>
      raise UNINITIALIZED_STACK;
  end PUSH;

  procedure POP(S : in out STACK) is
  begin
    DELETEHEAD(S.ELTS);
    S.SIZE := S.SIZE - 1;
  exception
    when EMPTYLIST =>
      raise EMPTY_STACK;
    when CONSTRAINT_ERROR =>
      raise UNINITIALIZED_STACK;
  end POP;

  procedure POP(S : in out STACK;
                E : out ELEM_TYPE) is
  begin
    E := FIRSTVALUE(S.ELTS);
    DELETEHEAD(S.ELTS);
    S.SIZE := S.SIZE - 1;
  exception
    when EMPTYLIST =>
      raise EMPTY_STACK;
    when CONSTRAINT_ERROR =>
      raise UNINITIALIZED_STACK;
  end POP;

  function COPY(S : in STACK) return STACK is
  begin
    if S = null then
      raise UNINITIALIZED_STACK;
    end if;

    return new STACK_REC'(SIZE => S.SIZE, ELTS => COPY(S.ELTS));
  end COPY;


  -- Queries:

  function TOP(S : in STACK) return ELEM_TYPE is
  begin
    return FIRSTVALUE(S.ELTS);
  exception
    when EMPTYLIST =>
      raise EMPTY_STACK;
    when CONSTRAINT_ERROR =>
      raise UNINITIALIZED_STACK;
  end TOP;

  function SIZE(S : in STACK) return NATURAL is
  begin
    return S.SIZE;
  exception
    when CONSTRAINT_ERROR =>
      raise UNINITIALIZED_STACK;
  end SIZE;

  function IS_EMPTY(S : in STACK) return BOOLEAN is
  begin
    return S.SIZE = 0;
  exception
    when CONSTRAINT_ERROR =>
      raise UNINITIALIZED_STACK;
  end IS_EMPTY;


  -- Heap Management:

  procedure DESTROY(S : in out STACK) is
    procedure FREE_STACK is
      new UNCHECKED_DEALLOCATION(STACK_REC, STACK);
  begin
    DESTROY(S.ELTS);
    FREE_STACK(S);
  exception
    when CONSTRAINT_ERROR =>

      -- stack is null
      return;
  end DESTROY;

end STACK_PKG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--string.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

package STRING_PKG is

--| Overview:
--| Package string_pkg exports an abstract data type, string_type.  A
--| string_type value is a sequence of characters.  The values have arbitrary
--| length.  For a value, s, with length, l, the individual characters are
--| numbered from 1 to l.  These values are immutable; characters cannot be
--| replaced or appended in a destructive fashion.
--|
--| In the documentation for this package, we are careful to distinguish
--| between string_type objects, which are Ada objects in the usual sense,
--| and string_type values, the members of this data abstraction as described
--| above.  A string_type value is said to be associated with, or bound to,
--| a string_type object after an assignment (:=) operation.
--|
--| The operations provided in this package fall into three categories:
--|
--| 1. Constructors:  These functions typically take one or more string_type
--|      objects as arguments.  They work with the values associated with
--|      these objects, and return new string_type values according to
--|      specification.  By a slight abuse of language, we will sometimes
--|      coerce from string_type objects to values for ease in description.
--|
--| 2. Heap Management:
--|      These operations (make_persistent, flush, mark, release) control the
--|      management of heap space.  Because string_type values are
--|      allocated on the heap, and the type is not limited, it is necessary
--|      for a user to assume some responsibility for garbage collection.
--|      String_type is not limited because of the convenience of
--|      the assignment operation, and the usefulness of being able to
--|      instantiate generic units that contain private type formals.
--|      ** Important: To use this package properly, it is necessary to read
--|      the descriptions of the operations in this section.
--|
--| 3. Queries:  These functions return information about the values
--|      that are associated with the argument objects.  The same conventions
--|      for description of operations used in (1) is adopted.
--|
--| A note about design decisions...  The decision to not make the type
--| limited causes two operations to be carried over from the representation.
--| These are the assignment operation, :=, and the "equality" operator, "=".
--| See the discussion at the beginning of the Heap Management section for a
--| discussion of :=.
--| See the spec for the first of the equal functions for a discussion of "=".
--|
--| The following is a complete list of operations, written in the order
--| in which they appear in the spec.  Overloaded subprograms are followed
--| by (n), where n is the number of subprograms of that name.
--|
--| 1. Constructors:
--|        create
--|        "&" (3)
--|        substr
--|        splice
--|        insert (3)
--|        lower (2)
--|        upper (2)
--| 2. Heap Management:
--|        make_persistent (2)
--|        flush
--|        mark, release
--| 3. Queries:
--|        is_empty
--|        length
--|        value
--|        fetch
--|        equal (3)
--|        "<" (3),
--|       "<=" (3)
--|        match_c
--|        match_not_c
--|        match_s (2)
--|        match_any (2)
--|        match_none (2)

--| Notes:
--| Programmer: Ron Kownacki

  type STRING_TYPE is private;

  BOUNDS          : exception;  --| Raised on index out of bounds.
  ANY_EMPTY       : exception;  --| Raised on incorrect use of match_any.
  ILLEGAL_ALLOC   : exception;  --| Raised by value creating operations.
  ILLEGAL_DEALLOC : exception;  --| Raised by release.


  -- Constructors:

  function CREATE(S : in STRING) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Return a value consisting of the sequence of characters in s.
  --| Sometimes useful for array or record aggregates.
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function "&"(S1, S2 : in STRING_TYPE) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Return the concatenation of s1 and s2.
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function "&"(S1 : in STRING_TYPE;
               S2 : in STRING) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Return the concatenation of s1 and create(s2).
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function "&"(S1 : in STRING;
               S2 : in STRING_TYPE) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Return the concatenation of create(s1) and s2.
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function SUBSTR(S   : in STRING_TYPE;
                  I   : in POSITIVE;
                  LEN : in NATURAL) return STRING_TYPE;

  --| Raises: bounds, illegal_alloc
  --| Effects:
  --| Return the substring, of specified length, that occurs in s at
  --| position i.  If len = 0, then returns the empty value.
  --| Otherwise, raises bounds if either i or (i + len - 1)
  --| is not in 1..length(s).
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function SPLICE(S   : in STRING_TYPE;
                  I   : in POSITIVE;
                  LEN : in NATURAL) return STRING_TYPE;

  --| Raises: bounds, illegal_alloc
  --| Effects:
  --| Let s be the string, abc, where a, b and c are substrings.  If
  --| substr(s, i, length(b)) = b, for some i in 1..length(s), then
  --| splice(s, i, length(b)) = ac.
  --| Returns a value equal to s if len = 0.  Otherwise, raises bounds if
  --| either i or (i + len - 1) is not in 1..length(s).
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function INSERT(S1, S2 : in STRING_TYPE;
                  I      : in POSITIVE) return STRING_TYPE;

  --| Raises: bounds, illegal_alloc
  --| Effects:
  --| Return substr(s1, 1, i - 1) & s2 &
  --|        substr(s1, i, length(s1) - i + 1).
  --| equal(splice(insert(s1, s2, i), i, length(s2)), s1) holds if no
  --| exception is raised by insert.
  --| Raises bounds if is_empty(s1) or else i is not in 1..length(s1).
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function INSERT(S1 : in STRING_TYPE;
                  S2 : in STRING;
                  I  : in POSITIVE) return STRING_TYPE;

  --| Raises: bounds, illegal_alloc
  --| Effects:
  --| Return substr(s1, 1, i - 1) & s2 &
  --|        substr(s1, i, length(s1) - i + 1).
  --| equal(splice(insert(s1, s2, i), i, length(s2)), s1) holds if no
  --| exception is raised by insert.
  --| Raises bounds if is_empty(s1) or else i is not in 1..length(s1).
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function INSERT(S1 : in STRING;
                  S2 : in STRING_TYPE;
                  I  : in POSITIVE) return STRING_TYPE;

  --| Raises: bounds, illegal_alloc
  --| Effects:
  --| Return s1(s1'first..i - 1) & s2 &
  --|        s1(i..length(s1) - i + 1).
  --| equal(splice(insert(s1, s2, i), i, length(s2)), s1) holds if no
  --| exception is raised by insert.
  --| Raises bounds if i is not in s'range.
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function LOWER(S : in STRING) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Return a value that contains exactly those characters in s with
  --| the exception that all upper case characters are replaced by their
  --| lower case counterparts.
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function LOWER(S : in STRING_TYPE) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Return a value that is a copy of s with the exception that all
  --| upper case characters are replaced by their lower case counterparts.
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function UPPER(S : in STRING) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Return a value that contains exactly those characters in s with
  --| the exception that all lower case characters are replaced by their
  --| upper case counterparts.
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)

  function UPPER(S : in STRING_TYPE) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Return a value that is a copy of s with the exception that all
  --| lower case characters are replaced by their upper case counterparts.
  --| Raises illegal_alloc if string space has been improperly
  --| released.  (See procedures mark/release.)


  -- Heap Management (including object/value binding):
  --
-- Two forms of heap management are provided.  The general scheme is to "mark"
  -- the current state of heap usage, and to "release" in order to reclaim all
  -- space that has been used since the last mark.  However, this alone is
  -- insufficient because it is frequently desirable for objects to remain
  -- associated with values for longer periods of time, and this may come into
  -- conflict with the need to clean up after a period of "string hacking."
  -- To deal with this problem, we introduce the notions of "persistent" and
  -- "nonpersistent" values.
  --
  -- The nonpersistent values are those that are generated by the constructors
  -- in the previous section.  These are claimed by the release procedure.
  -- Persistent values are generated by the two make_persistent functions
-- described below.  These values must be disposed of individually by means of
  -- the flush procedure.
  --
  -- This allows a description of the meaning of the ":=" operation.  For a
  -- statement of the form, s := expr, where expr is a string_type expression,
  -- the result is that the value denoted/created by expr becomes bound to the
  -- the object, s.  Assignment in no way affects the persistence of the value.
-- If expr happens to be an object, then the value associated  with it will be
  -- shared.  Ideally, this sharing would not be visible, since values are
  -- immutable.  However, the sharing may be visible because of the memory
-- management, as described below.  Programs which depend on such sharing are
  -- erroneous.

  function MAKE_PERSISTENT(S : in STRING_TYPE) return STRING_TYPE;

  --| Effects:
  --| Returns a persistent value, v, containing exactly those characters in
  --| value(s).  The value v will not be claimed by any subsequent release.
  --| Only an invocation of flush will claim v.  After such a claiming
  --| invocation of flush, the use (other than :=) of any other object to
  --| which v was bound is erroneous, and program_error may be raised for
  --| such a use.

  function MAKE_PERSISTENT(S : in STRING) return STRING_TYPE;

  --| Effects:
  --| Returns a persistent value, v, containing exactly those chars in s.
  --| The value v will not be claimed by any subsequent release.
  --| Only an invocation of flush will reclaim v.  After such a claiming
  --| invocation of flush, the use (other than :=) of any other object to
  --| which v was bound is erroneous, and program_error may be raised for
  --| such a use.

  procedure FLUSH(S : in out STRING_TYPE);

  --| Effects:
  --| Return heap space used by the value associated with s, if any, to
  --| the heap.  s becomes associated with the empty value.  After an
  --| invocation of flush claims the value, v, then any use (other than :=)
  --| of an object to which v was bound is erroneous, and program_error
  --| may be raised for such a use.
  --|
  --| This operation should be used only for persistent values.  The mark
  --| and release operations are used to deallocate space consumed by other
  --| values.  For example, flushing a nonpersistent value implies that a
  --| release that tries to claim this value will be erroneous, and
  --| program_error may be raised for such a use.

  procedure MARK;

  --| Effects:
  --| Marks the current state of heap usage for use by release.
  --| An implicit mark is performed at the beginning of program execution.

  procedure RELEASE;

  --| Raises: illegal_dealloc
  --| Effects:
  --| Releases all heap space used by nonpersistent values that have been
  --| allocated since the last mark.  The values that are claimed include
  --| those bound to objects as well as those produced and discarded during
  --| the course of general "string hacking."  If an invocation of release
  --| claims a value, v, then any subsequent use (other than :=) of any
  --| other object to which v is bound is erroneous, and program_error may
  --| be raised for such a use.
  --|
  --| Raises illegal_dealloc if the invocation of release does not balance
  --| an invocation of mark.  It is permissible to match the implicit
  --| initial invocation of mark.  However, subsequent invocations of
  --| constructors will raise the illegal_alloc exception until an
  --| additional mark is performed.  (Anyway, there is no good reason to
  --| do this.)  In any case, a number of releases matching the number of
  --| currently active marks is implicitly performed at the end of program
  --| execution.
  --|
  --| Good citizens generally perform their own marks and releases
  --| explicitly.  Extensive string hacking without cleaning up will
  --| cause your program to run very slowly, since the heap manager will
  --| be forced to look hard for chunks of space to allocate.

  -- Queries:

  function IS_EMPTY(S : in STRING_TYPE) return BOOLEAN;

  --| Effects:
  --| Return true iff s is the empty sequence of characters.

  function LENGTH(S : in STRING_TYPE) return NATURAL;

  --| Effects:
  --| Return number of characters in s.

  function VALUE(S : in STRING_TYPE) return STRING;

  --| Effects:
  --| Return a string, s2, that contains the same characters that s
  --| contains.  The properties, s2'first = 1 and s2'last = length(s),
  --| are satisfied.  This implies that, for a given string, s3,
  --| value(create(s3))'first may not equal s3'first, even though
  --| value(create(s3)) = s3 holds.  Thus, "content equality" applies
  --| although the string objects may be distinguished by the use of
  --| the array attributes.

  function FETCH(S : in STRING_TYPE;
                 I : in POSITIVE) return CHARACTER;

  --| Raises: bounds
  --| Effects:
  --| Return the ith character in s.  Characters are numbered from
  --| 1 to length(s).  Raises bounds if i not in 1..length(s).

  function EQUAL(S1, S2 : in STRING_TYPE) return BOOLEAN;

  --| Effects:
  --| Value equality relation; return true iff length(s1) = length(s2)
  --| and, for all i in 1..length(s1), fetch(s1, i) = fetch(s2, i).
  --| The "=" operation is carried over from the representation.
  --| It allows one to distinguish among the heap addresses of
  --| string_type values.  Even "equal" values may not be "=", although
  --| s1 = s2 implies equal(s1, s2).
  --| There is no reason to use "=".

  function EQUAL(S1 : in STRING_TYPE;
                 S2 : in STRING) return BOOLEAN;

  --| Effects:
  --| Return equal(s1, create(s2)).

  function EQUAL(S1 : in STRING;
                 S2 : in STRING_TYPE) return BOOLEAN;

  --| Effects:
  --| Return equal(create(s1), s2).

  function "<"(S1 : in STRING_TYPE;
               S2 : in STRING_TYPE) return BOOLEAN;

  --| Effects:
  --| Lexicographic comparison; return value(s1) < value(s2).

  function "<"(S1 : in STRING_TYPE;
               S2 : in STRING) return BOOLEAN;

  --| Effects:
  --| Lexicographic comparison; return value(s1) < s2.

  function "<"(S1 : in STRING;
               S2 : in STRING_TYPE) return BOOLEAN;

  --| Effects:
  --| Lexicographic comparison; return s1 < value(s2).

  function "<="(S1 : in STRING_TYPE;
                S2 : in STRING_TYPE) return BOOLEAN;

  --| Effects:
  --| Lexicographic comparison; return value(s1) <= value(s2).

  function "<="(S1 : in STRING_TYPE;
                S2 : in STRING) return BOOLEAN;

  --| Effects:
  --| Lexicographic comparison; return value(s1) <= s2.

  function "<="(S1 : in STRING;
                S2 : in STRING_TYPE) return BOOLEAN;

  --| Effects:
  --| Lexicographic comparison; return s1 <= value(s2).

  function MATCH_C(S     : in STRING_TYPE;
                   C     : in CHARACTER;
                   START : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match
  --| Effects:
  --| Return the minimum index, i in start..length(s), such that
  --| fetch(s, i) = c.  Returns 0 if no such i exists,
  --| including the case where is_empty(s).

  function MATCH_NOT_C(S     : in STRING_TYPE;
                       C     : in CHARACTER;
                       START : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match
  --| Effects:
  --| Return the minimum index, i in start..length(s), such that
  --| fetch(s, i) /= c.  Returns 0 if no such i exists,
  --| including the case where is_empty(s).

  function MATCH_S(S1, S2 : in STRING_TYPE;
                   START  : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match.
  --| Effects:
  --| Return the minimum index, i, in start..length(s1), such that,
  --| for all j in 1..length(s2), fetch(s2, j) = fetch(s1, i + j - 1).
  --| This is the position of the substring, s2, in s1.
  --| Returns 0 if no such i exists, including the cases
  --| where is_empty(s1) or is_empty(s2).
  --| Note that equal(substr(s1, match_s(s1, s2, i), length(s2)), s2)
  --| holds, providing that match_s does not raise an exception.

  function MATCH_S(S1    : in STRING_TYPE;
                   S2    : in STRING;
                   START : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match.
  --| Effects:
  --| Return the minimum index, i, in start..length(s1), such that,
  --| for all j in s2'range, s2(j) = fetch(s1, i + j - 1).
  --| This is the position of the substring, s2, in s1.
  --| Returns 0 if no such i exists, including the cases
  --| where is_empty(s1) or s2 = "".
  --| Note that equal(substr(s1, match_s(s1, s2, i), s2'length), s2)
  --| holds, providing that match_s does not raise an exception.

  function MATCH_ANY(S, ANY : in STRING_TYPE;
                     START  : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match, any_empty
  --| Effects:
  --| Return the minimum index, i in start..length(s), such that
  --| fetch(s, i) = fetch(any, j), for some j in 1..length(any).
  --| Raises any_empty if is_empty(any).
  --| Otherwise, returns 0 if no such i exists, including the case
  --| where is_empty(s).


  function MATCH_ANY(S     : in STRING_TYPE;
                     ANY   : in STRING;
                     START : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match, any_empty
  --| Effects:
  --| Return the minimum index, i, in start..length(s), such that
  --| fetch(s, i) = any(j), for some j in any'range.
  --| Raises any_empty if any = "".
  --| Otherwise, returns 0 if no such i exists, including the case
  --| where is_empty(s).

  function MATCH_NONE(S, NONE : in STRING_TYPE;
                      START   : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match
  --| Effects:
  --| Return the minimum index, i in start..length(s), such that
  --| fetch(s, i) /= fetch(none, j) for each j in 1..length(none).
  --| If (not is_empty(s)) and is_empty(none), then i is 1.
  --| Returns 0 if no such i exists, including the case
  --| where is_empty(s).

  function MATCH_NONE(S     : in STRING_TYPE;
                      NONE  : in STRING;
                      START : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match.
  --| Effects:
  --| Return the minimum index, i in start..length(s), such that
  --| fetch(s, i) /= none(j) for each j in none'range.
  --| If not is_empty(s) and none = "", then i is 1.
  --| Returns 0 if no such i exists, including the case
  --| where is_empty(s).


private

  type STRING_TYPE is access STRING;

  --| Abstract data type, string_type, is a constant sequence of chars
  --| of arbitrary length.  Representation type is access string.
  --| It is important to distinguish between an object of the rep type
  --| and its value; for an object, r, val(r) denotes the value.
  --|
  --| Representation Invariant:  I: rep --> boolean
  --| I(r: rep) = (val(r) = null) or else
  --|             (val(r).all'first = 1 &
  --|              val(r).all'last >= 0 &
  --|              (for all r2, val(r) = val(r2) /= null => r is r2))
  --|
  --| Abstraction Function:  A: rep --> string_type
  --| A(r: rep) = if r = null then
  --|                 the empty sequence
  --|             elsif r'last = 0 then
  --|                 the empty sequence
  --|             else
  --|                 the sequence consisting of r(1),...,r(r'last).

end STRING_PKG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--string.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with UNCHECKED_DEALLOCATION;
with LISTS, STACK_PKG;

package body STRING_PKG is

--| Overview:
--| The implementation for most operations is fairly straightforward.
--| The interesting aspects involve the allocation and deallocation of
--| heap space.  This is done as follows:
--|
--|     1. A stack of accesses to lists of string_type values is set up
--|        so that the top of the stack always refers to a list of values
--|        that were allocated since the last invocation of mark.
--|        The stack is called scopes, referring to the dynamic scopes
--|        defined by the invocations of mark and release.
--|        There is an implicit invocation of mark when the
--|        package body is elaborated; this is implemented with an explicit
--|        invocation in the package initialization code.
--|
--|     2. At each invocation of mark, a pointer to an empty list
--|        is pushed onto the stack.
--|
--|     3. At each invocation of release, all of the values in the
--|        list referred to by the pointer at the top of the stack are
--|        returned to the heap.  Then the list, and the pointer to it,
--|        are returned to the heap.  Finally, the stack is popped.

  package STRING_LIST_PKG is
    new LISTS(STRING_TYPE);
  subtype STRING_LIST is STRING_LIST_PKG.LIST;

  type STRING_LIST_PTR is access STRING_LIST;

  package SCOPE_STACK_PKG is
    new STACK_PKG(STRING_LIST_PTR);
  subtype SCOPE_STACK is SCOPE_STACK_PKG.STACK;

  use STRING_LIST_PKG;
  use SCOPE_STACK_PKG;

  SCOPES : SCOPE_STACK;  -- See package body overview.


  -- Utility functions/procedures:

  function ENTER(S : in STRING_TYPE) return STRING_TYPE;

  --| Raises: illegal_alloc
  --| Effects:
  --| Stores s, the address of s.all, in current scope list (top(scopes)),
  --| and returns s.  Useful for functions that create and return new
  --| string_type values.
  --| Raises illegal_alloc if the scopes stack is empty.

  function MATCH_STRING(S1, S2 : in STRING;
                        START  : in POSITIVE := 1) return NATURAL;

  --| Raises: no_match
  --| Effects:
  --| Returns the minimum index, i, in s1'range such that
  --| s1(i..i + s2'length - 1) = s2.  Returns 0 if no such index.
  --| Requires:
  --| s1'first = 1.

  -- Constructors:

  function CREATE(S : in STRING) return STRING_TYPE is
    subtype CONSTR_STR is STRING(1 .. S'LENGTH);
    DEC_S : CONSTR_STR := S;
  begin
    return ENTER(new CONSTR_STR'(DEC_S));

  -- DECada bug; above code (and decl of dec_s) replaces the following:
  --        return enter(new constr_str'(s));
  end CREATE;

  function "&"(S1, S2 : in STRING_TYPE) return STRING_TYPE is
  begin
    if IS_EMPTY(S1) then
      return ENTER(MAKE_PERSISTENT(S2));
    end if;
    if IS_EMPTY(S2) then
      return ENTER(MAKE_PERSISTENT(S1));
    end if;
    return CREATE(S1.all & S2.all);
  end "&";

  function "&"(S1 : in STRING_TYPE;
               S2 : in STRING) return STRING_TYPE is
  begin
    if S1 = null then
      return CREATE(S2);
    end if;
    return CREATE(S1.all & S2);
  end "&";

  function "&"(S1 : in STRING;
               S2 : in STRING_TYPE) return STRING_TYPE is
  begin
    if S2 = null then
      return CREATE(S1);
    end if;
    return CREATE(S1 & S2.all);
  end "&";

  function SUBSTR(S   : in STRING_TYPE;
                  I   : in POSITIVE;
                  LEN : in NATURAL) return STRING_TYPE is
  begin
    if LEN = 0 then
      return null;
    end if;
    return CREATE(S(I .. (I + LEN - 1)));
  exception
    when CONSTRAINT_ERROR =>

      -- on array fetch or null deref
      raise BOUNDS;
  end SUBSTR;

  function SPLICE(S   : in STRING_TYPE;
                  I   : in POSITIVE;
                  LEN : in NATURAL) return STRING_TYPE is
  begin
    if LEN = 0 then
      return ENTER(MAKE_PERSISTENT(S));
    end if;
    if I + LEN - 1 > LENGTH(S) then
      raise BOUNDS;
    end if;

    return CREATE(S(1 .. (I - 1)) & S((I + LEN) .. LENGTH(S)));
  end SPLICE;

  function INSERT(S1, S2 : in STRING_TYPE;
                  I      : in POSITIVE) return STRING_TYPE is
  begin
    if I > LENGTH(S1) then
      raise BOUNDS;
    end if;
    if IS_EMPTY(S2) then
      return CREATE(S1.all);
    end if;

    return CREATE(S1(1 .. (I - 1)) & S2.all & S1(I .. S1'LAST));
  end INSERT;

  function INSERT(S1 : in STRING_TYPE;
                  S2 : in STRING;
                  I  : in POSITIVE) return STRING_TYPE is
  begin
    if I > LENGTH(S1) then
      raise BOUNDS;
    end if;

    return CREATE(S1(1 .. (I - 1)) & S2 & S1(I .. S1'LAST));
  end INSERT;

  function INSERT(S1 : in STRING;
                  S2 : in STRING_TYPE;
                  I  : in POSITIVE) return STRING_TYPE is
  begin
    if not (I in S1'range ) then
      raise BOUNDS;
    end if;
    if S2 = null then
      return CREATE(S1);
    end if;

    return CREATE(S1(S1'FIRST .. (I - 1)) & S2.all & S1(I .. S1'LAST));
  end INSERT;

  function LOWER(S : in STRING) return STRING_TYPE is
    S2 : STRING_TYPE := CREATE(S);

    procedure LC(C : in out CHARACTER) is
    begin
      if ('A' <= C) and then (C <= 'Z') then
        C := CHARACTER'VAL(CHARACTER'POS(C) - CHARACTER'POS('A') + CHARACTER'POS
          ('a'));
      end if;
    end LC;

  begin
    for I in S2'range loop
      LC(S2(I));
    end loop;
    return S2;
  end LOWER;

  function LOWER(S : in STRING_TYPE) return STRING_TYPE is
  begin
    if S = null then
      return null;
    end if;
    return LOWER(S.all);
  end LOWER;

  function UPPER(S : in STRING) return STRING_TYPE is
    S2 : STRING_TYPE := CREATE(S);

    procedure UC(C : in out CHARACTER) is
    begin
      if ('a' <= C) and then (C <= 'z') then
        C := CHARACTER'VAL(CHARACTER'POS(C) - CHARACTER'POS('a') + CHARACTER'POS
          ('A'));
      end if;
    end UC;

  begin
    for I in S2'range loop
      UC(S2(I));
    end loop;
    return S2;
  end UPPER;

  function UPPER(S : in STRING_TYPE) return STRING_TYPE is
  begin
    if S = null then
      return null;
    end if;
    return UPPER(S.all);
  end UPPER;


  -- Heap Management:

  function MAKE_PERSISTENT(S : in STRING_TYPE) return STRING_TYPE is
    subtype CONSTR_STR is STRING(1 .. LENGTH(S));
  begin
    if S = null or else S.all = "" then
      return null;
    else
      return new CONSTR_STR'(S.all);
    end if;
  end MAKE_PERSISTENT;

  function MAKE_PERSISTENT(S : in STRING) return STRING_TYPE is
    subtype CONSTR_STR is STRING(1 .. S'LENGTH);
    DEC_S : CONSTR_STR := S;
  begin
    if S = "" then
      return null;
    else
      return new CONSTR_STR'(DEC_S);
    end if;
  end MAKE_PERSISTENT;

  procedure REAL_FLUSH is
    new UNCHECKED_DEALLOCATION(STRING, STRING_TYPE);
    --| Effect:
    --| Return space used by argument to heap.  Does nothing if null.
    --| Notes:
    --| This procedure is actually the body for the flush procedure,
    --| but a generic instantiation cannot be used as a body for another
    --| procedure.  You tell me why.

  procedure FLUSH(S : in out STRING_TYPE) is
  begin
    if S /= null then
      REAL_FLUSH(S);
    end if;

  -- Actually, the if isn't needed; however, DECada compiler chokes
  -- on deallocation of null.
  end FLUSH;

  procedure MARK is
  begin
    PUSH(SCOPES, new STRING_LIST'(CREATE));
  end MARK;

  procedure RELEASE is
    procedure FLUSH_LIST_PTR is
      new UNCHECKED_DEALLOCATION(STRING_LIST, STRING_LIST_PTR);
    ITER     : STRING_LIST_PKG.LISTITER;
    TOP_LIST : STRING_LIST_PTR;
    S        : STRING_TYPE;
  begin
    POP(SCOPES, TOP_LIST);
    ITER := MAKELISTITER(TOP_LIST.all);
    while MORE(ITER) loop
      NEXT(ITER, S);
      begin
        FLUSH(S);
      exception
        -- to prevent program error when trying to flush unpersistent strings
        -- 1-16-86
        when others => null;
      end;
    -- real_flush is bad, DECada bug
    --          real_flush(s);
    end loop;
    DESTROY(TOP_LIST.all);
    FLUSH_LIST_PTR(TOP_LIST);
  exception
    when EMPTY_STACK =>
      raise ILLEGAL_DEALLOC;
  end RELEASE;


  -- Queries:

  function IS_EMPTY(S : in STRING_TYPE) return BOOLEAN is
  begin
    return (S = null) or else (S.all = "");
  end IS_EMPTY;

  function LENGTH(S : in STRING_TYPE) return NATURAL is
  begin
    if S = null then
      return 0;
    end if;
    return (S.all'LENGTH);
  end LENGTH;

  function VALUE(S : in STRING_TYPE) return STRING is
    subtype NULL_RANGE is POSITIVE range 1 .. 0;
    subtype NULL_STRING is STRING(NULL_RANGE);
  begin
    if S = null then
      return NULL_STRING'("");
    end if;
    return S.all;
  end VALUE;

  function FETCH(S : in STRING_TYPE;
                 I : in POSITIVE) return CHARACTER is
  begin
    if IS_EMPTY(S) or else (not (I in S'range )) then
      raise BOUNDS;
    end if;
    return S(I);
  end FETCH;

  function EQUAL(S1, S2 : in STRING_TYPE) return BOOLEAN is
  begin
    if IS_EMPTY(S1) then
      return IS_EMPTY(S2);
    end if;
    return (S2 /= null) and then (S1.all = S2.all);

  -- The above code replaces the following.  (DECada buggy)
  --        return s1.all = s2.all;
  --    exception
  --    when constraint_error =>     -- s is null
  --        return is_empty(s1) and is_empty(s2);
  end EQUAL;

  function EQUAL(S1 : in STRING_TYPE;
                 S2 : in STRING) return BOOLEAN is
  begin
    if S1 = null then
      return S2 = "";
    end if;
    return S1.all = S2;
  end EQUAL;

  function EQUAL(S1 : in STRING;
                 S2 : in STRING_TYPE) return BOOLEAN is
  begin
    if S2 = null then
      return S1 = "";
    end if;
    return S1 = S2.all;
  end EQUAL;

  function "<"(S1 : in STRING_TYPE;
               S2 : in STRING_TYPE) return BOOLEAN is
  begin
    if IS_EMPTY(S1) then
      return (not IS_EMPTY(S2));
    else
      return (S1.all < S2);
    end if;

  -- Got rid of the following code:  (Think that DECada is buggy)
  --return s1.all < s2.all;
  --exception
  --when constraint_error =>   -- on null deref
  --return (not is_empty(s2));
  -- one of them must be empty
  end "<";

  function "<"(S1 : in STRING_TYPE;
               S2 : in STRING) return BOOLEAN is
  begin
    if S1 = null then
      return S2 /= "";
    end if;
    return S1.all < S2;
  end "<";

  function "<"(S1 : in STRING;
               S2 : in STRING_TYPE) return BOOLEAN is
  begin
    if S2 = null then
      return FALSE;
    end if;
    return S1 < S2.all;
  end "<";

  function "<="(S1 : in STRING_TYPE;
                S2 : in STRING_TYPE) return BOOLEAN is
  begin
    if IS_EMPTY(S1) then
      return TRUE;
    end if;
    return (S1.all <= S2);

  -- Replaces the following:  (I think DECada is buggy)
  --return s1.all <= s2.all;
  --exception
  --when constraint_error =>   -- on null deref
  --return is_empty(s1);   -- one must be empty, so s1<=s2 iff s1 = ""
  end "<=";

  function "<="(S1 : in STRING_TYPE;
                S2 : in STRING) return BOOLEAN is
  begin
    if S1 = null then
      return TRUE;
    end if;
    return S1.all <= S2;
  end "<=";

  function "<="(S1 : in STRING;
                S2 : in STRING_TYPE) return BOOLEAN is
  begin
    if S2 = null then
      return S1 = "";
    end if;
    return S1 <= S2.all;
  end "<=";

  function MATCH_C(S     : in STRING_TYPE;
                   C     : in CHARACTER;
                   START : in POSITIVE := 1) return NATURAL is
  begin
    if S = null then
      return 0;
    end if;
    for I in START .. S.all'LAST loop
      if S(I) = C then
        return I;
      end if;
    end loop;
    return 0;
  end MATCH_C;

  function MATCH_NOT_C(S     : in STRING_TYPE;
                       C     : in CHARACTER;
                       START : in POSITIVE := 1) return NATURAL is
  begin
    if S = null then
      return 0;
    end if;
    for I in START .. S.all'LAST loop
      if S(I) /= C then
        return I;
      end if;
    end loop;
    return 0;
  end MATCH_NOT_C;

  function MATCH_S(S1, S2 : in STRING_TYPE;
                   START  : in POSITIVE := 1) return NATURAL is
  begin
    if (S1 = null) or else (S2 = null) then
      return 0;
    end if;
    return MATCH_STRING(S1.all, S2.all, START);
  end MATCH_S;

  function MATCH_S(S1    : in STRING_TYPE;
                   S2    : in STRING;
                   START : in POSITIVE := 1) return NATURAL is
  begin
    if S1 = null then
      return 0;
    end if;
    return MATCH_STRING(S1.all, S2, START);
  end MATCH_S;

  function MATCH_ANY(S, ANY : in STRING_TYPE;
                     START  : in POSITIVE := 1) return NATURAL is
  begin
    if ANY = null then
      raise ANY_EMPTY;
    end if;
    return MATCH_ANY(S, ANY.all, START);
  end MATCH_ANY;

  function MATCH_ANY(S     : in STRING_TYPE;
                     ANY   : in STRING;
                     START : in POSITIVE := 1) return NATURAL is
  begin
    if ANY = "" then
      raise ANY_EMPTY;
    end if;
    if S = null then
      return 0;
    end if;

    for I in START .. S.all'LAST loop
      for J in ANY'range loop
        if S(I) = ANY(J) then
          return I;
        end if;
      end loop;
    end loop;
    return 0;
  end MATCH_ANY;

  function MATCH_NONE(S, NONE : in STRING_TYPE;
                      START   : in POSITIVE := 1) return NATURAL is
  begin
    if IS_EMPTY(S) then
      return 0;
    end if;
    if IS_EMPTY(NONE) then
      return 1;
    end if;

    return MATCH_NONE(S, NONE.all, START);
  end MATCH_NONE;

  function MATCH_NONE(S     : in STRING_TYPE;
                      NONE  : in STRING;
                      START : in POSITIVE := 1) return NATURAL is
    FOUND : BOOLEAN;
  begin
    if IS_EMPTY(S) then
      return 0;
    end if;

    for I in START .. S.all'LAST loop
      FOUND := TRUE;
      for J in NONE'range loop
        if S(I) = NONE(J) then
          FOUND := FALSE;
          exit;
        end if;
      end loop;
      if FOUND then
        return I;
      end if;
    end loop;
    return 0;
  end MATCH_NONE;


  -- Utilities:

  function ENTER(S : in STRING_TYPE) return STRING_TYPE is
  begin
    TOP(SCOPES).all := ATTACH(TOP(SCOPES).all, S);
    return S;
  exception
    when EMPTY_STACK =>
      raise ILLEGAL_ALLOC;
  end ENTER;

  function MATCH_STRING(S1, S2 : in STRING;
                        START  : in POSITIVE := 1) return NATURAL is
    OFFSET : NATURAL;
  begin
    OFFSET := S2'LENGTH - 1;
    for I in START .. (S1'LAST - OFFSET) loop
      if S1(I .. (I + OFFSET)) = S2 then
        return I;
      end if;
    end loop;
    return 0;
  exception
    when CONSTRAINT_ERROR =>

      -- on offset := s2'length (= 0)
      return 0;
  end MATCH_STRING;

begin

  -- Initialize the scopes stack with an implicit mark.
  SCOPES := CREATE;
  MARK;
end STRING_PKG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--sysparms.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG;
package SYSTEM_PARAMETERS is

  ---------------------------------------------------------------
  --  This package contains parameters that may need to be changed
  --  depending on the host system being used and the compiler being
  --  used.
  ---------------------------------------------------------------

  ---------------------------------------------------------------
  --  These declarations are used by the parser
  ---------------------------------------------------------------

  MAXCOLUMN : constant := 250;
  subtype SOURCE_COLUMN is NATURAL range 0 .. MAXCOLUMN;
  MAXLINE : constant := 100000;  -- This is completely arbitrary
  subtype SOURCE_LINE is NATURAL range 0 .. MAXLINE;


  ----------------------------------------------------------------
  -- Declarations to parameterize Printing
  ----------------------------------------------------------------

  type DELIMITER_NAME is (BASIC,      --| %, :, !
                          EXTENDED);  --| ", #, |
  DELIMITERS  : DELIMITER_NAME := EXTENDED;
  --| Determines whether to use the Basic or Extended character set for
  --| output.

  MAX_SOURCE_LINE_LENGTH : constant := 80;
  --|  Used to determine the maximum size of line that the source
  --|  instrumenter should generate.

  MAX_COLUMNS : constant := 133;
  subtype COLUMN_RANGE is POSITIVE range POSITIVE'FIRST .. MAX_COLUMNS;
  PAGE_WIDTH : COLUMN_RANGE := 74;
  --| Width of output page for the listing file used for display.  74 is
  --| used instead of 80 to leave room for the breakpoint number.

  RH_MARGIN  : COLUMN_RANGE := 60;
  --| The column beyond which no indenting is performed.

  subtype INDENTATION_RANGE is NATURAL range 0 .. RH_MARGIN;
  INDENTATION_LEVEL   : INDENTATION_RANGE := 2;
  --| Indentation Level for all constructs

  PREFIX              : constant STRING := "SD_";
  SD_PREFIX           : constant STRING := "SI2AFSD_1861_";
  --|  These prefixes are used when the source instrumenter creates
  --|  objects or procedures.

   PROGRAM_NAME_AND_VERSION : constant string
                            := "SYMBOLIC DEBUGGER VERSION 1.0";

---------------------------------------------------------------------
--  The following are file related parameters
---------------------------------------------------------------------

  FILE_PREFIX_LIMIT  : constant := 8;
  -- Defines the maximum size of a filename prefix

  FILE_SUFFIX_LIMIT  : constant := 4;
  --  Defines the maximum size of a filename suffix.  On DEC Ada
  --  this suffix includes the period.

   BASE_PROGRAM_LIBRARY    : STRING_PKG.STRING_TYPE;
   -- This object specifies the location of the base program library.
   -- The base program library contains files used by all users of the
   -- debugger on a system.

   CURRENT_PROGRAM_LIBRARY : STRING_PKG.STRING_TYPE;
   -- This defines the name of the current program library.  This is
   -- where the users listings and instrumenting files will be stored.

   PROGRAM_LIBRARY_CATALOG : constant STRING := "PKGFILES.CAT";
   --| The program library catalog contains the filenames of all
   --| compilation units in the program library that have been
   --| instrumented by the Source Instrumenter

   CATALOG_FILENAME_EXTENSION : constant STRING := ".CAT";

---------------------------------------------------------------------
--  The following are used to define the suffixes used by files created by
--  the insrumenter when instrumenting packages.
---------------------------------------------------------------------

  PUBLIC_SPEC_FILE_SUFFIX  : constant STRING(1 .. FILE_SUFFIX_LIMIT) := ".DPS";
  PUBLIC_BODY_FILE_SUFFIX  : constant STRING(1 .. FILE_SUFFIX_LIMIT) := ".DPB";
  PRIVATE_SPEC_FILE_SUFFIX : constant STRING(1 .. FILE_SUFFIX_LIMIT) := ".DVS";
  PRIVATE_BODY_FILE_SUFFIX : constant STRING(1 .. FILE_SUFFIX_LIMIT) := ".DVB";

---------------------------------------------------------------------

  EXTERNAL_FILENAME        : constant STRING := "SDFNAMES.MAP";
  --  The name of the file containing the catalog for the package files

  TEMP_LISTFILE       : STRING(1 .. 10) := "SDTEMP.OUT";
  -- The name of the temporary listing file created

  TEMP_CPLFILE        : STRING(1 .. 11) := "CPLTEMP.OUT";
  -- The name of a file containg the name of the current program library.
  -- This file is used when the debugger is run from the shell to allow
  -- for passing the name of the program library.

  DEFAULT_INST_FILE_EXT : constant STRING := "INS";
  -- default extension for instrumented files.

--------------------------------------------------------------------
--  These items are used to define the areas on the screen used
--  by the debugger in screen mode
--------------------------------------------------------------------

  NUMBER_OF_SOURCE_LINES : NATURAL := 8;
  -- Number of lines used for displaying source

  SOURCE_LINES_ABOVE     : NATURAL := 3;
  -- Number of lines above the current breakpoint that are displayed

  SOURCE_LINES_BELOW     : NATURAL := 4;
  -- number of lines below the current breakpoint that are displayed

  NUMBER_OF_OUTPUT_LINES : POSITIVE := 8;
  --| number of lines in the middle third of the screen


  MAX_INPUT_LENGTH       : INTEGER := 255; --| maximum size of input string

end SYSTEM_PARAMETERS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--sysdep.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SYSTEM_PARAMETERS; use SYSTEM_PARAMETERS;

PACKAGE sysdep IS

--  This package contains system dependencies.  The pacakge body
--  should be configured for the intended host system

-------------------------------------------------------------
-- the following functions are used by the virtual terminal
-------------------------------------------------------------

    PROCEDURE open;
    --
    -- Open the console for binary I/O, no echo.
    --

    PROCEDURE close;
    --
    -- Close the console.  Parameters should be reset to original condition.
    --

    PROCEDURE put ( data : IN string );

    --
    -- Put a string to the terminal.  There should be no translation of
    -- the characters. There can be exceptions to this rule (like CTRL-S and
    -- CTRL-Q)  and these exceptions must be identified in valid_character
    -- below.
    --

    PROCEDURE start_input;

    -- This procedure causes the virtual terminal to grab control of
    -- the input channel from the actual terminal.  This is done before
    -- we try to get input from the user.

    PROCEDURE stop_input;

    -- This procedure releases the input channel so that it can be used
    -- by the program being tested.

    PROCEDURE get ( data : IN OUT string;
                    last : OUT natural );

    --
    -- Get a string from the terminal keyboard.  This ocurrs with no echo
    -- and no translations.
    --

    PROCEDURE tcf_name ( name : OUT string;
                         last : OUT natural );
    --
    -- Returns the name of the terminal capabilities file as a string.
    -- You better pass in a string of sufficient length to handle the name
    -- that is returned or you will get a constraint error.  80 is a good
    -- random number.
    --

    PROCEDURE  terminal_name ( name : OUT string;
                               last : OUT natural );
    --
    -- Returns the name of the terminal.  This name of a string like "tv970".
    -- If the name cannot be determined then last is returned as 0 (zero).
    -- Again,  you better make the name parameter big enough to hold the
    -- value returned.
    --

    FUNCTION valid_character ( item : IN character ) RETURN boolean;

    --
    -- Returns a boolean value identifying whether the character passed in
    -- is safe to use in the environment.  Suspicious characters include
    -- CTRL-S  CTRL-Q  CTRL-C  CTRL-Y.

  -- Operations --

  function FINDTABCOLUMN( --| returns source column a tab is in
                         INCOLUMN : in SOURCE_COLUMN
                                   --| source column before tab
                         ) return SOURCE_COLUMN;

  --| Effects

  --| This subprogram implements the tab positioning strategy
  --| of the Host system.


   PROCEDURE spawn (command_string : in string);
   PRAGMA interface( EXTERNAL, spawn);
   PRAGMA import_procedure( spawn, "LIB$SPAWN");

   PROCEDURE SD_COMPILE(filename : in string);

    -- This procedure will invoke the compiler to compile the specified
    -- filename.

   PROCEDURE SD_LINK(compilation_unit : in string);

    --  This procedure will invoke the linker to link the specified
    --  unit.

   PROCEDURE SD_RUN(compilation_unit : in string);

    -- This procedure will run the specified program.

   PROCEDURE SD_SYS(command : in string);

    -- This procedure will invoke the specified system command.

   procedure SET_SCROLL_REGION(TOP    : in POSITIVE;
                               BOTTOM : in POSITIVE);

    -- This procedure defines an area of the terminal to be a scroll
    -- region.  It is used to define the bottom of the terminal as a
    -- scroll region.  This is used for target program output which will
    -- bypass the virtual terminal.

  package PREDEFINED_TYPES is

--  This procedure defines those optional types that are not defined
--  by the current compiler.  Dec Ada does not have LONG_INTEGER, or
--  SHORT_FLOAT so they are defined here.

    type Long_Integer  is new integer;  --| Not implemented in DEC Ada

--    type Long_Float    is new float;

--    type Short_Integer is new integer;

    type Short_Float   is new float;    --| Not implemented in DEC Ada

  end PREDEFINED_TYPES;

END sysdep;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--errmsg.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with SYSTEM_PARAMETERS;  -- host dependent constants

package LEXICAL_ERROR_MESSAGE is  --| handles lexical error messages

--| Overview
--|
--| Contains text, identifiers of text, and output subprograms
--| for package Lex.
--|

  package SP renames SYSTEM_PARAMETERS;

  --------------------------------------------------------------
  -- Declarations Global to Package Lexical_Error_Message
  ------------------------------------------------------------------

  type MESSAGE_TYPE is (BASE_OUT_OF_LEGAL_RANGE_USE_16,
    BASED_LITERAL_DELIMITER_MISMATCH, CHARACTER_CAN_NOT_START_TOKEN,
    CHARACTER_IS_NON_ASCII, CHARACTER_IS_NON_GRAPHIC, CONSECUTIVE_UNDERLINES,
    DIGIT_INVALID_FOR_BASE, DIGIT_NEEDED_AFTER_RADIX_POINT,
    DIGIT_NEEDED_BEFORE_RADIX_POINT, EXPONENT_MISSING_INTEGER_FIELD,
    ILLEGAL_USE_OF_SINGLE_QUOTE, INTEGER_LITERAL_CONVERSION_EXCEPTION_USE_1,
    LEADING_UNDERLINE, MISSING_SECOND_BASED_LITERAL_DELIMITER,
    NEGATIVE_EXPONENT_ILLEGAL_IN_INTEGER, NO_ENDING_STRING_DELIMITER,
    NO_INTEGER_IN_BASED_NUMBER, ONLY_GRAPHIC_CHARACTERS_IN_STRINGS,
    REAL_LITERAL_CONVERSION_EXCEPTION_USE_1, SOURCE_LINE_MAXIMUM_EXCEEDED,
    SOURCE_LINE_TOO_LONG, SPACE_MUST_SEPARATE_NUM_AND_IDS, TERMINAL_UNDERLINE,
    TOO_MANY_RADIX_POINTS);

  --------------------------------------------------------------
  -- Subprogram Bodies Global to Package Lexical_Error_Message
  --------------------------------------------------------------

  procedure OUTPUT_MESSAGE( --| output lexical error message
                           IN_LINE       : in SP.SOURCE_LINE;
                                          --| line number of error.
                           IN_COLUMN     : in SP.SOURCE_COLUMN;
                                          --| column number of error.
                           IN_MESSAGE_ID : in MESSAGE_TYPE);
                                          --| which message to output.

  --| Effects
  --|
  --| Output error message for lexer.
  --|

  ------------------------------------------------------------------

  procedure OUTPUT_MESSAGE( --| output lexical error message
                           IN_LINE           : in SP.SOURCE_LINE;
                                          --| line number of error.
                           IN_COLUMN         : in SP.SOURCE_COLUMN;
                                          --| column number of error.
                           IN_INSERTION_TEXT : in STRING;  --| text to insert.
                           IN_MESSAGE_ID     : in MESSAGE_TYPE);
                                          --| which message to output.

  --| Effects
  --|
  --| Output error message with inserted text.  The text is appended
  --| to the message if there are no insertion flags.

  ------------------------------------------------------------------

end LEXICAL_ERROR_MESSAGE;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--errmsg.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::



------------------------------------------------------------------

with TEXT_IO;

package body LEXICAL_ERROR_MESSAGE is

------------------------------------------------------------------
-- Declarations Local to Package Lexical_Error_Message
------------------------------------------------------------------

  INSERTION_FLAG : CHARACTER := '@';

  subtype MESSAGE_TEXT_RANGE is POSITIVE range 1 .. 64;

  MESSAGE_TEXT : constant array(MESSAGE_TYPE) of STRING(MESSAGE_TEXT_RANGE) := (
  -- 1234567890123456789012345678901234567890123456789012345678901234
  -- Base_Out_Of_Legal_Range_Use_16   =>
  "This base " & INSERTION_FLAG -- insert a String
  & " is not in the range 2 to 16. Assuming base 16.      ",
  -- Based_Literal_Delimiter_Mismatch =>
  "Based_literal delimiters must be the same.                      ",
  -- Character_Can_Not_Start_Token    =>
  "This character " & INSERTION_FLAG -- insert a character
  & " can not start a token.                         ",
  -- Character_Is_Non_ASCII  =>
  "This value x@VALUE@x is not an ASCII character.                 ",
  --|? should display the value, but this message is unlikely.
  --|? see Lex.bdy
  -- Character_Is_Non_Graphic=>
  "This character with decimal value" & INSERTION_FLAG
  -- insert the decimal value
  & " is not a graphic_character.  ",
  -- Consecutive_Underlines  =>
  "Consecutive underlines are not allowed.                         ",
  -- Digit_Invalid_For_Base  =>
  "This digit " & INSERTION_FLAG -- insert a Character
  & " is out of range for the base specified.            ",
  -- Digit_Needed_After_Radix_Point   =>
  "At least one digit must appear after a radix point              ",
  -- Digit_Needed_Before_Radix_Point  =>
  "At least one digit must appear before a radix point             ",
  -- Exponent_Missing_Integer_Field   =>
  "The exponent is missing its integer field.                      ",
  -- Illegal_Use_Of_Single_Quote  =>
  "Single quote is not used for an attribute or character literal. ",
  -- Integer_Literal_Conversion_Exception_Using_1 =>
  "Error while evaluating a integer_literal. Using a value of '1'. ",
  -- Leading_Underline    =>
  "Initial underlines are not allowed.                             ",
  -- Missing_Second_Based_Literal_Delimiter   =>
  "Second based_literal delimiter is missing.                      ",
  -- Negative_Exponent_Illegal_In_Integer =>
  "A negative exponent is illegal in an integer literal.           ",
  -- No_Ending_String_Delimiter   =>
  "String is improperly terminated by the end of the line.         ",
  -- No_Integer_In_Based_Number   =>
  "A based number must have a value.                               ",
  -- Only_Graphic_Characters_In_Strings   =>
  "This non-graphic character with decimal value" & INSERTION_FLAG
  -- insert the decimal value
  & " found in string. ",
  -- Real_Literal_Conversion_Exception_Using_1    =>
  "Error while evaluating a real_literal. Using a value of '1.0'.  ",
  -- Source_Line_Maximum_Exceeded =>
  "Maximum allowable source line number of " & INSERTION_FLAG
  -- insert an Integer'IMAGE
  & " exceeded.             ",
  -- Source_Line_Too_Long =>
  "Source line number " & INSERTION_FLAG -- insert an Integer'IMAGE
  & " is too long.                               ",
  -- Space_Must_Separate_Num_And_Ids      =>
  "A space must separate numeric_literals and identifiers.         ",
  -- Terminal_Underline   =>
  "Terminal underlines are not allowed.                            ",
  -- Too_Many_Radix_Points        =>
  "A real_literal may have only one radix point.                   ");

  ------------------------------------------------------------------
  -- Subprogram Bodies Global to Package Lexical_Error_Message
  ------------------------------------------------------------------

  procedure OUTPUT_MESSAGE(IN_LINE       : in SP.SOURCE_LINE;
                           IN_COLUMN     : in SP.SOURCE_COLUMN;
                           IN_MESSAGE_ID : in MESSAGE_TYPE) is

  begin

    -- output error message including line and column number
    TEXT_IO.NEW_LINE(TEXT_IO.STANDARD_OUTPUT);
    TEXT_IO.PUT_LINE(FILE => TEXT_IO.STANDARD_OUTPUT, ITEM =>
      "Lexical Error: Line: " & SP.SOURCE_LINE'IMAGE(IN_LINE) & " Column: " & SP
      .SOURCE_COLUMN'IMAGE(IN_COLUMN) & " - " & MESSAGE_TEXT(IN_MESSAGE_ID));

  end OUTPUT_MESSAGE;

  ------------------------------------------------------------------

  procedure OUTPUT_MESSAGE(IN_LINE           : in SP.SOURCE_LINE;
                           IN_COLUMN         : in SP.SOURCE_COLUMN;
                           IN_INSERTION_TEXT : in STRING;  --| text to insert.
                           IN_MESSAGE_ID     : in MESSAGE_TYPE) is

  --------------------------------------------------------------
  -- Declarations for SubProgram Output_Message
  --------------------------------------------------------------

    INSERTION_INDEX : POSITIVE := (MESSAGE_TEXT_RANGE'LAST + 1);
    --| if insertion flag is not found,
    --| then we append the In_Message_Text to the message

    ------------------------------------------------------------------

  begin

    --| Algorithm
    --|
    --| Find the insertion point.
    --| if the Message_Text doesn't have an Insertion_Flag,
    --| then set the Insertion_Index to the end of the message.
    for I in MESSAGE_TEXT_RANGE loop
      if (INSERTION_FLAG = MESSAGE_TEXT(IN_MESSAGE_ID)(I)) then
        INSERTION_INDEX := I;
        exit;
      end if;
    end loop;

    -- output error message with test, line and column number
    TEXT_IO.NEW_LINE(TEXT_IO.STANDARD_OUTPUT);
    TEXT_IO.PUT_LINE(FILE => TEXT_IO.STANDARD_OUTPUT, ITEM =>
      "Lexical Error: Line: " & SP.SOURCE_LINE'IMAGE(IN_LINE) & " Column: " & SP
      .SOURCE_COLUMN'IMAGE(IN_COLUMN) & " - " & MESSAGE_TEXT(IN_MESSAGE_ID)(1
      .. (INSERTION_INDEX - 1)) & IN_INSERTION_TEXT & MESSAGE_TEXT(
      IN_MESSAGE_ID)((INSERTION_INDEX + 1) .. MESSAGE_TEXT_RANGE'LAST));

  end OUTPUT_MESSAGE;

  ------------------------------------------------------------------

end LEXICAL_ERROR_MESSAGE;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--grmconst.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

--+ GRMCONST.SPC +--

package GRAMMAR_CONSTANTS is


  type PARSERINTEGERCOMMON is range 0 .. 450000;
  --| range of possible values for parser's integer values (found
  --| in NYU parse tables generator output)

  subtype PARSERINTEGER is PARSERINTEGERCOMMON;
  --| range of possible values for parser's integer types (found
  --| in NYU parse tables generator output)

  function SETGRAMMARSYMBOLCOUNT return PARSERINTEGER;

  function SETACTIONCOUNT return PARSERINTEGER;

  function SETSTATECOUNTPLUSONE return PARSERINTEGER;

  function SETLEFTHANDSIDECOUNT return PARSERINTEGER;

  function SETRIGHTHANDSIDECOUNT return PARSERINTEGER;

end GRAMMAR_CONSTANTS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--ptbls.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

----------------------------------------------------------------------
with SYSTEM_PARAMETERS;  -- host dependent constants for the compiler.
with GRAMMAR_CONSTANTS;  -- constants generated by parser generator
use GRAMMAR_CONSTANTS;

package PARSETABLES is  --| Table output of parse tables generator

--| Overview
--|
--| This package contains the constants and tables generated by running
--| the LALR(1) parse tables generator on the Ada Grammar.
--| It also contains subprograms to access values in the more complex
--| tables, that could have their structures tuned later.
--|

--| Tuning
--|
--| --------------------------------------------------------------
--|
--| The Parser Generator has two options that effect the speed of
--| compilation:
--|
--| NODEFAULT : Eliminates the default reductions.
--| This also would improve error recovery.
--| Note that the table DefaultMap is still produced, though it
--| will never be referenced.
--| Thus, there need be no change to the code
--| in ParserUtilities.GetAction .
--|
--| LF : This changes the load factor used to pack and size the
--| ActionTables. It can range between 0 and 100.
--| A low LF means fewer collisions and faster parsing.
--| A high LF means more collisions and slower parsing.
--| ----------------------------------------------------------------
--|
--| The types GrammarSymbolRecord and FollowSymbolRecord
--| have a lot of unused space. The space/time tradeoff of
--| converting these into discriminated records or another
--| alternative representation, could be investigated.
--| This investigation should take the elaboration time
--| of the initializing aggregates into account.
--|
--| ----------------------------------------------------------------
--|
--| The Action Tables might be made made smaller by a restructuring of
--| the grammar.
--| For example: Have a rule for the token sequence:
--|
--| BEGIN seq_Of_Statements [EXCP..]
--|
--| ----------------------------------------------------------------
--|
--| The ParserGenerator might be modified along with
--| ParseTables.GetAction to produce smaller tables.
--| See:
--|
--| "Combined Actions to Reduce LR-Parsertables"
--| by K.Groneing. SIGPLAN Notices, Volume 19, Number 3, March 1984.
--|
--| ----------------------------------------------------------------
--|

--| Notes
--|
--| Abbreviations Used
--|
--| Rep : Representation
--|

--| RUN-TIME INPUT OF NYU LALR GENERATED TABLES AND CONSTANTS
--|
--|
--| followed by the current correct value of the
--| constant supplied by the NYU LALR Parser Generator:
--|
--| GrammarSymbolCount
--| LeftHandSideCount
--| RightHandSideCount
--| ActionTableOneLength
--| ActionTableTwoLength
--| DefaultMapLength
--| InSymbolMapLength
--| FollowMapLength
--| StateCountPlusOne
--| GrammarSymbolCountPlusOne
--| ActionCount
--| ActionTableSize
--|
--| in each of the eight declarations:
--|
--| GrammarSymbolTable
--| LeftHandSide
--| RightHandSide
--| ActionTableOne
--| ActionTableTwo
--| DefaultMap
--| InSymbolMap
--| FollowSymbolMap
--|

  package GC renames GRAMMAR_CONSTANTS;

  ------------------------------------------------------------------
  -- Common Declarations for Action_Token_Map
  ------------------------------------------------------------------

  MAX_ACTION_TOKEN_COUNT : constant := 48;
  --| This constant may need to be made larger if the grammar
  --| ever gets too large.
  --| It could be automatically generated.


  ------------------------------------------------------------------
  -- Common Declarations for Shift_State_Map
  ------------------------------------------------------------------

  MAX_SHIFT_STATE_COUNT  : constant := 90;
  --| This constant may need to be made larger if the grammar
  --| ever gets too large.
  --| It could be automatically generated.



  subtype PARSERSTRINGRANGEPLUSZEROCOMMON is NATURAL range 0 ..
    SYSTEM_PARAMETERS.MAXCOLUMN;
  --| Parser's string should never be greater than a source line
  --| worth of text.

  subtype GRAMMARSYMBOLREPRANGEPLUSZEROCOMMON is PARSERSTRINGRANGEPLUSZEROCOMMON
    range 0 .. 57;

  subtype FOLLOWSYMBOLRANGECOMMON is GC.PARSERINTEGER range 1 .. 50;

  ------------------------------------------------------------------
  -- Declarations Global to Package ParseTables
  ------------------------------------------------------------------

  subtype POSITIVEPARSERINTEGER is GC.PARSERINTEGER range 1 .. GC.PARSERINTEGER'
    LAST;

  subtype PARSERSTRINGRANGEPLUSZERO is PARSERSTRINGRANGEPLUSZEROCOMMON;
  --| Parser's string should never be greater than a source line
  --| worth of text.

  ----------------------------------------------------------------------
  -- The first constant used to  the Parse Tables
  ----------------------------------------------------------------------

  GRAMMARSYMBOLCOUNT : constant GC.PARSERINTEGER := GC.SETGRAMMARSYMBOLCOUNT;
  --| Number of terminals and nonterminals in the Ada grammar
  --| rules input to the parse tables generator

  subtype GRAMMARSYMBOLRANGE is GC.PARSERINTEGER range 1 .. GRAMMARSYMBOLCOUNT;
  --| valid range of values for grammar symbols

  ------------------------------------------------------------------
  -- Parser Table Generated Token Values for Terminals
  ------------------------------------------------------------------

  -- WARNING: need to be checked after each Parser Generator Run.
  -- This could be made part of the ParseTables/ErrorParseTables
  -- generator program(s) at some point.

  ------------------------------------------------------------------
  -- Special Empty Terminal
  ------------------------------------------------------------------

  EMPTY_TOKENVALUE      : constant GRAMMARSYMBOLRANGE := 1;

  ------------------------------------------------------------------
  -- Reserved Words
  ------------------------------------------------------------------

  ABORTTOKENVALUE       : constant GRAMMARSYMBOLRANGE := 2;
  ABSTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 3;
  ACCEPTTOKENVALUE      : constant GRAMMARSYMBOLRANGE := 4;
  ACCESSTOKENVALUE      : constant GRAMMARSYMBOLRANGE := 5;
  ALLTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 6;
  ANDTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 7;
  ARRAYTOKENVALUE       : constant GRAMMARSYMBOLRANGE := 8;
  ATTOKENVALUE          : constant GRAMMARSYMBOLRANGE := 9;
  BEGINTOKENVALUE       : constant GRAMMARSYMBOLRANGE := 10;
  BODYTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 11;
  CASETOKENVALUE        : constant GRAMMARSYMBOLRANGE := 12;
  CONSTANTTOKENVALUE    : constant GRAMMARSYMBOLRANGE := 13;
  DECLARETOKENVALUE     : constant GRAMMARSYMBOLRANGE := 14;
  DELAYTOKENVALUE       : constant GRAMMARSYMBOLRANGE := 15;
  DELTATOKENVALUE       : constant GRAMMARSYMBOLRANGE := 16;
  DIGITSTOKENVALUE      : constant GRAMMARSYMBOLRANGE := 17;
  DOTOKENVALUE          : constant GRAMMARSYMBOLRANGE := 18;
  ELSETOKENVALUE        : constant GRAMMARSYMBOLRANGE := 19;
  ELSIFTOKENVALUE       : constant GRAMMARSYMBOLRANGE := 20;
  ENDTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 21;
  ENTRYTOKENVALUE       : constant GRAMMARSYMBOLRANGE := 22;
  EXCEPTIONTOKENVALUE   : constant GRAMMARSYMBOLRANGE := 23;
  EXITTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 24;
  FORTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 25;
  FUNCTIONTOKENVALUE    : constant GRAMMARSYMBOLRANGE := 26;
  GENERICTOKENVALUE     : constant GRAMMARSYMBOLRANGE := 27;
  GOTOTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 28;
  IFTOKENVALUE          : constant GRAMMARSYMBOLRANGE := 29;
  INTOKENVALUE          : constant GRAMMARSYMBOLRANGE := 30;
  ISTOKENVALUE          : constant GRAMMARSYMBOLRANGE := 31;
  LIMITEDTOKENVALUE     : constant GRAMMARSYMBOLRANGE := 32;
  LOOPTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 33;
  MODTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 34;
  NEWTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 35;
  NOTTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 36;
  NULLTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 37;
  OFTOKENVALUE          : constant GRAMMARSYMBOLRANGE := 38;
  ORTOKENVALUE          : constant GRAMMARSYMBOLRANGE := 39;
  OTHERSTOKENVALUE      : constant GRAMMARSYMBOLRANGE := 40;
  OUTTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 41;
  PACKAGETOKENVALUE     : constant GRAMMARSYMBOLRANGE := 42;
  PRAGMATOKENVALUE      : constant GRAMMARSYMBOLRANGE := 43;
  PRIVATETOKENVALUE     : constant GRAMMARSYMBOLRANGE := 44;
  PROCEDURETOKENVALUE   : constant GRAMMARSYMBOLRANGE := 45;
  RAISETOKENVALUE       : constant GRAMMARSYMBOLRANGE := 46;
  RANGETOKENVALUE       : constant GRAMMARSYMBOLRANGE := 47;
  RECORDTOKENVALUE      : constant GRAMMARSYMBOLRANGE := 48;
  REMTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 49;
  RENAMESTOKENVALUE     : constant GRAMMARSYMBOLRANGE := 50;
  RETURNTOKENVALUE      : constant GRAMMARSYMBOLRANGE := 51;
  REVERSETOKENVALUE     : constant GRAMMARSYMBOLRANGE := 52;
  SELECTTOKENVALUE      : constant GRAMMARSYMBOLRANGE := 53;
  SEPARATETOKENVALUE    : constant GRAMMARSYMBOLRANGE := 54;
  SUBTYPETOKENVALUE     : constant GRAMMARSYMBOLRANGE := 55;
  TASKTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 56;
  TERMINATETOKENVALUE   : constant GRAMMARSYMBOLRANGE := 57;
  THENTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 58;
  TYPETOKENVALUE        : constant GRAMMARSYMBOLRANGE := 59;
  USETOKENVALUE         : constant GRAMMARSYMBOLRANGE := 60;
  WHENTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 61;
  WHILETOKENVALUE       : constant GRAMMARSYMBOLRANGE := 62;
  WITHTOKENVALUE        : constant GRAMMARSYMBOLRANGE := 63;
  XORTOKENVALUE         : constant GRAMMARSYMBOLRANGE := 64;

  ------------------------------------------------------------------
  -- Identifier and Literals
  ------------------------------------------------------------------

  IDENTIFIERTOKENVALUE  : constant GRAMMARSYMBOLRANGE := 65;
  NUMERICTOKENVALUE     : constant GRAMMARSYMBOLRANGE := 66;
  STRINGTOKENVALUE      : constant GRAMMARSYMBOLRANGE := 67;
  CHARACTERTOKENVALUE   : constant GRAMMARSYMBOLRANGE := 68;

  ------------------------------------------------------------------
  -- Single Delimiters
  ------------------------------------------------------------------

  AMPERSAND_TOKENVALUE  : constant GRAMMARSYMBOLRANGE := 69;
  APOSTROPHE_TOKENVALUE : constant GRAMMARSYMBOLRANGE := 70;
  LEFTPAREN_TOKENVALUE  : constant GRAMMARSYMBOLRANGE := 71;
  RIGHTPAREN_TOKENVALUE : constant GRAMMARSYMBOLRANGE := 72;
  STAR_TOKENVALUE       : constant GRAMMARSYMBOLRANGE := 73;
  PLUS_TOKENVALUE       : constant GRAMMARSYMBOLRANGE := 74;
  COMMA_TOKENVALUE      : constant GRAMMARSYMBOLRANGE := 75;
  MINUS_TOKENVALUE      : constant GRAMMARSYMBOLRANGE := 76;
  DOT_TOKENVALUE        : constant GRAMMARSYMBOLRANGE := 77;
  SLASH_TOKENVALUE      : constant GRAMMARSYMBOLRANGE := 78;
  COLON_TOKENVALUE      : constant GRAMMARSYMBOLRANGE := 79;
  SEMICOLON_TOKENVALUE  : constant GRAMMARSYMBOLRANGE := 80;
  LT_TOKENVALUE         : constant GRAMMARSYMBOLRANGE := 81;
  EQ_TOKENVALUE         : constant GRAMMARSYMBOLRANGE := 82;
  GT_TOKENVALUE         : constant GRAMMARSYMBOLRANGE := 83;
  BAR_TOKENVALUE        : constant GRAMMARSYMBOLRANGE := 84;


  ------------------------------------------------------------------
  -- Double Delimiters
  ------------------------------------------------------------------

  EQGT_TOKENVALUE       : constant GRAMMARSYMBOLRANGE := 85;
  DOTDOT_TOKENVALUE     : constant GRAMMARSYMBOLRANGE := 86;
  STARSTAR_TOKENVALUE   : constant GRAMMARSYMBOLRANGE := 87;
  COLONEQ_TOKENVALUE    : constant GRAMMARSYMBOLRANGE := 88;
  SLASHEQ_TOKENVALUE    : constant GRAMMARSYMBOLRANGE := 89;
  GTEQ_TOKENVALUE       : constant GRAMMARSYMBOLRANGE := 90;
  LTEQ_TOKENVALUE       : constant GRAMMARSYMBOLRANGE := 91;
  LTLT_TOKENVALUE       : constant GRAMMARSYMBOLRANGE := 92;
  GTGT_TOKENVALUE       : constant GRAMMARSYMBOLRANGE := 93;
  LTGT_TOKENVALUE       : constant GRAMMARSYMBOLRANGE := 94;

  ------------------------------------------------------------------
  -- Comment Terminal
  ------------------------------------------------------------------

  COMMENT_TOKENVALUE    : constant GRAMMARSYMBOLRANGE := 95;

  ------------------------------------------------------------------
  -- Special Terminals
  ------------------------------------------------------------------

  EOF_TOKENVALUE        : constant GRAMMARSYMBOLRANGE := 96;

  ------------------------------------------------------------------
  -- Special Non-Terminals
  ------------------------------------------------------------------

  ACC_TOKENVALUE        : constant GRAMMARSYMBOLRANGE := 97;

  ------------------------------------------------------------------
  -- Grammar Symbol Classes
  ------------------------------------------------------------------

  subtype TOKENRANGE is GRAMMARSYMBOLRANGE range 1 .. EOF_TOKENVALUE;

  subtype TOKENRANGELESSEOF is GRAMMARSYMBOLRANGE range 1 .. (EOF_TOKENVALUE - 1
    );

  subtype NONTOKENRANGE is GRAMMARSYMBOLRANGE range (EOF_TOKENVALUE + 1) ..
    GRAMMARSYMBOLCOUNT;

  ACTIONCOUNT       : constant GC.PARSERINTEGER := GC.SETACTIONCOUNT;
  --| Number of actions in the parse tables.
  -- NYU Reference Name: NUM_ACTIONS

  STATECOUNTPLUSONE : constant GC.PARSERINTEGER := GC.SETSTATECOUNTPLUSONE;
  --| Number of states plus one in the parse tables.
  -- NYU Reference Name: NUM_STATES

  subtype STATERANGE is GC.PARSERINTEGER range 1 .. (STATECOUNTPLUSONE - 1);

  subtype ACTIONRANGE is GC.PARSERINTEGER range 0 .. ACTIONCOUNT;

  LEFTHANDSIDECOUNT : constant GC.PARSERINTEGER := GC.SETLEFTHANDSIDECOUNT;
  --| Number of left hand sides in the Ada grammar rules.

  subtype LEFTHANDSIDERANGE is GC.PARSERINTEGER range 1 .. LEFTHANDSIDECOUNT;

  function GET_LEFTHANDSIDE(GRAMMARRULE : in LEFTHANDSIDERANGE) return
    GRAMMARSYMBOLRANGE;
  pragma INLINE(GET_LEFTHANDSIDE);

  RIGHTHANDSIDECOUNT : constant GC.PARSERINTEGER := GC.SETRIGHTHANDSIDECOUNT;
  --| Number of right hand sides in the Ada grammar rules.

  subtype RIGHTHANDSIDERANGE is GC.PARSERINTEGER range 1 .. RIGHTHANDSIDECOUNT;

  function GET_RIGHTHANDSIDE(GRAMMARRULE : in RIGHTHANDSIDERANGE) return GC.
    PARSERINTEGER;
  pragma INLINE(GET_RIGHTHANDSIDE);

  ------------------------------------------------------------------
  -- Subprogram Bodies Global to Package ParseTables
  ------------------------------------------------------------------

  function GETACTION(INSTATEVALUE  : in STATERANGE;
                     INSYMBOLVALUE : in GRAMMARSYMBOLRANGE) return ACTIONRANGE;

  function GET_GRAMMAR_SYMBOL( --| return the string representation
  --| of the grammar symbol
                              IN_INDEX : in GRAMMARSYMBOLRANGE) return STRING;

  --| Effects
  --|
  --| This subprogram returns the string representation of the
  --| GrammarSymbolRange passed in.
  --|

  ------------------------------------------------------------------
  subtype FOLLOWMAPRANGE is NONTOKENRANGE;

  type FOLLOWSYMBOLARRAY is array(POSITIVEPARSERINTEGER range <>) of
    GRAMMARSYMBOLRANGE;

  type FOLLOWSYMBOLRECORD is
    record
      FOLLOW_SYMBOL_COUNT : TOKENRANGE;
      FOLLOW_SYMBOL       : FOLLOWSYMBOLARRAY(TOKENRANGE);
    end record;
    ------------------------------------------------------------------

  function GET_FOLLOW_MAP( --| return the array of follow symbols
  --| of the grammar symbol passed in
                          IN_INDEX : in FOLLOWMAPRANGE) return
    FOLLOWSYMBOLRECORD;


  --| Effects
  --|
  --| This subprogram returns the array of follow symbols for the
  --| grammar symbol passed in.
  --|

  ------------------------------------------------------------------
  -- The following declarations are for Error Recovery.
  ------------------------------------------------------------------
  ------------------------------------------------------------------
  -- Action_Token_Map
  ------------------------------------------------------------------

  subtype ACTION_TOKEN_RANGE is GC.PARSERINTEGER range 1 ..
    MAX_ACTION_TOKEN_COUNT;

  subtype ACTION_TOKEN_RANGE_PLUS_ZERO is GC.PARSERINTEGER range 0 ..
    MAX_ACTION_TOKEN_COUNT;
  --| for the set_size (which could be null!)

  type ACTION_TOKEN_ARRAY is array(POSITIVEPARSERINTEGER range <>) of
    TOKENRANGELESSEOF;

  type ACTION_TOKEN_RECORD is
    record
      SET_SIZE : ACTION_TOKEN_RANGE_PLUS_ZERO;
      SET      : ACTION_TOKEN_ARRAY(ACTION_TOKEN_RANGE);
    end record;

    ------------------------------------------------------------------
    -- Shift_State_Map
    ------------------------------------------------------------------

  subtype SHIFT_STATE_RANGE is GC.PARSERINTEGER range 1 .. MAX_SHIFT_STATE_COUNT
    ;

  subtype SHIFT_STATE_RANGE_PLUS_ZERO is GC.PARSERINTEGER range 0 ..
    MAX_SHIFT_STATE_COUNT;
  --| for the set_size (which could be null!)

  type SHIFT_STATE_ARRAY is array(POSITIVEPARSERINTEGER range <>) of STATERANGE
    ;

  type SHIFT_STATE_RECORD is
    record
      SET_SIZE : SHIFT_STATE_RANGE_PLUS_ZERO;
      SET      : SHIFT_STATE_ARRAY(SHIFT_STATE_RANGE);
    end record;

    ------------------------------------------------------------------

  function GET_ACTION_TOKEN_MAP( --| return the array of action tokens
  --| for the state passed in.
                                IN_INDEX : in STATERANGE
                                --| the state to return action tokens
                                --| for.
                                ) return ACTION_TOKEN_RECORD;

  ------------------------------------------------------------------

  function GET_SHIFT_STATE_MAP( --| return the array of shift states
  --| for the grammar symbol passed in.
                               IN_INDEX : in GRAMMARSYMBOLRANGE
                               --| grammar symbol to return shifts
                               --| for.
                               ) return SHIFT_STATE_RECORD;

  -- The following variables contain statistics information
  -- collected during the parse:
  PARSERDECISIONCOUNT : NATURAL := 0;  --| Total number of times that
  --| GetAction was called.
  MAXCOLLISIONS       : NATURAL := 0;  --| Of all the calls to GetAction
  --| The one which resulted in the greatest number of collisions
  TOTALCOLLISIONS     : NATURAL := 0;
  --| Total number of collisions which occurred during parsing.

end PARSETABLES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--lexidval.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


----------------------------------------------------------------------

with PARSETABLES;  -- tables from parser generator

package LEX_IDENTIFIER_TOKEN_VALUE is
--| Classify identifiers and reserved words and determine which
--| identifiers are in package STANDARD.

------------------------------------------------------------------
-- Subprogram Bodies Global to
-- Package Lex_Identifier_Token_Value
------------------------------------------------------------------

  procedure FIND(
  --| returns token value and whether identifier is in package STANDARD.

                 IN_IDENTIFIER   : in STRING;
                                       --| text of identifier to identify

                 OUT_TOKEN_VALUE : out PARSETABLES.TOKENRANGE);
  --| TokenValue of this identifier

  --| Effects
  --|
  --| This subprogram determines if the identifier is
  --| a reserved word or a plain identifier.
  --|
  --| The answer is indicated by returning the appropriate TokenValue.
  --|

  ------------------------------------------------------------------

end LEX_IDENTIFIER_TOKEN_VALUE;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--pdecls.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


-----------------------------------------------------------------------

with SYSTEM_PARAMETERS;  -- host dependent constants
with PARSETABLES;  -- constants and state tables
use PARSETABLES;

with GRAMMAR_CONSTANTS; use GRAMMAR_CONSTANTS;

package PARSERDECLARATIONS is  --| Objects used by the Parser

--| Notes

--| Abbreviations used in this compilation unit:
--|
--| gram : grammar
--| sym  : symbol
--| val  : value
--|

  package SP renames SYSTEM_PARAMETERS;
  package PT renames PARSETABLES;
  package GC renames GRAMMAR_CONSTANTS;

  -- Exceptions --

  MEMORYOVERFLOW            : exception;  --| raised if Parser runs out of
  --| newable memory.
  PARSER_ERROR              : exception;  --| raised if an error occurs during
  --| parsing.

  --| The double delimiters were named with a combination of the name of
  --| each component symbol.

  ARROW_TOKENVALUE          : GRAMMARSYMBOLRANGE renames EQGT_TOKENVALUE;
  EXPONENTIATION_TOKENVALUE : GRAMMARSYMBOLRANGE renames STARSTAR_TOKENVALUE;
  ASSIGNMENT_TOKENVALUE     : GRAMMARSYMBOLRANGE renames COLONEQ_TOKENVALUE;
  NOTEQUALS_TOKENVALUE      : GRAMMARSYMBOLRANGE renames SLASHEQ_TOKENVALUE;
  STARTLABEL_TOKENVALUE     : GRAMMARSYMBOLRANGE renames LTLT_TOKENVALUE;
  ENDLABEL_TOKENVALUE       : GRAMMARSYMBOLRANGE renames GTGT_TOKENVALUE;
  BOX_TOKENVALUE            : GRAMMARSYMBOLRANGE renames LTGT_TOKENVALUE;

  ------------------------------------------------------------------
  -- Grammar Symbol Classes
  ------------------------------------------------------------------

  subtype RESERVEDWORDRANGE is GRAMMARSYMBOLRANGE range ABORTTOKENVALUE ..
    XORTOKENVALUE;

  subtype SINGLEDELIMITERRANGE is GRAMMARSYMBOLRANGE range AMPERSAND_TOKENVALUE
    .. BAR_TOKENVALUE;

  subtype DOUBLEDELIMITERRANGE is GRAMMARSYMBOLRANGE range ARROW_TOKENVALUE ..
    BOX_TOKENVALUE;

  ------------------------------------------------------------------
  -- ParseTables.GetAction return values
  ------------------------------------------------------------------

  subtype ERROR_ACTION_RANGE is  --| ActionRange that indicates
  ACTIONRANGE range 0 .. 0;  --| the error range

  subtype SHIFT_ACTION_RANGE is  --| ActionRange that indicates
  --| a shift action.
  ACTIONRANGE range 1 .. (STATECOUNTPLUSONE - 1);

  subtype ACCEPT_ACTION_RANGE is  --| ActionRange that indicates
  --| the accept action.
  ACTIONRANGE range STATECOUNTPLUSONE .. STATECOUNTPLUSONE;

  subtype REDUCE_ACTION_RANGE is  --| ActionRange that indicates
  --| a reduce action.
  ACTIONRANGE range (STATECOUNTPLUSONE + 1) .. ACTIONCOUNT;

  ------------------------------------------------------------------
  -- Queue and Stack Management
  ------------------------------------------------------------------

  subtype STATEPARSESTACKSINDEX is  --| range of index values for
  GC.PARSERINTEGER range 0 .. 200;  --| StateStack and ParseStack

  subtype STATEPARSESTACKSRANGE is  --| array index values for
  --| StateStack and ParseStack
  STATEPARSESTACKSINDEX range 1 .. STATEPARSESTACKSINDEX'LAST;

  LOOK_AHEAD_LIMIT : POSITIVE := 5;  --| Look ahead limit for parser

  ------------------------------------------------------------------
  -- StateStack Element
  ------------------------------------------------------------------

  subtype STATESTACKELEMENT is STATERANGE;

  type SOURCE_TEXT is access STRING;

  NULL_SOURCE_TEXT : constant SOURCE_TEXT := null;

  ------------------------------------------------------------------
  -- ParseStack and Grammar Symbol Elements
  ------------------------------------------------------------------

  type TOKEN is
    record
      TEXT          : SOURCE_TEXT;
      SRCPOS_LINE   : SP.SOURCE_LINE;
      SRCPOS_COLUMN : SP.SOURCE_COLUMN;
    end record;

  type PARSESTACKELEMENT is
    record
      GRAM_SYM_VAL : GRAMMARSYMBOLRANGE;
      --| used by parser to identify kind of grammar symbol
      LEXED_TOKEN  : TOKEN;
      --| lexed tokens not yet reduced (eliminated)
      --| by ReduceActions.
    end record;

    ------------------------------------------------------------------

  CURTOKEN : PARSESTACKELEMENT;
  --| return from Lex.GetNextSourceToken
  --| Token used in subprogram Parse to determine
  --| next action from.
  --| Also used in ReduceActionsUtilities to determine last
  --| compilation unit in a compilation.

  ------------------------------------------------------------------
  -- Subprogram Bodies Global to Package ParserDeclarations
  ------------------------------------------------------------------

  function GET_SOURCE_TEXT( --| get a string from a Source_Text
  --| object
                           IN_SOURCE_TEXT :
                                    --| the object to get the string from
                           in SOURCE_TEXT) return STRING;

  --| Effects

  --| This subprogram gets a string from a Source_Text object.
  --| It exists to concentrate the interface to Source_Text objects.

  ------------------------------------------------------------------

  procedure PUT_SOURCE_TEXT( --| put a string into a Source_Text
  --| object
                            IN_STRING          : in STRING;
                                   --| the string to store
                            IN_OUT_SOURCE_TEXT :
                                   --| the object to store the string in
                            in out SOURCE_TEXT);


  --| Effects

  --| This subprogram stores a string in a Source_Text object.
  --| It exists to concentrate the interface to Source_Text objects.

  ------------------------------------------------------------------

  function DUMP_PARSE_STACK_ELEMENT( --| return the data in a
  --| ParseStackElement or
  --| TokenQueueElement as a string
                                    IN_PSE : in PARSESTACKELEMENT
                                        --| the Element to display.
                                    ) return STRING;

  --| Effects

  --| This subprogram returns the data in a ParseStackElement or its
  --| sub-type a TokenQueueElement as a string.

  --| Notes

  --| Abbreviations used in this compilation unit
  --|
  --| PSE : ParseStackElement
  --|
  --| Only the lexed_token variant is currently fully displayed.
  --| The other variants would have to make use of an IDL
  --| writer.

  ------------------------------------------------------------------

end PARSERDECLARATIONS;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--lex.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


----------------------------------------------------------------------

with PARSERDECLARATIONS;  -- declarations for the Parser
with SYSTEM_PARAMETERS;  -- Host dependents constants

package LEX is  --| perform lexical analysis

--| Overview
--|
--| This package is used to identify tokens in the source file and
--| return them to subprogram Parser.
--|
--| The useful reference is Chapter 2 of the Ada (Trade Mark) LRM.

--| Effects
--|
--| The subprograms in package Lex are used to sequentially read
--| a source file and identify lexical units (tokens) in the file.
--| Comments and error messages are saved for use by the lister.

  package SP renames SYSTEM_PARAMETERS;
  package PD renames PARSERDECLARATIONS;
  -- other package renames are in the package body

  ------------------------------------------------------------------
  -- Subprogram Declarations Global to Package Lex
  ------------------------------------------------------------------

  procedure INITIALIZATION;  --| Initializes the lexer

  --| Effects
  --|
  --| This subprogram initializes the lexer.

  ------------------------------------------------------------------

  function GETNEXTNONCOMMENTTOKEN --| returns next non-comment token
  --| in source file.
  return PD.PARSESTACKELEMENT;

  --| Effects
  --|
  --| This subprogram scans the source file for the next token not
  --| including comment tokens.

  --| Requires
  --|
  --| This subprogram requires an opened source file,
  --| and the state information internal to the package body.

  ------------------------------------------------------------------

  function GETNEXTSOURCETOKEN --| returns next token in source file.
  return PD.PARSESTACKELEMENT;

  --| Effects
  --|
  --| This subprogram scans the source file for the next token.
  --| The tokens returned include any comment literal tokens.

  --| Requires
  --|
  --| This subprogram requires an opened source file,
  --| and the state information internal to the package body.

  ------------------------------------------------------------------

  function SHOW_CURRENT_LINE return SP.SOURCE_LINE;

  --| Effects
  --|
  --| Returns the current line number being processed

  ------------------------------------------------------------------

end LEX;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--lex.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


----------------------------------------------------------------------

with SYSDEP;  -- Host dependents constants
with LEX_IDENTIFIER_TOKEN_VALUE;
-- contains data structures and subprogram
--    to distinguish identifiers from
--    reserved words
with LEXICAL_ERROR_MESSAGE;  -- outputs error messages.
with PARSETABLES;  -- tables from parser generator
use PARSETABLES;
with GRAMMAR_CONSTANTS;  -- constants from the parser generator
use GRAMMAR_CONSTANTS;
with TEXT_IO;


package body LEX is

--| Overview
--|
--| Package Lex is implemented as a state machine via case statements.
--| The implementation is optimized to minimize the number of times
--| each character is handled.  Each character is handled twice: once
--| on input and once on lexing based on the character.
--|
--| The algorithm depends on having an End_Of_Line_Character
--| terminate each source file line.  This concludes the final token
--| on the line for the case statement scanners.

--| Notes
--|
--| Abbreviations Used:
--|
--| Char : Character
--| CST  : Current_Source_Token
--| gram : grammar
--| sym  : symbol
--| val  : value
--| RW   : Reserved Word
--|

  use PARSERDECLARATIONS;
  package LEM renames LEXICAL_ERROR_MESSAGE;
  package PT renames PARSETABLES;
  package GC renames GRAMMAR_CONSTANTS;
  -- other package renames are in the package spec

  ------------------------------------------------------------------
  -- Character Types
  ------------------------------------------------------------------

  subtype GRAPHIC_CHARACTER is CHARACTER range ' ' .. ASCII.TILDE;

  subtype UPPER_CASE_LETTER is CHARACTER range 'A' .. 'Z';

  subtype LOWER_CASE_LETTER is CHARACTER range ASCII.LC_A .. ASCII.LC_Z;

  subtype DIGIT is CHARACTER range '0' .. '9';

  subtype VALID_BASE_RANGE is GC.PARSERINTEGER range 2 .. 16;

  subtype END_OF_LINE_CHARACTER is CHARACTER range ASCII.LF .. ASCII.CR;

  ------------------------------------------------------------------
  -- Source position management
  ------------------------------------------------------------------

  CURRENT_COLUMN     : SP.SOURCE_COLUMN := 1;
  CURRENT_LINE       : SP.SOURCE_LINE := 1;
  --| the position of Next_Char in the source file.
  --| Visible so the Lexical_Error_message package can use them.

  ------------------------------------------------------------------
  -- Source Input Buffers and their Management
  ------------------------------------------------------------------

  NEXT_CHAR          : CHARACTER := ' ';  --| input buffer for next character
  --| to scan from source file

  END_OF_LINE_BUFFER :  --| character that signals end of
  --| line buffer
  constant CHARACTER := END_OF_LINE_CHARACTER'FIRST;

  subtype LINE_BUFFER_RANGE is POSITIVE range 1 .. ((SP.SOURCE_COLUMN'LAST) + 2)
    ;
  --| The first extra element is needed to hold the End_Of_Line_Buffer
  --| character. The second extra element allows Line_Buffer_Index
  --| to exceed Line_Buffer_Last.

  LINE_BUFFER         : STRING(LINE_BUFFER_RANGE) := ( -- 1 =>
  END_OF_LINE_BUFFER, others => ' ');
  --| input buffer containing source file line being lexed.

  LINE_BUFFER_LAST    : SP.SOURCE_COLUMN := LINE_BUFFER'FIRST;
  --| length of source file line being lexed.

  LINE_BUFFER_INDEX   : LINE_BUFFER_RANGE;
  --| index of character being lexed.

  END_OF_FILE_REACHED : BOOLEAN := FALSE;
  --| true when end of the input source has been reached

  ------------------------------------------------------------------
  -- Token to be Returned and its Management
  ------------------------------------------------------------------

  CST                 : PD.PARSESTACKELEMENT;
                                   --| token being assembled for return by
  --| subprogram GetNextSourceToken

  subtype CST_INITIALIZATION_TYPE is PD.PARSESTACKELEMENT;

  CST_INITIALIZER          : CST_INITIALIZATION_TYPE;
  --| short cut to initializing discriminants properly

  END_OF_FILE_TOKEN        : CST_INITIALIZATION_TYPE;

  ------------------------------------------------------------------
  -- Other objects
  ------------------------------------------------------------------

  EXIT_AFTER_GET_NEXT_CHAR : BOOLEAN := FALSE;
  --| true; call Get_Next_Char before exiting, so that
  --| Next_Char contains the next character to be scanned.
  --| This object is not located in subprogram GetNextSourceToken,
  --| to save the time of re-elaboration on each call.

  PREVIOUS_TOKEN_VALUE     : PT.TOKENRANGE := PT.STRINGTOKENVALUE;
  --| used to resolve tick use as a token in T'('a') versus
  --| use as a delimiter in a character literal.

  SOURCE_FILE              : TEXT_IO.FILE_TYPE;

  ------------------------------------------------------------------
  -- Declarations for Scan_Numeric_Literal and Scan_Comment
  ------------------------------------------------------------------

  TEMP_SOURCE_TEXT         : PD.SOURCE_TEXT;  --| temporary to hold value of
  --| Source_Text

  ------------------------------------------------------------------

  subtype WORK_STRING_RANGE_PLUS_ZERO is NATURAL range 0 .. NATURAL(SP.
    SOURCE_COLUMN'LAST);

  WORK_STRING        : STRING(1 .. WORK_STRING_RANGE_PLUS_ZERO'LAST);

  WORK_STRING_LENGTH : WORK_STRING_RANGE_PLUS_ZERO;
  -- Must initialize to 0 before each use.

  ------------------------------------------------------------------
  -- Declarations for Procedures:
  --
  -- Scan_Exponent, Scan_Based_Integer, Scan_Integer,
  -- and Scan_Numeric_Literal
  ------------------------------------------------------------------

  SEEN_RADIX_POINT   : BOOLEAN := FALSE;
  --| true  : real
  --| false : integer

  ------------------------------------------------------------------
  -- Subprogram Specifications Local to Package Lex
  ------------------------------------------------------------------

  procedure GET_NEXT_CHAR;  --| Obtains next character

  --| Requires
  --|
  --| This subprogram requires an opened source file, and
  --| Current Column > Line_Buffer_Last on its first call to initialize
  --| the input buffers Next_Char and Line_Buffer correctly.
  --|

  --| Effects
  --|
  --| This subprogram places the next character from the source file
  --| in Next_Char and updates the source file position.
  --| Subprogram Get_Next_Line sets End_Of_File_Reached true, and causes
  --| Next_Char to be set to the last character in Line_Buffer.
  --|

  --| Modifies
  --|
  --| Current_Column
  --| Current_Line
  --| Next_Char
  --| Line_Buffer
  --| Line_Buffer_Last
  --| Line_Buffer_Index
  --| End_Of_File_Reached
  --|

  ------------------------------------------------------------------

  procedure GET_NEXT_LINE;  --| gets next source file line to lex

  --| Requires
  --|
  --| This subprogram requires the source file to be open.
  --|

  --| Effects
  --|
  --| This subprogram gets next source line from input file.
  --| Sets Current_Column and Line_Buffer_Index to 1, and
  --| increments Current_Line.
  --| If the End of File is detected,
  --| End_Of_File_Reached is set true,
  --| End_Of_File_Token is set up,
  --| and Next_Char is set to End_Of_Line_Buffer.
  --|

  --| Modifies
  --|
  --| Current_Line
  --| End_Of_File_Reached
  --| End_Of_File_Token - only when the end of file is reached.
  --| Line_Buffer
  --| Line_Buffer_Last
  --|

  ------------------------------------------------------------------

  function LOOK_AHEAD( --| Return character n columns ahead
  --| in current in current line.
                      IN_COLUMNS_AHEAD :  --| Number of columns ahead to get
                      in SP.SOURCE_COLUMN --| return character from.
                      ) return CHARACTER;

  --| Requires
  --|
  --| Line_Buffer
  --| Line_Buffer_Last
  --|

  --| Effects
  --|
  --| Return character In_Columns_Ahead in Line_Buffer.
  --| If this character is off the end of Line_Buffer,
  --| End_Of_Line_Buffer character is returned.
  --|

  ------------------------------------------------------------------

  procedure SET_CST_GRAM_SYM_VAL( --| Sets gram_sym_val for current
  --| token.
                                 IN_TOKEN_VALUE : in PT.TOKENRANGE);
                                            --| value of token

  --| Effects
  --|
  --| This subprogram fills in gram_sym_val for the current token.
  --|

  ------------------------------------------------------------------

  procedure SET_CST_SOURCE_REP( --| Saves the symbol representation
  --| in the current token.
                               IN_STRING : in STRING);
                                     --| string holding symbol.

  --| Effects
  --|
  --| This subprogram fills in lexed_token.symrep for the current token.
  --|

  ------------------------------------------------------------------

  procedure INITIALIZE_CST;  --| Sets lx_srcpos for current token.

  --| Requires
  --|
  --| This subprogram requires Current_Column and Current_Line.
  --|

  --| Effects
  --|
  --| This subprogram sets common fields in CST.
  --|

  ------------------------------------------------------------------

  procedure ADD_NEXT_CHAR_TO_SOURCE_REP;
  --| appends Next_Char to growing
  --| source representation

  --| Requires
  --|
  --| Next_Char
  --|

  --| Effects
  --|
  --| This subprogram appends Next_Char to the growing source
  --| representation.
  --|

  --| Modifies
  --|
  --| Work_String
  --| Work_String_Length
  --|

  ------------------------------------------------------------------

  procedure CHECK_FOR_CONSECUTIVE_UNDERLINES;
  --| Issues an error message if
  --| consecutive underlines occur.

  --| Requires
  --|
  --| Work_String
  --| Work_String_Length
  --|

  --| Effects
  --|
  --| Issues an error message if consecutive underlines occur.
  --|

  ------------------------------------------------------------------

  procedure CHECK_FOR_TERMINAL_UNDERLINE;
  --| Issues an error message if
  --| a terminal underline occurs.

  --| Requires
  --|
  --| Work_String
  --| Work_String_Length
  --|

  --| Effects
  --|
  --| This subprogram issues an error message if a terminal underline
  --| occurs.

  ------------------------------------------------------------------

  procedure SCAN_COMMENT;  --| Scans comments.

  --| Requires
  --|
  --| This subprogram requires an opened source file.
  --|

  --| Effects
  --|
  --| This subprogram scans the rest of a comment.
  --|

  --| Modifies
  --|
  --| CST
  --|

  ------------------------------------------------------------------

  procedure SCAN_IDENTIFIER_INCLUDING_RW;
  --| Scans identifiers including
  --| reserved words

  --| Requires
  --|
  --| This subprogram requires an opened source file.
  --|

  --| Effects
  --|
  --| This subprogram scans the rest of the identifier,
  --| and determines if its a reserved word.
  --|

  --| Modifies
  --|
  --| CST
  --|

  ------------------------------------------------------------------

  procedure SCAN_EXPONENT;  --| Scans exponent field in
  --| appropriate numeric_literals

  --| Requires
  --|
  --| This subprogram requires an opened source file.
  --|

  --| Effects
  --|
  --| This subprogram scans the end of numeric_literals which
  --| contain exponents.
  --|

  --| Modifies
  --|
  --| Work_String
  --| Work_String_Length
  --|

  ------------------------------------------------------------------

  procedure SCAN_BASED_INTEGER( --| scans a based integer field of
  --| a numeric literal
                               IN_BASE_TO_USE :  --| the base to use for lexing.
                               in VALID_BASE_RANGE);

  --| Requires
  --|
  --| This subprogram requires an opened source file.

  --| Effects
  --|
  --| This subprogram scans a based integer field in a numeric literal,
  --| verifying that is lexically correct.
  --|

  --| Modifies
  --|
  --| Work_String
  --| Work_String_Length
  --|

  --| Notes
  --|
  --| This subprogram and Scan_Integer are nearly identical.
  --| They are separate to save the overhead of:
  --|
  --| - passing a base in for decimal literals; and
  --|
  --| - distinguishing the extended digit 'E' from the exponent
  --| delimiter 'E'.
  --|

  ------------------------------------------------------------------

  procedure SCAN_INTEGER;  --| scans an integer field of
  --|  a numeric literal

  --| Requires
  --|
  --| This subprogram requires an opened source file.
  --|

  --| Effects
  --|
  --| This subprogram scans an integer field in a numeric literal,
  --| verifying it is lexically correct.
  --|

  --| Modifies
  --|
  --| Work_String
  --| Work_String_Length
  --|

  --| Notes
  --|
  --| This subprogram and Scan_Based_Integer are nearly identical.
  --| They are separate to save the overhead of:
  --|
  --| - passing a base in for decimal literals; and
  --|
  --| - distinguishing the extended digit 'E' from the exponent
  --| delimiter 'E'.
  --|

  ------------------------------------------------------------------

  procedure SCAN_NUMERIC_LITERAL;  --| Scans numbers

  --| Requires
  --|
  --| This subprogram requires an opened source file, and the
  --| Universal Arithmetic package to handle conversions.
  --|

  --| Effects
  --|
  --| This subprogram scans the rest of the numeric literal and converts
  --| it to internal universal number format.
  --|

  --| Modifies
  --|
  --| CST
  --|

  -------------------------------------------------------------------

  procedure SCAN_STRING_LITERAL;  --| Scans string literals

  --| Requires
  --|
  --| This subprogram requires an opened source file.
  --|

  --| Effects
  --|
  --| This subprogram scans the rest of the string literal.
  --|

  --| Modifies
  --|
  --| CST
  --|

  ------------------------------------------------------------------
  -- Subprogram Bodies Global to Package Lex
  -- (declared in package specification).
  ------------------------------------------------------------------

  ------------------------------------------------------------------
  procedure INITIALIZATION is

  begin

    END_OF_FILE_REACHED := FALSE;

    -- forces Get_Next_Char to call Get_Next_Line

    -- revised 1/31/86
    -- no it doesn't because get_next_char never checks what current_column is,
    -- just increments it again.

   -- revise to do real initializing of necessary values.

    LINE_BUFFER := (END_OF_LINE_BUFFER, others => ' ');
      -- END_OF_LINE_BUFFER is a constant CHARACTER = ASCII.LF
    LINE_BUFFER_LAST := LINE_BUFFER'FIRST; -- 1
    LINE_BUFFER_INDEX := LINE_BUFFER_RANGE'FIRST; -- 1
    CURRENT_COLUMN := LINE_BUFFER_LAST + 1;

    WORK_STRING := (others => ' ');
    WORK_STRING_LENGTH := WORK_STRING_RANGE_PLUS_ZERO'FIRST; -- 0

    GET_NEXT_CHAR;

  end INITIALIZATION;

  ------------------------------------------------------------------

  function GETNEXTNONCOMMENTTOKEN return PD.PARSESTACKELEMENT is separate;

  ------------------------------------------------------------------

  function GETNEXTSOURCETOKEN return PD.PARSESTACKELEMENT is

  --| Overview
  --|
  --| Note the following LRM Sections:
  --|     LRM Section 2.2  - Lexical Elements, Separators and Delimiters
  --|     LRM Section 2.2  - Notes
  --|     LRM Section 2.5  - Character Literals
  --|     LRM Section 2.7  - Comments
  --|     LRM Section 2.7  - Note
  --|     LRM Section 2.10 - Allowed Replacements of Characters
  --|

  begin

    if (END_OF_FILE_REACHED) then
      CST := END_OF_FILE_TOKEN;
    else

      -- this else terminates
      -- shortly before the return statement

      -- This loop performs the following functions:
      --
      -- 1) It scans for and ignores repeated separators.
      -- 2) It reports illegal characters between tokens.
      -- 3) It identifies and lexes tokens.
      --    Delimiters and character literals are handled
      --    by code inside this loop.
      --    Complex tokens: identifiers, string and
      --    numeric literals are lexed by called
      --    subprograms.
      -- 4) It recognizes and processes comments that
      --    occur before the first token found.  Comments
      --    after tokens are processed by a separate loop
      --    after this one.
      SCAN_FOR_TOKEN : loop
        case NEXT_CHAR is
          when UPPER_CASE_LETTER | LOWER_CASE_LETTER =>
            INITIALIZE_CST;
            SCAN_IDENTIFIER_INCLUDING_RW;
            exit SCAN_FOR_TOKEN;

          -- Next_Char already updated
          when DIGIT =>
            INITIALIZE_CST;
            SCAN_NUMERIC_LITERAL;
            exit SCAN_FOR_TOKEN;

          -- Next_Char already updated
          when ASCII.QUOTATION |

          -- '"'
          ASCII.PERCENT =>

            -- '%'
            INITIALIZE_CST;
            SCAN_STRING_LITERAL;
            exit SCAN_FOR_TOKEN;

          -- Next_Char already updated
          when ''' =>
            INITIALIZE_CST;
            if ((GC."="(PREVIOUS_TOKEN_VALUE, PT.IDENTIFIERTOKENVALUE)) or else
              (GC."="(PREVIOUS_TOKEN_VALUE, PT.ALLTOKENVALUE)) or else (GC."="(
              PREVIOUS_TOKEN_VALUE, PT.STRINGTOKENVALUE)) or else (GC."="(
              PREVIOUS_TOKEN_VALUE, PT.CHARACTERTOKENVALUE)) or else (GC."="(
              PREVIOUS_TOKEN_VALUE, PT.RIGHTPAREN_TOKENVALUE))) then

              --  CST is a ' delimiter
              SET_CST_GRAM_SYM_VAL(PT.APOSTROPHE_TOKENVALUE);
            elsif (LOOK_AHEAD(2) = ''') then

              -- CST is a character literal
              CST.GRAM_SYM_VAL := PT.CHARACTERTOKENVALUE;
              GET_NEXT_CHAR;
              if not (NEXT_CHAR in GRAPHIC_CHARACTER) then

                -- flag as an error
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, INTEGER'IMAGE(
                  CHARACTER'POS(NEXT_CHAR))

                -- convert to string
                , LEM.CHARACTER_IS_NON_GRAPHIC);
              end if;

              -- save the source representation.
              SET_CST_SOURCE_REP("'" & NEXT_CHAR);
              GET_NEXT_CHAR;

            -- pass by the closing
            -- single quote
            else

              -- flag single quote use as illegal
              LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                ILLEGAL_USE_OF_SINGLE_QUOTE);

              --  assume CST is a ' delimiter;
              SET_CST_GRAM_SYM_VAL(PT.APOSTROPHE_TOKENVALUE);
            end if;
            EXIT_AFTER_GET_NEXT_CHAR := TRUE;


          when ASCII.AMPERSAND =>

            -- '&'
            INITIALIZE_CST;
            SET_CST_GRAM_SYM_VAL(PT.AMPERSAND_TOKENVALUE);
            EXIT_AFTER_GET_NEXT_CHAR := TRUE;

          when '(' =>
            INITIALIZE_CST;
            SET_CST_GRAM_SYM_VAL(PT.LEFTPAREN_TOKENVALUE);
            EXIT_AFTER_GET_NEXT_CHAR := TRUE;

          when ')' =>
            INITIALIZE_CST;
            SET_CST_GRAM_SYM_VAL(PT.RIGHTPAREN_TOKENVALUE);
            EXIT_AFTER_GET_NEXT_CHAR := TRUE;

          when '*' =>
            INITIALIZE_CST;
            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when '*' =>
                SET_CST_GRAM_SYM_VAL(PD.EXPONENTIATION_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when others =>
                SET_CST_GRAM_SYM_VAL(PT.STAR_TOKENVALUE);
                exit SCAN_FOR_TOKEN;

            -- Next_Char already updated
            end case;

          when '+' =>
            INITIALIZE_CST;
            SET_CST_GRAM_SYM_VAL(PT.PLUS_TOKENVALUE);
            EXIT_AFTER_GET_NEXT_CHAR := TRUE;

          when ',' =>
            INITIALIZE_CST;
            SET_CST_GRAM_SYM_VAL(PT.COMMA_TOKENVALUE);
            EXIT_AFTER_GET_NEXT_CHAR := TRUE;

          when '-' =>

            -- Minus_Sign or Hyphen
            INITIALIZE_CST;
            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when '-' =>

                -- Minus_Sign or Hyphen
                -- two hyphens indicate a comment
                SET_CST_GRAM_SYM_VAL(PT.COMMENT_TOKENVALUE);
                SCAN_COMMENT;
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when others =>
                SET_CST_GRAM_SYM_VAL(PT.MINUS_TOKENVALUE);
                exit SCAN_FOR_TOKEN;

            -- Next_Char already updated
            end case;

          when '.' =>
            INITIALIZE_CST;
            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when '.' =>
                SET_CST_GRAM_SYM_VAL(PT.DOTDOT_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when others =>
                SET_CST_GRAM_SYM_VAL(PT.DOT_TOKENVALUE);
                exit SCAN_FOR_TOKEN;

            -- Next_Char already updated
            end case;

          when '/' =>
            INITIALIZE_CST;
            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when '=' =>
                SET_CST_GRAM_SYM_VAL(PD.NOTEQUALS_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when others =>
                SET_CST_GRAM_SYM_VAL(PT.SLASH_TOKENVALUE);
                exit SCAN_FOR_TOKEN;

            -- Next_Char already updated
            end case;

          when ASCII.COLON =>

            -- ':'
            INITIALIZE_CST;
            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when '=' =>
                SET_CST_GRAM_SYM_VAL(PD.ASSIGNMENT_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when others =>
                SET_CST_GRAM_SYM_VAL(PT.COLON_TOKENVALUE);
                exit SCAN_FOR_TOKEN;

            -- Next_Char already updated
            end case;

          when ASCII.SEMICOLON =>

            -- ';'
            INITIALIZE_CST;
            SET_CST_GRAM_SYM_VAL(PT.SEMICOLON_TOKENVALUE);
            EXIT_AFTER_GET_NEXT_CHAR := TRUE;

          when '<' =>
            INITIALIZE_CST;
            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when '=' =>
                SET_CST_GRAM_SYM_VAL(PT.LTEQ_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when '<' =>
                SET_CST_GRAM_SYM_VAL(PD.STARTLABEL_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when '>' =>
                SET_CST_GRAM_SYM_VAL(PD.BOX_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when others =>
                SET_CST_GRAM_SYM_VAL(PT.LT_TOKENVALUE);
                exit SCAN_FOR_TOKEN;

            -- Next_Char already updated
            end case;

          when '=' =>
            INITIALIZE_CST;
            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when '>' =>
                SET_CST_GRAM_SYM_VAL(PD.ARROW_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when others =>
                SET_CST_GRAM_SYM_VAL(PT.EQ_TOKENVALUE);
                exit SCAN_FOR_TOKEN;

            -- Next_Char already updated
            end case;

          when '>' =>
            INITIALIZE_CST;
            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when '=' =>
                SET_CST_GRAM_SYM_VAL(PT.GTEQ_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when '>' =>
                SET_CST_GRAM_SYM_VAL(PD.ENDLABEL_TOKENVALUE);
                EXIT_AFTER_GET_NEXT_CHAR := TRUE;
              when others =>
                SET_CST_GRAM_SYM_VAL(PT.GT_TOKENVALUE);
                exit SCAN_FOR_TOKEN;

            -- Next_Char already updated
            end case;

          when ASCII.BAR |

          -- '|'
          ASCII.EXCLAM =>

            -- '!'
            -- vertical bar and its alternative
            INITIALIZE_CST;
            SET_CST_GRAM_SYM_VAL(PT.BAR_TOKENVALUE);
            EXIT_AFTER_GET_NEXT_CHAR := TRUE;

          when ASCII.HT =>

            -- Horizontal Tab
            -- a lexical unit separator - skip it.
            -- position Current_Column properly. This is done
            --     here to save the cost of a test on every
            --     character in Get_Next_Char.
            CURRENT_COLUMN := SYSDEP.FINDTABCOLUMN(CURRENT_COLUMN);

          when ' ' | END_OF_LINE_CHARACTER =>

            -- rest of the lexical unit separators
            if (END_OF_FILE_REACHED) then
              return END_OF_FILE_TOKEN;
            end if;


          when ASCII.UNDERLINE =>

            -- '_'
            case LOOK_AHEAD(1) is
              when UPPER_CASE_LETTER | LOWER_CASE_LETTER =>

                -- flag illegal leading under line
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                  LEADING_UNDERLINE);
                INITIALIZE_CST;
                SCAN_IDENTIFIER_INCLUDING_RW;
                exit SCAN_FOR_TOKEN;

              -- Next_Char already updated
              when DIGIT =>

                -- flag illegal leading under line
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                  LEADING_UNDERLINE);
                INITIALIZE_CST;
                SCAN_NUMERIC_LITERAL;
                exit SCAN_FOR_TOKEN;

              -- Next_Char already updated
              when others =>

                -- flag illegal character for start
                -- of token
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, "_", LEM.
                  CHARACTER_CAN_NOT_START_TOKEN);
            end case;


          when ASCII.SHARP |

          -- '#'
          ASCII.DOLLAR |

          -- '$'
          ASCII.QUERY |

          -- '?'
          ASCII.AT_SIGN |

          -- '@'
          ASCII.L_BRACKET |

          -- '['
          ASCII.BACK_SLASH |

          -- '\'
          ASCII.R_BRACKET |

          -- ']'
          ASCII.CIRCUMFLEX |

          -- '^'
          ASCII.GRAVE |

          -- '`'
          ASCII.L_BRACE |

          -- '{'
          ASCII.R_BRACE |

          -- '}'
          ASCII.TILDE =>

            -- '~'
            -- flag illegal character for start of token
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, NEXT_CHAR & ""

            -- convert to string
            , LEM.CHARACTER_CAN_NOT_START_TOKEN);

          when ASCII.NUL ..

          -- Null to
          ASCII.BS |

          --  Back Space
          ASCII.SO ..

          -- Shift Out to
          ASCII.US |

          --  Unit Separator
          ASCII.DEL =>

            -- Delete
            -- flag as non-graphic ASCII control character
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, INTEGER'IMAGE(
              CHARACTER'POS(NEXT_CHAR))

            -- convert to string
            , LEM.CHARACTER_IS_NON_GRAPHIC);

          when others =>

            -- should never happen due to 's
            -- definition of CHARACTER. flag as illegal anyhow
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
              CHARACTER_IS_NON_ASCII);
        end case;

        GET_NEXT_CHAR;

        -- for next time through loop.
        if (EXIT_AFTER_GET_NEXT_CHAR) then
          EXIT_AFTER_GET_NEXT_CHAR := FALSE;
          exit SCAN_FOR_TOKEN;
        end if;

      end loop SCAN_FOR_TOKEN;

      -- Next_Char already updated
      PREVIOUS_TOKEN_VALUE := CST.GRAM_SYM_VAL;

    -- for resolving T'('c')
    end if;

    -- (End_Of_File_Reached)
    return CST;

  -- On leaving: object Next_Char should contain character
  -- to scan on next call of this function.
  end GETNEXTSOURCETOKEN;

  ------------------------------------------------------------------
  -- Subprogram Bodies Local to Package Lex
  ------------------------------------------------------------------

  procedure GET_NEXT_CHAR is

  begin

    --| Algorithm
    --|
    --| Source File is scanned returning each character until the
    --| end of the file is found. Proper column positioning for a tab
    --| character is done in GetNextSourceToken for speed.
    --|

    -- The End_Of_Line_Character that Get_Next_Line
    -- inserts needs to be seen by the scanning
    -- case statements to terminate tokens correctly.
    CURRENT_COLUMN := CURRENT_COLUMN + 1;
    LINE_BUFFER_INDEX := LINE_BUFFER_INDEX + 1;
    NEXT_CHAR := LINE_BUFFER(LINE_BUFFER_INDEX);

    if (LINE_BUFFER_INDEX > LINE_BUFFER_LAST) then
      GET_NEXT_LINE;

      -- Current_Column and Line_Buffer_Index are handled there.
      NEXT_CHAR := LINE_BUFFER(LINE_BUFFER_INDEX);
    end if;

  end GET_NEXT_CHAR;  -- procedure

  ------------------------------------------------------------------

  procedure GET_NEXT_LINE is

  begin

    -- Get next source line from CURRENT_INPUT. Update column and
    -- line counts
    CURRENT_COLUMN := 1;
    LINE_BUFFER_INDEX := 1;

    IGNORE_NULL_LINE : loop

      -- do NOT move next statement out of loop
      if (CURRENT_LINE < SP.SOURCE_LINE'LAST) then
        begin -- block
          CURRENT_LINE := SP.SOURCE_LINE -- type conversion
          (TEXT_IO.LINE(FILE => TEXT_IO.CURRENT_INPUT));
          if (CURRENT_LINE >= SP.SOURCE_LINE'LAST) then
            raise CONSTRAINT_ERROR;
          end if;
        exception
          when others =>
            CURRENT_LINE := SP.SOURCE_LINE'LAST;
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, SP.SOURCE_LINE'
              IMAGE(SP.SOURCE_LINE'LAST), LEM.SOURCE_LINE_MAXIMUM_EXCEEDED);
        end;  -- block
      end if;
      TEXT_IO.GET_LINE(FILE => TEXT_IO.CURRENT_INPUT, ITEM => LINE_BUFFER(1 .. (
        LINE_BUFFER'LAST - 1)), LAST => LINE_BUFFER_LAST);
      -- flag a line that is too long as an error
      if (LINE_BUFFER_LAST >= LINE_BUFFER'LAST - 1) and then (TEXT_IO.
        END_OF_LINE(FILE => TEXT_IO.CURRENT_INPUT)) then
        LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
          SOURCE_LINE_TOO_LONG);
      end if;
      exit IGNORE_NULL_LINE when (LINE_BUFFER_LAST /= (LINE_BUFFER'FIRST - 1));
    end loop IGNORE_NULL_LINE;

    LINE_BUFFER_LAST := LINE_BUFFER_LAST + 1;
    LINE_BUFFER(LINE_BUFFER_LAST) := END_OF_LINE_BUFFER;

  exception
  -- when end of file is reached
    when TEXT_IO.END_ERROR =>
    -- save that state for GetNextSourceToken
      END_OF_FILE_REACHED := TRUE;

      -- update column and line counts
      LINE_BUFFER_LAST := 1;
      LINE_BUFFER(LINE_BUFFER_LAST) := END_OF_LINE_BUFFER;
      LINE_BUFFER_INDEX := 1;
      CURRENT_COLUMN := 1;
      -- Current_Line is ok.
      -- Last call to GET_LINE advanced it one.

      -- set the value of End_Of_File_Token
      -- the discriminants were set up by the object declaration
      END_OF_FILE_TOKEN.GRAM_SYM_VAL := PT.EOF_TOKENVALUE;
      END_OF_FILE_TOKEN.LEXED_TOKEN := (SRCPOS_LINE => CURRENT_LINE,
        SRCPOS_COLUMN => CURRENT_COLUMN, TEXT => PD.NULL_SOURCE_TEXT);

  end GET_NEXT_LINE;

  ------------------------------------------------------------------
  function LOOK_AHEAD(IN_COLUMNS_AHEAD : in SP.SOURCE_COLUMN) return CHARACTER
    is

    ------------------------------------------------------------------
    -- Declarations for subprogram Look_Ahead
    ------------------------------------------------------------------
    POSITION_TO_TRY : INTEGER := INTEGER

    --type conversion
    (LINE_BUFFER_INDEX + IN_COLUMNS_AHEAD);

  ------------------------------------------------------------------
  begin

  -- if request is past the end of line
    if (POSITION_TO_TRY > INTEGER(LINE_BUFFER_LAST)) then
    -- type conversion
    -- return the end_of_line character
      return END_OF_LINE_BUFFER;
    else
    -- else return the requested character
      return LINE_BUFFER(POSITION_TO_TRY);
    end if;

  end LOOK_AHEAD;

  -- function

  ------------------------------------------------------------------
  procedure SET_CST_GRAM_SYM_VAL(IN_TOKEN_VALUE : in PT.TOKENRANGE) is

  begin

    CST.GRAM_SYM_VAL := IN_TOKEN_VALUE;

  end SET_CST_GRAM_SYM_VAL;

  ----------------------------------------------------------------------
  procedure SET_CST_SOURCE_REP(IN_STRING : in STRING) is

  begin

  -- store the representation
    PD.PUT_SOURCE_TEXT(IN_STRING, CST.LEXED_TOKEN.TEXT);

  end SET_CST_SOURCE_REP;

  ------------------------------------------------------------------
  procedure INITIALIZE_CST is

  begin

  -- Set up discriminants, and source position properly
  -- Set other CST fields to null values
    CST := CST_INITIALIZER;

    CST.LEXED_TOKEN := (SRCPOS_LINE => CURRENT_LINE, SRCPOS_COLUMN =>
      CURRENT_COLUMN, TEXT => PD.NULL_SOURCE_TEXT);

  end INITIALIZE_CST;

  ------------------------------------------------------------------
  procedure ADD_NEXT_CHAR_TO_SOURCE_REP is

  begin

  -- append the character to growing source representation
    WORK_STRING_LENGTH := WORK_STRING_LENGTH + 1;
    WORK_STRING(WORK_STRING_LENGTH) := NEXT_CHAR;

  end ADD_NEXT_CHAR_TO_SOURCE_REP;

  ------------------------------------------------------------------
  procedure CHECK_FOR_CONSECUTIVE_UNDERLINES is

  begin

  -- flag consecutive underlines as an error (leading
  -- underlines are handled in GetNextSourceToken).
    if (WORK_STRING(WORK_STRING_LENGTH) = ASCII.UNDERLINE) then
      LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
        CONSECUTIVE_UNDERLINES);
    end if;

  end CHECK_FOR_CONSECUTIVE_UNDERLINES;

  -- procedure

  ------------------------------------------------------------------
  procedure CHECK_FOR_TERMINAL_UNDERLINE is

  begin

  -- flag a trailing underline as an error.
  -- trailing underlines are saved for the same
  -- reason as leading ones.
  -- See comment in GetNextSourceToken.

    if (WORK_STRING(WORK_STRING_LENGTH) = ASCII.UNDERLINE)
    -- check the preceeding character
    then
      LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.TERMINAL_UNDERLINE);
    end if;

  end CHECK_FOR_TERMINAL_UNDERLINE;

  ------------------------------------------------------------------
  procedure SCAN_COMMENT is

  --| Overview
  --|
  --| Note the following LRM Sections:
  --|     LRM Section 2.7  - Comments
  --|     LRM Section 2.7  - Note
  --|
  begin

  -- get to the beginning of the comment
    GET_NEXT_CHAR;
    SET_CST_SOURCE_REP(LINE_BUFFER(LINE_BUFFER_INDEX .. LINE_BUFFER_LAST - 1));
    -- subtract 1 so that the carridge return is not also returned.

    LINE_BUFFER_INDEX := LINE_BUFFER_LAST + 1;
    -- force next call to Get_Next_Char to call Get_Next_Line

  end SCAN_COMMENT;

  ------------------------------------------------------------------
  procedure SCAN_IDENTIFIER_INCLUDING_RW is

  --| Overview
  --|
  --| Note the following LRM Sections:
  --|     LRM Section 2.3 - Identifiers
  --|     LRM Section 2.3 - Note
  --|     LRM Section 2.9 - Reserved Words
  --|     LRM Section 2.9 - Notes
  --|

  ------------------------------------------------------------------
  begin

    WORK_STRING_LENGTH := 0;

    -- scan source file for rest of token
    -- note that first character of the token is stored first
    SCAN_FOR_IDENTIFIER_INCLUDING_RW : loop
      ADD_NEXT_CHAR_TO_SOURCE_REP;

      -- set up for processing next characte
      GET_NEXT_CHAR;

      case NEXT_CHAR is
        when UPPER_CASE_LETTER | LOWER_CASE_LETTER | DIGIT =>
        -- action is at start of next loop cycle
          null;
        when ASCII.UNDERLINE =>  -- '_'
          CHECK_FOR_CONSECUTIVE_UNDERLINES;
        when others =>
          CHECK_FOR_TERMINAL_UNDERLINE;

          -- token is terminated by any character except letter
          --     digit, or underline;
          exit SCAN_FOR_IDENTIFIER_INCLUDING_RW;  -- this loop
      end case;

    end loop SCAN_FOR_IDENTIFIER_INCLUDING_RW;

    -- find out what kind of token it is
    LEX_IDENTIFIER_TOKEN_VALUE.FIND(IN_IDENTIFIER => WORK_STRING(1 ..
      WORK_STRING_LENGTH), OUT_TOKEN_VALUE => CST.GRAM_SYM_VAL);

    -- store the source representation of the token found
    SET_CST_SOURCE_REP(WORK_STRING(1 .. WORK_STRING_LENGTH));

  end SCAN_IDENTIFIER_INCLUDING_RW;

  ------------------------------------------------------------------
  procedure SCAN_EXPONENT is

  --| Overview
  --|
  --| Note the following LRM Sections:
  --|     LRM Section 2.4.1 - Decimal Literals
  --|     LRM Section 2.4.1 - Notes
  --|     LRM Section 2.4.2 - Based Literals
  --|
  begin

  -- Check for missing 'E' or 'e',
  -- and for existence of the exponent
    case NEXT_CHAR is
      when 'E' | 'e' =>
        null;  -- normal case
      when others =>
        return;  -- no exponent to process
    end case;
    -- add first character to growing literal
    ADD_NEXT_CHAR_TO_SOURCE_REP;


    -- scan source file for rest of the exponent
    -- verify that next character is legal for an integer field
    GET_NEXT_CHAR;

    case NEXT_CHAR is
      when '+' =>
      -- add sign character to growing literal
        ADD_NEXT_CHAR_TO_SOURCE_REP;

        GET_NEXT_CHAR;
      when '-' =>  -- Minus_Sign
        if not (SEEN_RADIX_POINT) then
        -- flag negative exponent as illegal in an integer
          LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
            NEGATIVE_EXPONENT_ILLEGAL_IN_INTEGER);
        end if;

        -- add sign character to growing literal
        ADD_NEXT_CHAR_TO_SOURCE_REP;

        GET_NEXT_CHAR;
      when others =>
        null;
    end case;

    case NEXT_CHAR is
      when DIGIT =>
      -- scan the integer field of the exponent
        SCAN_INTEGER;
      when ASCII.UNDERLINE =>  -- '_'
        if (LOOK_AHEAD(1) in DIGIT) then
        -- flag illegal leading under line
          LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.LEADING_UNDERLINE
            );
          -- scan the integer field of the exponent
          SCAN_INTEGER;
        else
        -- issue error message that integer field is missing
          LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
            EXPONENT_MISSING_INTEGER_FIELD);
        end if;
      when others =>
      -- issue an error message that integer field is missing
        LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
          EXPONENT_MISSING_INTEGER_FIELD);
    end case;

  end SCAN_EXPONENT;

  ------------------------------------------------------------------
  procedure SCAN_BASED_INTEGER(IN_BASE_TO_USE : in VALID_BASE_RANGE) is

    --| Overview
    --|
    --| Note the following LRM Sections:
    --|     LRM Section 2.4   - Numeric Literals
    --|     LRM Section 2.4.2 - Based Literals
    --|

    ------------------------------------------------------------------
    -- Declarations for Procedure Scan_Based_Integer
    ------------------------------------------------------------------
    BAD       : constant GC.PARSERINTEGER := GC.PARSERINTEGER'LAST;

    --| an integer value greater than 15 to use as a flag to indicate
    --| illegal values.
    TRANSFORM : constant array(CHARACTER) of GC.PARSERINTEGER :=

    -------- ( nul,  soh,  stx,  etx,     eot,  enq,  ack,  bel,
    (BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   bs,   ht,   lf,   vt,      ff,   cr,   so,   si,
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   dle,  dc1,  dc2,  dc3,     dc4,  nak,  syn,  etb,
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   can,  em,   sub,  esc,     fs,   gs,   rs,   us,
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   ' ',  '!',  '"',  '#',     '$',  '%',  '&',  ''',
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   '(',  ')',  '*',  '+',     ',',  '-',  '.',  '/',
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   '0',  '1',  '2',  '3',     '4',  '5',  '6',  '7',
    0, 1, 2, 3, 4, 5, 6, 7,

    --------   '8',  '9',  ':',  ';',     '<',  '=',  '>',  '?',
    8, 9, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   '@',  'A',  'B',  'C',     'D',  'E',  'F',  'G',
    BAD, 10, 11, 12, 13, 14, 15, BAD,

    --------   'H',  'I',  'J',  'K',     'L',  'M',  'N',  'O',
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   'P',  'Q',  'R',  'S',     'T',  'U',  'V',  'W',
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   'X',  'Y',  'Z',  '[',     '\',  ']',  '^',  '_',
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   '`',  'a',  'b',  'c',     'd',  'e',  'f',  'g',
    BAD, 10, 11, 12, 13, 14, 15, BAD,

    --------   'h',  'i',  'j',  'k',     'l',  'm',  'n',  'o',
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   'p',  'q',  'r',  's',     't',  'u',  'v',  'w',
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD,

    --------   'x',  'y',  'z',  '{',     '|',  '}',  '~',   del);
    BAD, BAD, BAD, BAD, BAD, BAD, BAD, BAD);

  --| used to transform a character value to an integer value for
  --| purpose of checking that a digit is within the legal range
  --| for the base passed in via In_Base_To_Use.

  ------------------------------------------------------------------
  begin

  -- check that first character, if not an under line,
  -- is a valid digit for base being used.
    if (NEXT_CHAR /= ASCII.UNDERLINE) and then (TRANSFORM(NEXT_CHAR) >=
      IN_BASE_TO_USE) then
    -- flag digit as invalid for base
      LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, NEXT_CHAR & ""
                                  -- convert to string
      , LEM.DIGIT_INVALID_FOR_BASE);
    end if;

    -- scan source file for rest of the field
    -- note that first character of the field is stored first
    SCAN_FOR_BASED_INTEGER : loop

      ADD_NEXT_CHAR_TO_SOURCE_REP;

      -- set up for processing next character
      GET_NEXT_CHAR;

      case NEXT_CHAR is
        when 'A' .. 'F' | 'a' .. 'f' | DIGIT =>
        -- check if Next_Char is in valid base range
          if (TRANSFORM(NEXT_CHAR) >= IN_BASE_TO_USE) then
          -- flag digit as invalid for base
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, NEXT_CHAR & ""
                                              -- convert to string
            , LEM.DIGIT_INVALID_FOR_BASE);
          end if;
          -- rest of action is at start of next loop cycle
        when ASCII.UNDERLINE =>  -- '_'
          CHECK_FOR_CONSECUTIVE_UNDERLINES;
        when others =>
          CHECK_FOR_TERMINAL_UNDERLINE;
          -- field is terminated by any character except
          -- extended digit (letters a to f and digits),
          -- or underline
          exit SCAN_FOR_BASED_INTEGER;  -- this loop
      end case;

    end loop SCAN_FOR_BASED_INTEGER;
    -- Next_Char already updated

  end SCAN_BASED_INTEGER;

  ------------------------------------------------------------------
  procedure SCAN_INTEGER is

  --| Overview
  --|
  --| Note the following LRM Sections:
  --|     LRM Section 2.4   - Numeric Literals
  --|     LRM Section 2.4.1 - Decimal Literals
  --|     LRM Section 2.4.1 - Notes
  --|
  begin

  -- scan source file for rest of the field
  -- note that first character of the field is stored first
    SCAN_FOR_INTEGER : loop

      ADD_NEXT_CHAR_TO_SOURCE_REP;

      -- set up for processing next character
      GET_NEXT_CHAR;

      case NEXT_CHAR is
        when DIGIT =>
        -- rest of action is at start of next loop cycle
          null;
        when ASCII.UNDERLINE =>  -- '_'
          CHECK_FOR_CONSECUTIVE_UNDERLINES;
        when others =>
          CHECK_FOR_TERMINAL_UNDERLINE;

          -- field is terminated by any character except
          --     digit, or underline
          exit SCAN_FOR_INTEGER;  -- this loop
      end case;

    end loop SCAN_FOR_INTEGER;  -- Next_Char already updated

  end SCAN_INTEGER;

  ------------------------------------------------------------------
  procedure SCAN_NUMERIC_LITERAL is

    --| Overview
    --|
    --| Note the following LRM Sections:
    --|     LRM Section 2.4   - Numeric Literals
    --|     LRM Section 2.4.1 - Decimal Literals
    --|     LRM Section 2.4.1 - Notes
    --|     LRM Section 2.4.2 - Based Literals
    --|     LRM Section 2.10  - Allowed Replacements of Characters
    --|

    ------------------------------------------------------------------
    -- Declarations for Scan_Numeric_Literal
    ------------------------------------------------------------------
    BASED_LITERAL_DELIMITER : CHARACTER;

    --| holds value of first based_literal delimeter:
    --| ASCII.COLON (':') or ASCII.SHARP ('#');
    --| so the second one can be checked to be identical.
    BASE_BEING_USED         : GC.PARSERINTEGER;

  --| base value to be passed to Scan_Based_Literal.

  ------------------------------------------------------------------
  begin

    CST.GRAM_SYM_VAL := PT.NUMERICTOKENVALUE;

    WORK_STRING_LENGTH := 0;
    -- also used by sub-scanners called from this subprogram.

    -- Scan first field
    SCAN_INTEGER;

    -- Now, scan rest of literal dependent on what Next_char is
    case NEXT_CHAR is

    -- have a decimal_literal
      when '.' =>
        if (LOOK_AHEAD(1) = '.') then
        -- next token is a range double delimiter.
        -- finished with numeric_literal.
          SEEN_RADIX_POINT := FALSE;  -- have an integer_literal
          -- already set_up for next scanner,
          -- no call to Get_Next_Char.
        else
          SEEN_RADIX_POINT := TRUE;
          ADD_NEXT_CHAR_TO_SOURCE_REP;
          GET_NEXT_CHAR;
          case NEXT_CHAR is
            when DIGIT =>
              SCAN_INTEGER;
              -- check and flag multiple radix points
              while (NEXT_CHAR = '.') and then (LOOK_AHEAD(1) in DIGIT) loop
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                  TOO_MANY_RADIX_POINTS);
                ADD_NEXT_CHAR_TO_SOURCE_REP;
                GET_NEXT_CHAR;
                SCAN_INTEGER;
              end loop;
            when ASCII.UNDERLINE =>  -- '_'
            -- flag illegal leading under line
              LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                LEADING_UNDERLINE);
              SCAN_INTEGER;
              -- not flagging an integer consisting of a
              -- single underline as a trailing radix
              -- point case.  Check and flag multiple radix
              -- points.
              while (NEXT_CHAR = '.') and then (LOOK_AHEAD(1) in DIGIT) loop
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                  TOO_MANY_RADIX_POINTS);
                ADD_NEXT_CHAR_TO_SOURCE_REP;
                GET_NEXT_CHAR;
                SCAN_INTEGER;
              end loop;
            when others =>
            -- flag trailing radix point as an error
              LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                DIGIT_NEEDED_AFTER_RADIX_POINT);
          end case;

          SCAN_EXPONENT;  -- check for and process exponent

        end if;

        -- have a based_literal
      when ASCII.SHARP |  -- '#'
      ASCII.COLON =>  -- ':'
        BASED_LITERAL_DELIMITER := NEXT_CHAR;
        BASE_BEING_USED := GC.PARSERINTEGER'VALUE(WORK_STRING(1 ..
          WORK_STRING_LENGTH));
        if (BASE_BEING_USED not  in VALID_BASE_RANGE) then
        -- flag illegal bases as errors
          LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, WORK_STRING(1 ..
            WORK_STRING_LENGTH), LEM.BASE_OUT_OF_LEGAL_RANGE_USE_16);
          BASE_BEING_USED := 16;
          -- we use the maximum base to pass all the
          -- extended_digits as legal.
        end if;

        ADD_NEXT_CHAR_TO_SOURCE_REP;  -- save the base delimiter
        GET_NEXT_CHAR;

        case NEXT_CHAR is
          when 'A' .. 'F' | 'a' .. 'f' | DIGIT =>
            SCAN_BASED_INTEGER(BASE_BEING_USED);
          when ASCII.UNDERLINE =>  -- '_'
          -- flag illegal leading under line
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
              LEADING_UNDERLINE);
            -- not flagging an integer consisting of a single
            -- under line as a trailing radix point case.
            SCAN_BASED_INTEGER(BASE_BEING_USED);
          when '.' =>
          -- flag leading radix point as an error
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
              DIGIT_NEEDED_BEFORE_RADIX_POINT);
          when ASCII.SHARP |  -- '#'
          ASCII.COLON =>  -- ':'
          -- flag missing field as an error
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
              NO_INTEGER_IN_BASED_NUMBER);

            -- based_literal_delimiter_mismatch handled in
            -- next case statement.
          when others =>
          -- flag missing field as an error
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
              NO_INTEGER_IN_BASED_NUMBER);
        end case;

        case NEXT_CHAR is
          when '.' =>
            SEEN_RADIX_POINT := TRUE;  -- have a real_literal
            ADD_NEXT_CHAR_TO_SOURCE_REP;

            GET_NEXT_CHAR;
            case NEXT_CHAR is
              when 'A' .. 'F' | 'a' .. 'f' | DIGIT =>
                SCAN_BASED_INTEGER(BASE_BEING_USED);
                -- check and flag multiple radix points
                while (NEXT_CHAR = '.') and then ((LOOK_AHEAD(1) in DIGIT) or (
                  LOOK_AHEAD(1) in 'A' .. 'F') or (LOOK_AHEAD(1) in 'a' .. 'f'))
                  loop
                  LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                    TOO_MANY_RADIX_POINTS);
                  ADD_NEXT_CHAR_TO_SOURCE_REP;
                  GET_NEXT_CHAR;
                  SCAN_BASED_INTEGER(BASE_BEING_USED);
                end loop;
              when ASCII.UNDERLINE =>  -- '_'
              -- flag illegal leading under lined
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                  LEADING_UNDERLINE);
                -- not flagging an integer consisting of
                -- a single underline as a trailing
                -- radix point case.
                SCAN_BASED_INTEGER(BASE_BEING_USED);
              when others =>
              -- flag trailing radix point as an error
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                  DIGIT_NEEDED_AFTER_RADIX_POINT);
            end case;

            case NEXT_CHAR is
              when ASCII.SHARP |  -- '#'
              ASCII.COLON =>  -- ':'

                ADD_NEXT_CHAR_TO_SOURCE_REP;
                -- save the base delimiter

                if (NEXT_CHAR /= BASED_LITERAL_DELIMITER) then
                -- flag based_literal delimiter
                -- mismatch as an error
                  LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, "Opener: " &
                    BASED_LITERAL_DELIMITER & " Closer: " & NEXT_CHAR, LEM.
                    BASED_LITERAL_DELIMITER_MISMATCH);
                end if;

                GET_NEXT_CHAR;  -- after base delimiter
                -- check for and process exponent
                SCAN_EXPONENT;

              when others =>
              -- flag missing second
              -- based_literal delimiter as an error
                LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
                  MISSING_SECOND_BASED_LITERAL_DELIMITER);
            end case;

          when ASCII.SHARP |  -- '#'
          ASCII.COLON =>  -- ':'
          -- have an integer_literal
            SEEN_RADIX_POINT := FALSE;
            -- save the base delimiter
            ADD_NEXT_CHAR_TO_SOURCE_REP;

            if (NEXT_CHAR /= BASED_LITERAL_DELIMITER) then
            -- flag based_literal delimiter mismatch error
              LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, "Opener: " &
                BASED_LITERAL_DELIMITER & " Closer: " & NEXT_CHAR, LEM.
                BASED_LITERAL_DELIMITER_MISMATCH);
            end if;

            GET_NEXT_CHAR;  -- get character after base delimiter
            SCAN_EXPONENT;  -- check for and process exponent

          when others =>
          -- assume an integer_literal
            SEEN_RADIX_POINT := FALSE;
            -- flag missing second
            -- based_literal delimiter as an error
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
              MISSING_SECOND_BASED_LITERAL_DELIMITER);
        end case;

        --we have an integer_literal
      when others =>
        SEEN_RADIX_POINT := FALSE;  -- have an integer_literal
        SCAN_EXPONENT;  -- check for and process exponent
    end case;

    -- one last error check
    if (NEXT_CHAR in UPPER_CASE_LETTER) or (NEXT_CHAR in LOWER_CASE_LETTER)
      then
    -- flag missing space between numeric_literal and
    -- identifier (including RW) as an error.
      LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
        SPACE_MUST_SEPARATE_NUM_AND_IDS);
    end if;

    -- now store the source representation of the token found.
    SET_CST_SOURCE_REP(WORK_STRING(1 .. WORK_STRING_LENGTH));

  end SCAN_NUMERIC_LITERAL;

  ------------------------------------------------------------------
  procedure SCAN_STRING_LITERAL is

    --| Overview
    --|
    --| Note the following LRM Sections:
    --|     LRM Section 2.6  - String Literals
    --|     LRM Section 2.6  - Note
    --|     LRM Section 2.10 - Allowed Replacements of Characters
    --|
    STRING_DELIMITER : CHARACTER := NEXT_CHAR;

  begin

    WORK_STRING_LENGTH := 0;

    CST.GRAM_SYM_VAL := PT.STRINGTOKENVALUE;

    -- scan until matching string delimiter or end of line is found
    SCAN_FOR_STRING : loop
      GET_NEXT_CHAR;

      if (NEXT_CHAR = STRING_DELIMITER) then
        GET_NEXT_CHAR;
        if (NEXT_CHAR = STRING_DELIMITER) then
        -- add one string delimiter to growing string
          ADD_NEXT_CHAR_TO_SOURCE_REP;
        else  -- string is ended
          exit SCAN_FOR_STRING;
        end if;
      elsif (NEXT_CHAR in GRAPHIC_CHARACTER) then
      -- add graphic character to growing string
        ADD_NEXT_CHAR_TO_SOURCE_REP;
      elsif (NEXT_CHAR in END_OF_LINE_CHARACTER) then
      -- string is ended. flag the error.
        LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, LEM.
          NO_ENDING_STRING_DELIMITER);
        exit SCAN_FOR_STRING;
      else  -- flag non-graphic characters as errors
        LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, INTEGER'IMAGE(CHARACTER
          'POS(NEXT_CHAR))
        -- convert to string
        , LEM.ONLY_GRAPHIC_CHARACTERS_IN_STRINGS);
      end if;

    end loop SCAN_FOR_STRING;  -- Next_Char already updated

    -- now store the source representation found without the
    -- string delimiters
    SET_CST_SOURCE_REP(WORK_STRING(1 .. WORK_STRING_LENGTH));

    return;

  end SCAN_STRING_LITERAL;

  ------------------------------------------------------------------
  function SHOW_CURRENT_LINE return SP.SOURCE_LINE is

  --| Overview
  --| Return current line number
  begin

    return CURRENT_LINE;

  end SHOW_CURRENT_LINE;

------------------------------------------------------------------
end LEX;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--lexidval.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::



----------------------------------------------------------------------

with GRAMMAR_CONSTANTS;  -- constants from the parser generator
use GRAMMAR_CONSTANTS;
--| to gain visibility on ParserInteger's operations

package body LEX_IDENTIFIER_TOKEN_VALUE is

--| Overview
--|
--| This perfect hash algorithm taken from
--|  "A Perfect Hash Function for Ada Reserved Words"
--|  by David Wolverton, published in Ada Letters Jul-Aug 1984
--|
  use PARSETABLES;
  package PT renames PARSETABLES;

  ------------------------------------------------------------------
  -- Declarations Local to Package Lex_Identifier_Token_Value
  ------------------------------------------------------------------

  subtype HASHRANGE is INTEGER;
  subtype HASHIDENTIFIERSUBRANGE is HASHRANGE range 0 .. 70;

  type XLATEARRAY is array(CHARACTER) of HASHRANGE;
  XLATE : constant XLATEARRAY := XLATEARRAY'('A' => 0, 'B' => 49, 'C' => 0, 'D'
    =>  -7, 'E' =>  -20, 'F' => 18, 'G' =>  -2, 'H' =>  -38, 'I' => 33, 'J' =>
    0, 'K' =>  -9, 'L' => 9, 'M' => 29, 'N' =>  -9, 'O' => 6, 'P' => 26, 'Q' =>
    0, 'R' => 8, 'S' => 1, 'T' => 1, 'U' =>  -9, 'V' => 0, 'W' => 56, 'X' =>  -
    28, 'Y' => 11, 'Z' => 0, others => 0);

  type HASHTABLEARRAY is array(HASHIDENTIFIERSUBRANGE) of PARSETABLES.TOKENRANGE
    ;
  --| Mapping from hash value into the token values.

  HASHTABLE  : constant HASHTABLEARRAY := HASHTABLEARRAY'(40 => 2,  -- ABORT
  6 => 3,  -- ABS
  37 => 4,  -- ACCEPT
  43 => 5,  -- ACCESS
  34 => 6,  -- ALL
  22 => 7,  -- AND
  16 => 8,  -- ARRAY
  3 => 9,  -- AT
  61 => 10,  -- BEGIN
  70 => 11,  -- BODY
  20 => 12,  -- CASE
  35 => 13,  -- CONSTANT
  14 => 14,  -- DECLARE
  9 => 15,  -- DELAY
  36 => 16,  -- DELTA
  38 => 17,  -- DIGITS
  7 => 18,  -- DO
  0 => 19,  -- ELSE
  19 => 20,  -- ELSIF
  2 => 21,  -- END
  30 => 22,  -- ENTRY
  8 => 23,  -- EXCEPTION
  1 => 24,  -- EXIT
  57 => 25,  -- FOR
  45 => 26,  -- FUNCTION
  21 => 27,  -- GENERIC
  46 => 28,  -- GOTO
  69 => 29,  -- IF
  42 => 30,  -- IN
  52 => 31,  -- IS
  17 => 32,  -- LIMITED
  67 => 33,  -- LOOP
  53 => 34,  -- MOD
  58 => 35,  -- NEW
  23 => 36,  -- NOT
  26 => 37,  -- NULL
  54 => 38,  -- OF
  44 => 39,  -- OR
  47 => 40,  -- OTHERS
  50 => 41,  -- OUT
  25 => 42,  -- PACKAGE
  56 => 43,  -- PRAGMA
  51 => 44,  -- PRIVATE
  49 => 45,  -- PROCEDURE
  29 => 46,  -- RAISE
  5 => 47,  -- RANGE
  41 => 48,  -- RECORD
  48 => 49,  -- REM
  24 => 50,  -- RENAMES
  39 => 51,  -- RETURN
  31 => 52,  -- REVERSE
  12 => 53,  -- SELECT
  27 => 54,  -- SEPARATE
  18 => 55,  -- SUBTYPE
  32 => 56,  -- TASK
  28 => 57,  -- TERMINATE
  4 => 58,  -- THEN
  15 => 59,  -- TYPE
  10 => 60,  -- USE
  59 => 61,  -- WHEN
  63 => 62,  -- WHILE
  60 => 63,  -- WITH
  11 => 64,  -- XOR
  others => PT.IDENTIFIERTOKENVALUE);

  --| These are used to convert lower to upper case.
  CONVERT    : array(CHARACTER) of CHARACTER;
  DIFFERENCE : constant := CHARACTER'POS('a') - CHARACTER'POS('A');

  ------------------------------------------------------------------
  -- Subprogram Specifications Local to
  -- Package Lex_Identifier_Token_Value
  ------------------------------------------------------------------

  function NORMALIZETOUPPERCASE( --| normalize SYMREP to upper case
                                IN_STRING : in STRING) return STRING;

  ------------------------------------------------------------------
  -- Subprogram Bodies Global to Package Lex_Identifier_Token_Value
  ------------------------------------------------------------------

  procedure FIND(IN_IDENTIFIER   : in STRING;
                 OUT_TOKEN_VALUE : out PARSETABLES.TOKENRANGE) is

    subtype ID_STRING is STRING(IN_IDENTIFIER'range );

    IN_IDENTIFIER_NORMALIZED : ID_STRING;

    LENGTH                   : HASHRANGE := IN_IDENTIFIER_NORMALIZED'LENGTH;
    --| Length of string

    FIRST                    : HASHRANGE := IN_IDENTIFIER_NORMALIZED'FIRST;
    --| Lower bound

    FIRSTCHAR, LASTCHAR      : CHARACTER;
    --| First and last characters

    SECONDTOLASTCHAR         : CHARACTER;
    --| Second to last character

    SECONDTOLAST             : HASHRANGE;
    --| Alphabetic position of 2nd to last char.

    HASHVALUE                : HASHRANGE;
    --| Perfect hash value.

    TOKENVALUE               : PARSETABLES.GRAMMARSYMBOLRANGE;

  begin
    IN_IDENTIFIER_NORMALIZED := NORMALIZETOUPPERCASE(IN_IDENTIFIER);

    -- Assume In_Identifier is a plain identifier.
    OUT_TOKEN_VALUE := PT.IDENTIFIERTOKENVALUE;

    if (LENGTH <= 1) or else (LENGTH >= 10) then

      -- Couldn't be a reserved word.
      return;
    else
      FIRSTCHAR := IN_IDENTIFIER_NORMALIZED(FIRST);
      LASTCHAR := IN_IDENTIFIER_NORMALIZED((FIRST + LENGTH) - 1);
      SECONDTOLASTCHAR := IN_IDENTIFIER_NORMALIZED((FIRST + LENGTH) - 2);
      SECONDTOLAST := CHARACTER'POS(SECONDTOLASTCHAR) - CHARACTER'POS('A');
      HASHVALUE := XLATE(FIRSTCHAR) + XLATE(LASTCHAR) + 2*SECONDTOLAST + LENGTH
        ;
    end if;

    if HASHVALUE in HASHIDENTIFIERSUBRANGE then

      -- index and see if it matches a reserved word value.
      -- if so, then compare the string to the reserved word text.
      TOKENVALUE := PARSETABLES.GRAMMARSYMBOLRANGE(HASHTABLE(HASHVALUE));

      -- conversion
      if TOKENVALUE /= PT.IDENTIFIERTOKENVALUE then
        if (IN_IDENTIFIER_NORMALIZED = PT.GET_GRAMMAR_SYMBOL(TOKENVALUE)) then
          OUT_TOKEN_VALUE := PT.TOKENRANGE(TOKENVALUE);

        -- conversion
        end if;
      end if;
    end if;
  end FIND;

  ------------------------------------------------------------------
  -- Subprogram Bodies Local to
  -- Package Lex_Identifier_Token_Value
  ------------------------------------------------------------------

  function NORMALIZETOUPPERCASE( --| normalize SYMREP to upper case
                                IN_STRING : in STRING) return STRING is

    OUTSTRING : STRING(IN_STRING'range );

  begin
    for I in IN_STRING'range loop
      OUTSTRING(I) := CONVERT(IN_STRING(I));
    end loop;
    return OUTSTRING;
  end NORMALIZETOUPPERCASE;

  ------------------------------------------------------------------

begin

  --| Initialize the conversion array for lower to upper case conversion
  for I in CHARACTER loop
    case I is
      when 'a' .. 'z' =>
        CONVERT(I) := CHARACTER'VAL(CHARACTER'POS(I) - DIFFERENCE);
      when others =>
        CONVERT(I) := I;
    end case;
  end loop;

------------------------------------------------------------------
end LEX_IDENTIFIER_TOKEN_VALUE;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--pdecls.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


----------------------------------------------------------------------

package body PARSERDECLARATIONS is

  subtype DUMP_STRING_RANGE_PLUS_ZERO is STANDARD.NATURAL range 0 .. 4000;

  DUMP_STRING        : STRING(1 .. DUMP_STRING_RANGE_PLUS_ZERO'LAST);

  DUMP_STRING_LENGTH : DUMP_STRING_RANGE_PLUS_ZERO;
  -- must be set to zero before each use.

  ------------------------------------------------------------------
  -- Subprograms Local to Package ParserDeclarations
  ------------------------------------------------------------------

  procedure APPEND_TO_DUMP_STRING( --| Add In_String to Dump_String
                                  IN_STRING : in STRING --| String to append
                                  );

  --| Effects

  --| This subprogram appends In_String to the package Body global
  --| Dump_String.

  --| Modifies
  --|
  --| Dump_String
  --| Dump_String_Length

  ------------------------------------------------------------------
  -- Subprogram Bodies Global to Package ParserDeclarations
  -- (declared in package specification).
  ------------------------------------------------------------------

  function GET_SOURCE_TEXT(IN_SOURCE_TEXT : in SOURCE_TEXT) return STRING is

  begin

    if (IN_SOURCE_TEXT = NULL_SOURCE_TEXT) then
      return "";
    else
      return IN_SOURCE_TEXT.all;
    end if;

  end GET_SOURCE_TEXT;

  ------------------------------------------------------------------

  procedure PUT_SOURCE_TEXT(IN_STRING          : in STRING;
                            IN_OUT_SOURCE_TEXT : in out SOURCE_TEXT) is

  begin

    IN_OUT_SOURCE_TEXT := new STRING'(IN_STRING);

  end PUT_SOURCE_TEXT;

  ------------------------------------------------------------------

  function DUMP_PARSE_STACK_ELEMENT(IN_PSE : in PARSESTACKELEMENT) return STRING
    is

  --| Notes

  --| Abbreviations used in this compilation unit
  --|
  --| PSE : ParseStackElement
  --|

  begin

    DUMP_STRING_LENGTH := 0;

    -- Output data common to all ParseStackElements
    APPEND_TO_DUMP_STRING("Element Kind:  " & PT.GET_GRAMMAR_SYMBOL(IN_PSE.
      GRAM_SYM_VAL) & " "

    -- give extra space to help highlight delimiters
    );

    -- Output data common to all lexed_tokens
    APPEND_TO_DUMP_STRING(" Token - Line: " & SP.SOURCE_LINE'IMAGE(IN_PSE.
      LEXED_TOKEN.SRCPOS_LINE) & " Column: " & SP.SOURCE_COLUMN'IMAGE(IN_PSE.
      LEXED_TOKEN.SRCPOS_COLUMN));

    APPEND_TO_DUMP_STRING(" Text: %" & GET_SOURCE_TEXT(IN_PSE.LEXED_TOKEN.TEXT)
      & "%");

    -- Finally, finish up the message
    APPEND_TO_DUMP_STRING("");

    return DUMP_STRING(1 .. DUMP_STRING_LENGTH);

  end DUMP_PARSE_STACK_ELEMENT;

  ------------------------------------------------------------------
  -- Subprogram Bodies Local to Package ParserDeclarations
  ------------------------------------------------------------------

  procedure APPEND_TO_DUMP_STRING(IN_STRING : in STRING --| String to append
                                  ) is

  begin

    DUMP_STRING((DUMP_STRING_LENGTH + 1) .. (DUMP_STRING_LENGTH + IN_STRING'LAST
      )) := IN_STRING;

    DUMP_STRING_LENGTH := DUMP_STRING_LENGTH + IN_STRING'LENGTH;

  end APPEND_TO_DUMP_STRING;

  ------------------------------------------------------------------

end PARSERDECLARATIONS;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--parsestk.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

-- $Source: /nosc/work/parser/RCS/ParseStk.spc,v $
-- $Revision: 4.0 $ -- $Date: 85/02/19 11:33:03 $ -- $Author: carol $

----------------------------------------------------------------------

with PARSERDECLARATIONS;  -- declarations for the Parser
use PARSERDECLARATIONS;

package PARSESTACK is  --| Elements awaiting parsing

--| Overview
--|
--| The ParseStack used by the parser.
--|
--| This data structure has the following sets of operations:
--|
--| 1) A set that add and delete elements.  This set can
--| raise the exceptions: UnderFlow and OverFlow.
--| The set includes:
--|
--|     Pop
--|     Push
--|     Reduce
--|
--| 2) A function that returns the number of elements in the
--| data structure. This set raises no exceptions.
--| The set includes:
--|
--|     Length

--|
--| Notes
--|
--|     Under some implementations the exception
--| ParserDeclarations.MemoryOverflow could be raised.
--|

  package PD renames PARSERDECLARATIONS;

  ------------------------------------------------------------------
  -- Declarations Global to Package ParseStack
  ------------------------------------------------------------------

  OVERFLOW  : exception;
  --| raised if no more space in stack.
  UNDERFLOW : exception;
  --| raised if no more elements in stack.

  ------------------------------------------------------------------

  procedure PUSH( --| Adds new top element to stack
                 ELEMENT : in PD.PARSESTACKELEMENT);  --| element to add

  --| Raises
  --|
  --| OverFlow - no more space in stack.

  --| Effects
  --|
  --| This subprogram adds an element to the top of the stack.
  --|

  ------------------------------------------------------------------

  function POP --| Removes top element in stack
  return PD.PARSESTACKELEMENT;

  --| Raises
  --|
  --| UnderFlow - no more elements in stack.

  --| Effects
  --|
  --| This subprogram obtains the element at the top of the stack.
  --|

  ------------------------------------------------------------------

  function LENGTH --| Returns the number of
  --| elements in the stack
  return PD.STATEPARSESTACKSINDEX;

  --| Effects
  --|
  --| This subprogram returns the number of elements in the stack.
  --|

  ----------------------------------------------------------------------

  procedure REDUCE( --| Pops and discards top n elements on
  --| the stack.
                   TOPN : in PD.STATEPARSESTACKSINDEX);
  --| Number of elements to pop.

  --| Raises
  --|
  --| Underflow - no more elements in stack.

  --| Effects
  --|
  --| Pops and discards top N elements on the stack.
  --| If TopN is greater than the number of elements in the stack,
  --| Underflow is raised.
  --| This subprogram is used by the parser to reduce the stack during
  --| a reduce action.
  --| This stack reduction could be done with a for loop and
  --| the Pop subprogram at a considerable cost in execution time.
  --|

  ----------------------------------------------------------------------

end PARSESTACK;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--statestk.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

-- $Source: /nosc/work/parser/RCS/StateStk.spc,v $
-- $Revision: 4.0 $ -- $Date: 85/02/19 11:43:44 $ -- $Author: carol $

----------------------------------------------------------------------

with PARSERDECLARATIONS;  -- declarations for the Parser
use PARSERDECLARATIONS;

package STATESTACK is  --| Elements awaiting parsing

--| Overview
--|
--| The StateStack used by the parser.
--|
--| This data structure has the following sets of operations:
--|
--| 1) A set that add and delete elements.
--| This set can raise the exceptions Underflow and Overflow.
--| The set includes:
--|
--|     Pop
--|     Push
--|     Reduce
--|
--| 2) A function that returns the number of elements in the
--| data structure.
--| This set raises no exceptions.
--| The set includes:
--|
--|     Length
--|
--| 3) A copy operations, to return the top of the stack.
--| The exception, UnderFlow,
--| is utilized to indicate the end of a sequential examination.
--| The set includes:
--|
--|     CopyTop
--|     InitCopy
--|     CopyNext

--| Notes
--|
--|     Under some implementations the exception
--| ParserDeclarations.MemoryOverflow could be raised.
--|

------------------------------------------------------------------
-- Declarations Global to Package StateStack
------------------------------------------------------------------

  OVERFLOW  : exception;
  --| raised if no more space in stack.
  UNDERFLOW : exception;
  --| raised if no more elements in stack.

  ------------------------------------------------------------------

  procedure PUSH( --| Adds new top element to stack
                 ELEMENT : in STATESTACKELEMENT);  --| element to add

  --|
  --| Raises
  --|
  --| OverFlow - no more space in stack.

  --| Effects
  --|
  --| This subprogram adds an element to the top of the stack.
  --|

  ------------------------------------------------------------------

  function POP return STATESTACKELEMENT;  --| Removes top element in stack

  --| Raises
  --|
  --| UnderFlow - no more elements in stack.

  --| Effects
  --|
  --| This subprogram pops the element at the top of the stack.
  --|

  ------------------------------------------------------------------

  function COPYTOP return STATESTACKELEMENT;
  --| Copy top element in stack

  --| Raises
  --|
  --| UnderFlow - no more elements in stack.
  --|

  --| Effects
  --|
  --| Returns the top of the stack.

  ------------------------------------------------------------------

  function COPYNEXT return STATESTACKELEMENT;
  --| Copy element after previous one copied

  --| Raises
  --|
  --| UnderFlow - no more elements in stack.

  --| Effects
  --|
  --| This subprogram is used in conjunction with
  --| CopyTop or Init Copy to sequentially examine the stack.
  --|

  ------------------------------------------------------------------

  function LENGTH return STATEPARSESTACKSINDEX;
  --| Returns the number of elements in the stack

  --| Effects
  --|
  --| This subprogram returns the number of elements in the stack.
  --|

  ------------------------------------------------------------------

  procedure INITCOPY;  --| Initialize sequential examination of
  --| the data structure

  --| Effects
  --|
  --| Initializes the copy function,
  --| so that subsequent calls to CopyNext will sequentially examine
  --| the elements in the data structure.
  --|

  ------------------------------------------------------------------

  function COPYTHISONE( --| returns element given by parm 'which_one'
                       WHICH_ONE : in STATEPARSESTACKSRANGE) return
    STATESTACKELEMENT;

  --| Overview
  --|
  --| Returns the state stack element indicated by the parameter
  --| 'which_one'.  This operation is needed by LocalStateStack
  --| because, in essence, the state stack is being copied in two
  --| nested loops and the Next_To_Copy counter can therefore only
  --| be used for one of the series of copies.

  ------------------------------------------------------------------

  procedure REDUCE( --| Pops and discards top n elements on
  --| the stack.
                   TOPN : in STATEPARSESTACKSINDEX);
                                      --| Number of elements to pop.

  --| Raises:
  --|
  --| Underflow - no more elements in stack.

  --| Effects
  --|
  --| Pops and discards TopN elements on the stack.
  --| If TopN is greater than the number of elements in the stack,
  --| Underflow is raised.
  --| This subprogram is used by the parser to reduce the stack during
  --| a reduce action.
  --| This stack reduction could be done with a for
  --| loop and the Pop subprogram at a considerable cost in execution
  --| time.
  --|

  ------------------------------------------------------------------

end STATESTACK;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--parse.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

-- $Source: /nosc/work/parser/RCS/Parse.spc,v $
-- $Revision: 4.0 $ -- $Date: 85/02/19 11:48:41 $ -- $Author: carol $

----------------------------------------------------------------------

with PARSERDECLARATIONS;  -- declarations for the Parser
use PARSERDECLARATIONS;

package PARSER is

--| Notes
--|
--| WARNING:
--|
--| Some of the code for this package is in the grammar source that is
--| input to the parse table generator. One of the ouputs of the
--| parse table generator is the source for the body of the procedure
--| Apply_Actions used in this package. This procedure provides case
--| statements to select the number of the rule to be used.
--| This procedure is declared as separate subunits in the
--| body of this package. It is strongly recommended that
--| the code of these functions be kept integrated with the grammar
--| for the following reasons.
--|
--| 1) to keep the case select numbers consistent with the reduce
--| action numbers in the parse tables.
--|
--| 2) to associate each grammar rule with the code for its actions.
--|

  package PD renames PARSERDECLARATIONS;

  ------------------------------------------------------------------

  procedure APPLY_ACTIONS(RULE_NUMBER : in PT.LEFTHANDSIDERANGE);

  ------------------------------------------------------------------

  function PARSE --| NYU LALR style parser
  return PD.PARSESTACKELEMENT;

  --| Raises
  --|
  --| ParserDeclarations.MemoryOverflow
  --|

  --| Effects
  --|
  --| This parser takes input from a Lexer and parses it according
  --| to a set of grammar rules that have been converted into a set of
  --| ParseTables by the NYU LALR Parser Generator.

  --| Requires
  --|
  --| The parser expects the Lexer and other units it uses to be
  --| initialized.
  --|
  --| The units that stay the same for different grammars are:
  --|
  --| Parser.Parse (this subprogram)
  --| ParseStack
  --|
  --| The units that need to be changed for different grammars are:
  --|
  --| Parser.Apply_Actions
  --| Lex
  --| ParserDeclarations
  --| ParseTables
  --|

  --| Modifies
  --|
  --| The following are modified:
  --|
  --| ParseStack
  --|

  ------------------------------------------------------------------

end PARSER;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--parsestk.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

-- $Source: /nosc/work/parser/RCS/ParseStk.bdy,v $
-- $Revision: 4.0 $ -- $Date: 85/02/19 11:34:13 $ -- $Author: carol $

----------------------------------------------------------------------

with PARSETABLES;  -- state tables generated by parser
--     generator
use PARSETABLES;

with GRAMMAR_CONSTANTS; use GRAMMAR_CONSTANTS;
                                -- to have visibility on operations
-- on type ParserInteger declared there.
package body PARSESTACK is

--| Overview
--|
--| The data structure is implemented as an array.
--|

------------------------------------------------------------------
-- Declarations Global to Package Body ParseStack
------------------------------------------------------------------

  INDEX : PD.STATEPARSESTACKSINDEX := 0;
  --| top element in stack.

  SPACE : array(PD.STATEPARSESTACKSRANGE) of PD.PARSESTACKELEMENT;
  --| Storage used to hold stack elements

  ------------------------------------------------------------------
  -- Subprogram Bodies Global to Package ParseStack
  -- (declared in package specification).
  ------------------------------------------------------------------

  procedure PUSH(ELEMENT : in PD.PARSESTACKELEMENT) is

  begin

    if (INDEX >= PD.STATEPARSESTACKSRANGE'LAST) then
      raise OVERFLOW;
    end if;

    INDEX := INDEX + 1;
    SPACE(INDEX) := ELEMENT;

  end PUSH;

  ------------------------------------------------------------------

  function POP return PD.PARSESTACKELEMENT is

  begin

    if (INDEX < PD.STATEPARSESTACKSRANGE'FIRST) then
      raise UNDERFLOW;
    end if;

    INDEX := INDEX - 1;
    return SPACE(INDEX + 1);

  end POP;

  ------------------------------------------------------------------

  function LENGTH return PD.STATEPARSESTACKSINDEX is

  begin

    return INDEX;

  end LENGTH;

  ------------------------------------------------------------------

  procedure REDUCE(TOPN : in PD.STATEPARSESTACKSINDEX) is

  begin
    if (TOPN > INDEX) then
      raise UNDERFLOW;
    end if;

    INDEX := INDEX - TOPN;

  end REDUCE;  -- procedure

  ------------------------------------------------------------------

end PARSESTACK;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--statestk.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

-- $Source: /nosc/work/parser/RCS/StateStk.bdy,v $
-- $Revision: 4.0 $ -- $Date: 85/02/19 11:45:59 $ -- $Author: carol $

----------------------------------------------------------------------

with PARSETABLES;  -- state tables generated
-- by parser generator
use PARSETABLES;
with GRAMMAR_CONSTANTS;  -- constants generated by parser generator
use GRAMMAR_CONSTANTS;  -- to have visiblity on operations
-- on type ParserInteger.

package body STATESTACK is

--| Overview
--|
--| The data structure is implemented as an array.
--|

--| Notes
--|
--| Abbreviations used in this compilation unit:
--|
--| Init : used as prefix for Initialize
--|

------------------------------------------------------------------
-- Declarations Global to Package Body StateStack
------------------------------------------------------------------

  INDEX        : STATEPARSESTACKSINDEX := 0;
  --| top element in stack.
  NEXT_TO_COPY : STATEPARSESTACKSINDEX := 0;
  --| next element to copy in stack.

  SPACE        : array(STATEPARSESTACKSRANGE) of STATESTACKELEMENT;
  --| Storage used to hold stack elements


  ------------------------------------------------------------------
  -- Subprogram Bodies Global to Package StateStack
  -- (declared in package specification).
  ------------------------------------------------------------------

  procedure PUSH(ELEMENT : in STATESTACKELEMENT) is

  begin

    if (INDEX >= STATEPARSESTACKSRANGE'LAST) then
      raise OVERFLOW;
    end if;

    INDEX := INDEX + 1;
    SPACE(INDEX) := ELEMENT;

  end PUSH;

  ------------------------------------------------------------------

  function POP return STATESTACKELEMENT is

  begin

    if (INDEX < STATEPARSESTACKSRANGE'FIRST) then
      raise UNDERFLOW;
    end if;

    INDEX := INDEX - 1;
    return SPACE(INDEX + 1);

  end POP;

  ------------------------------------------------------------------

  function COPYTOP return STATESTACKELEMENT is

  begin

    INITCOPY;
    return COPYNEXT;

  end COPYTOP;

  ------------------------------------------------------------------

  function COPYNEXT return STATESTACKELEMENT is

  begin

    NEXT_TO_COPY := NEXT_TO_COPY - 1;

    if (NEXT_TO_COPY < STATEPARSESTACKSRANGE'FIRST) then
      raise UNDERFLOW;
    end if;

    return SPACE(NEXT_TO_COPY);

  end COPYNEXT;

  ------------------------------------------------------------------

  function LENGTH return STATEPARSESTACKSINDEX is

  begin

    return INDEX;

  end LENGTH;

  ------------------------------------------------------------------

  procedure INITCOPY is

  begin

    NEXT_TO_COPY := INDEX + 1;

  -- start examination here
  end INITCOPY;

  ------------------------------------------------------------------

  function COPYTHISONE( --| returns the which_oneth element
                       WHICH_ONE : in STATEPARSESTACKSRANGE) return
    STATESTACKELEMENT is

  begin

    if WHICH_ONE > INDEX then
      raise OVERFLOW;
    end if;

    return (SPACE(WHICH_ONE));

  end COPYTHISONE;

  ------------------------------------------------------------------

  procedure REDUCE(TOPN : in STATEPARSESTACKSINDEX) is

  begin

    if (TOPN > INDEX) then
      raise UNDERFLOW;
    end if;

    INDEX := INDEX - TOPN;

  end REDUCE;

  ------------------------------------------------------------------

end STATESTACK;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--PTBLS.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--+ PTBLS.BDY +--

package body ParseTables is
----------------------------------------------------------------------
-- The rest of the constants used to define the Parse Tables
----------------------------------------------------------------------

    DefaultValue : constant := 1 ; -- default for aggregates.

    ActionTableOneLength : constant GC.ParserInteger :=
         8610 ;
        --| Length (number of entries) in map ActionTableOne.
    subtype ActionTableOneRange is GC.ParserInteger
            range 1..ActionTableOneLength;

    ActionTableTwoLength : constant GC.ParserInteger :=
         8610 ;
        --| Length (number of entries) in map ActionTableTwo.
    subtype ActionTableTwoRange is GC.ParserInteger
            range 1..ActionTableTwoLength;

    DefaultMapLength : constant GC.ParserInteger :=
         1043 ;
        --| Length (number of entries) in map Defaults.
    subtype DefaultMapRange is GC.ParserInteger range 1..DefaultMapLength;

    FollowMapLength : constant GC.ParserInteger :=
          298 ;
        --| Length (number of entries) in the FollowMap.

    GrammarSymbolCountPlusOne : constant GC.ParserInteger :=
          395 ;
        --| Number of symbols plus one in the parse tables.
        -- NYU Reference Name: NUM_INPUTS

    ActionTableSize : constant GC.ParserInteger :=
         5737 ;
        --| Maximum entry in Action Tables referenced by hash
        --| function. Entries above TableSize are collision chains.
        -- NYU Reference Name: TABLE_SIZE

    ------------------------------------------------------------------
    -- Tables generated by Parse Tables Generator
    ------------------------------------------------------------------

    subtype GrammarSymbolRepRangePlusZero is
        GrammarSymbolRepRangePlusZeroCommon;

    GrammarSymbolTableIndex : constant
        array (GrammarSymbolRange'first .. GrammarSymbolRange'last * 2)
        of GC.ParserInteger :=
         (    1,    0,    1,    5,    6,    8,    9,   14,   15,   20
,   21,   23,   24,   26,   27,   31,   32,   33,   34,   38
,   39,   42,   43,   46,   47,   54,   55,   61,   62,   66
,   67,   71,   72,   77,   78,   79,   80,   83,   84,   88
,   89,   91,   92,   96,   97,  105,  106,  109,  110,  112
,  113,  120,  121,  127,  128,  131,  132,  133,  134,  135
,  136,  137,  138,  144,  145,  148,  149,  151,  152,  154
,  155,  157,  158,  161,  162,  163,  164,  165,  166,  171
,  172,  174,  175,  181,  182,  187,  188,  194,  195,  203
,  204,  208,  209,  213,  214,  219,  220,  222,  223,  229
,  230,  235,  236,  242,  243,  248,  249,  256,  257,  263
,  264,  267,  268,  276,  277,  280,  281,  284,  285,  287
,  288,  291,  292,  296,  297,  300,  301,  303,  304,  313
,  314,  328,  329,  342,  343,  359,  360,  360,  361,  361
,  362,  362,  363,  363,  364,  364,  365,  365,  366,  366
,  367,  367,  368,  368,  369,  369,  370,  370,  371,  371
,  372,  372,  373,  373,  374,  374,  375,  377,  378,  379
,  380,  381,  382,  383,  384,  385,  386,  387,  388,  389
,  390,  391,  392,  393,  394,  395,  396,  397,  398,  412
,  413,  416,  417,  420,  421,  431,  432,  461,  462,  467
,  468,  483,  484,  500,  501,  519,  520,  541,  542,  560
,  561,  578,  579,  599,  600,  620,  621,  640,  641,  658
,  659,  681,  682,  699,  700,  720,  721,  746,  747,  761
,  762,  779,  780,  793,  794,  802,  803,  830,  831,  837
,  838,  847,  848,  862,  863,  880,  881,  901,  902,  928
,  929,  952,  953,  967,  968,  982,  983,  992,  993, 1018
, 1019, 1047, 1048, 1058, 1059, 1085, 1086, 1108, 1109, 1128
, 1129, 1149, 1150, 1171, 1172, 1193, 1194, 1216, 1217, 1225
, 1226, 1235, 1236, 1257, 1258, 1273, 1274, 1298, 1299, 1320
, 1321, 1339, 1340, 1356, 1357, 1389, 1390, 1425, 1426, 1444
, 1445, 1472, 1473, 1490, 1491, 1515, 1516, 1545, 1546, 1561
, 1562, 1585, 1586, 1612, 1613, 1629, 1630, 1645, 1646, 1649
, 1650, 1663, 1664, 1680, 1681, 1685, 1686, 1705, 1706, 1720
, 1721, 1734, 1735, 1747, 1748, 1770, 1771, 1791, 1792, 1812
, 1813, 1836, 1837, 1848, 1849, 1862, 1863, 1882, 1883, 1918
, 1919, 1938, 1939, 1981, 1982, 1988, 1989, 2012, 2013, 2018
, 2019, 2027, 2028, 2051, 2052, 2067, 2068, 2071, 2072, 2095
, 2096, 2117, 2118, 2138, 2139, 2148, 2149, 2170, 2171, 2181
, 2182, 2190, 2191, 2205, 2206, 2217, 2218, 2226, 2227, 2243
, 2244, 2261, 2262, 2270, 2271, 2278, 2279, 2298, 2299, 2320
, 2321, 2329, 2330, 2363, 2364, 2384, 2385, 2411, 2412, 2441
, 2442, 2459, 2460, 2488, 2489, 2523, 2524, 2561, 2562, 2569
, 2570, 2592, 2593, 2614, 2615, 2637, 2638, 2666, 2667, 2694
, 2695, 2734, 2735, 2741, 2742, 2798, 2799, 2834, 2835, 2838
, 2839, 2845, 2846, 2879, 2880, 2885, 2886, 2915, 2916, 2939
, 2940, 2948, 2949, 2968, 2969, 2987, 2988, 3009, 3010, 3030
, 3031, 3050, 3051, 3073, 3074, 3086, 3087, 3098, 3099, 3107
, 3108, 3118, 3119, 3140, 3141, 3156, 3157, 3174, 3175, 3182
, 3183, 3193, 3194, 3213, 3214, 3227, 3228, 3239, 3240, 3255
, 3256, 3269, 3270, 3284, 3285, 3299, 3300, 3314, 3315, 3328
, 3329, 3342, 3343, 3354, 3355, 3368, 3369, 3382, 3383, 3397
, 3398, 3413, 3414, 3429, 3430, 3434, 3435, 3473, 3474, 3521
, 3522, 3551, 3552, 3560, 3561, 3580, 3581, 3650, 3651, 3682
, 3683, 3708, 3709, 3729, 3730, 3747, 3748, 3760, 3761, 3772
, 3773, 3786, 3787, 3801, 3802, 3834, 3835, 3848, 3849, 3892
, 3893, 3916, 3917, 3935, 3936, 3951, 3952, 3975, 3976, 3991
, 3992, 4014, 4015, 4040, 4041, 4050, 4051, 4054, 4055, 4076
, 4077, 4104, 4105, 4120, 4121, 4141, 4142, 4170, 4171, 4195
, 4196, 4211, 4212, 4246, 4247, 4272, 4273, 4284, 4285, 4299
, 4300, 4325, 4326, 4369, 4370, 4401, 4402, 4433, 4434, 4464
, 4465, 4481, 4482, 4508, 4509, 4565, 4566, 4590, 4591, 4604
, 4605, 4626, 4627, 4642, 4643, 4657, 4658, 4675, 4676, 4699
, 4700, 4746, 4747, 4772, 4773, 4790, 4791, 4807, 4808, 4828
, 4829, 4860, 4861, 4884, 4885, 4915, 4916, 4927, 4928, 4967
, 4968, 4980, 4981, 4991, 4992, 5023, 5024, 5053, 5054, 5060
, 5061, 5078, 5079, 5091, 5092, 5107, 5108, 5121, 5122, 5146
, 5147, 5153, 5154, 5178, 5179, 5195, 5196, 5215, 5216, 5226
, 5227, 5255, 5256, 5275, 5276, 5291, 5292, 5308, 5309, 5322
, 5323, 5369, 5370, 5387, 5388, 5413, 5414, 5429, 5430, 5448
, 5449, 5464, 5465, 5495, 5496, 5524, 5525, 5547, 5548, 5570
, 5571, 5588, 5589, 5610, 5611, 5629, 5630, 5651, 5652, 5675
, 5676, 5727, 5728, 5751, 5752, 5775, 5776, 5788, 5789, 5821
, 5822, 5835, 5836, 5863, 5864, 5886, 5887, 5905, 5906, 5921
, 5922, 5937, 5938, 5953, 5954, 5965, 5966, 5980, 5981, 5989
, 5990, 5998, 5999, 6052, 6053, 6077, 6078, 6090, 6091, 6103
, 6104, 6118, 6119, 6140, 6141, 6168, 6169, 6186, 6187, 6217
, 6218, 6229, 6230, 6248, 6249, 6271, 6272, 6302, 6303, 6317
, 6318, 6336, 6337, 6354, 6355, 6370, 6371, 6397, 6398, 6413
, 6414, 6432, 6433, 6458, 6459, 6489, 6490, 6515)  ;

    GrammarSymbolTable : constant String :=
         ('A','B','O','R','T','A','B','S','A','C'
,'C','E','P','T','A','C','C','E','S','S'
,'A','L','L','A','N','D','A','R','R','A'
,'Y','A','T','B','E','G','I','N','B','O'
,'D','Y','C','A','S','E','C','O','N','S'
,'T','A','N','T','D','E','C','L','A','R'
,'E','D','E','L','A','Y','D','E','L','T'
,'A','D','I','G','I','T','S','D','O','E'
,'L','S','E','E','L','S','I','F','E','N'
,'D','E','N','T','R','Y','E','X','C','E'
,'P','T','I','O','N','E','X','I','T','F'
,'O','R','F','U','N','C','T','I','O','N'
,'G','E','N','E','R','I','C','G','O','T'
,'O','I','F','I','N','I','S','L','I','M'
,'I','T','E','D','L','O','O','P','M','O'
,'D','N','E','W','N','O','T','N','U','L'
,'L','O','F','O','R','O','T','H','E','R'
,'S','O','U','T','P','A','C','K','A','G'
,'E','P','R','A','G','M','A','P','R','I'
,'V','A','T','E','P','R','O','C','E','D'
,'U','R','E','R','A','I','S','E','R','A'
,'N','G','E','R','E','C','O','R','D','R'
,'E','M','R','E','N','A','M','E','S','R'
,'E','T','U','R','N','R','E','V','E','R'
,'S','E','S','E','L','E','C','T','S','E'
,'P','A','R','A','T','E','S','U','B','T'
,'Y','P','E','T','A','S','K','T','E','R'
,'M','I','N','A','T','E','T','H','E','N'
,'T','Y','P','E','U','S','E','W','H','E'
,'N','W','H','I','L','E','W','I','T','H'
,'X','O','R','i','d','e','n','t','i','f'
,'i','e','r','n','u','m','e','r','i','c'
,'_','l','i','t','e','r','a','l','s','t'
,'r','i','n','g','_','l','i','t','e','r'
,'a','l','c','h','a','r','a','c','t','e'
,'r','_','l','i','t','e','r','a','l','&'
,''','(',')','*','+',',','-','.','/',':'
,';','<','=','>',''','|',''','=','>','.'
,'.','*','*',':','=','/','=','>','=','<'
,'=','<','<','>','>','<','>','c','o','m'
,'m','e','n','t','_','l','i','t','e','r'
,'a','l','$','E','O','F','$','A','C','C'
,'c','o','m','p','i','l','a','t','i','o'
,'n','g','e','n','e','r','a','l','_','c'
,'o','m','p','o','n','e','n','t','_','a'
,'s','s','o','c','i','a','t','i','o','n'
,'s','p','r','a','g','m','a','t','y','p'
,'e','_','d','e','c','l','a','r','a','t'
,'i','o','n','b','a','s','i','c','_','d'
,'e','c','l','a','r','a','t','i','o','n'
,'s','u','b','t','y','p','e','_','d','e'
,'c','l','a','r','a','t','i','o','n','s'
,'u','b','p','r','o','g','r','a','m','_'
,'d','e','c','l','a','r','a','t','i','o'
,'n','p','a','c','k','a','g','e','_','d'
,'e','c','l','a','r','a','t','i','o','n'
,'t','a','s','k','_','s','p','e','c','i'
,'f','i','c','a','t','i','o','n','g','e'
,'n','e','r','i','c','_','s','p','e','c'
,'i','f','i','c','a','t','i','o','n','g'
,'e','n','e','r','i','c','_','i','n','s'
,'t','a','n','t','i','a','t','i','o','n'
,'r','e','n','a','m','i','n','g','_','d'
,'e','c','l','a','r','a','t','i','o','n'
,'o','b','j','e','c','t','_','d','e','c'
,'l','a','r','a','t','i','o','n','b','a'
,'s','i','c','_','c','o','l','o','n','_'
,'d','e','c','l','a','r','a','t','i','o'
,'n','n','u','m','b','e','r','_','d','e'
,'c','l','a','r','a','t','i','o','n','e'
,'x','c','e','p','t','i','o','n','_','d'
,'e','c','l','a','r','a','t','i','o','n'
,'r','e','n','a','m','i','n','g','_','c'
,'o','l','o','n','_','d','e','c','l','a'
,'r','a','t','i','o','n','i','d','e','n'
,'t','i','f','i','e','r','_','l','i','s'
,'t','s','u','b','t','y','p','e','_','i'
,'n','d','i','c','a','t','i','o','n','['
,':','=','e','x','p','r','e','s','s','i'
,'o','n',']','s','t','a','r','t','_','c'
,'a','d','c','o','n','s','t','r','a','i'
,'n','e','d','_','a','r','r','a','y','_'
,'d','e','f','i','n','i','t','i','o','n'
,'e','n','d','_','c','a','d','e','x','p'
,'r','e','s','s','i','o','n','s','a','v'
,'e','_','i','d','e','n','t','i','f','i'
,'e','r','{',',','s','a','v','e','_','i'
,'d','e','n','t','i','f','i','e','r','}'
,'f','u','l','l','_','t','y','p','e','_'
,'d','e','c','l','a','r','a','t','i','o'
,'n','i','n','c','o','m','p','l','e','t'
,'e','_','t','y','p','e','_','d','e','c'
,'l','a','r','a','t','i','o','n','p','r'
,'i','v','a','t','e','_','t','y','p','e'
,'_','d','e','c','l','a','r','a','t','i'
,'o','n','t','y','p','e','_','i','d','e'
,'n','t','i','f','i','e','r','t','y','p'
,'e','_','d','e','f','i','n','i','t','i'
,'o','n','l','e','f','t','_','p','a','r'
,'e','n','d','i','s','c','r','i','m','i'
,'n','a','n','t','_','s','p','e','c','i'
,'f','i','c','a','t','i','o','n','{',';'
,'d','i','s','c','r','i','m','i','n','a'
,'n','t','_','s','p','e','c','i','f','i'
,'c','a','t','i','o','n','}','r','i','g'
,'h','t','_','p','a','r','e','n','e','n'
,'u','m','e','r','a','t','i','o','n','_'
,'t','y','p','e','_','d','e','f','i','n'
,'i','t','i','o','n','i','n','t','e','g'
,'e','r','_','t','y','p','e','_','d','e'
,'f','i','n','i','t','i','o','n','r','e'
,'a','l','_','t','y','p','e','_','d','e'
,'f','i','n','i','t','i','o','n','a','r'
,'r','a','y','_','t','y','p','e','_','d'
,'e','f','i','n','i','t','i','o','n','r'
,'e','c','o','r','d','_','t','y','p','e'
,'_','d','e','f','i','n','i','t','i','o'
,'n','a','c','c','e','s','s','_','t','y'
,'p','e','_','d','e','f','i','n','i','t'
,'i','o','n','d','e','r','i','v','e','d'
,'_','t','y','p','e','_','d','e','f','i'
,'n','i','t','i','o','n','t','y','p','e'
,'_','m','a','r','k','c','o','n','s','t'
,'r','a','i','n','t','t','y','p','e','_'
,'n','a','m','e','|','s','u','b','t','y'
,'p','e','_','n','a','m','e','r','a','n'
,'g','e','_','c','o','n','s','t','r','a'
,'i','n','t','f','l','o','a','t','i','n'
,'g','_','p','o','i','n','t','_','c','o'
,'n','s','t','r','a','i','n','t','f','i'
,'x','e','d','_','p','o','i','n','t','_'
,'c','o','n','s','t','r','a','i','n','t'
,'s','t','a','r','t','_','e','x','p','a'
,'n','d','e','d','_','n','a','m','e','s'
,'i','m','p','l','e','_','e','x','p','r'
,'e','s','s','i','o','n','e','n','u','m'
,'e','r','a','t','i','o','n','_','l','i'
,'t','e','r','a','l','_','s','p','e','c'
,'i','f','i','c','a','t','i','o','n','{'
,',','e','n','u','m','e','r','a','t','i'
,'o','n','_','l','i','t','e','r','a','l'
,'_','s','p','e','c','i','f','i','c','a'
,'t','i','o','n','}','e','n','u','m','e'
,'r','a','t','i','o','n','_','l','i','t'
,'e','r','a','l','f','l','o','a','t','i'
,'n','g','_','a','c','c','u','r','a','c'
,'y','_','d','e','f','i','n','i','t','i'
,'o','n','[','r','a','n','g','e','_','c'
,'o','n','s','t','r','a','i','n','t',']'
,'f','i','x','e','d','_','a','c','c','u'
,'r','a','c','y','_','d','e','f','i','n'
,'i','t','i','o','n','u','n','c','o','n'
,'s','t','r','a','i','n','e','d','_','a'
,'r','r','a','y','_','d','e','f','i','n'
,'i','t','i','o','n','i','n','d','e','x'
,'_','l','e','f','t','_','p','a','r','e'
,'n','i','n','d','e','x','_','s','u','b'
,'t','y','p','e','_','d','e','f','i','n'
,'i','t','i','o','n','{',',','i','n','d'
,'e','x','_','s','u','b','t','y','p','e'
,'_','d','e','f','i','n','i','t','i','o'
,'n','}','i','n','d','e','x','_','r','i'
,'g','h','t','_','p','a','r','e','n','i'
,'n','d','e','x','_','c','o','n','s','t'
,'r','a','i','n','t','n','a','m','e','d'
,'i','s','c','r','e','t','e','_','r','a'
,'n','g','e','{',',','d','i','s','c','r'
,'e','t','e','_','r','a','n','g','e','}'
,'r','a','n','g','e','s','t','a','r','t'
,'_','o','f','_','r','e','c','o','r','d'
,'_','t','y','p','e','r','e','c','o','r'
,'d','_','t','e','r','m','i','n','a','l'
,'c','o','m','p','o','n','e','n','t','_'
,'l','i','s','t','{','p','r','a','g','m'
,'a','_','d','e','c','l','}','{','c','o'
,'m','p','o','n','e','n','t','_','d','e'
,'c','l','a','r','a','t','i','o','n','}'
,'c','o','m','p','o','n','e','n','t','_'
,'d','e','c','l','a','r','a','t','i','o'
,'n','c','l','o','s','i','n','g','_','{'
,'p','r','a','g','m','a','_','d','e','c'
,'l','}','{','c','o','m','p','o','n','e'
,'n','t','_','d','e','c','l','a','r','a'
,'t','i','o','n','}',''','v','a','r','i'
,'a','n','t','_','p','a','r','t','n','u'
,'l','l','_','s','t','a','t','e','m','e'
,'n','t','C','A','S','E','_','_','i','d'
,'e','n','t','i','f','i','e','r','_','_'
,'I','S','{','p','r','a','g','m','a','_'
,'v','a','r','i','a','n','t','}','_','_'
,'v','a','r','i','a','n','t','_','_','{'
,'v','a','r','i','a','n','t','}','s','t'
,'a','r','t','_','r','e','c','o','r','d'
,'_','v','a','r','i','a','n','t','W','H'
,'E','N','_','_','v','a','r','i','a','n'
,'t','_','c','h','o','i','c','e','_','_'
,'{','|','v','a','r','i','a','n','t','_'
,'c','h','o','i','c','e','}','_','_','='
,'>','v','a','r','i','a','n','t','W','H'
,'E','N','_','_','v','a','r','i','a','n'
,'t','_','O','T','H','E','R','S','_','_'
,'=','>','c','h','o','i','c','e','s','t'
,'a','r','t','_','b','d','i','{','b','a'
,'s','i','c','_','d','e','c','l','a','r'
,'a','t','i','v','e','_','i','t','e','m'
,'}','d','e','c','l','a','r','a','t','i'
,'v','e','_','p','a','r','t','b','o','d'
,'y','{','l','a','t','e','r','_','d','e'
,'c','l','a','r','a','t','i','v','e','_'
,'i','t','e','m','}','b','a','s','i','c'
,'_','d','e','c','l','a','r','a','t','i'
,'v','e','_','i','t','e','m','r','e','p'
,'r','e','s','e','n','t','a','t','i','o'
,'n','_','c','l','a','u','s','e','u','s'
,'e','_','c','l','a','u','s','e','l','a'
,'t','e','r','_','d','e','c','l','a','r'
,'a','t','i','v','e','_','i','t','e','m'
,'p','r','o','p','e','r','_','b','o','d'
,'y','b','o','d','y','_','s','t','u','b'
,'s','u','b','p','r','o','g','r','a','m'
,'_','b','o','d','y','p','a','c','k','a'
,'g','e','_','b','o','d','y','t','a','s'
,'k','_','b','o','d','y','i','n','d','e'
,'x','e','d','_','c','o','m','p','o','n'
,'e','n','t','s','e','l','e','c','t','e'
,'d','_','c','o','m','p','o','n','e','n'
,'t','a','t','t','r','i','b','u','t','e'
,'s','e','l','e','c','t','o','r','a','t'
,'t','r','i','b','u','t','e','_','d','e'
,'s','i','g','n','a','t','o','r','c','o'
,'m','p','o','n','e','n','t','_','a','s'
,'s','o','c','i','a','t','i','o','n','s'
,'a','g','g','r','e','g','a','t','e','e'
,'x','p','r','e','s','s','i','o','n',','
,'e','x','p','r','e','s','s','i','o','n'
,'{',',','e','x','p','r','e','s','s','i'
,'o','n','}','[',',','o','t','h','e','r'
,'s','=','>','e','x','p','r','e','s','s'
,'i','o','n',']','c','h','o','i','c','e'
,'{','|','c','h','o','i','c','e','}','='
,'>','e','x','p','r','e','s','s','i','o'
,'n','{',',','c','h','o','i','c','e','{'
,'|','c','h','o','i','c','e','}','=','>'
,'e','x','p','r','e','s','s','i','o','n'
,'}','o','t','h','e','r','s','=','>','e'
,'x','p','r','e','s','s','i','o','n','g'
,'a','_','e','x','p','r','e','s','s','i'
,'o','n','{',',','g','a','_','e','x','p'
,'r','e','s','s','i','o','n','}','i','d'
,'e','n','t','i','f','i','e','r','{','|'
,'i','d','e','n','t','i','f','i','e','r'
,'}','=','>','e','x','p','r','e','s','s'
,'i','o','n','{',',','i','d','e','n','t'
,'i','f','i','e','r','{','|','i','d','e'
,'n','t','i','f','i','e','r','}','=','>'
,'e','x','p','r','e','s','s','i','o','n'
,'}','r','e','l','a','t','i','o','n','r'
,'e','l','a','t','i','o','n','{','A','N'
,'D','_','_','r','e','l','a','t','i','o'
,'n','}','r','e','l','a','t','i','o','n'
,'{','O','R','_','_','r','e','l','a','t'
,'i','o','n','}','r','e','l','a','t','i'
,'o','n','{','X','O','R','_','_','r','e'
,'l','a','t','i','o','n','}','r','e','l'
,'a','t','i','o','n','{','A','N','D','_'
,'_','T','H','E','N','_','_','r','e','l'
,'a','t','i','o','n','}','r','e','l','a'
,'t','i','o','n','{','O','R','_','_','E'
,'L','S','E','_','_','r','e','l','a','t'
,'i','o','n','}','[','r','e','l','a','t'
,'i','o','n','a','l','_','o','p','e','r'
,'a','t','o','r','_','_','s','i','m','p'
,'l','e','_','e','x','p','r','e','s','s'
,'i','o','n',']','[','N','O','T',']','I'
,'N','[','u','n','a','r','y','_','a','d'
,'d','i','n','g','_','o','p','e','r','a'
,'t','o','r',']','t','e','r','m','{','b'
,'i','n','a','r','y','_','a','d','d','i'
,'n','g','_','o','p','e','r','a','t','o'
,'r','_','_','t','e','r','m','}','f','a'
,'c','t','o','r','{','m','u','l','t','i'
,'p','l','y','i','n','g','_','o','p','e'
,'r','a','t','o','r','_','_','f','a','c'
,'t','o','r','}','t','e','r','m','p','r'
,'i','m','a','r','y','[','e','x','p','o'
,'n','e','n','t','i','a','t','i','n','g'
,'_','o','p','e','r','a','t','o','r','_'
,'_','p','r','i','m','a','r','y',']','f'
,'a','c','t','o','r','h','i','g','h','_'
,'p','r','e','c','e','d','e','n','c','e'
,'_','u','n','a','r','y','_','o','p','e'
,'r','a','t','o','r','p','a','r','e','n'
,'t','h','e','s','i','z','e','d','_','e'
,'x','p','r','e','s','s','i','o','n','a'
,'l','l','o','c','a','t','o','r','q','u'
,'a','l','i','f','i','e','d','_','e','x'
,'p','r','e','s','s','i','o','n','r','e'
,'l','a','t','i','o','n','a','l','_','o'
,'p','e','r','a','t','o','r','b','i','n'
,'a','r','y','_','a','d','d','i','n','g'
,'_','o','p','e','r','a','t','o','r','u'
,'n','a','r','y','_','a','d','d','i','n'
,'g','_','o','p','e','r','a','t','o','r'
,'m','u','l','t','i','p','l','y','i','n'
,'g','_','o','p','e','r','a','t','o','r'
,'e','x','p','o','n','e','n','t','i','a'
,'t','i','n','g','_','o','p','e','r','a'
,'t','o','r','e','x','p','a','n','d','e'
,'d','_','n','a','m','e','{','p','r','a'
,'g','m','a','_','s','t','m','}','s','t'
,'a','t','e','m','e','n','t','{','s','t'
,'a','t','e','m','e','n','t','}','s','e'
,'q','u','e','n','c','e','_','o','f','_'
,'s','t','a','t','e','m','e','n','t','s'
,'s','i','m','p','l','e','_','s','t','a'
,'t','e','m','e','n','t','c','o','m','p'
,'o','u','n','d','_','s','t','a','t','e'
,'m','e','n','t','{','l','a','b','e','l'
,'}','+','b','r','e','a','k','_','p','o'
,'i','n','t','a','s','s','i','g','n','m'
,'e','n','t','_','s','t','a','t','e','m'
,'e','n','t','e','x','i','t','_','s','t'
,'a','t','e','m','e','n','t','b','r','e'
,'a','k','_','r','e','t','u','r','n','r'
,'e','t','u','r','n','_','s','t','a','t'
,'e','m','e','n','t','g','o','t','o','_'
,'s','t','a','t','e','m','e','n','t','d'
,'e','l','a','y','_','s','t','a','t','e'
,'m','e','n','t','a','b','o','r','t','_'
,'s','t','a','t','e','m','e','n','t','r'
,'a','i','s','e','_','s','t','a','t','e'
,'m','e','n','t','c','o','d','e','_','s'
,'t','a','t','e','m','e','n','t','c','a'
,'l','l','_','s','t','a','t','e','m','e'
,'n','t','i','f','_','s','t','a','t','e'
,'m','e','n','t','c','a','s','e','_','s'
,'t','a','t','e','m','e','n','t','l','o'
,'o','p','_','s','t','a','t','e','m','e'
,'n','t','b','l','o','c','k','_','s','t'
,'a','t','e','m','e','n','t','a','c','c'
,'e','p','t','_','s','t','a','t','e','m'
,'e','n','t','s','e','l','e','c','t','_'
,'s','t','a','t','e','m','e','n','t','l'
,'a','b','e','l','c','o','n','d','i','t'
,'i','o','n','_','_','T','H','E','N','_'
,'_','s','e','q','u','e','n','c','e','_'
,'o','f','_','s','t','a','t','e','m','e'
,'n','t','s','{','E','L','S','I','F','_'
,'_','c','o','n','d','i','t','i','o','n'
,'_','_','T','H','E','N','_','_','s','e'
,'q','u','e','n','c','e','_','o','f','_'
,'s','t','a','t','e','m','e','n','t','s'
,'}','[','E','L','S','E','_','_','s','e'
,'q','u','e','n','c','e','_','o','f','_'
,'s','t','a','t','e','m','e','n','t','s'
,']','c','o','n','d','i','t','i','o','n'
,'C','A','S','E','_','_','e','x','p','r'
,'e','s','s','i','o','n','_','_','I','S'
,'{','p','r','a','g','m','a','_','a','l'
,'t','}','_','_','c','a','s','e','_','s'
,'t','a','t','e','m','e','n','t','_','a'
,'l','t','e','r','n','a','t','i','v','e'
,'_','_','{','c','a','s','e','_','s','t'
,'a','t','e','m','e','n','t','_','a','l'
,'t','e','r','n','a','t','i','v','e','}'
,'W','H','E','N','_','_','c','a','s','e'
,'_','c','h','o','i','c','e','_','_','{'
,'|','c','h','o','i','c','e','}','_','_'
,'=','>','c','a','s','e','_','s','t','a'
,'t','e','m','e','n','t','_','a','l','t'
,'e','r','n','a','t','i','v','e','W','H'
,'E','N','_','_','c','a','s','e','_','O'
,'T','H','E','R','S','_','_','=','>','['
,'l','o','o','p','_','i','d','e','n','t'
,'i','f','i','e','r',':',']','l','o','o'
,'p','_','t','e','r','m','i','n','a','l'
,'[','i','d','e','n','t','i','f','i','e'
,'r',']','l','o','o','p','_','p','a','r'
,'a','m','e','t','e','r','b','e','g','i'
,'n','_','e','n','d','_','b','l','o','c'
,'k','d','e','c','l','a','r','a','t','i'
,'v','e','_','p','a','r','t','_','_','b'
,'e','g','i','n','_','e','n','d','_','b'
,'l','o','c','k','b','e','g','i','n','_'
,'t','e','r','m','i','n','a','l','s','e'
,'q','u','e','n','c','e','_','o','f','_'
,'s','t','a','t','e','m','e','n','t','s'
,'_','_','e','n','d','_','b','l','o','c'
,'k','_','s','t','a','t','e','m','e','n'
,'t','s','[','e','x','c','e','p','t','i'
,'o','n','_','h','a','n','d','l','e','r'
,'_','p','a','r','t',']','[','b','l','o'
,'c','k','_','i','d','e','n','t','i','f'
,'i','e','r',':',']','d','e','c','l','a'
,'r','e','_','t','e','r','m','i','n','a'
,'l','s','u','b','p','r','o','g','r','a'
,'m','_','s','p','e','c','i','f','i','c'
,'a','t','i','o','n','s','t','a','r','t'
,'_','i','d','e','n','t','i','f','i','e'
,'r','p','a','r','a','m','e','t','e','r'
,'_','s','p','e','c','i','f','i','c','a'
,'t','i','o','n','{',';','p','a','r','a'
,'m','e','t','e','r','_','s','p','e','c'
,'i','f','i','c','a','t','i','o','n','}'
,'d','e','s','i','g','n','a','t','o','r'
,'m','o','d','e','g','e','n','e','r','i'
,'c','_','p','a','r','a','m','e','t','e'
,'r','_','m','o','d','e','s','u','b','p'
,'r','o','g','r','a','m','_','s','p','e'
,'c','i','f','i','c','a','t','i','o','n'
,'_','_','I','S','[','e','n','d','_','d'
,'e','s','i','g','n','a','t','o','r',']'
,'p','a','c','k','a','g','e','_','s','p'
,'e','c','i','f','i','c','a','t','i','o'
,'n','P','A','C','K','A','G','E','_','_'
,'s','t','a','r','t','_','i','d','e','n'
,'t','i','f','i','e','r','_','_','I','S'
,'{','b','a','s','i','c','_','d','e','c'
,'l','a','r','a','t','i','v','e','_','i'
,'t','e','m','}',''','p','r','i','v','a'
,'t','e','_','t','e','r','m','i','n','a'
,'l','P','A','C','K','A','G','E','_','_'
,'B','O','D','Y','_','_','s','t','a','r'
,'t','_','i','d','e','n','t','i','f','i'
,'e','r','_','_','I','S','d','e','c','l'
,'a','r','a','t','i','v','e','_','p','a'
,'r','t','_','_','n','o','_','b','e','g'
,'i','n','p','a','c','k','a','g','e','_'
,'n','a','m','e','{',',','p','a','c','k'
,'a','g','e','_','n','a','m','e','}','T'
,'A','S','K','_','_','s','t','a','r','t'
,'_','i','d','e','n','t','i','f','i','e'
,'r','_','_','I','S','{','e','n','t','r'
,'y','_','d','e','c','l','a','r','a','t'
,'i','o','n','}','_','_','{','r','e','p'
,'r','e','s','e','n','t','a','t','i','o'
,'n','_','c','l','a','u','s','e','}','T'
,'A','S','K','_','_','T','Y','P','E','_'
,'_','s','t','a','r','t','_','i','d','e'
,'n','t','i','f','i','e','r','_','_','I'
,'S','T','A','S','K','_','_','B','O','D'
,'Y','_','_','s','t','a','r','t','_','i'
,'d','e','n','t','i','f','i','e','r','_'
,'_','I','S','[','(','d','i','s','c','r'
,'e','t','e','_','r','a','n','g','e',')'
,']','[','f','o','r','m','a','l','_','p'
,'a','r','t',']','e','n','t','r','y','_'
,'d','e','c','l','a','r','a','t','i','o'
,'n','[','(','e','x','p','r','e','s','s'
,'i','o','n',')',']','[','f','o','r','m'
,'a','l','_','p','a','r','t',']','A','C'
,'C','E','P','T','_','_','s','t','a','r'
,'t','_','i','d','e','n','t','i','f','i'
,'e','r','_','_','[','(','e','x','p','r'
,'e','s','s','i','o','n',')',']','[','f'
,'o','r','m','a','l','_','p','a','r','t'
,']','_','_','D','O','d','o','_','s','e'
,'q','u','e','n','c','e','_','o','f','_'
,'s','t','a','t','e','m','e','n','t','s'
,'s','e','l','e','c','t','i','v','e','_'
,'w','a','i','t','c','o','n','d','i','t'
,'i','o','n','a','l','_','e','n','t','r'
,'y','_','c','a','l','l','t','i','m','e'
,'d','_','e','n','t','r','y','_','c','a'
,'l','l','s','e','l','e','c','t','_','t'
,'e','r','m','i','n','a','l','s','e','l'
,'e','c','t','_','a','l','t','e','r','n'
,'a','t','i','v','e','{','O','R','_','_'
,'s','e','l','e','c','t','_','a','l','t'
,'e','r','n','a','t','i','v','e','}','W'
,'H','E','N','_','_','c','o','n','d','i'
,'t','i','o','n','_','_','=','>','_','_'
,'s','e','l','e','c','t','i','v','e','_'
,'w','a','i','t','_','a','l','t','e','r'
,'n','a','t','i','v','e','s','e','l','e'
,'c','t','i','v','e','_','w','a','i','t'
,'_','a','l','t','e','r','n','a','t','i'
,'v','e','a','c','c','e','p','t','_','a'
,'l','t','e','r','n','a','t','i','v','e'
,'d','e','l','a','y','_','a','l','t','e'
,'r','n','a','t','i','v','e','t','e','r'
,'m','i','n','a','t','e','_','a','l','t'
,'e','r','n','a','t','i','v','e','a','c'
,'c','e','p','t','_','s','t','a','t','e'
,'m','e','n','t','_','_','d','e','c','i'
,'s','i','o','n','_','p','o','i','n','t'
,'[','s','e','q','u','e','n','c','e','_'
,'o','f','_','s','t','a','t','e','m','e'
,'n','t','s',']','d','e','l','a','y','_'
,'s','t','a','t','e','m','e','n','t','_'
,'_','d','e','c','i','s','i','o','n','_'
,'p','o','i','n','t','T','E','R','M','I'
,'N','A','T','E','_','_',';','c','a','l'
,'l','_','s','t','a','t','e','m','e','n'
,'t','_','_','[','s','e','q','u','e','n'
,'c','e','_','o','f','_','s','t','a','t'
,'e','m','e','n','t','s',']','e','l','s'
,'e','_','t','e','r','m','i','n','a','l'
,'o','r','_','t','e','r','m','i','n','a'
,'l','d','e','l','a','y','_','a','l','t'
,'e','r','n','a','t','i','v','e','_','i'
,'n','_','t','i','m','e','d','_','e','n'
,'t','r','y','c','a','l','l','_','s','t'
,'a','t','e','m','e','n','t','_','_','d'
,'e','c','i','s','i','o','n','_','p','o'
,'i','n','t','{',',','n','a','m','e','}'
,'{','c','o','m','p','i','l','a','t','i'
,'o','n','_','u','n','i','t','}','p','r'
,'a','g','m','a','_','h','e','a','d','e'
,'r','c','o','m','p','i','l','a','t','i'
,'o','n','_','u','n','i','t','c','o','n'
,'t','e','x','t','_','c','l','a','u','s'
,'e','l','i','b','r','a','r','y','_','o'
,'r','_','s','e','c','o','n','d','a','r'
,'y','_','u','n','i','t','s','u','b','u'
,'n','i','t','{','w','i','t','h','_','c'
,'l','a','u','s','e','{','u','s','e','_'
,'c','l','a','u','s','e','}','}','l','i'
,'b','r','a','r','y','_','u','n','i','t'
,'_','n','a','m','e','{',',','l','i','b'
,'r','a','r','y','_','u','n','i','t','_'
,'n','a','m','e','}','w','i','t','h','_'
,'c','l','a','u','s','e','S','E','P','A'
,'R','A','T','E','_','_','(','_','_','e'
,'x','p','a','n','d','e','d','_','n','a'
,'m','e','_','_',')','{','n','o','n','_'
,'o','t','h','e','r','s','_','h','a','n'
,'d','l','e','r','}','[','o','t','h','e'
,'r','s','_','h','a','n','d','l','e','r'
,']','e','x','c','e','p','t','i','o','n'
,'_','h','a','n','d','l','e','r','o','t'
,'h','e','r','s','_','h','a','n','d','l'
,'e','r','W','H','E','N','_','_','e','x'
,'c','e','p','t','i','o','n','_','c','h'
,'o','i','c','e','_','_','{','|','e','x'
,'c','e','p','t','i','o','n','_','c','h'
,'o','i','c','e','}','_','_','=','>','n'
,'o','n','_','o','t','h','e','r','s','_'
,'h','a','n','d','l','e','r','W','H','E'
,'N','_','_','e','x','c','e','p','t','i'
,'o','n','_','O','T','H','E','R','S','_'
,'_','=','>','e','x','c','e','p','t','i'
,'o','n','_','c','h','o','i','c','e','g'
,'e','n','e','r','i','c','_','f','o','r'
,'m','a','l','_','p','a','r','t','g','e'
,'n','e','r','i','c','_','t','e','r','m'
,'i','n','a','l','{','g','e','n','e','r'
,'i','c','_','p','a','r','a','m','e','t'
,'e','r','_','d','e','c','l','a','r','a'
,'t','i','o','n','}','g','e','n','e','r'
,'i','c','_','p','a','r','a','m','e','t'
,'e','r','_','d','e','c','l','a','r','a'
,'t','i','o','n','g','e','n','e','r','i'
,'c','_','t','y','p','e','_','i','d','e'
,'n','t','i','f','i','e','r','g','e','n'
,'e','r','i','c','_','t','y','p','e','_'
,'d','e','f','i','n','i','t','i','o','n'
,'[','I','S','_','_','n','a','m','e','_'
,'_','o','r','_','_','<','>',']','I','S'
,'_','_','N','E','W','_','_','e','x','p'
,'a','n','d','e','d','_','n','a','m','e'
,'g','e','n','e','r','i','c','_','a','s'
,'s','o','c','i','a','t','i','o','n','{'
,',','g','e','n','e','r','i','c','_','a'
,'s','s','o','c','i','a','t','i','o','n'
,'}','g','e','n','e','r','i','c','_','i'
,'n','s','t','a','n','t','i','a','t','i'
,'o','n','_','I','S','[','g','e','n','e'
,'r','i','c','_','f','o','r','m','a','l'
,'_','p','a','r','a','m','e','t','e','r'
,'=','>',']','g','e','n','e','r','i','c'
,'_','a','c','t','u','a','l','_','p','a'
,'r','a','m','e','t','e','r','g','e','n'
,'e','r','i','c','_','f','o','r','m','a'
,'l','_','p','a','r','a','m','e','t','e'
,'r','g','e','n','e','r','i','c','_','a'
,'c','t','u','a','l','_','p','a','r','a'
,'m','e','t','e','r','l','e','n','g','t'
,'h','_','c','l','a','u','s','e','e','n'
,'u','m','e','r','a','t','i','o','n','_'
,'r','e','p','r','e','s','e','n','t','a'
,'t','i','o','n','_','c','l','a','u','s'
,'e','a','d','d','r','e','s','s','_','c'
,'l','a','u','s','e','r','e','c','o','r'
,'d','_','r','e','p','r','e','s','e','n'
,'t','a','t','i','o','n','_','c','l','a'
,'u','s','e','r','e','p','s','p','e','c'
,'_','r','e','c','o','r','d','_','t','e'
,'r','m','i','n','a','l','{','c','o','m'
,'p','o','n','e','n','t','_','c','l','a'
,'u','s','e','}',''','a','l','i','g','n'
,'m','e','n','t','_','c','l','a','u','s'
,'e','c','o','m','p','o','n','e','n','t'
,'_','c','l','a','u','s','e','{','p','r'
,'a','g','m','a','_','v','a','r','i','a'
,'n','t','}','{','p','r','a','g','m','a'
,'_','a','l','t','}','d','i','s','c','r'
,'i','m','i','n','a','n','t','_','_',';'
,'{','v','a','r','i','a','n','t','}','{'
,'|','c','h','o','i','c','e','}','{','b'
,'a','s','i','c','_','d','e','c','l','a'
,'r','a','t','i','v','e','_','i','t','e'
,'m','}','_','_','b','a','s','i','c','_'
,'d','e','c','l','a','r','a','t','i','v'
,'e','_','i','t','e','m','|','E','M','P'
,'T','Y','{','b','a','s','i','c','_','c'
,'o','l','o','n','_','d','e','c','l','a'
,'r','a','t','i','o','n','}','g','a','_'
,'e','x','p','r','e','s','s','i','o','n'
,'{','|','i','d','e','n','t','i','f','i'
,'e','r','}','c','o','n','d','i','t','i'
,'o','n','_','_','T','H','E','N','E','L'
,'S','I','F','_','_','c','o','n','d','i'
,'t','i','o','n','_','_','T','H','E','N'
,'{','c','a','s','e','_','s','t','a','t'
,'e','m','e','n','t','_','a','l','t','e'
,'r','n','a','t','i','v','e','}','e','x'
,'c','e','p','t','i','o','n','_','t','e'
,'r','m','i','n','a','l','{','p','r','a'
,'g','m','a','_','a','l','t','}','_','_'
,'e','x','c','e','p','t','i','o','n','_'
,'h','a','n','d','l','e','r','p','a','r'
,'a','m','e','t','e','r','_','_',';','{'
,'e','n','t','r','y','_','d','e','c','l'
,'a','r','a','t','i','o','n','}','{','r'
,'e','p','r','e','s','e','n','t','a','t'
,'i','o','n','_','c','l','a','u','s','e'
,'}','o','p','t','i','o','n','a','l','_'
,'s','e','q','u','e','n','c','e','_','o'
,'f','_','s','t','a','t','e','m','e','n'
,'t','s','u','s','e','_','c','l','a','u'
,'s','e','_','l','i','s','t','{','|','e'
,'x','c','e','p','t','i','o','n','_','c'
,'h','o','i','c','e','}','{','c','o','m'
,'p','o','n','e','n','t','_','c','l','a'
,'u','s','e','}','C','A','S','E','_','_'
,'i','d','e','n','t','i','f','i','e','r'
,'W','H','E','N','_','_','c','h','o','i'
,'c','e','_','_','{','|','c','h','o','i'
,'c','e','}','_','_','=','>','W','H','E'
,'N','_','_','O','T','H','E','R','S','_'
,'_','=','>','W','H','E','N','_','_','c'
,'o','n','d','i','t','i','o','n','_','_'
,'=','>','S','E','P','A','R','A','T','E'
,'_','_','(','_','_','e','x','p','a','n'
,'d','e','d','_','n','a','m','e','s','t'
,'a','r','t','_','{','b','a','s','i','c'
,'_','c','o','l','o','n','_','d','e','c'
,'l','a','r','a','t','i','o','n','}','{'
,'b','a','s','i','c','_','c','o','l','o'
,'n','_','d','e','c','l','a','r','a','t'
,'i','o','n','}',''')  ;
        --| Table of symbols used in the grammar.
        -- NYU Reference Name: NO_SYM

    LeftHandSide :
         constant array (LeftHandSideRange)
         of GrammarSymbolRange :=
          (  100,  100,  102,  102,  102,  102,  102,  102,  102,  102
,  111,  111,  111,  111,  110,  110,  110,  110,  118,  120
,  112,  115,  122,  101,  101,  101,  124,  124,  127,  128
,  128,  128,  128,  128,  128,  128,  103,  116,  116,  140
,  141,  141,  141,  141,  139,  143,  143,  133,  148,  150
,  150,  134,  135,  135,  144,  151,  145,  153,  136,  136
,  154,  119,  156,  159,  155,  158,  161,  161,  163,  163
,  137,  166,  166,  166,  169,  130,  172,  178,  178,  176
,  180,  180,  180,  138,  125,  125,  183,  183,  181,  186
,  186,  186,  189,  189,  189,  189,  189,  189,  189,  184
,  184,  190,  190,  190,  160,  160,  160,  160,  160,  160
,  195,  196,  196,  198,  198,  198,  197,  199,  199,  199
,  199,  201,  200,  200,  200,  200,  200,  200,   99,   99
,   99,  121,  121,  121,  121,  121,  121,  210,  210,  147
,  220,  223,  223,  225,  221,  221,  221,  221,  221,  221
,  221,  228,  228,  228,  228,  228,  228,  229,  229,  229
,  230,  230,  224,  224,  231,  231,  231,  231,  232,  227
,  227,  226,  226,  226,  226,  237,  235,  235,  235,  235
,  238,  238,  238,  238,  238,  238,  238,  238,  238,  238
,  239,  239,  239,  239,  239,  239,  241,  244,  258,  173
,  242,  252,  262,  253,  266,  266,  254,  254,  254,  254
,  271,  273,  272,  275,  255,  255,  243,  243,  243,  243
,  245,  245,  246,  104,  279,  279,  279,  279,  283,  283
,  281,  284,  284,  285,  285,  285,  192,  251,  105,  288
,  288,  193,  193,  293,  126,  126,  126,  126,  188,  294
,  114,  114,  109,  109,  106,  106,  106,  106,  194,  301
,  256,  256,  304,  247,  257,  257,  257,  305,  309,  309
,  312,  312,  312,  313,  314,  315,  319,  306,  307,  316
,  318,  324,  248,   98,  327,  328,  328,  328,  330,  330
,  330,  330,  330,  330,  330,  329,  335,  333,  191,  191
,  191,  331,  113,  339,  339,  342,  340,  344,  249,  249
,  107,  107,  345,  348,  348,  348,  348,  349,  350,  350
,  350,  350,  350,  350,  350,  350,  108,  108,  108,  108
,  108,  108,  352,  355,  353,  357,  357,  358,  187,  187
,  187,  187,  359,  360,  362,  362,  366,  365,  361,  250
,  167,  167,  367,  367,  234,  234,  368,  368,  117,  117
,  123,  123,  142,  233,  233,  149,  149,  152,  152,  157
,  157,  162,  162,  168,  168,  131,  131,  370,  370,  371
,  371,  182,  182,  182,  185,  185,  202,  202,  204,  205
,  205,  203,  203,  206,  374,  374,  374,  207,  207,  208
,  209,  209,  375,  375,  211,  211,  212,  212,  213,  213
,  214,  214,  215,  215,  216,  216,  217,  217,  218,  218
,  218,  219,  219,  222,  222,  236,  236,  240,  240,  259
,  260,  260,  261,  261,  378,  378,  268,  268,  270,  270
,  277,  277,  276,  276,  380,  337,  337,  338,  338,  282
,  282,  287,  287,  287,  295,  295,  382,  382,  383,  383
,  300,  300,  300,  300,  302,  302,  302,  302,  310,  310
,  317,  317,  325,  325,  326,  326,  332,  332,  385,  385
,  334,  334,  386,  386,  347,  347,  351,  351,  351,  354
,  354,  356,  356,  387,  387,  165,  170,  171,  164,  363
,  174,  389,  390,  263,  346,  388,  177,  179,  265,  267
,  264,  269,  274,  175,  278,  289,  280,  290,  297,  291
,  292,  296,  298,  299,  303,  308,  320,  384,  323,  311
,  391,  379,  341,  343,  286,  364,  336,  392,  146,  373
,  393,  394,  394,  372,  372,  376,  377,  321,  322,  369
,  381,  129,  132)  ;
        --| Map of the grammar rule number (constant array index) to
        --| numeric value of left hand side symbol.
        -- NYU Reference Name: LHS

    RightHandSide :
         constant array (RightHandSideRange)
         of GC.ParserInteger :=
          (    6,    3,    1,    1,    1,    1,    1,    1,    1,    1
,    1,    1,    1,    1,    5,    6,    7,    8,    0,    0
,    6,    2,    1,    1,    1,    1,    4,    8,    1,    2
,    2,    2,    2,    2,    2,    2,    5,    1,    2,    1
,    1,    1,    1,    3,    3,    2,    4,    4,    1,    1
,    1,    1,    1,    1,    2,    2,    2,    2,    1,    1
,    7,    4,    3,    4,    1,    1,    2,    1,    1,    3
,    5,    4,    4,    2,    5,    4,    5,    3,    3,    0
,    1,    3,    2,    2,    3,    7,    2,    4,    0,    1
,    1,    1,    1,    1,    1,    1,    1,    1,    1,    1
,    1,    1,    1,    1,    1,    1,    1,    1,    1,    1
,    4,    3,    3,    1,    1,    1,    3,    1,    1,    1
,    1,    3,    2,    5,    5,    3,    3,    1,    1,    4
,    2,    1,    1,    1,    1,    1,    1,    2,    3,    1
,    1,    2,    2,    3,    1,    1,    1,    1,    1,    1
,    1,    1,    1,    1,    1,    1,    1,    1,    1,    1
,    1,    1,    1,    1,    1,    1,    1,    1,    1,    3
,    3,    2,    5,    4,    4,    3,    1,    1,    2,    2
,    2,    2,    2,    2,    2,    2,    2,    2,    2,    2
,    2,    2,    2,    2,    2,    2,    0,    0,    3,    2
,    4,    7,    1,    5,    2,    2,    7,   11,   12,    9
,    1,    2,    4,    1,    5,    4,    2,    4,    3,    5
,    2,    3,    3,    2,    2,    6,    4,    8,    1,    1
,    4,    1,    2,    1,    2,    3,    4,    2,    2,    4
,    6,    5,    4,    1,    6,   10,    5,    9,    4,    2
,    6,    6,    5,    4,    3,    4,    5,    5,    4,    4
,    4,    5,    1,    3,    1,    1,    1,    7,    2,    2
,    1,    1,    1,    2,    2,    2,    2,    8,    9,    1
,    1,    1,    4,    1,    2,    5,    2,    2,    1,    1
,    1,    1,    1,    1,    1,    1,    4,    1,    4,    6
,    6,    2,    4,    2,    1,    2,    2,    1,    2,    3
,    3,    3,    2,    5,    5,    9,    4,    1,    3,    2
,    2,    2,    2,    1,    1,    1,    4,    8,    4,    8
,    3,    7,    4,    1,    1,    1,    1,    1,    1,    1
,    1,    1,    5,    5,    9,   10,    5,    4,    6,    4
,    0,    2,    0,    2,    0,    2,    0,    2,    0,    2
,    0,    3,    1,    1,    3,    0,    3,    0,    1,    0
,    3,    0,    3,    0,    3,    0,    3,    0,    2,    0
,    3,    1,    3,    2,    1,    3,    3,    3,    4,    0
,    3,    0,    2,    3,    1,    3,    2,    1,    3,    4
,    0,    3,    0,    3,    3,    3,    3,    3,    3,    3
,    4,    4,    4,    4,    0,    2,    1,    2,    1,    2
,    3,    1,    3,    0,    2,    1,    3,    1,    2,    2
,    0,    3,    0,    2,    0,    2,    0,    2,    0,    1
,    0,    2,    0,    2,    2,    1,    2,    0,    1,    0
,    3,    0,    1,    1,    0,    3,    1,    3,    0,    3
,    0,    4,    3,    7,    0,    4,    3,    7,    0,    3
,    1,    1,    0,    3,    1,    2,    0,    3,    1,    3
,    0,    3,    0,    3,    0,    2,    0,    2,    2,    0
,    3,    1,    3,    1,    3,    1,    1,    1,    0,    1
,    2,    4,    3,    3,    1,    2,    1,    1,    1,    1
,    3,    1,    1,    3,    1,    3,    1,    1,    2,    1
,    4,    3,    4,    4,    4,    1,    2,    3,    1,    2
,    3,    1,    4,    3,    2,    1,    2,    4,    0,    4
,    0,    3,    0,    3,    1,    2,    3,    1,    1,    1
,    1,    1,    1)  ;
        --| Map of the grammar rule number (constant array index) to
        --| size of right hand sides (number of symbols).
        -- NYU Reference Name: RHS

    ActionTableOne :
         constant array (ActionTableOneRange)
         of GC.ParserInteger :=
          (  824,  152,    0,    0,    0,    0,  116,    0,    0,    0
,    0,    0,   85,    0,    0, 7332,  859,    0,  572,  987
,    0,    0,    0,   41,   42, 7334, 7336,    0,    0,   45
,    0,    0, 7338,  594,   47,    0,    0,    0,    0,   37
,    0,    0,    0,    0,   79,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  789,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0, 7341,   39,   40,    0,    0,    0,    0,  679,   49
,    0,  467,    0,  118,    0,    0,    0,    0,    0,  383
,    0,    0,    0,    0,    0,  705,  892,    0,    0,    0
,    0,   41,   42,   43, 7343, 7345, 7347,   45,  777,  743
, 7349, 7353, 7355, 7358,    0,    0,    0,    0,   51,    0
,  838,  273,    0,    0,    0,  187,    0,    0,    0,    0
,  275,    0,    0,    0,    0,  363,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0, 7360,   53,   54,    0,   49,    0,   55
,    0,    0,    0,    0,    0,   56,   57,    0,   58,   59
, 7362,   61,   62,   63,  300,    0,   64,   65,   66,   67
,    0,   68,   69, 7364,   71, 7366,   39, 7368, 7370,    0
,    0,    0,  262,    0,    0,    0,   51,    0,    0,   78
,    0,    0,    0,    0,    0, 1032,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  122,   42,   43,   44,    0
,    0,   45,  342,    0,    0,    0,    0,    0,    0,    0
,    0,   52,   53, 7372,  747,    0,    0,   55,  880,    0
,    0,  881,    0, 7374, 7376,    0,   58,   59,   60,   61
,   62,   63,    0,   79,   64,   65,   66,   67,    0, 7378
,   69,   70,   71,   72,    0,    0,   73,    0,    0,    0
,    0,    0,    0,  421,  146,    0,   38, 7380,   40,    0
,  147,    0,    0,    0,    0,    0,    0,    0,    0,    0
,  401,    0,  930,    0,    0,  931,    0,    0,    0,   37
,    0,    0,    0,   37,    0,    0,  122,   42, 7382,   44
,  171,    0,   45,    0,    0, 7384,    0,   47,   37,    0
,   37,    0,    0,  852,    0,    0,    0,    0,    0,    0
,    0,   38, 7386,   40,    0,   38,   39,   40,    0,    0
,    0,    0,    0,    0,   79,   52, 7388,   54,  188,    0
,   38, 7390, 7392, 7395,   40,    0,    0,    0,    0,    0
,    0,  122,   42, 7397, 7399, 7401, 7403, 7405,   44,   65
, 7407, 7409,   47,   68, 7412, 7414, 7416,   72,  932,    0
,  805,   42, 7418, 7420,   43,   44,   45,    0, 7422,   46
,  247, 7424,  595,   47,    0,    0,   37,    0,  144, 7426
,    0,  171,    0,    0,    0,  426,  860,   38,   39,   40
,   74,    0, 1020,    0,    0,    0,    0,  625,    0,    0
,    0, 7428,    0,  118,    0,    0,    0,    0,   38,   39
, 7430,    0,    0,    0,    0,    0, 7432, 7434, 7438,   43
,   44,    0,   55, 7441,  786,  723,   46,   50,   47,    0
,  988,    0,    0,    0,  427,    0,  171,    0, 7443, 7445
, 7447, 7450, 7452,    0, 7454,   69,   70, 7457, 7459,   47
,    0,   73,    0,  854,  801,  171,  118,  171,    0,  176
,    0,    0,    0,    0,    0,    0,    0,    0,  498,    0
,    0,   52,   53, 7461, 7465, 7467,   53, 7469,    0,  500
,    0,   55,   45,    0,    0,    0, 7471, 7473, 7475,   61
, 7477, 7480, 7483, 7486, 7488, 7493, 7495,   67, 7497, 7499
, 7502, 7504,   71, 7506,   69, 7509, 7511, 7514,   61,   62
, 7516,    0,  171,   64,   65, 7519, 7521, 7523, 7525, 7528
, 7530, 7534, 7537, 7539,   72,   73,   37,   73,    0,    0
,    0,    0,    0,  171,    0,    0,    0,    0,  851,   80
,    0,    0,    0,    0,    0,    0,    0, 7541, 7544, 7546
,   43,   44,    0,   55,   45,  680,    0,   46,   38, 7548
,   40,    0,   58, 7550,   60,   61,   62,   63,   52,   53
, 7552,   65,   66,   67,   55,   68, 7554,   70,   71, 7556
,   39,   40,   73,   58, 7558,   60,   61,   62, 7560,   42
, 7562, 7564, 7566,   66, 7568,    0,   68, 7570, 7573, 7575
,   72,    0,    0,   73,    0,    0,    0,    0,    0,  122
,   42,   43, 7577,    0,  750,   45,    0,   37,   46,   37
,   47,  867, 7580,    0,   43,   44,    0,    0,   79,    0
, 7582,   39,   40,    0,  958,    0,  365,    0,    0,    0
,    0,  324,    0,  125, 7584,    0,    0,    0,    0,   38
,   39, 7587,   39,   40,   74,    0,  121,    0,    0,    0
,  122,   42,   43, 7589,    0,  123, 7591,    0,    0,   46
, 7593,   47,  580,    0,    0,    0,    0,    0,   52, 7595
, 7597, 7599, 7602, 7604, 7607,   45,  325,   45,   46,  933
, 7609,  124, 7611,    0,    0,  194,    0,    0,    0,    0
,    0, 7613, 7615, 7617, 7620,    0,   68, 7623, 7625,   71
,   72,  758,    0, 7627,    0,    0,    0,  976,   52,   53
, 7630,    0,    0,    0, 7632,    0,  396, 7635,    0, 7637
,  315,  316,    0,    0,    0,    0,    0,  661,  492,   52
, 7639, 7643, 7646, 7650, 7652,   55, 7654,   69, 7656, 7659
, 7661,  634, 7663, 7665, 7668, 7670,   60, 7672,   62,   63
,    0,  265,   64, 7674,   66,   67,    0, 7676,   69,   70
, 7678, 7680,    0,    0, 7682,  911, 7684, 7686, 7689,  765
, 7691,  468,  767, 7693,    0,    0,    0,    0,    0,  802
,   52, 7695,   54,   99,    0, 1584, 7697,    0,    0,    0
,    0, 7701,    0,    0,    0,    0, 1584,  100,    0,   52
, 7703, 7705, 7708, 7711,   65, 7713, 7715,   55, 7717, 7719
, 7721,   71, 7724,    0,    0,   73,   58, 7726, 7728, 7730
, 7732,   63,   64,   65, 7734, 7736,   66, 7739,   69, 7741
, 7743, 7746,   71, 7750, 7753, 7756, 7758,  223,  638,    0
, 1586,    0,    0,    0,    0,  468,  639,    0,    0,    0
,    0,    0,    0,  469,    0,    0,   37,    0,    0,    0
,    0,  366,    0,  281,    0,    0,    0,    0,  831,    0
,    0,    0,    0,    0,  681, 7760,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0, 7762,   39
,   40,  901,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,  263,    0,    0,  948,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  543,    0,    0, 7764,   42
,   43,   44,    0,    0,   45,    0,    0,    0,    0,    0
,    0,  101,    0,  102,  103, 7766,    0,    0,    0,  599
,    0,    0,    0,    0,    0,    0,    0,  883,    0,    0
,    0,    0,    0,    0,    0,    0,  639,    0,  447,    0
,    0,    0,    0,    0,    0, 1033,    0,    0,  604,    0
,    0,  324,    0,    0,  751,    0,    0,    0,    0,    0
,  977,    0,    0,    0, 1013,    0,    0,    0,  492,    0
, 7768,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,  736,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,  171,    0,    0,    0,    0,    0,   82
,  105,    0,    0,    0,    0,    0,  919,   25,    0,  144
,    0,    0,    0,   28,    0,    0,    0,    0,    0,    0
,  106,    0,    0,    0,    0,    0,    0,    0,   52, 7771
,   54,    0,    0,    0,   55,    0,    0,    0,  868,    0
,    0,    0,    0,    0,    0,    0,    0,    0, 7773,    0
,    0,    0,   65,  296,   67,    0,   68,   69,   70,   71
,   72,    0, 7775,    0,    0,    0,    0,    0,    0,  674
,    0,    0,    0,    0,    0,    0,    0,    0,    0,  598
,    0,    0,  324,    0,    0,  841,  241,    0,    0,    0
,  862,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  693,    0,    0,    0,    0
,    0,    0,    0,    0,  695,    0,    0,    0,    0,    0
,  581,    0,  116,    0,    0,    0,    0,    0,    0,  248
,    0,    0,    0,    0,  471,    0, 7777,    0, 1004,  324
,    0,    0, 7779,  243,    0,  428,    0,    0,    0,    0
, 7781,  863,    0,  894,    0,    0,    0,  676,  107,    0
,    0, 7783,  146,  706,    0,    0,    0,    0,  147,    0
,    0,    0,  995, 7786,  194,  241,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  176,    0,    0,    0,    0
,    0,    0,    0,    0,  429,    0,    0,  545,  188,  118
,    0,    0,  642,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,  324,    0,  116,  912,    0,    0,    0
,    0,    0,    0,    0,    0,  301,    0,    0,  949,    0
,    0, 7788,  243,    0,  682,    0,  367,  683,    0,    0
,    0,    0,    0,  430,    0,    0,    0,    0,    0,    0
,    0,    0,    0,  352,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,  708,    0,  709,    0
,    0,    0,  122,    0,   43,   44,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,   37,    0,    0,    0
, 7790,    0,  118,    0,    0,    0,    0,  234,    0,    0
,    0,    0,  302,    0,    0,    0,    0,    0,    0,    0
,  229,    0,    0,    0,    0,    0,    0,  684,   38, 7792
,   40,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  819,    0,    0,    0,    0,    0
,    0,   37,    0,   37,  663,    0,    0,    0,  122,   42
,   43,   44,  405,    0,   45,    0,    0,   46,    0,   47
,    0,    0,    0,    0,    0,    0,    0,  617,    0,    0
,    0,  341,    0,   38,   39, 7794,   39,   40,    0,    0
,    0,    0,  448,  300,    0,    0,    0,    0,    0,    0
,    0,  989,    0,    0,    0,  108,    0,    0,    0,    0
,    0,   84,   52, 7796, 7798, 7801, 7804, 7806,   44, 7808
,    0,   45,   46,    0, 7810,  397,   47,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  930,    0,    0
, 7812,    0,    0,    0,    0,    0,    0,    0,   37,    0
,    0,    0,    0,  171,    0,  381,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,  664,    0,    0,  718
,  643,    0,  190,    0,    0,    0,  644,    0,    0,    0
,   38,   39,   40,    0,    0,    0,    0,  122,   52, 7815
, 7817,    0,    0, 7819,   55,  286,    0, 7821,    0,    0
,    0,    0,    0,    0, 1426,    0,  304,    0, 7823, 7825
, 7827, 7830, 7832, 7834,   67,    0, 7836,   69,   70, 7838
,   72,   47,    0, 7840,    0, 7843,  194, 1426, 1426,    0
,    0,  599,    0,    0,    0,    0,    0,    0, 1426, 1426
,    0,    0, 7845, 7848,   53, 7850,   53,   54, 7853, 7855
,    0,   55,    0,    0,    0,    0,    0,    0,   58,   59
, 7858, 7861,   62, 7863,    0,  599, 7865, 7869, 7871, 7873
,   66, 7875,   69, 7877, 7879, 7881,   71, 7883,   73,   37
,   73,    0, 7885, 7888,  116, 1521,    0,    0,    0,    0
,    0,    0,   50,    0, 7890,    0,    0,    0,    0,    0
,    0,    0,    0, 1521,    0,   51,    0,    0,    0,    0
,    0,   38, 7893,   40,    0,  249,    0,   52,   53,   54
,    0,    0,    0,    0,    0,    0,   38,   39,   40,    0
,    0,  842,    0,  950,  407,    0, 7895,    0,  118,    0
,   52, 7897, 7900,   43,   44,    0,   55,   45,    0,  711
,   46,    0,   47,  282,    0,   58, 7902, 7904, 7906, 7908
,   63,    0,   45,   64,   65, 7910,   67,   47,   68,   69
,   70, 7912,   72, 1241,    0,   73,    0,   79,    0, 1241
,    0, 1241,    0, 7914, 1241,    0,   86,    0,    0,    0
,  885,   37,    0, 1241, 7916,    0,    0, 7918, 1241,    0
,    0,    0, 1241,    0,    0,    0, 1241,    0,    0,    0
,    0,    0,  625,    0,  864, 1241,    0,    0,    0,    0
, 1242,  174, 1241, 7920,   39, 7922,    0,    0, 1241,  300
, 1241, 1241,    0,    0, 1241,    0, 7924, 1241, 7928,    0
, 1241, 7930,    0,    0,    0, 1034,    0,    0,   37,    0
, 1241, 7932,  431,  122, 7934, 7936,   44,   38,   39, 7938
,    0, 7941,   46, 1241,   47,    0,    0,    0,    0,  194
,    0,   52, 7943,   54,    0,    0,    0, 7945,    0, 1241
,   38, 7947,   40,    0,    0,    0, 7950, 7952, 7956, 7961
, 7963, 7965,   55, 7967, 7969,   65, 7971,   67,   47,   68
,   69, 7973, 7975, 7977,   61,   62, 7979,    0,    0,   64
, 7981, 7984, 7986,   44,   68,   69, 7988,   71, 7990, 7992
,    0, 7995,    0,  719,    0,    0,  407,  324,    0,    0
,  645,    0,    0,    0,    0, 7997,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0, 7999,    0
,    0,    0, 8001,  902,   88,    0,    0,  968,    0,    0
,    0,  665,    0,  122,    0,   43,   44,    5, 8004, 8006
,    0,    0,    8,    0,    0,    0,    0,   37,    0,    0
,    0,    0, 8008, 8010, 8012, 8014,    0,    0,    0, 8017
,    0,    0, 8019,    0,    0,    0,    0,  646,    0,    0
,    0,    0,    0, 8021,   13, 8023,   64, 8025, 8027, 8029
, 8031, 8033,   69, 8035,   71, 8037,    0,   52, 8039,   54
,  197,    0,    0, 8041,    0,    0,    0, 8043,    0,    0
,    0,    0,    0,  198,  199,  829,  158,  200,  201, 8045
, 8047, 8051, 8054,   67, 8058, 8060, 8062,   70, 8064,   72
,   47,    0,   73,    0,    0,  390,  469,    0,  896,    0
,  601,  408,    0, 8067, 8069, 8071, 8073, 8075,   68, 8077
, 8079,   71, 8081,    0,   37,   73,    0,    0,    0,  202
,  203,  204, 8083,  206, 8086,  208,  209,  210, 8088,  301
,    0,    0,    0,   52,   53,   54,  243, 1149,    0,    0
,    0,    0, 8090, 8092, 8094, 1149, 8096, 8099, 8102, 1149
, 8105, 1149,    0,    0, 1149, 8107, 1149,    0, 1380,    0
, 1149,  265, 1149, 1149, 1149,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  806,  807,  122, 8109,   43,   44
,    0,    0, 8111,   39, 8114, 8116,    0,   47,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  214,  215, 8118,    0, 8120,   52
, 8122,   54,  122,   42, 8124, 8127,  499,  605, 8129,  500
,    0,   46,    0,   47,    0,    0,    0,    0,  501, 1481
,    0,    0, 8131, 8134,   66, 8137,    0, 8139,   69,   70
,   71, 8141,    0,    0,   73,    0,    0,    0,    0,    0
,  505,    0,    0,    0,    0,    0,    0,  506,  286,    0
,  572,    0,    0,    0,    0,    0, 1481,  243,  619,  507
,    0, 8144,   44,    0,  468,  886,    0,    0,    0,    0
, 1035,    0,  802,    0,    0,    0,    0,    0,    0,    0
,   79,    0,    0,    0,  286,  808,    0,  217,    0,    0
,    0,    0,    0,    0,    0,    0, 8147, 8149,   54,    0
,    0,    0,   55,    0,  218,    0,  219,    0,  998,    0
,  782,   58,   59,   60,   61, 8152,   63,    0,    0,   64
,   65,   66,   67,    0, 8154,   69,   70,   71,   72,    0
,    0,   73,   52,   53,   54,    0,    0,    0,   55,  432
,    0,    0,  583,    0,    0,    0,    0,   58,   59,   60
,   61,   62,   63,   32, 8156,   64,   65,   66,   67,    0
,   68,   69,   70,   71,   72,    0,  698, 8158, 8162,  222
,  223, 1560, 1560, 1560,    0,    0,    0,    0,    0,    0
,    0, 1378,    0, 8164,  914,    0,  666,  471, 1560, 8166
, 8168, 8170,    0,    0,    0,    0,    0,    0,    0,    0
,   38, 8172, 8174,    0,    0, 1560, 1560,    0,    0,    0
,    0, 1560,    0,    0,    0,   38,   39,   40,    0,    0
,    0,    0,    0,  285,  224,    0,    0,    0,    0,    0
,  122,   42,   43,   44,    0,    0, 8176,  511,    0,   46
,  512, 8178,  514,  515,  516, 8180, 8182, 8184, 8187, 8189
,  522, 8191,    0,    0,   46,    0,   47,  524,  498,    0
, 1427,    0,  525,    0, 1427, 8193, 1427,    0,    0,  500
,    0,  526,    0,  475,    0,    0, 8195,    0,    0,  809
,    0, 8197,  194, 1427, 1427,    0,    0,    0, 1151,    0
,    0, 8199, 1151,    0, 8201, 8203,  160, 8205, 8208, 8210
,  529, 8213,  531,    0, 1588,    0,  112, 1151,    0,    0
,    0,  755,  286,    0,    0,  756,    0,    0,    0,  713
,    0,    0, 1151,    0,    0,  171,    0, 8215, 1151, 1151
, 1151, 1151, 8217, 1151, 1151, 8219, 1151, 1149,    0, 8221
, 8223, 1151,    0, 1381,    0, 1151,    0, 1151, 1151, 1151
,  249,    0,    0,  952,  407,    0,  545,    0,  118,    0
, 8225, 8227,   54,    0, 1149,    0, 8229,   38,   39, 8231
,    0,    0,    0,    0,  686, 8233,   53, 8236,    0, 1149
,  229,   55,    0,   64,   65,   66,   67,    0,   68,   69
, 8238, 8240, 8242,   61, 8244, 8246,    0,  122, 8248, 8250
, 8253, 8256, 1149, 8258, 8261, 8263, 8265, 8268, 8271, 8274
,   73, 1149, 1149, 1149,    0,    0, 8276, 1149,    0, 1149
, 1149, 1149,  504,    0,    0, 1241,    0, 1241,    0,    0
,    0,    0,    0, 1241,    0, 1241,    0, 8278, 8280,   43
, 8282,    0, 8284,   45, 1572,    0,   46, 1241, 8286,  300
,    0, 8288, 1241,    0,    0,    0, 1241,    0,  449,  132
, 1241,    0, 1572,    0,    0,  133,  301,    0,    0, 8290
,    0,  237,    0,  243, 1242,    0, 1241,    0,    0,  620
,    0,    0,    0,  284,    0, 1241,  384,    0, 1241,    0
, 8292, 1241,  171,    0,  226,    0,    0,    0,  176,    0
,    0,  758,    0,    0,    0,  783,    0,    0,    0,    0
, 8294,  135,  136,    0,    0, 8296,    0,    0,  138, 8298
,  140,  249,    0,    0,  738,    0,  921,   52,   53,   54
,    0,    0,  171,   55,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0, 8300,    0,    0, 8302,  897
,   64, 8304, 8306,   67,    0,   68, 8308, 8310, 8312,   72
,    0,    0,   73,   37,    0,  761,  762, 8314, 8316, 8319
, 8321,    0,  767, 8323,  113,    0,    0,    0,    0, 8325
,    0,  667,  548,    0,  873, 8327,    0,    0,    0,    0
,   64,   65,   66, 8329,  551, 8331, 8333, 8335,   71, 8337
,    0,  922,   73,    0,    0,    0,    0,  145,  146,  552
,    0,    0, 8339,  699,  147,    0,   37,    0,    0,    0
,    0, 8341,    0, 1419,  144,  122,   42,   43, 8343,    0
,  685, 8345, 8347,   40, 8350,    0,   47,  194,    0,    0
,    0,    0,    0,    0,    0, 8352,  142,    0, 8354,   39
,   40, 8356,    0, 8358, 8360,    0,    0,  143,  616,    0
,    0, 8362, 8364, 8366, 8368,    0,  164, 8370,    0,    0
,   46,    0, 8372,    0,    0,    0, 1419,    0,  122,   42
, 8374, 8376,   14,    0,   45,    0,    0,   46,    0,   47
,  165,    0,    0,    0, 8379,  166,  556,   15,    0,  122
,   16,   43,   44,    0,    0,  557,    0,  286,    0,   17
,  558, 8381,  560,  561,  562,  563,  564,  312,  599,    0
, 8383, 8385, 8387,    0,    0,    0,   38,   39, 8390,    0
,  569, 8393,    0,    0,    0,  865,    0,    0,    0,    0
,    0,  571,    0,  286,    0,    0,    0,  990,    0,    0
,    0,   37,    0,    0,    0,   52, 8395, 8398,   43, 8400
, 8402,   55, 8404,   21,    0,   46,    0,   47,    0, 8406
,  289, 1024,  144,  791,  792,    0,  793,    0,   64,   65
,   66,   67,    0, 8409, 8411, 8413,   71,   72,  621,    0
,   73,   52, 8415,   54, 8417,  145, 8419, 8421,    0,    0
,    0,    0,  147,  114,    0,    0,   58, 8423, 8425, 8427
, 8429,   63,  370,  122, 8431, 8434, 8436, 8438,  607, 8440
,   69, 8442,   71,   72,    0,  417,   73,    0,    0,   52
,   53, 8444,   65,   66,   67,    0, 8446,   69, 8448,   71
,   72,    0,    0,   73,    0,    0,    0,   22, 8450, 1486
,    0,  125,  355, 8452,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0, 1482,    0,  238,    0,  874,    0
,    0, 8454, 1482,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,   52,   53,   54,  330
,    0,    0,   55,    0,  145, 8457,    0,  372,    0,    0
,    0, 8460,   59,   60,   61,   62,   63,    0,  171,   64
,   65,   66, 8463,  551,   68,   69,   70,   71,   72,    0
,    0,   73,    0,  937, 8465,   53,  331,    0,    0,    0
,    0,    0,    0,    0,   24,    0,    0,    0,    0,    0
, 8467, 8469,    0, 8471, 8476,   54, 1037, 8478,    0,   55
,    0,    0,    0,  800,  477,    0,    0,    0,   37,    0
,  623,    0,    0,    0,    0,    0,    0, 8480,    0,   67
,    0, 8482,   69,   70,   71,   72,  726,    0,    0,    0
,    0, 8484, 1026,    0,    0,   29,   30,    0,    0,    0
,   38, 8486,   40,    0,    0,    0,    0,    0,    0,    0
,   32, 8489,    0,  188,  132,    0,    0,    0,    0,    0
,  133,    0,    0, 1459,    0,    0,    0,    0,    0,    0
,  122, 8491,   43, 8493,    0,    0,   45,    0,  379,   46
,    0, 8495,    0, 8497,    0,    0, 1015,  669, 1459,  670
,  671,  672,  500,    0,    0,    0, 8499, 8501,    0, 8503
,    0,  301,    0,    0,    0,  134,  135,  136, 8505, 1125
,  255,    0,    0,  138,  139,  140,   37,    0,  249,    0
,  194,    0,  194,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  755,    0,    0,    0,  756,   37
,    0,    0,  122,    0, 8507,   44,    0,    0,   38,   39
,   40,    0,  286,    0,    0,    0,    0,    0,    0,  116
,    0,    0,    0,   35,    0,  171,    0,  176,    0,    0
,    0,   38,   39,   40,    0,    0,    0,  407,  122, 8509
,   43,   44,  385,    0,   45,    0,    0,   46,    0,   47
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,   52, 8511, 8513,   43,   44,    0, 8515, 8517,    0,  714
, 8519,    0,   47,    0,  688,  290,  923,  924,    0,    0
,    0,  700,    0, 8521,   65, 8523,   67,  356, 8525,   69
,   70,   71,   72,    0,    0,   73,    0, 8527,  844,   79
,  141,  142,  468,    0,    0,    0,    0,    0,    0,    0
,    0,    0,  143,    0,    0,    0,    0,    0,    0,    0
,  265,    0,    0,  608,    0, 8529,  476,  308,    0,    0
,    0,    0,   52, 8531, 8533,    0,  793,    0,    0,    0
,    0,    0,    0,  373,    0,    0,    0,    0, 1041,    0
,  239,    0,    0,    0,  240,    0, 8536,  453,    0,    0
,  269,  270,  887,    0,    0,    0,    0,    0,   52,   53
,   54,    0,    0,    0,   55,  189,    0,  190,    0,    0
,    0,  176,   91,    0,  758,  386,    0,  775,  759,    0
,    0, 8538, 8541, 8543,   67,    0,   68, 8546,   70,   71
,   72,    0,    0,   73,    0,    0,  242,    0,    0,  272
,    0,    0,    0,  243,   64, 8549,   66, 8551,    0,   68
,   69, 8553,   71,   72,    0,    0, 8555,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,  182
,  527,    0,    0,    0,    0,  241,    0,  647,  761,  762
,  763,  764,  765,  766,    0,  767,  768,  769,  728,    0
,    0,  770,    0,   37,    0,  624,    0, 1027,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  916,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  831, 8557,   39,   40,  970,    0
,    0,    0,  243,    0,    0,  347,  116,    0,    0,    0
,    0,    0,  398,    0,  332,    0,    0,    0,    0,    0
,    0,    0,  648,    0,    0,  122, 8561,   43, 8563,    0
,    0,   45,    0,    0,   46,    0,   47,    0,    0,    0
,    0,    0,  241,  273,  255,  739,    0,    0,    0, 8565
,  146,    0,    0, 1042,    0,  434,  147,    0,    0,  116
,    0,   79,    0,  229,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,   37,    0,    0,    0,    0
,    0,    0, 8567,    0,    0,    0,    0,   94,    0,    0
,   37,    0,  572,    0,    0,    0,    0,    0,    0,  243
,    0,  116,    0,    0,  168,    0,  613, 8569,   39,   40
, 8572,   37,  812,    0,    0,    0,    0,    0,    0,    0
,  171,    0, 8574,   39,   40,    0,    0,    0,    0,    0
,   37,    0,    0,    0,  545,    0,  118,  122,   42, 8576
,   44,    0,    0, 8578,   39,   40,   46,    0,   47,    0
,    0,    0,  122,   42,   43, 8580, 8582,   54,   45,    0
,    0, 8584,   38, 8586, 8588,    0,    0,    0,    0,  689
,  291,    0,    0,  122, 8590,   43, 8592,    0, 8594, 8596
,   66,   67,   46,   68, 8598, 8600,   71,   72,  649,    0
, 8602,    0,  122,   42, 8604,   44,  639,    0,   45,    0
,    0,   46,    0,   47,    0,  534,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,  286
,    0,    0,    0,    0,    0,    0,    0,  300,    0,  650
,    0,    0,  171,    0,  925,    0,  833,    0,    0, 8606
,    0,    0,    0,    0,  584,    0,    0,  171,  625,  170
,    0,    0,    0,    0,    0,  286,    0,    0,    0,   37
,    0,    0,    0,    0,  229,    0,    0,   52, 8608, 8611
,    0,    0,    0,   55, 8613,    0,  478,    0,    0,    0
,    0,    0, 8615,   53,   54,    0,    0, 8617,   55,    0
,   64, 8620, 8622, 8624,    0,   68, 8626,   70, 8629,   72
,    0,  420,   73,   52, 8631, 8633, 8635,   66, 8637, 8639
,   68,   69,   70, 8641,   72, 1515,    0,   73, 8643, 8645
,   60, 8647, 8649, 8653, 8659,    0,   64, 8661, 8664,   67
,   46, 8666, 8668, 8670,   71,   72,    0, 8672, 8675, 8677
, 8679,   62, 8681,    0,    0, 8683,   65, 8685,   67,    0
,   68, 8687, 8689,   71,   72,    0, 1241,   73,   37, 1241
,    0, 1241, 8691,    0,  118,  405,    0,    0,    0,    0
,    0,   38,   39,   40,    0,    0,    0,  357,  122,    0
,   43,   44,    0,    0,    0,    0, 8693,  786,    0,  627
,   38,   39,   40,    0,  407,    0,    0,  116,  720,    0
,  118,  310,   42, 8695, 8697,    0,    0, 8699,    0,    0
,   46,    0,   47,    0, 8702,    0,  806,  961,    0,  793
,  122,   42,   43,   44,    0,    0,   45,    0,    0,   46
,    0,   47,  845,    0,    0,    0,    0,    0,    0,  813
,    0,    0,    0,    0,    0,    0,    0,  941, 8704, 8706
,    0, 8709,   53,   54,    0,  300,   79, 8711,    0,  468
,    0,    0,    0,    0,    0,    0,    0,  469,    0, 8713
,    0,    0,  545,  898, 8715,   65,   66,   67,    0,   68
,   69,   70,   71, 8717,    0,    0,   73,    0,    0,    0
,    0,  300,    0,    0,    0,    0,  171,  132,    0,    0
,    0,    0,  286, 8719,    0,    0,  195,    0,   52,   53
,   54,    0,    0,    0,    0,  171,    0,    0,    0, 1028
,    0,    0,    0,    0,  971,    0,  730,    0,    0,  917
,    0,   52, 8722, 8724, 8728,  412,    0,   55,  413,    0
,  147,    0,    0,  954,    0,    0,   58,   59, 8730, 8732
, 8734, 8737, 8739,    0,   64,   65, 8741, 8744,  140,   68
,   69,   70,   71,   72,  690, 8746,   73,    0,    0,    0
,  374,  375,    0,   64,   65,   66,   67,    0, 8748, 8750
, 8752, 8754,   72, 8756,  787,   73,    0,    0,    0,   79
,    0,    0,    0,    0,    0,   85, 1558,    0,   86,    0
,    0,    0,  629,    0,    0,    0,    0,  788,  122,   42
, 8758,   44,    0,    0,   45,    0,    0,    0,    0,    0
,    0,  609,    0,    0,    0, 1579, 1579, 1579,    0,    0
,    0,    0,    0,    0,    0, 1378, 1124,   37,    0,    0
,    0,    0, 1579, 1579,    0, 1579,    0,    0,    0,    0
,    0,    0,    0,    0,    0, 1579, 1579,    0,    0, 1579
, 1579,    0,    0,  943,    0, 1579,    0,    0,    0,   38
,   39, 8760,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,  141, 8762,    0,   85,    0,    0, 8764
,    0,    0, 8766, 8768,  316,  143,    0,  982,    0,  122
,   42,   43,   44,  171,    0,   45,  421,  146,   46,    0
,   47,    0,    0, 8770,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,  436,    0,    0,    0,  391,    0,    0,    0,   52,   53
,   54,    0,    0,    0,   55,  257,    0,    0,    0,    0
,    0, 1009,  701, 8772,    0,  740,  116,    0,    0,    0
,    0,    0,    0,    0,  298,    0,    0,    0, 8774,   71
, 8776,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,  286,    0,    0,    0,   38,   39,   40,    0,    0
,    0,    0,    0,    0,  171,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  335,    0,    0,  673,   37,  614
,    0,    0,  437,    0,    0,  122, 8778,   43,   44,   87
,    0, 8780, 1007,    0,   46,    0,   47,    0,    0, 8782
,   53, 8784,    0,  118,    0,   55,    0,    0,    0,    0
,   38, 8786, 8788,    0, 8791, 8794,   60, 8796, 8798,   63
,    0,    0,   64, 8800,   66, 8802,    0,   68,   69,   70
,   71,   72,    0,  548,   73,    0,  549,    0,    0,    0
,  122,   42, 8804, 8807, 8809, 8811, 8813,   39, 8815, 8817
,   38, 8819,   40,  795,    0,    0,  195,  972,    0,    0
,  587,    0,    0,    0,    0,    0,    0,  286,    0,  348
,  992,  815, 8821,    0,    0,  589,  122,   42,   43,   44
, 8823, 8825, 8827,   44,    0,   46,   45,   47,   37,   46
,  962,   47,    0,    0,  300,  927,    0,    0,    0,  590
,    0,    0,    0,    0,    0,    0,    0,    0,    0, 8829
,  393,    0,    0,    0,   48,   52,   53, 8831,    0,    0
,   38, 8833, 8835,    0,    0,    0,    0,    0,    0, 8837
, 8839,    0,  625,    0,    0,  125,   49,  171,   64,   65
,   66, 8841,   39, 8843,   69,   70,   71, 8845,    0,    0
, 8848, 8851, 8853,   44,  336,  460,   45,    0,  286,   46
,    0,   47, 8855,   39, 8857,    0,  592,  630,    0,    0
,   52, 8859, 8862, 8865, 8867,   51,   55,   45, 8869, 8871
, 8873,   40, 8875,    0,    0,  147,    0,    0,    0,    0
,    0,    0,  122, 8877, 8879, 8881,   67,    0, 8883,   69
,   70, 8886, 8888, 8890,   72,   73, 8893,   53,   54,   41
, 8895, 8897, 8899,    0,    0,   45, 8902,    0,   46,    0
, 8904,   58, 8906, 8909,   61, 8911, 8913, 8915,   61, 8917
, 8919,   66, 8921, 8923, 8925, 8927, 8929, 8931, 8933, 8935
,   70, 8937,   72,  537,    0, 8940,    0,  112,    0,    0
,    0,    0,    0,  286,    0,    0,    0,    0,    0,    0
,    0,  422,    0,    0,    0,   49,  171,    0,    0,    0
,    0,    0,    0,  731,  265,    0,    0,    0,    0,    0
,   52,   53,   54,   90,    0,    0,   55,  171,    0,    0
,  266,   50,    0,    0,    0,   58,   59,   60, 8942,   62
, 8944,   52,   53, 8946, 8948,   66,   67,   55, 8950,   69
,   70,   71,   72,    0,    0,   73,   58,   59,   60,   61
, 8952,   63,   52,   53, 8954,   65,   66, 8956,   55,   68
,   69,   70,   71,   72,    0,    0,   73,    0,    0,   52
,   53,   54,    0,    0,    0, 8958,   65,   66,   67,    0
,   68, 8961, 8963,   71, 8965,   59,   60, 8967,   62,   63
,    0,    0,   64,   65, 8970,   67,  702,   68,   69,   70
,   71,   72,    0, 8973,   73,    0,    0,   13, 8975,    0
,    0,    0,    0,    0,    0,    0,    0,  615,  379,   74
,    0,    0,    0,  480,    0,    0,   16,    0, 1149,    0
,    0,    0,  421,  146,    0, 8977,   39, 8979,    0, 8981
,    0, 8984,  576,    0,    0,  676,    0,    0,    0,  468
,    0, 1149,    0,    0,    0, 1149,    0, 8986,    0,    0
, 8989,    0,    0,  116,    0,  122,   42,   43, 8991,    0
, 1149,   45,  317,    0,   46,    0,   47,    0,    0,   37
,  241,  928,  116,    0,    0, 8993,  482,  483,  484, 8995
, 1149, 1149, 8997, 9000, 9003, 1149, 9006, 1149, 9008, 1149
,    0,    0, 1149, 9010, 1149, 1447, 1447, 1149, 1149, 1029
, 9012, 9014, 9016,   40, 9018,    0,  121,    0,    0,    0
,    0,  461,  122, 9020, 9022,   44,    0,    0,   45,    0
, 9024,   46,  394,   47,    0,  716,  194,  243,  545,    0
,  118,  122, 9026, 9028,   44,  456,  603, 9030,   74,  147
,   46,    0,   47,    0, 9032,   37,    0,    0,    0,    0
,  171,    0,    0,    0,    0,  486,    0, 9034,    0,  487
,  488,  321, 9036,  102, 9038, 9040,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,   38,   39,   40
,    0,    0,    0,  652,    0,   52,   53, 9043,  599,    0
,    0,   55,    0,    0,  286,    0,    0,    0,    0,    0
,   58,   59,   60, 9045, 9047,   63,    0, 9049, 9051, 9053
, 9055,   67,    0, 9057,   69,   70, 9060, 9062,   47,    0
,   73,  300,    0,    0,    0,    0,  125, 1019,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  822,   37,    0
,  775,    0,   52,   53,   54,    0,  126,  180, 9064,    0
, 9066,  184,    0,    0,    0,  548,    0, 9068,  549,   26
, 9071, 9073,   53, 9076,    0,   64, 9078, 9081,   67,  219
, 9085, 9089, 9091,   71, 9094,  742,   58, 9097,   60,   61
,   62,   63,  944,    0,   64, 9099, 9101,   67,    0, 9103
,   69,   70,   71,   72,  945,  194, 9105,  144,    0,    0
,  310,   42, 9107,   44,    0,    0, 9109,   39,   40,   46
,    0,   47,    0,  722,  652,  854,   32,   33,    0,    0
,    0,  555,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0, 9111, 9113, 9116, 9119
,    0,    0,   45,   55,    0,   46,    0,   47, 9121,  295
,    0,  776, 9123, 9125,    0,    0, 9127,    0,    0,    0
,   64,   65,   66,   67,    0,   68, 9129, 9131,   71, 9133
,  200,  201,   73,    0,    0,    0, 1579,    0,  946, 9135
,  550,  551, 9137, 9139,  559, 9141, 9143, 9145,  563,  564
,    0, 1579, 1579, 9147,  566, 9149,    0,    0,  339,    0
,   92, 9151,    0,  569,  570,    0,    0,    0, 9153, 9155
,    0, 9157, 9159,  203, 9161,  205,  206,  207, 9164,  209
, 9166, 1579, 9169,  655,  656, 9172, 9176,    0,    0,    0
,   52, 9178,   54,    0,  401, 9181, 9183,  213,    0,    0
,    0,    0,    0,    0,    0,   58,   59,   60,   61,   62
,   63,    0,  908,   64, 9185, 9187, 9189,    0,   68,   69
,   70,   71,   72,    0,    0,   73,   52,   53,   54,    0
,    0,    0,   55,    0,    0,    0,    0,    0,    0,  743
,  744,  745,  732,    0,  122,   42,   43,   44,   79,   64
, 9191,   66, 9194,   46,   68, 9196,   70, 9199, 9201,  216
,    0, 9204,  322, 9208,  103, 9210,    0,  670, 9212, 9214
,    0,    0,    0,    0,    0,  568,    0,  569,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
, 9216,    0,    0,  549,    0,  229,    0,  611,    0,    0
,    0,  585,  586,    0,  261,    0,    0,    0,    0,    0
,  856,    0,    0,  538,    0,    0,  974, 9218,  181,    0
,  900, 9220,   38,   39,   40,    0,  632,    0,    0, 9222
,    0,    0,  589, 1039,    0,    0,    0,    0,  395,    0
, 9225,  314,  315,  316,    0,  194,    0,   25,  229,   26
,   27,    0,  122, 9227, 9231,   44,  590,  218,   45,  219
, 9233,   46,    0,   47, 9235,   53, 9238,  577,    0,    0
,   55,    0,    0,    0,  929,  539,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  194,    0,   64, 9240,   66
,   67,    0, 9242,   69,   70,   71,   72,    0,    0,   73
,    0,    0,  407,    0,  556,    0,   32,   33,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0, 1002,   37
,  220, 9244,  222, 9246,  748,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  268,    0,    0,    0,    0,  570
,    0,    0,  195,    0,    0,    0,    0,  171,    0,    0
,    0,   38,   39, 9248,    0,    0, 1241,  194, 9250,    0
,    0,    0,    0,    0, 1241,    0, 1241,    0, 9252, 1241
,    0,    0,    0, 9255, 1220, 1220,    0, 1220, 1241, 1241
,    0,  122, 9257, 9260, 9263,    0,    0, 9265,   55,    0
, 9268, 1241,   47,    0,  246,    0,    0,    0,    0,    0
, 9270,    0,    0,    0,    0, 9272,   65, 9275,   67,    0
, 9277,   69,   70,   71, 9279, 1220, 1241, 9281,    0, 1241
,    0, 1241, 1241,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
, 1031,    0,    0,    0,   87,    0, 9283,    0,    0,    0
,    0,    0,    0, 9285,    0,    0,    0,  578,    0,    0
,    0,    0,    0,  678,  704,    0,    0,    0,    0,    0
,  837,    0,    0,    0,    0,    0, 9287,    0,    0,  402
,    0,    0,    0,    0,    0,  362,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0, 1011,  194,  651,    0
,    0,   52,   53,   54,  241,    0,    0,   55,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  334,    0,    0
,  749,    0,    0,   79,   64, 9289, 9291,   67,    0,   68
,   69,   70,   71, 9293,    0,    0, 9295,    0,    0,    0
,    0,    0,    0,    0,    0,  468,   97,    0,    0,  440
,  441,  442,  443, 9297, 9299,    0,    0,    0,    0,    0
,    0,  243,    0,    0,    0,    0,  175,    0,    0,    0
,    0,  379,  742,    0,    0,    0,    0,    0,    0,  616
,    0,    0, 9301, 9303,  411, 9305,  176,    0, 9307,  270
,    0,    0,    0,    0,    0,  116,    0,    0,    0,    0
,    0,    0, 9309,  146,    0, 9311,  270,    0,    0,  147
,    0,    0,  634,    0,    0,    0,    0,    0,    0,  271
,  635,    0,    0,    0,    0,  462,    0,    0,   37,    0
,    0,    0,    0,    0,    0,  241, 9313,  272,    0,    0
,    0,    0,    0, 9315,  177,    0,    0,    0,  850,    0
,  229,    0,    0,    0,  272,    0,    0,    0,    0,    0
,   38,   39, 9317,  858,   86,   43,  243,   44,  153,   46
,  457,  380,  335,   38,   44,  273,  798,   50,  799,  274
,  909,  778,   46,   91,  745,  656,  800,  779,   47,  194
,  658,   52,   37,  195,   60,   70,   50,   72,   38,  471
,   40, 1040,   73,  746,   54,  994,   56,   37,   57,  425
,   68,   39,  579,   43,   79,   46,   94,   39,   74,  116
,   53,   39,   55,   40,   38,  343,   39,  403,   43,  122
,   44,  154,   43,   41,   44,   42,   45,   43,   46,  173
,  404,   45,   67,   46,   69,   37,   70,   47,   71,   43
,  122,   44,   42,  660,   45,   47,   46,  116,  276,  299
,   49,  301,   40,  825,   52,  243,  122,   53,  344,   42
,   54,    2,  286,   45,  596,  310,   64,   42,   65,  311
,   51,   66,   44,  286,   67,   68,  542,   45,   71,   46
,   72,   80,   54,  625,   52,    3, 1003,   53,   54,   52
,   55,   54,   58,   37,   59,   56,   60,   57,   62,   52
,   58,   63,   53,   59,   54,   52,   60,   53,   61,   64
,   54,  312,  300,   62,   65,   63,   66,   55,   55,   64
,   68,  286,   65,   69,   66,   70,   67,   72,  351,   68
,   58,   70,   73,   59,   71,   60,   72,   63,  196,   73
,   66,   64,   67,   65,  947,   66,   38,   68,   67,   39
,   69,   40,   70,   68,  286,  755,   71,   69,   72,   70
,  839,   71,  300,   52,   37,  122,   53,   42,   54,   47
,   39,   59,  121,   64,   54,  826,   69,   72,   38,   59
,  121,  122,   63,   43,  189,   44,   64,   65,  190,   45
,   67,   46,   69,  342,   37,   70,   47,   71,  882,  364
,   44,  122,  446,   38,  459,  918,  788,  144,   40,   38
,   44,  840,   45,  910,  797,  459,  122,   53,   42,   54
,   43,  122,  277,   44,   42,   43,  125,  324,   55,   44
,   47,   46,   47,  636,   64,    4,   65,    5,   66,  126
,    6,   67,  125,    7,   69,    8,   70,  827,  975,  893
,   73,  760,   54,   55,  326,  126,  463,  345,  378,  314
,  693,  493,  278,   53,  421,   64,   54,  268,  146,   65
,  279,   66,  280,   67,  127,   68,  128,  147,   70,  129
,  694,   71,   72,  130,   52,  195,   53,  597,   73,   54
,   58,  171,   59,  116,   61,  124,   65,  527,   68,  828
,   71,  155,   72,  806,   73,  861,  125,  793,  763,   98
,  764,  191,  766,  192,  768,  468,   53,  469,   55,  126
,  637,   16,  933, 1012,   53, 1584,   54, 1584,   52, 1584
,   53,  344,   64,   54,   66,   55,   67,  127,   68,  128
,   69,  735,   70,  724,  129,   72,  130, 1584,   59,  194
,   60, 1584,   61, 1584,   62,   66,   64,   67,   65,    9
,   68,   67,   70,   68,   71, 1584,   69,   72,  803, 1584
,   70,   72,  470,   81,   73, 1584,  220, 1584,  221,   73
,  222,  195,  640,  857,   38,  599,  122,  229,  104,  965
,  959,  193,  662,   53,  804,  229,  641,  471,  301,  249
,  780,   98,  966,  834,  421,  156,   16,  707,  544,  195
, 1044,  710,  300,  685,   39,   40,   38,  122,   53,   42
,   54,  109,   43,  122,   27,   44,   42,  913,   43,   45
,  353,   47,   46,  934,  472,  464,   43,   53,   44,   54
,  546, 1426,  286,  303,  171, 1426, 1426,  157,  171,   41
, 1426,   64,   42,   65,   43,   66,   44,   68,   45,   71
,   46,  935,  895,   73,  582, 1426,  324,  547, 1426,   52
, 1426,  996,   54,   52,  250, 1589,  500,   55,  251,   60
,  600,  389,  116,   61,  324,   63,  737,   64,   49, 1521
,   65, 1521,   66,   64,   67,   65,   68,   67,   70,   68
,   71,   69,   72,   70,  194,   72,  869,  229, 1521,  195
,    2, 1021,   37, 1521, 1005,   39,  545, 1328,  884,  122
,   53,   42,   54,  122,   59,   42,   60,   43,   61,   44
,   62,   46,   66, 1241,   71, 1241,   85, 1241,  327, 1241
,  368,   38,  286,   37,   40,  997, 1241, 1241,  171,  286
, 1241, 1241,  175,  171, 1241,   42, 1241,   43, 1241,   40
,   45, 1241,  406,  176, 1241,   53, 1242,   55,  758,   39
,  131,   52,   58,  122,   53,  752,   59,   42,   54,  870
, 1241,   60,   43,   61,   44,   62, 1241,   63,   45, 1241
, 1241,   64,   46,   66,   58,   70,   59,   71,   60,   72
,   63,   73,   65,  696,  122,   66,   42,   67,   43,   70
,   45,   72,  406,   46,  283,  177,   73,   47,  473,  465
,  967,  171,  767,  305,   87,  110,   10,  265,    7,  806
,  324,  978,   52, 1022,   53,  793,  843,   54,  871,   55
,  618,  286,  241,  196,  171,   14,  494,   65,  495,   66
,   38,   67,   39,  412,   40,   68,  413,   70,   72,  284
,   53,   73,   55,   16,  697,  496,  805,  324,   64,   42
, 1149,   52,   65,   43,   53,   66,   44,  781,   54,  252
,  235,   68,   45,   69,   55,   71,   46,  468, 1149,   64
,  409,   65,  410,   66,  411,   67,  412, 1149, 1149,   69
,  413,   70, 1149,   72,  969, 1149,  205,  414,  207,  920
,  111, 1149,  211, 1149,  212, 1149,  213, 1149,   38,   11
,  903, 1149,   39,  474, 1149,   40,   37, 1149, 1149,   12
,  793,   42,   38,   45,  178,  712,   40,   46,   86,  497
,  216,  951,  498,  241,   53,   43, 1485,  328,   55,   44
,   45, 1485,   64,  502,  369,   65,   87,  503,   67,   88
,   68, 1481,  249,   72,  504,   43,  171,   79,   52,   26
,  171,   53,   27,  753,   62,  820,   68,  508,   33,   73
,  509, 1560,  220,   37,  221,   37,  249,   52, 1560,   53
, 1560,   54, 1560, 1560,   39, 1560,   40,  510,   45,  513
,   47,  122,  517,   42,  518,   43,  519,  225,   44,  520
,  521, 1427,   45,  523, 1427, 1151,  476,  236,  116, 1427
, 1014,  159, 1427, 1151, 1427,  179,  194,  527, 1151, 1427
,  161,  872,  528, 1427,  625,  530,  286, 1151, 1006, 1151
,   37, 1151,  195, 1151,  171, 1151, 1149,   52,  804,   53
, 1149,   55, 1149,   40,   52,  287,   37, 1149,   54,   58
,   70,   59,   71,   60,   72, 1149,   62,   63,   73,   64
,   42, 1149,   65,   43, 1149,   66,   44, 1149,   67, 1149
,   68,   45, 1149,   69, 1067,   70, 1149,   71,   46, 1149
,   72,   38, 1149,   47,   39, 1067,   40, 1149,  241, 1241
,  122, 1241,   42,  532,   44, 1572,  830, 1241,   47, 1241
,  162, 1241,  415, 1241,  725,  760,  134,  406,  137,  264
,  139,  682,  324,  683,  904, 1036,   65,  799,   66,   69
,  450,  527,   70,  800,   71,  763,   52,  764,  354,   53
,  765,   54,  766,  382,  768,   55,  915,  288,  549,  346
,  550,   67,   38,   68,   39,   69,   40,   70,   37,   72
,  553,  306,  554,  307,  936,   44,   38,   45, 1541,  606
,   39,  533,   46,  771,  141,   38,  555,  253,  163,  742
,  754,  194,  254,  409,  122,  410,   42,  411,   43,  412
,   44,  413,   45, 1541,   47,  874,   43,  414,   44,   13
,  195,   37,  195,  559,  565,  171,  421,  566,  146,  567
,  416,  147,  568,   40,  570,  121,  171,  122,   53,   42
,   54,   44,   18,  265,   19,   45,   20, 1023,  790,  687
,   38,   68,   39,   69,   40,   70,  116,   53,  433,  329
,  146,   43,   55,   44,  622,   59,   52,   60,   53,   61
,   54,   62,   55,   64,   42,   65,   43,   66,   44,  504
,   67,   68,   45,  476,   70,   64,   54,   68,  180,   70
,  124,  167,   23, 1486,  451,  999,  126,  144,  254,  371
,  146, 1482,   58,  147,  550,   67,   98,   52,  374,  324
,  960,   25,  905,  144,   16,   52,   26,   53,   27,  799
,   28,  668,  148,  297,  227, 1025, 1459,   39,  228,   31
,  241,   33,   42,  115,  338,   44,  498,   47,  229,  324
,  794, 1459,  568,   34,  569, 1459,  243, 1125,  875,   43
,   42,  195,  122,   53,   42,   54,  602,   55,   45,  181
,   46,   86,  452,   64,  727,   66,  120,   68,  757,  116
, 1016,  458,  806,   53,  792,  784,   54,  171,  241,   64
,  271,   52,   65,   53,   66,  760,   54,   69,   55,   92
,  539,   65,  418,   67,  979,   70,  419,   73,  938,  832
,   38,   36,   42,  144,  771,   44,  939,  145,  810,  729
,  573,   38,  286,  991,  811,   38,  256,   43,  244,   38
,   45,   44,   52,  599,   53,   46,   55,   47,   39,  715
,   40,   42,  309,   44,  117,   64,  118,   45,   65,   47
,   69,  953,   70,  785,   73,   43,  333, 1000,  169,  171
,   53,  230,   54,  119,  286,   83,   52,  387,  940,  171
,  116,   38,   65,   39,   66,   40,   67, 1241,  834,   69
, 1241,   71, 1241,   53,   64,   54,   65, 1241,   67, 1241
, 1241,   55,   71, 1515, 1241,   58, 1241,   59,  122,   61
,   42, 1241,   62,   52,   43, 1241,  116,   63,   53,   84
,   44,   54,   45, 1241,   65,   66,   55, 1241,   68,   47
,   69, 1515,   70,  194,   58,  249,   73,   59,   60,   37
, 1241,   61,  772,   63, 1242,   64, 1241,   66,   69,  183
,  835,   70, 1241,  454,  406,  626,  265,  311,  980,   44
,  981,  888,   45,   84,  231, 1043,  876,  194,  942,  249
,   52,  435,   55,  312, 1017,  814,   64,  118,   72,  286
,  926,  628,  133,  409,   53,  421,  410,  399,   54,  146
,  411,  134,   60,  135,   61,  136,   62,   52,   63,   53
,  414,   54,  138,   66,   55,  139,   67,  300,  292,   38
,   68,  846,   69,   40,   70,  906,   71,  358,  334,   43
, 1579,   40,  479,  639,  142,   86,  313,  455,  314, 1001
,  315,  194,  147, 1038,   37,  471,   70,  195,   72,  359
,   42,   45,   88,   52,  194,   54,  545,   39,  258,  574
,   40,   38,   58,   37,   40,   59,  438,   61,  575,   62
,   37,   65,   75,   67,   76,  599,   43,  122,   44,   42
,  585,   43,  586,   44,   38,   45,   40,   45,   46,  340
,   47,   39,  588,  773,  171,   41,   89,   42,   45,   43
,   37,  392,  535,   54,   39,   55,   40,  459,  691,  536
,  293,   37,   38,   67,   40,   68,  556,   37,   72,  122
,  852,   73,  907,   42,   43,  116,   38,   50,  591,   40
,  171,  310,   53,   42,   54,   52,  311,   53,   44,   54
,  145,   55,   38,  146,   46,   39,  570,   47,   64,   42
,   65,   43,   66,   44,   68,   45,  172,   71,   46,   72
,   70,  847,   47,   71,  889,   52,   42,   52,   43,   53
,   55,   44,   54,  337,   55,  741,   47,  821,   59,   56
,   60,   57,   62,   58,   63,   59,  312,   60,   64,   62
,   65,   63,  286,   67,  853,   64,   68,   65,   69,   66
,   70,   67,  963,   71,   72,   68, 1018,   69,   73,  232
,   71,  171,   73,   61,  721,   63,  854,   64,   54,   65
,   51,   68,  176,  631,   62,   64,   54,  674,   67,  468
,   55,   64,   56,   69,   57,   70,   58,   72,  816,   61
,   73,  983,   66,   78,   37,  294,  955,   14,  899,   38
,  319,   40,  194,  147,  259,  675,  201,  469,  774, 1149
,   37, 1149,   44, 1149,  481, 1149,  610,  485,  314,   38
, 1149,  315,   39, 1149,  316,   40, 1149, 1008, 1149,  817
, 1149,  116, 1149,  245, 1149,   38, 1149,   39, 1149,  973
,  796,  421,   42,  146,   43,  301,  147,  421,   42,  146
,   43,  286,   45,  692,  651,  703,  260, 1009,  322, 1010
,  103,  852,  104,  349,   54,  376,  229,   61,   62,  194
,  171,  122,   64,   42,   65,   43,   66,   44,   68,  124
,   45,   71,   46,  890,   72,  855,   55,  489,  338,  194
,   25,  388,   27,  185,  400,   52,  195,   28,   54,  550
,  423,   65,  551,  218,   66,   55,  106,   38,   68,  377
,   39,   69,   40,   70,  378,   37,   72,  149,   73,   59
,  553,   65,  993,   66,   68,  267,  229,   73,  311,  171
,   38,   45,  122,  196,   42,   13,   52,   43,   14,   53
,   44,   54,  471,  360,  195,  194,  361,  318,  312,   16
,  198,   69,  319,   70,  556,   72,  877,  233,  878,  286
, 1030,  558,  560,   91,  561,  120,  984,  562,  565, 1579
,  567,  171,  568, 1378,  848, 1579,  407, 1579,  144, 1579
,  229,  202,  571,  818,  204,  677,  208,  653,  490,  210
,   37,  654, 1579,  836,  657, 1579,  439,  658, 1579,  171
, 1579,   53,  668,  211,   55,  212,   38,   65,   39,   66
,   40,   67,   45,   65,   75,   67,   76,   47,   69,  320
,   71,  214,  249,   72,  215,  964,  733,   73,  321,  816
,  102,  669,  104,  671,   93,  176,  672,  548,   37,  956
,  587,  717,   86,  985,  171,  588,  323,   94,  746,  453
,   28,   42,  747,   43,  106,  186,   52,  891,  466,   54
,  201,  986,   65,   68,  424,  591,  221,  592,  223,   40
,  332, 1241,   77, 1241,  540,  174,  879, 1220,   42, 1241
,   52,   43, 1241,   53,   44,   54,   45, 1241,  341,  831
,   46, 1241,  350, 1242,  541,   64, 1241,   66,  857,   68
,  407,   72,   84,   73,  406,   95,  849,  150,  171,  491
,   65,  593,   66,   96,  249,   72,  734,   73,  469,  444
,  195,  445,  409,  612,  866,  410,  659,  412,  413,  269
,  633,  414,  957,  269,  271,  151,  504,   45,  823,   40
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
 ) ;
        --| Actions to perform for all combinations of parser
        --| states and input tokens.
        -- NYU Reference Name: ACTION_TABLE1

    ActionTableTwo :
        constant array (ActionTableTwoRange)
        of GC.ParserInteger :=
         (286850,22949,    0,    0,    0,    0,154905,    0,    0,    0
,    0,    0,86067,    0,    0,    0,304077,    0,177865,372924
,    0,    0,    0,263925,263926,    0,    0,    0,    0,263931
,    0,    0,    0,177880,263936,    0,    0,    0,    0,97568
,    0,    0,    0,    0,131995,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,263959,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,97601,97602,    0,    0,    0,    0,218084,263981
,    0,154980,    0,154982,    0,    0,    0,    0,    0,109092
,    0,    0,    0,    0,    0,229575,321368,    0,    0,    0
,    0,97630,97631,97632,    0,    0,    0,97636,258273,332855
,    0,    0,    0,    0,    0,    0,    0,    0,264020,    0
,292707,166494,    0,    0,    0,34547,    0,    0,    0,    0
,57500,    0,    0,    0,    0,97664,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,264056,264057,    0,97686,    0,264061
,    0,    0,    0,    0,    0,264067,264068,    0,264070,264071
,    0,264073,264074,264075,155073,    0,264078,264079,264080,264081
,    0,264083,264084,    0,264086,    0,28871,    0,    0,    0
,    0,    0,51825,    0,    0,    0,97725,    0,    0, 5936
,    0,    0,    0,    0,    0,401795,    0,    0,    0,    0
,    0,    0,    0,    0,    0,28900,28901,28902,28903,    0
,    0,28906,86277,    0,    0,    0,    0,    0,    0,    0
,    0,97760,97761,    0,332980,    0,    0,97766,315773,    0
,    0,315776,    0,    0,    0,    0,97775,97776,97777,97778
,97779,97780,    0, 5990,97783,97784,97785,97786,    0,    0
,97789,97790,97791,97792,    0,    0,97795,    0,    0,    0
,    0,    0,    0,235490,235491,    0,212545,    0,212547,    0
,235497,    0,    0,    0,    0,    0,    0,    0,    0,    0
,189611,    0,344512,    0,    0,344515,    0,    0,    0,298623
,    0,    0,    0,57673,    0,    0,212575,212576,    0,212578
,28995,    0,212581,    0,    0,    0,    0,212586,287168,    0
,166693,    0,    0,304384,    0,    0,    0,    0,    0,    0
,    0,298655,    0,298657,    0,57705,57706,57707,    0,    0
,    0,    0,    0,    0,189665,29030,    0,29032,34770,    0
,287200,    0,    0,    0,166727,    0,    0,    0,    0,    0
,    0,298685,298686,    0,    0,    0,    0,    0,57738,29054
,    0,    0,298696,29058,    0,    0,    0,29062,344598,    0
,287230,287231,    0,    0,166757,166758,287236,    0,    0,287239
,46286,    0,178239,166766,    0,    0,120873,    0,384777,    0
,    0,212670,    0,    0,    0,132356,304467,252835,252836,252837
,97939,    0,396265,    0,    0,    0,    0,298741,    0,    0
,    0,    0,    0,69267,    0,    0,    0,    0,120905,120906
,    0,    0,    0,    0,    0,    0,    0,    0,    0,252867
,252868,    0,212711,    0,310242,241399,252874,57817,252876,    0
,373355,    0,    0,    0,132405,    0,298780,    0,    0,    0
,    0,    0,    0,    0,    0,212734,212735,    0,    0,120946
,    0,212740,    0,304534,275850,287325,275852,166850,    0,350436
,    0,    0,    0,    0,    0,    0,    0,    0,304549,    0
,    0,298815,298816,    0,    0,    0,57866,    0,    0,304560
,    0,57871,98031,    0,    0,    0,    0,    0,    0,298833
,    0,    0,    0,    0,    0,    0,    0,298841,    0,    0
,    0,    0,298846,    0,57894,    0,    0,    0,287378,287379
,    0,    0,252960,287383,287384,    0,    0,    0,    0,    0
,    0,    0,    0,    0,166917,287395,149708,166920,    0,    0
,    0,    0,    0,121030,    0,    0,    0,    0,298882,189880
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,293157,293158,    0,253001,293161,218581,    0,293164,149740,    0
,149742,    0,253010,    0,253012,253013,253014,253015,121065,121066
,    0,253019,253020,253021,121071,253023,    0,253025,253026,    0
,17811,17812,253030,121080,    0,121082,121083,121084,    0,149771
,    0,    0,    0,121090,    0,    0,121093,    0,    0,    0
,121097,    0,    0,121100,    0,    0,    0,    0,    0,17840
,17841,17842,    0,    0,253062,17846,    0,333383,17849,212908
,17851,310439,    0,    0,367812,367813,    0,    0, 6385,    0
,    0,344871,344872,    0,356348,    0,98185,    0,    0,    0
,    0,339144,    0,293250,    0,    0,    0,    0,    0,333415
,333416,    0,212941,212942,58044,    0,212945,    0,    0,    0
,344900,344901,344902,    0,    0,17896,    0,    0,    0,344909
,    0,344911,172802,    0,    0,    0,    0,    0,293285,    0
,    0,    0,    0,    0,    0,333451,75287,212976,333454,344929
,    0,17922,    0,    0,    0,310513,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,293313,    0,    0,293316
,293317,304792,    0,    0,    0,    0,    0,367905,149900,149901
,    0,    0,    0,    0,    0,    0,121223,    0,    0,    0
,121227,121228,    0,    0,    0,    0,    0,213026,161394,17970
,    0,    0,    0,    0,    0,17976,    0,149929,    0,    0
,    0,299095,    0,    0,    0,    0,17987,    0,17989,17990
,    0,333527,17993,    0,17995,17996,    0,    0,17999,18000
,    0,    0,    0,    0,    0,333541,    0,    0,    0,304860
,    0,276177,304863,    0,    0,    0,    0,    0,    0,276185
,345030,    0,345032,12287,    0,230295,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,230306,12301,    0,333575
,    0,    0,    0,    0,345054,    0,    0,213106,    0,    0
,    0,345061,    0,    0,    0,345065,213115,    0,    0,    0
,    0,213120,333598,333599,    0,    0,213125,    0,333604,    0
,    0,    0,213131,    0,    0,    0,    0,172977,207400,    0
,230350,    0,    0,    0,    0,350832,207408,    0,    0,    0
,    0,    0,    0,350840,    0,    0,63993,    0,    0,    0
,    0,98420,    0,58263,    0,    0,    0,    0,304959,    0
,    0,    0,    0,    0,218910,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,64026
,64027,327930,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,52565,    0,    0,350892,    0,    0,    0,    0
,    0,    0,    0,    0,    0,167318,    0,    0,    0,64056
,64057,64058,    0,    0,64061,    0,    0,    0,    0,    0
,    0,12435,    0,12437,12438,    0,    0,    0,    0,184553
,    0,    0,    0,    0,    0,    0,    0,316512,    0,    0
,    0,    0,    0,    0,    0,    0,379628,    0,138676,    0
,    0,    0,    0,    0,    0,402585,    0,    0,184582,    0
,    0,253429,    0,    0,253432,    0,    0,    0,    0,    0
,368178,    0,    0,    0,391130,    0,    0,    0,362449,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,247723,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,64150,    0,    0,    0,    0,    0, 6786
,12524,    0,    0,    0,    0,    0,339539,12531,    0,224802
,    0,    0,    0,12537,    0,    0,    0,    0,    0,    0
,12544,    0,    0,    0,    0,    0,    0,    0,64185,    0
,64187,    0,    0,    0,64191,    0,    0,    0,310886,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,64209,64210,64211,    0,64213,64214,64215,64216
,64217,    0,    0,    0,    0,    0,    0,    0,    0,322391
,    0,    0,    0,    0,    0,    0,    0,    0,    0,178976
,    0,    0,293719,    0,    0,293722,69980,    0,    0,    0
,305201,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,224898,    0,    0,    0,    0
,    0,    0,    0,    0,224907,    0,    0,    0,    0,    0
,173280,    0,167545,    0,    0,    0,    0,    0,    0,47075
,    0,    0,    0,    0,351141,    0,    0,    0,385567,259354
,    0,    0,    0,70037,    0,133146,    0,    0,    0,    0
,    0,305262,    0,322475,    0,    0,    0,322479,12682,    0
,    0,    0,385591,230693,    0,    0,    0,    0,385597,    0
,    0,    0,379864,    0,242178,374130,    0,    0,    0,    0
,    0,    0,    0,    0,    0,133186,    0,    0,    0,    0
,    0,    0,    0,    0,133195,    0,    0,167620,207780,167622
,    0,    0,207784,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,334009,    0,230745,334012,    0,    0,    0
,    0,    0,    0,    0,    0,374180,    0,    0,351235,    0
,    0,    0,374187,    0,219290,    0,98815,219293,    0,    0
,    0,    0,    0,133244,    0,    0,    0,    0,    0,    0
,    0,    0,    0,93095,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,230796,    0,230798,    0
,    0,    0,196380,    0,196382,196383,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,150498,    0,    0,    0
,    0,    0,230822,    0,    0,    0,    0,41506,    0,    0
,    0,    0,70196,    0,    0,    0,    0,    0,    0,    0
,173470,    0,    0,    0,    0,    0,    0,219373,150530,    0
,150532,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,282497,    0,    0,    0,    0,    0
,    0,236608,    0,116133,213663,    0,    0,    0,150560,150561
,150562,150563,127616,    0,150566,    0,    0,150569,    0,150571
,    0,    0,    0,    0,    0,    0,    0,196475,    0,    0
,    0,127635,    0,236640,236641,    0,116166,116167,    0,    0
,    0,    0,139120,230913,    0,    0,    0,    0,    0,    0
,    0,374346,    0,    0,    0,12919,    0,    0,    0,    0
,    0,127665,196510,    0,    0,    0,    0,    0,116198,    0
,    0,116201,236679,    0,    0,121942,116206,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,345697,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,58858,    0
,    0,    0,    0,150655,    0,104761,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,213775,    0,    0,236726
,208042,    0,208044,    0,    0,    0,208048,    0,    0,    0
,58890,58891,58892,    0,    0,    0,    0,311325,150690,    0
,    0,    0,    0,    0,150696,236752,    0,    0,    0,    0
,    0,    0,    0,    0,35966,    0,70390,    0,    0,    0
,    0,    0,    0,    0,150716,    0,    0,150719,150720,    0
,150722,58931,    0,    0,    0,    0,35988,35989,35990,    0
,    0,179418,    0,    0,    0,    0,    0,    0,36000,36001
,    0,    0,    0,    0,236801,    0,116326,116327,    0,    0
,    0,116331,    0,    0,    0,    0,    0,    0,236815,236816
,    0,    0,236819,    0,    0,397458,    0,    0,    0,    0
,116350,    0,236829,    0,    0,    0,116356,    0,236835,99148
,116360,    0,    0,    0,133575, 1625,    0,    0,    0,    0
,    0,    0,59002,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0, 1643,    0,59015,    0,    0,    0,    0
,    0,99180,    0,99182,    0,122132,    0,311455,311456,311457
,    0,    0,    0,    0,    0,    0,328675,328676,328677,    0
,    0,294258,    0,351630,363105,    0,    0,    0,386057,    0
,59050,    0,    0,99212,99213,    0,59056,99216,    0,231169
,99219,    0,99221,59063,    0,59065,    0,    0,    0,    0
,59070,    0,328711,59073,59074,    0,59076,328716,59078,59079
,59080,    0,59082,162349,    0,59085,    0,196775,    0,162355
,    0,162357,    0,    0,162360,    0,127940,    0,    0,    0
,317265,150893,    0,162369,    0,    0,    0,    0,162374,    0
,    0,    0,162378,    0,    0,    0,162382,    0,    0,    0
,    0,    0,328761,    0,305815,162391,    0,    0,    0,    0
,162396,30446,162398,    0,150926,    0,    0,    0,127982,386148
,127984,162407,    0,    0,162410,    0,    0,162413,    0,    0
,127994,    0,    0,    0,    0,403375,    0,    0,116528,    0
,128004,    0,133743,150955,    0,    0,150958,368965,368966,    0
,    0,    0,150964,128017,150966,    0,    0,    0,    0,128023
,    0,99340,    0,99342,    0,    0,    0,    0,    0,128033
,116560,    0,116562,    0,    0,    0,    0,    0,    0,    0
,    0,    0,328841,    0,    0,99364,    0,99366,369006,99368
,99369,    0,    0,    0,328853,328854,    0,    0,    0,328858
,    0,    0,    0,116593,328863,328864,    0,328866,    0,    0
,    0,    0,    0,237080,    0,    0,128080,208399,    0,    0
,208402,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,328902,42053,    0,    0,363328,    0,    0
,    0,214170,    0,323175,    0,323177,323178, 1907,    0,    0
,    0,    0, 1912,    0,    0,    0,    0,277293,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,208469,    0,    0
,    0,    0,    0,    0,36366,    0,151108,    0,    0,    0
,    0,    0,151114,    0,151116,    0,    0,369125,    0,369127
,36382,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,36395,36396,288825,24924,36399,36400,    0
,    0,    0,    0,369151,    0,    0,    0,369155,    0,369157
,277366,    0,369160,    0,    0,116735,156895,    0,323270,    0
,179847,128215,    0,    0,    0,    0,    0,    0,116748,    0
,    0,116751,    0,    0,99543,116755,    0,    0,    0,36441
,36442,36443,    0,36445,    0,36447,36448,36449,    0,277405
,    0,    0,    0,323305,323306,323307,277412,122514,    0,    0
,    0,    0,    0,    0,    0,122522,    0,    0,    0,122526
,    0,122528,    0,    0,122531,    0,122533,    0,122535,    0
,122537,277437,122539,122540,122541,    0,    0,    0,    0,    0
,    0,    0,    0,    0,277450,277451,99605,    0,99607,99608
,    0,    0,    0,197141,    0,    0,    0,99616,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,36526,36527,    0,    0,    0,277485
,    0,277487,197170,197171,    0,    0,162752,185701,    0,162755
,    0,197179,    0,197181,    0,    0,    0,    0,162764,162765
,    0,    0,    0,    0,277510,    0,    0,    0,277514,277515
,277516,    0,    0,    0,277520,    0,    0,    0,    0,    0
,162786,    0,    0,    0,    0,    0,    0,162793,99687,    0
,317695,    0,    0,    0,    0,    0,162802,317702,197226,162805
,    0,    0,162808,    0,283287,317710,    0,    0,    0,    0
,403770,    0,283295,    0,    0,    0,    0,    0,    0,    0
,30875,    0,    0,    0,197252,277571,    0,36619,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,99737,    0
,    0,    0,99741,    0,36636,    0,36638,    0,380860,    0
,260385,99750,99751,99752,99753,    0,99755,    0,    0,99758
,99759,99760,99761,    0,    0,99764,99765,99766,99767,    0
,    0,99770,197300,197301,197302,    0,    0,    0,197306,134200
,    0,    0,174362,    0,    0,    0,    0,197315,197316,197317
,197318,197319,197320,36685,    0,197323,197324,197325,197326,    0
,197328,197329,197330,197331,197332,    0,226019,    0,    0,36701
,36702,71125,71126,71127,    0,    0,    0,    0,    0,    0
,    0,71135,    0,    0,335040,    0,214565,157196,71142,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,59680,    0,    0,    0,    0,71159,71160,    0,    0,    0
,    0,71165,    0,    0,    0,289175,289176,289177,    0,    0
,    0,    0,    0,59703,36756,    0,    0,    0,    0,    0
,59710,59711,59712,59713,    0,    0,    0,162983,    0,59719
,162986,    0,162988,162989,162990,    0,    0,    0,    0,    0
,162996,    0,    0,    0,289214,    0,289216,163003,363799,    0
,134321,    0,163008,    0,134325,    0,134327,    0,    0,363810
,    0,163017,    0,157282,    0,    0,    0,    0,    0,277765
,    0,    0,134343,134344,134345,    0,    0,    0,122875,    0
,    0,    0,122879,    0,    0,    0,25354,    0,    0,    0
,163046,    0,163048,    0,134365,    0,13890,122894,    0,    0
,    0,363852,59792,    0,    0,363856,    0,    0,    0,231909
,    0,    0,122909,    0,    0,59805,    0,    0,122915,122916
,122917,122918,    0,122920,122921,    0,122923,317982,    0,    0
,    0,122928,    0,122930,    0,122932,    0,122934,122935,122936
,352417,    0,    0,352420,363895,    0,386845,    0,386847,    0
,    0,    0,59842,    0,318009,    0,    0,197535,197536,    0
,    0,    0,    0,    0,220490,    0,289336,    0,    0,318024
,88545,289341,    0,59863,59864,59865,59866,    0,59868,59869
,    0,    0,    0,289353,    0,    0,    0,197565,    0,    0
,    0,    0,318047,    0,    0,    0,    0,    0,    0,    0
,289370,318056,318057,318058,    0,    0,    0,318062,    0,318064
,318065,318066,404122,    0,    0,381177,    0,381179,    0,    0
,    0,    0,    0,381185,    0,381187,    0,    0,    0,54182
,    0,    0,    0,54186,381196,    0,54189,381199,    0,386938
,    0,    0,381204,    0,    0,    0,381208,    0,140256,19780
,381212,    0,381214,    0,    0,19786,186160,    0,    0,    0
,    0,42740,    0,186167,381226,    0,381228,    0,    0,197647
,    0,    0,    0,151755,    0,381237,111599,    0,381240,    0
,    0,381243,197660,    0,37026,    0,    0,    0,140296,    0
,    0,364042,    0,    0,    0,260780,    0,    0,    0,    0
,    0,19832,19833,    0,    0,    0,    0,    0,19839,    0
,19841,249322,    0,    0,249325,    0,341119,197695,197696,197697
,    0,    0,54275,197701,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,323931
,197718,    0,    0,197721,    0,197723,    0,    0,    0,197727
,    0,    0,197730,60043,    0,364106,364107,    0,    0,    0
,    0,    0,364113,    0,14158,    0,    0,    0,    0,    0
,    0,214960,169065,    0,312492,    0,    0,    0,    0,    0
,54333,54334,54335,    0,169077,    0,    0,    0,54341,    0
,    0,341194,54345,    0,    0,    0,    0,312515,312516,169092
,    0,    0,    0,226466,312522,    0,266628,    0,    0,    0
,    0,    0,    0,387112,169107,60105,60106,60107,    0,    0
,346960,    0,    0,157642,    0,    0,60116,278123,    0,    0
,    0,    0,    0,    0,    0,    0,19967,    0,    0,266661
,266662,    0,    0,    0,    0,    0,    0,19978,381410,    0
,    0,    0,    0,    0,    0,    0,25724,    0,    0,    0
,157679,    0,    0,    0,    0,    0,387165,    0,266690,266691
,    0,    0, 2792,    0,266696,    0,    0,266699,    0,266701
,25748,    0,    0,    0,    0,25753,169179, 2807,    0,134760
, 2810,134762,134763,    0,    0,169188,    0,60187,    0, 2819
,169193,    0,169195,169196,169197,169198,169199,157726,375733,    0
,    0,    0,    0,    0,    0,    0,100365,100366,    0,    0
,169213,    0,    0,    0,    0,306906,    0,    0,    0,    0
,    0,169224,    0,157752,    0,    0,    0,375762,    0,    0
,    0,65968,    0,    0,    0,60235,    0,    0,100397,    0
,    0,60241,    0, 2873,    0,100404,    0,100406,    0,    0
,60250,398734,318417,266785,266786,    0,266788,    0,60258,60259
,60260,60261,    0,    0,    0,    0,60266,60267,197956,    0
,60270,157800,    0,157802,    0,318440,    0,    0,    0,    0
,    0,    0,318447,14387,    0,    0,157815,    0,    0,    0
,    0,157820,100451,66030,    0,    0,    0,    0,186512,    0
,157829,    0,157831,157832,    0,129149,157835,    0,    0,134890
,134891,    0,266844,266845,266846,    0,    0,266849,    0,266851
,266852,    0,    0,266855,    0,    0,    0, 2957,    0,249650
,    0,100490,94754,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,249665,    0,43135,    0,318513,    0
,    0,    0,249673,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,100525,100526,100527,77580
,    0,    0,100531,    0,20215,    0,    0,100536,    0,    0
,    0,    0,100541,100542,100543,100544,100545,    0,66125,100548
,100549,100550,    0,215292,100553,100554,100555,100556,100557,    0
,    0,100560,    0,347253,    0,77616,77617,    0,    0,    0
,    0,    0,    0,    0, 3044,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,66162,404646,    0,    0,66166
,    0,    0,    0,404653,157963,    0,    0,    0,60438,    0
,198128,    0,    0,    0,    0,    0,    0,    0,    0,66186
,    0,    0,66189,66190,66191,66192,244040,    0,    0,    0
,    0,    0,398945,    0,    0, 3095, 3096,    0,    0,    0
,60470,    0,60472,    0,    0,    0,    0,    0,    0,    0
, 3110,    0,    0,37535,49010,    0,    0,    0,    0,    0
,49016,    0,    0,49019,    0,    0,    0,    0,    0,    0
,60500,    0,60502,    0,    0,    0,60506,    0,180985,60509
,    0,    0,    0,    0,    0,    0,393262,215416,49044,215418
,215419,215420,255580,    0,    0,    0,    0,    0,    0,    0
,    0,72005,    0,    0,    0,49061,49062,49063,    0,49065
,49066,    0,    0,49069,49070,49071,353133,    0,158077,    0
,255608,    0,135133,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,255622,    0,    0,    0,255626,100728
,    0,    0,255630,    0,    0,255633,    0,    0,353165,353166
,353167,    0,60582,    0,    0,    0,    0,    0,    0,364650
,    0,    0,    0, 3223,    0,60595,    0,244181,    0,    0
,    0,100760,100761,100762,    0,    0,    0,255665,353195,    0
,353197,353198,112245,    0,353201,    0,    0,353204,    0,353206
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,60630,    0,    0,100792,100793,    0,    0,    0,    0,232749
,    0,    0,100801,    0,221280,60645,341759,341760,    0,    0
,    0,227024,    0,    0,60654,    0,60656,95079,    0,60659
,60660,60661,60662,    0,    0,60665,    0,    0,295885,77880
,49196,49197,318837,    0,    0,    0,    0,    0,    0,    0
,    0,    0,49208,    0,    0,    0,    0,    0,    0,    0
,353277,    0,    0,186907,    0,    0,186910,72171,    0,    0
,    0,    0,255760,    0,    0,    0,353293,    0,    0,    0
,    0,    0,    0,100872,    0,    0,    0,    0,410675,    0
,43509,    0,    0,    0,43513,    0,    0,141045,    0,    0
,250051,250052,318897,    0,    0,    0,    0,    0,353325,353326
,353327,    0,    0,    0,353331,37797,    0,37799,    0,    0
,    0,32066,89437,    0,255812,112388,    0,364818,255816,    0
,    0,    0,    0,    0,353351,    0,353353,    0,353355,353356
,353357,    0,    0,353360,    0,    0,43565,    0,    0,250100
,    0,    0,    0,43572,100943,    0,100945,    0,    0,100948
,100949,    0,100951,100952,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,32124
,255868,    0,    0,    0,    0,347665,    0,209979,255876,255877
,255878,255879,255880,255881,    0,255883,255884,255885,244412,    0
,    0,255889,    0,60833,    0,198523,    0,399320,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,336230,    0,    0,    0,    0,    0
,    0,    0,    0,    0,290344,    0,60866,60867,364929,    0
,    0,    0,347722,    0,    0,89560,72350,    0,    0,    0
,    0,    0,123989,    0,78095,    0,    0,    0,    0,    0
,    0,    0,210054,    0,    0,60895,    0,60897,    0,    0
,    0,60901,    0,    0,60904,    0,60906,    0,    0,    0
,    0,    0,169915,250234,181391,250236,    0,    0,    0,    0
,49446,    0,    0,410880,    0,135506,49452,    0,    0,278935
,    0,158460,    0,37985,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,112578,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,89642,    0,    0
,342073,    0,169965,    0,    0,    0,    0,    0,    0,169972
,    0,15075,    0,    0,26552,    0,192927,    0,112611,112612
,    0,210143,278988,    0,    0,    0,    0,    0,    0,    0
,60990,    0,    0,342106,342107,    0,    0,    0,    0,    0
,198688,    0,    0,    0,279010,    0,279012,112640,112641,    0
,112643,    0,    0,    0,210176,210177,112649,    0,112651,    0
,    0,    0,342135,342136,342137,    0,    0,61027,342141,    0
,    0,    0,198720,    0,    0,    0,    0,    0,    0,221675
,61040,    0,    0,210205,    0,210207,    0,    0,    0,    0
,61050,61051,210214,61053,    0,    0,61056,61057,210220,    0
,    0,    0,198750,198751,    0,198753,296283,    0,198756,    0
,    0,198759,    0,198761,    0,164341,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,112722
,    0,    0,    0,    0,    0,    0,    0,279103,    0,210261
,    0,    0,112735,    0,342217,    0,290586,    0,    0,    0
,    0,    0,    0,    0,175854,    0,    0,342230,198806,26697
,    0,    0,    0,    0,    0,210287,    0,    0,    0,359453
,    0,    0,    0,    0,393880,    0,    0,112770,    0,    0
,    0,    0,    0,112776,    0,    0,158675,    0,    0,    0
,    0,    0,    0,342266,342267,    0,    0,    0,342271,    0
,112793,    0,    0,    0,    0,112798,    0,112800,    0,112802
,    0,130015,112805,210335,    0,    0,    0,342290,    0,    0
,342293,342294,342295,    0,342297,336561,    0,342300,    0,    0
,210352,    0,    0,    0,    0,    0,210358,    0,    0,210361
,359524,    0,    0,    0,210366,210367,    0,    0,    0,    0
,    0,198899,    0,    0,    0,    0,198904,    0,198906,    0
,198908,    0,    0,198911,198912,    0,336602,198915,61228,336605
,    0,336607,    0,    0,141552,193186,    0,    0,    0,    0
,    0,72715,72716,72717,    0,    0,    0,95669,325150,    0
,325152,325153,    0,    0,    0,    0,    0,262052,    0,198947
,61260,61261,61262,    0,336640,    0,    0,313695,239115,    0
,239117,72745,72746,    0,    0,    0,    0,    0,    0,    0
,72754,    0,72756,    0,    0,    0,359610,359611,    0,359613
,61290,61291,61292,61293,    0,    0,61296,    0,    0,61299
,    0,61301,296519,    0,    0,    0,    0,    0,    0,279315
,    0,    0,    0,    0,    0,    0,    0,348167,    0,    0
,    0,    0,359646,359647,    0,141643,158855,    0,    0,399812
,    0,    0,    0,    0,    0,    0,    0,399820,    0,    0
,    0,    0,313770,325245,    0,359669,359670,359671,    0,359673
,359674,359675,359676,    0,    0,    0,359680,    0,    0,    0
,    0,239208,    0,    0,    0,    0,72840,113000,    0,    0
,    0,    0,61372,    0,    0,    0,388385,    0,325280,325281
,325282,    0,    0,    0,    0,61385,    0,    0,    0,399872
,    0,    0,    0,    0,365455,    0,244980,    0,    0,336775
,    0,72875,    0,    0,    0,336781,    0,72881,336784,    0
,353997,    0,    0,354000,    0,    0,72890,72891,    0,    0
,    0,    0,    0,    0,72898,72899,    0,    0,113061,72903
,72904,72905,72906,72907,222070,    0,72910,    0,    0,    0
,101599,101600,    0,61443,61444,61445,61446,    0,    0,    0
,    0,    0,61452,    0,262249,61455,    0,    0,    0,78670
,    0,    0,    0,    0,    0, 9832,405686,    0, 9835,    0
,    0,    0,199160,    0,    0,    0,    0,262272,67215,67216
,    0,67218,    0,    0,67221,    0,    0,    0,    0,    0
,    0,187705,    0,    0,    0,32810,32811,32812,    0,    0
,    0,    0,    0,    0,    0,32820,405726,250828,    0,    0
,    0,    0,32827,32828,    0,32830,    0,    0,    0,    0
,    0,    0,    0,    0,    0,32840,32841,    0,    0,32844
,32845,    0,    0,348383,    0,32850,    0,    0,    0,250860
,250861,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,113186,    0,    0,193507,    0,    0,    0
,    0,    0,    0,    0,73038,113198,    0,371365,    0,250890
,250891,250892,250893,67310,    0,250896,130420,130421,250899,    0
,250901,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,136181,    0,    0,    0,118974,    0,    0,    0,67345,67346
,67347,    0,    0,    0,67351,50141,    0,    0,    0,    0
,    0,405841,227995,    0,    0,250946,216525,    0,    0,    0
,    0,    0,    0,    0,67371,    0,    0,    0,    0,67376
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,250972,    0,    0,    0,61655,61656,61657,    0,    0
,    0,    0,    0,    0,250985,    0,    0,    0,    0,    0
,    0,    0,    0,    0,78885,    0,    0,216576,147733,193630
,    0,    0,136263,    0,    0,61685,    0,61687,61688,10056
,    0,    0,388701,    0,61694,    0,61696,    0,    0,    0
,251021,    0,    0,216602,    0,251026,    0,    0,    0,    0
,147765,    0,    0,    0,    0,    0,251037,    0,    0,251040
,    0,    0,251043,    0,251045,    0,    0,251048,251049,251050
,251051,251052,    0,354320,251055,    0,354323,    0,    0,    0
,147795,147796,    0,    0,    0,    0,    0,245331,    0,    0
, 4380,    0, 4382,268285,    0,    0,159285,365818,    0,    0
,354347,    0,    0,    0,    0,    0,    0,61767,    0,90454
,377305,279777,    0,    0,    0,354362,245360,245361,245362,245363
,    0,    0,    0, 4413,    0,245369, 4416,245371,319953, 4419
,360114, 4421,    0,    0,216693,342908,    0,    0,    0,354386
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,119180,    0,    0,    0, 4444,61815,61816,    0,    0,    0
,319985,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,245416,    0,    0,147890, 4466,27415,61838,61839
,61840,    0,188056,    0,61844,61845,61846,    0,    0,    0
,    0,    0,    0,320018,79065,147910,320021,    0,245442,320024
,    0,320026,    0,56126,    0,    0,354453,199555,    0,    0
,147925,    0,    0,    0,    0, 4505,147931,188091,    0,    0
,    0,165147,    0,    0,    0,67622,    0,    0,    0,    0
,    0,    0,56155,    0,    0,    0,147951,    0,    0,147954
,147955,    0,    0,    0,27482,147960,    0,245491,245492,165175
,    0,    0,    0,    0,    0,165181,    0,    0,165184,    0
,    0,245505,    0,    0,245508,    0,    0,    0, 4558,    0
,    0,245515,    0,    0,    0,    0,    0,    0,    0,    0
, 4570,    0, 4572,165209,    0,    0,    0,142265,    0,    0
,    0,    0,    0,188167,    0,    0,    0,    0,    0,    0
,    0,130805,    0,    0,    0,165231,188180,    0,    0,    0
,    0,    0,    0,245557,56237,    0,    0,    0,    0,    0
,320145,320146,320147,10350,    0,    0,320151,56250,    0,    0
,56253,165257,    0,    0,    0,320160,320161,320162,    0,320164
,    0,188215,188216,    0,    0,320170,320171,188221,    0,320174
,320175,320176,320177,    0,    0,320180,188230,188231,188232,188233
,    0,188235,56285,56286,    0,188239,188240,    0,56291,188243
,188244,188245,188246,188247,    0,    0,188250,    0,    0,165305
,165306,165307,    0,    0,    0,    0,56309,56310,56311,    0
,56313,    0,    0,56316,    0,165321,165322,    0,165324,165325
,    0,    0,165328,165329,    0,165331,228439,165333,165334,165335
,165336,165337,    0,    0,165340,    0,    0,159606,    0,    0
,    0,    0,    0,    0,    0,    0,    0,194038,182565, 4719
,    0,    0,    0,159622,    0,    0,159625,    0,16202,    0
,    0,    0,171105,171106,    0,    0,148161,    0,    0,    0
,    0,    0,171115,    0,    0,217014,    0,    0,    0,400602
,    0,16225,    0,    0,    0,16229,    0,    0,    0,    0
,    0,    0,    0,268665,    0,148190,148191,148192,    0,    0
,16244,148196,73616,    0,148199,    0,148201,    0,    0,102308
,377685,343264,257210,    0,    0,    0,159685,159686,159687,    0
,16264,16265,    0,    0,    0,16269,    0,16271,    0,16273
,    0,    0,16276,    0,16278,16279,16280,16281,16282,400662
,    0,    0,    0,102342,    0,    0,102345,    0,    0,    0
,    0,148246,113825,    0,    0,113828,    0,    0,113831,    0
,    0,113834,119572,113836,    0,234315,211368,377742,268740,    0
,268742,102370,    0,    0,102373,142533,182693,    0,165484,343332
,102379,    0,102381,    0,    0,56488,    0,    0,    0,    0
,148285,    0,    0,    0,    0,159764,    0,    0,    0,159768
,159769,159770,    0,159772,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,56520,56521,56522
,    0,    0,    0,211425,    0,148320,148321,    0,320433,    0
,    0,148326,    0,    0,113907,    0,    0,    0,    0,    0
,148335,148336,148337,    0,    0,148340,    0,    0,    0,    0
,    0,148346,    0,    0,148349,148350,    0,    0,56561,    0
,148355,268833,    0,    0,    0,    0,102465,395053,    0,    0
,    0,    0,    0,    0,    0,    0,    0,286060,119688,    0
,257378,    0,113955,113956,113957,    0,102485,131171,    0,    0
,    0,33646,    0,    0,    0,349185,    0,    0,349188,159868
,    0,    0,102501,    0,    0,113978,    0,    0,113981,159878
,    0,    0,    0,113986,    0,251676,102515,    0,102517,102518
,102519,102520,349212,    0,102523,    0,    0,102526,    0,    0
,102529,102530,102531,102532,349224,228748,    0,349227,    0,    0
,119750,119751,    0,119753,    0,    0,    0,217286,217287,119759
,    0,119761,    0,240240,251715,303349,159925,159926,    0,    0
,    0,349251,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,217321,56686,    0,217324,    0,217326,    0,62429
,    0,257489,    0,    0,    0,    0,    0,    0,    0,    0
,56703,56704,56705,56706,    0,56708,    0,    0,56711,    0
,73924,73925,56715,    0,    0,    0,159985,    0,349308,    0
,280466,280467,    0,    0,349314,    0,    0,    0,349318,349319
,    0,160000,160001,    0,349324,    0,    0,    0,79689,    0
,10847,    0,    0,349333,349334,    0,    0,    0,    0,    0
,    0,    0,    0,73967,    0,73969,73970,73971,    0,73973
,    0,160030,    0,211665,211666,    0,    0,    0,    0,    0
,119880,    0,119882,    0,125621,    0,    0,73991,    0,    0
,    0,    0,    0,    0,    0,119895,119896,119897,119898,119899
,119900,    0,332171,119903,    0,    0,    0,    0,119908,119909
,119910,119911,119912,    0,    0,119915,217445,217446,217447,    0
,    0,    0,217451,    0,    0,    0,    0,    0,    0,251880
,251881,251882,246146,    0,366625,366626,366627,366628,125675,217468
,    0,217470,    0,366634,217473,    0,217475,    0,    0,74053
,    0,    0,74056,    0,74058,    0,    0,280593,    0,    0
,    0,    0,    0,    0,    0,280601,    0,280603,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,177363,    0,91310,    0,188841,    0,    0
,    0,177371,177372,    0,51160,    0,    0,    0,    0,    0
,303594,    0,    0,165909,    0,    0,366707,    0,131492,    0
,326552,    0,56915,56916,56917,    0,200344,    0,    0,    0
,    0,    0,177402,406883,    0,    0,    0,    0,120038,    0
,    0,120041,120042,120043,    0,286418,    0,74151,297895,74153
,74154,    0,56945,    0,    0,56948,177426,74161,56951,74163
,    0,56954,    0,56956,    0,366756,    0,171700,    0,    0
,366761,    0,    0,    0,343817,165971,    0,    0,    0,    0
,    0,    0,    0,    0,    0,143033,    0,366778,    0,366780
,366781,    0,    0,366784,366785,366786,366787,    0,    0,366790
,    0,    0,286475,    0,177474,    0,74210,74211,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,384020,217648
,74224,    0,74226,    0,252075,    0,    0,    0,    0,    0
,    0,    0,    0,    0,57027,    0,    0,    0,    0,177509
,    0,    0,143090,    0,    0,    0,    0,57040,    0,    0
,    0,217680,217681,    0,    0,    0,194737,338163,    0,    0
,    0,    0,    0,    0,194745,    0,194747,    0,    0,194750
,    0,    0,    0,    0,194755,194756,    0,194758,194759,194760
,    0,217710,    0,    0,    0,    0,    0,    0,57081,    0
,    0,194772,217721,    0,45613,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,57099,    0,57101,    0
,    0,57104,57105,57106,    0,194796,194797,    0,    0,194800
,    0,194802,194803,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,401353,    0,    0,    0,11241,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,171890,    0,    0
,    0,    0,    0,217792,229267,    0,    0,    0,    0,    0
,292380,    0,    0,    0,    0,    0,    0,    0,    0,126016
,    0,    0,    0,    0,    0,97337,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,389945,366998,257996,    0
,    0,217840,217841,217842,137525,    0,    0,217846,    0,    0
,    0,    0,    0,    0,    0,    0,    0,126064,    0,    0
,252281,    0,    0,126070,217863,    0,    0,217866,    0,217868
,217869,217870,217871,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,355572,11353,    0,    0,137570
,137571,137572,137573,    0,    0,    0,    0,    0,    0,    0
,    0,137582,    0,    0,    0,    0,91691,    0,    0,    0
,    0,103170,332651,    0,    0,    0,    0,    0,    0,194970
,    0,    0,    0,    0,194975,    0,91711,    0,    0,57292
,    0,    0,    0,    0,    0,321200,    0,    0,    0,    0
,    0,    0,    0,200731,    0,    0,166312,    0,    0,200737
,    0,    0,200740,    0,    0,    0,    0,    0,    0,57322
,200748,    0,    0,    0,    0,149120,    0,    0,263863,    0
,    0,    0,    0,    0,    0,177815,    0,57340,    0,    0
,    0,    0,    0,    0,91769,    0,    0,    0,298305,    0
,407310,    0,    0,    0,166360,    0,    0,    0,    0,    0
,263895,263896,    0,304076,86070,263927,177872,263928,22974,263934
,143457,103298,126285,97600,97633,57474,275481,264007,275482,57476
,332856,258275,97639,34532,332857,258276,275488,258277,97641,315648
,258278,264055,28838,315705,264072,264085,97712,264087,28870,355881
,28872,407515,264090,332979,97762,378885,97772,212513,97773,132210
,97788,212546,172387,212577,92100,212584,34737,298656,264234,69190
,29031,287201,29036,287202,166725,86407,166726,126567,298687,178210
,298688,23312,178212,57735,178213,57736,298691,57737,298694,29055
,126585,57741,29056,57744,29059,252803,29060,57746,29061,287232
,166755,287233,166756,212657,166761,287241,166764,275775,57769,69265
,57791,287280,120907,287286,212705,287287,252865,212706,86492,252866
,212707,  438,298767,252871,178305,120935,212728,120936,212729,120937
,57830,212730,120938,287312,212731,212733,166837,120941,212736,120944
,212737, 6205,298817,252921,178340,  493,384873,178341,178342,57865
,298821,57867,298830,293093,298831,57877,298832,57878,298834,287360
,57880,298835,287361,57881,287362,166885,57882,166886,57883,298838
,166887,120991,69358,57884,298839,57885,298840,287366,166891,57888
,298843,252947,57889,298844,57890,298845,57891,298847,92315,57893
,287375,57895,298850,287376,57896,287377,57897,287380,172640,57900
,287385,166908,287386,166909,350494,166910,293125,287388,166911,293126
,287389,293127,287390,166913,121017,304602,287391,166914,287392,166915
,293130,166916,275943,252995,17778,293155,252996,293156,252997,293166
,149741,253011,149745,253018,121067,287446,253024,253027,17810,121081
,17815,149770,121085,149772,35032,149773,121088,121089,35034,149776
,121091,149779,121094,86672,344838,121095,149781,121096,316167,98161
,17843,367810,138330,344870,293237,339147,310462,224407,333417,212940
,344903,293270,344906,333432,270329,149852,333445,293286,333446,293287
,333447,212970,58071,333448,212971,212972,149865,75284,293291,212973
,333456,212979,212981,207244,293308,  721,293309,  722,293310,149885
,  723,293311,17935,  724,293314,  727,293315,287578,367901,322005
,293320,304801,149902,149906,75325,17955,149909,86802,149911,121226
,224503,161396,58130,17971,299085,149923,17972,344982,299086,149924
,58132,149925,58133,149926,17975,149928,17977,299092,149930,17979
,224512,149931,149932,17981,367940,310570,367941,178620,149935,367942
,17985,344995,17986,167150,17988,213052,17994,304848,17998,287640
,18001,23739,18002,333540,18005,304857,213065,333543,304858,12271
,304859,35220,304861,35222,304864,155702,345031,155710,345036,213085
,207348,12290,396674,390937,333576,230310,333577,230311,213100,230312
,213101,86887,345053,213102,345055,333581,345056,213105,345058,213107
,345059,247530,345060,241794,213109,345062,213111,230327,213116,230328
,213117,230329,213118,230330,213119,333600,213123,333601,213124,  855
,333603,213126,333605,213128,333606,230340,213129,333607,276237,230341
,213130,213132,155762, 6600,333610,230344,172974,230345,172975,213135
,172976,230385,207437,304979,64025,316483,64055,173075,12439,362451
,356714,35442,213348,64186,276474,92890,207644,156011,70030,47082
,259357,12666,362631,305261,385590,24159,12685,230703,167596,242235
, 1281,230820,167713,219375,150531,236642,116165,236670,196511,236671
,196512,12928,236672,116195,12929,236673,116196,334203,116197,236676
,93251,236681,116204,345700,156379,150642,311327,150691,311328,150692
,167906,35955,116277,70381,236765,35970,35971,24497,116290,58920
,35972,150713,58921,150714,58922,150715,58923,150718,58926,150721
,58929,345783,322835,150725,173675,35987,380224,167955,36004,236800
,36005,380227,236802,116325,47484,36010,363020,236806,47485,236817
,179447,116340,385980,236818,248294,236820,248297,236823,58976, 1606
,236824, 1607,236825,116348,236826,116349,236828,116351,236830,116353
,236831,116354,236832,116355,363048,116357,311420,254050, 1622,36045
, 1623,397487,328643, 1634,386031,99181,386055, 1676,317216,99210
,59051,99211,59052,328705,59066,328706,59067,328707,59068,328708
,59069,328714,59075,162347,59081,162359,127937,162370,76315,162373
,99266,150925,99292,368933,150927,380418,162412,127990,99305,328787
,127992,127995,30466,328800,128005,150956,128008,150957,128009,368967
,150961,128013,162437,30486,128026,99341,128031,99346,363252,116561
,19032,328835,99355,368995,328836,254255,99356,368996,328837,311626
,128042,99357,368997,99358,368998,99359,128045,99360,369001,128047
,128048,99363,369004,99365,328850,99370,328851,99371,328852,99372
,328855,99375,328859,225593,116590,328860,116591,328861,116592,328865
,116596,328867,128072,116599,59229,30544,328870,116601,156774,151037
,363319,151050,363323,70736,42051,13382, 1908,369077, 1909,369090
,294509,369091,151085,397777,151086,369093,294512,151087,311727,151091
,196990,116672,179790,36365,116685,36367,162583,151109,162584,151110
,277325,151111,277326,162586,277327,151113,162589,151115,151117,59325
,369126,151120,369131,36385,225710,162603,277355,260144,369148,277356
,122457,116720,369149,277357,116721,369150,277358,260147,116722,47880
,42143,369153,277361,369154,116726,369156,277364,156887,122480,116743
,128218,116744,128219,116745,128220,116746,128221,122484,122486,116749
,128224,116750,122489,116752,363453,122499,36444,128238,36446,340511
,13502,122519,36464,122520,36465,122521,36466,122523,99575, 2046
,329056,122524,99576,156947,122525,99577,197108,122527,122532, 2055
,277453,99606,197140,99611,30767,231564,197142,99614,30770,162742
,36528,352065,162744,317645,277486,197172,162750,76695,277491,197173
,197176,162754,277508,162768,99661,277509,254561,162769,277511,254563
,277513,162773,306202,277517,162777,162807,99700,42330,99735,36628
,197265,99736,36629,254653,99754,283347,99763,162900,36686,197335
,162913,71121,36699,59648,36700,289143,214562,162935,71143,162936
,71144,162937,71145,71155,59681,71156,59682,162982,59716,162987
,59721,289205,162991,289206,162992,289207,162993,36779,289208,162994
,162995,134310,289211,162997,134326,122852,157285,42545,386770,134342
,392517,25349,134355,122881,134356,31090,363838,163043,122884,134359
,25356,312207,163045,134360,289261,163047,289287,122914,386821,122919
,197503,122922,134400,122926,289300,122927,318005,59840,283584,59841
,318011,59846,318014,197537,289335,59855,54118,318022,289337,289350
,59870,289351,59871,289352,59872,318039,289354,289355,59875,289358
,197566,318044,289359,197567,318045,289360,197568,318046,289361,318048
,289363,197571,318049,289364,318050,289365,318051,289366,197574,318052
,289367,54150,318053,197576,54151,318054,54152,318061,186110,381189
,54180,381190,54181,163186,54183,381194,289402,381200,54191,381203
,25509,381221,128793,381242,243554,364051,19831,381267,19836,54262
,19840,346875,329664,346878,329667,404251,197719,404252,197720,197724
,140354,364098,197725,404258,197726,364108,54310,364109,94470,54311
,364110,54312,364111,105946,364114,54316,335435,60059,169068,88750
,169076,54336,60075,54338,60076,54339,60077,54340,157608,54342
,169095,71566,169104,71575,346958,60108,157640,60111,387121,186326
,157641,163380,60114,364186,19966,266660,169131,48657,25709,398616
,255191,387143,48660,381413,157670,381414,157671,381415,157672,381416
,157673,381419,157676,387161,157681,312588,266692,381433,266693, 2791
,278180,100333,387200,169194,169203,60200,243785,169204,243786,169205
,129046,243792,169211,100367,169214,100370,157765,100395,60236,100396
,60237,100398, 2869,266772, 2870,100401, 2872,398732,266781,220885
,66000,60263,66001,60264,66002,60265,197960,157801,134855,77485
,318441,77487,157806,77488,197975,157816,266820,157817,266821,157818
,266822,157819,266826,157823,66031,157824,66032,157825,66033,404517
,157826,157828,66036,186515,157830,266843,134892,266848,31631,266850
,100477,25906, 2958,249654,140651,381623,100510,20192,261170,100534
,20216,249702,100540,20222,215291,100551,94826,77615,358744,330059
,358745, 3051,330062,215322,94845,66160, 3053,66161, 3054,404647
, 3057,215346,20288,66188,37503,398944,48987,60471,37523, 3101
,71955, 3111,60501,14605,226876,60503,255569,60511,410470,393259
,267058,49052,215426, 3157,215428,49055,72012,49064,313002,255632
,353196,135190,100790,60631,100791,60632,181113,60636,100796,31952
,100799,31955,140971,60653,244239,60655,152450,60658,255725,198355
,393441,146750,353290,255761,353291,261499,255762,100885,43515,353348
,250082,100920,353349,100921,353350,255821,100922,353354,100926,89452
,250106,100944,129631,100946,370589,100950,129640,100955,347715,290345
,60865, 3495,60896,49422,255956,60898,347769,49445,278958,244536
,169980,112610,60977,376515,278986,342105,49518,112642,43798,210175
,112646,342138,61025,353613,61026,342144,61031,342146,198721,233144
,198722,210206,72518,210208,15150,61048,15152,210211,61049,210216
,61054,353642,61055,261855,61060,198752,78275,382381,26687,210300
,112771,38190,112772,15243,198832, 9511,342265,112785,348007,198845
,141475,359485,112794,359486,112795,359487,112796,336542,290646,112799
,336544,112801,336550,210336,342288,210337,342289,336552,342291,336554
,336555,210341,342296,336559,336564,210350,336565,210351,359515,210353
,359516,336568,210354,198880,359517,336569,239040,210355,198881, 9560
,359518,198882,359521,336573,210359,210360,198886,336577,210363,359526
,210364,336579,210365,336583,198895,118577,210370,198896,198897,72683
,336586,198898,256270,198900,336591,198903,336593,198905,198909,32536
,290702,198910,336608,141550,336632,198944,359597,72747,371072,72748
,371075,319442,72751,193235,38336,411275,313746,388328,348169,170322
,359645,135902,359651,72801,394085,279345,359668,313772,359677,72827
,342486,199061,113006,336778,72876,353990,336779,124510,72877,353991
,336780,113051,72892,113052,72893,113053,72894,61420,72895,61421
,336798,61422,113059,72900,61426,113060,72901,313863,61435,67185
,61448,296666,61449,67187,61450,331090,61451,95875,78664,67217
,32795,250862,159070,359878,113187,193510,73033,141880,73036,382835
,73037,348433,130427,405843,61623,400121,67375,348490,67377,96108
,61686,61691,10058,251020,159228,251022,216600,147766,50237,170715
,147767,27290,251035,245298,27292,251036,136296,251038,170720,251039
, 4348,251044,38775,251046,38777,279748,147797,27320,147798,27321
,354331,27322,354332,27323,245330,147801,245332,27326,147804,84697
,147806, 4381,354359,256830,61780, 4410,10148, 4411,245366, 4412
,188023,119179,165083,61817,319986,61821,319987,147877,222465,165095
,61830,56093,188055,61841,188057,61843,354434,165113,61847,320015
,302804,61850,331490,320016,320017,199540,56125, 4492,354451,56127
,245455,188085,147926,188086,147927,27450,188087,27451,188088,27452
,67615,27456,165145,67616,188094,165146,354469,188096,147948,56156
,147949,56157,147950,56158,147953,56161,27476,147956,56164,147957
,27480,297120,56166,27481,320071,245490,165176, 4540,165177, 4541
,245496,165178, 4542,79127, 4546,251241,165186,285665,245506, 4552
,245507, 4553,245509, 4555,245510, 4556,188141, 4557,245513, 4559
,245514, 4560,320097,245516,302887, 4563,245518, 4564,245519, 4565
,245520, 4566,360261,245521,245522, 4568,394685, 4569,245525,38993
, 4571,320110, 4575,320163,239845,320165,302954,320168,188217,320169
,165270,320173,228381,199708,188234,188238,56287,216926,188241,325947
,165311,56308,165317,56314,165318,56315,165320,56317,280063,165323
,56320,371862,165330,39116,148128,62073,354665,159607,326007,148160
,159636,148162,389118,171112,50635,217010,159640,400610,257185,16231
,113763,16234,148193,16242,159684,16259,188373,159688,188376,113795
,16266,188377,113796,16267,188378,113797,16268,389175,16270,280174
,16272,125280,16277,44969,16284,102340,16285,102341,16286,366245
,268716,354780,113826,354781,113827,377735,354787,343325,102371,343326
,102372,148272,102376,222860,211386,228610,50763,389251,159771,389253
,159773,303199,159774,90930,148322,102426,297500,148338,148339,45073
,113920,56550,148343,56551,148344,56552,148345,56553,148348,102452
,56556,148351,56559,320462,148352,303282,113961,159859,79541,251658
,159866,113970,159869,33655,125448,102500,45130,159872,102502,349196
,131190,113979,349197,159876,113980,102506,159879,119720,113983,102509
,119721,113984,119722,113985,102511,217253,113987,22195,113990,102516
,349215,102524,377901,102525,102528,56632,360700,102535,119752,56645
,217285,119756,217315,73890,217316,73891,56680,217317,73892,56681
,217318,56682,400911,96850,228805,194383,96855,73907,119806,73910
,73920,56709,73921,56710,349299,56712,314887,39511,314890,119832
,400946,349313,349315,10832,349316,16570,372265,349317,349323,160002
,349325,119845,349331,160010,297705,160017,194440,160018,280497,160020
,171495,73966,349344,280500,73968,217397,73972,211662,160029,73974
,366563,211664,160031,291985,211667,160034,137086,211668,160035,217410
,160040,119881,280521,73989,119886,73990,366595,119904,366596,119905
,366597,119906,366631,217469, 5200,217471, 5202,366636,217474,74049
,217476,74051,246162,217477,74052,360905,246165,217480,74055,320748
,74057,280591,74059,280594,10955,355176,280595,177360,56883,355234
,177387,234761,131495,372457,366720,177399,74144,11037,252004,154475
,74157,56946,252005,56947,74164,34005,366755,320859,154486,366757
,45485,372516,366779,366783,131566,177491,74225,177493,74227,217682
,125890,194739, 5418,194749,166064,85746,315231,194754,217711,194763
,57075,217712,194764,57076,217713,57077,217716,194768,85765,303774
,217719,194781,91515,194786,166101,57098,194788,57100,303794,57103
,338220,57107,85795,57110,194827,11243,298100,22724,217805,160435
,217864,177705,217865,11333,246557,217872,246560,217875,355580,137574
,367055,137575,194973,189236,309714,194974,212187,194976,194979,57291
,200730,194993,355632,166311,166342,22917,275352,57346,286845,263897
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
 ) ;
        --| Hash values to check against to verify that
        --| correct action has been found for this
        --| parser state and input token.
        -- NYU Reference Name: ACTION_TABLE2

    DefaultMap :
        constant array (DefaultMapRange) of GC.ParserInteger :=
         ( 1521,    0,    0,    0,    0, 1519,    0, 1340, 1329, 1520
,    0, 1331,    0, 1549,    0,    0,    0, 1333, 1334, 1335
, 1336, 1337, 1338,    0, 1133,    0, 1395, 1133, 1332, 1339
,    0,    0, 1529,    0,    0, 1395, 1207,    0, 1208, 1190
,    0, 1189, 1151, 1150,    0, 1205, 1206,    0, 1439, 1459
, 1191, 1152, 1153, 1154, 1194, 1173, 1445, 1176, 1177, 1178
, 1179, 1180, 1181, 1184, 1185, 1463, 1468, 1466,    0, 1195
, 1192, 1193,    0, 1442, 1273, 1274,    0,    0, 1561,    0
, 1269, 1583,    0, 1268,    0,    0, 1395,    0, 1496, 1283
,    0, 1562,    0, 1585, 1288, 1483,    0,    0,    0,    0
, 1346, 1146, 1147, 1148,    0, 1133,    0,    0,    0, 1357
, 1581, 1342, 1525, 1523, 1522, 1408, 1216, 1084, 1407,    0
,    0, 1149,    0,    0, 1191, 1424,    0, 1436, 1434, 1172
,    0, 1461,    0, 1198, 1196, 1200,    0, 1197, 1201, 1199
, 1182,    0,    0,    0,    0,    0,    0, 1441,    0, 1175
,    0,    0,    0,    0,    0,    0,    0,    0, 1204, 1202
, 1203,    0, 1211, 1212, 1209, 1210,    0, 1213, 1186,    0
, 1191, 1187, 1464, 1378,    0, 1596,    0,    0,    0,    0
,    0,    0,    0,    0, 1375, 1583, 1131, 1557, 1256, 1399
, 1497, 1498,    0,    0, 1396,    0,    0,    0,    0,    0
, 1583, 1047, 1134, 1048, 1049, 1050, 1051, 1052, 1053, 1054
, 1068, 1069, 1070, 1395, 1135, 1136,    0, 1395, 1395, 1383
, 1384, 1385, 1386, 1483, 1564, 1395, 1428, 1587, 1484,    0
, 1483,    0,    0, 1579, 1483,    0, 1355, 1356,    0,    0
, 1067,    0, 1405, 1530,    0, 1395,    0,    0,    0,    0
,    0,    0, 1188,    0,    0, 1127,    0, 1166,    0, 1167
, 1436, 1330, 1462, 1440, 1113, 1183, 1460, 1090, 1164, 1163
, 1165, 1162, 1161, 1214, 1215,    0, 1157, 1158, 1160, 1159
, 1156, 1445, 1443,    0,    0, 1459, 1449,    0, 1451, 1453
, 1450, 1452, 1454,    0,    0, 1465, 1467, 1469, 1271, 1407
,    0, 1494,    0, 1373, 1565,    0, 1371, 1494, 1582,    0
,    0, 1382, 1534, 1379,    0, 1536,    0,    0,    0, 1395
, 1144, 1145,    0,    0, 1258, 1487, 1281,    0, 1149,    0
, 1154,    0,    0,    0,    0, 1073,    0,    0, 1499,    0
,    0, 1501,    0, 1503,    0, 1284,    0,    0, 1287,    0
,    0,    0, 1560, 1362,    0, 1531, 1278,    0, 1066,    0
, 1341, 1524,    0, 1219, 1218, 1409, 1448, 1444, 1438, 1431
, 1434, 1171, 1126,    0,    0, 1432, 1434, 1437,    0, 1170
,    0,    0, 1155, 1174, 1447, 1446, 1455, 1457, 1456, 1458
, 1278,    0, 1276,    0, 1534, 1534,    0,    0,    0, 1377
,    0,    0, 1429, 1132,    0,    0, 1400, 1399, 1221, 1222
,    0,    0,    0, 1472, 1576,    0, 1401,    0, 1046, 1543
,    0,    0,    0,    0,    0, 1566, 1299, 1543, 1129,    0
, 1294,    0,    0, 1483,    0, 1395, 1563, 1483, 1483, 1055
, 1395, 1056, 1057, 1058,    0, 1286, 1568, 1303,    0,    0
,    0,    0, 1279, 1403,    0, 1526, 1217, 1436, 1125, 1425
, 1433, 1436, 1435, 1114, 1091, 1277, 1403, 1597, 1595,    0
,    0,    0,    0, 1270,    0,    0, 1537,    0,    0,    0
, 1138, 1139, 1140, 1141, 1143, 1137, 1142, 1395,    0,    0
,    0, 1470,    0, 1223, 1224, 1473,    0,    0,    0,    0
,    0,    0,    0,    0,    0, 1570, 1149,    0, 1225, 1226
, 1227, 1229, 1230, 1231, 1232, 1233, 1234, 1235, 1236, 1237
, 1238, 1239, 1240, 1401,    0,    0, 1399, 1309, 1310, 1311
, 1399,    0, 1228, 1257,    0, 1488,    0,    0,    0,    0
,    0,    0,    0,    0, 1082, 1567, 1300,    0,    0,    0
,    0,    0, 1583,    0,    0, 1104, 1071,    0,    0,    0
,    0,    0,    0,    0, 1096, 1097, 1098, 1412, 1412, 1103
,    0,    0, 1420, 1583, 1293, 1298,    0, 1505, 1502, 1395
,    0, 1285,    0, 1063,    0,    0,    0, 1368,    0,    0
, 1369, 1370,    0, 1420, 1533, 1532, 1361, 1280,    0,    0
, 1406, 1169, 1168, 1275,    0, 1495,    0,    0, 1376, 1535
, 1565, 1568, 1430, 1343, 1243, 1399, 1517, 1509,    0,    0
,    0, 1261,    0,    0, 1247, 1475,    0, 1399, 1244, 1353
,    0,    0,    0, 1282,    0,    0,    0,    0, 1556,    0
, 1399, 1559, 1483, 1133, 1307,    0,    0, 1513, 1265,    0
,    0, 1402, 1492, 1489, 1349, 1399, 1490, 1399,    0,    0
,    0, 1544, 1395, 1388, 1387, 1297, 1081,    0, 1083, 1085
, 1086, 1087, 1128, 1109,    0,    0, 1102, 1100,    0,    0
, 1291, 1094, 1095, 1410, 1093, 1074, 1075, 1076, 1077, 1078
, 1079, 1080, 1413, 1099, 1101, 1540, 1395,    0,    0, 1500
, 1301,    0,    0, 1504, 1302, 1063,    0, 1403,    0, 1082
, 1366, 1365, 1367, 1364,    0, 1359,    0, 1404, 1358, 1272
, 1374, 1372,    0,    0, 1471,    0,    0,    0, 1548, 1308
,    0,    0, 1263, 1267, 1477, 1590, 1474, 1354,    0,    0
,    0,    0, 1399, 1479, 1399, 1553, 1554, 1255,    0,    0
,    0,    0, 1483, 1483,    0,    0,    0, 1325, 1326, 1324
, 1313, 1314, 1315, 1316, 1317, 1399, 1399, 1399,    0, 1399
,    0, 1477, 1266,    0, 1352, 1527, 1348, 1493, 1491, 1350
, 1351, 1045, 1393,    0, 1395, 1538,    0, 1580,    0, 1414
, 1191, 1416, 1112,    0, 1289, 1089,    0,    0, 1418, 1395
, 1403, 1594,    0,    0,    0, 1191,    0, 1494, 1304,    0
, 1403,    0,    0, 1347,    0,    0, 1064,    0, 1363,    0
, 1344, 1345,    0, 1327,    0, 1494, 1569, 1305, 1262,    0
, 1592,    0,    0, 1399, 1399, 1394, 1245,    0,    0, 1424
, 1249, 1555, 1250,    0, 1399,    0, 1260,    0,    0, 1321
,    0,    0, 1318, 1516, 1319, 1320, 1593, 1399, 1399, 1571
, 1574,    0, 1399, 1578,    0,    0,    0,    0,    0, 1395
, 1088,    0,    0, 1111,    0, 1106, 1092,    0,    0, 1542
,    0, 1118, 1120, 1543, 1130, 1421, 1507,    0,    0,    0
, 1064,    0, 1059,    0, 1403,    0,    0, 1518, 1511,    0
, 1264,    0,    0, 1478, 1476, 1248, 1547,    0, 1480,    0
,    0,    0, 1483, 1259, 1306, 1575, 1399,    0,    0,    0
,    0, 1514,    0, 1577,    0,    0,    0,    0, 1539, 1110
,    0,    0, 1107,    0, 1108, 1411, 1115,    0, 1395,    0
, 1395, 1397,    0,    0,    0, 1072,    0, 1506, 1065, 1060
, 1403, 1296,    0, 1295,    0,    0, 1510, 1591,    0, 1546
,    0, 1399,    0,    0,    0,    0, 1573,    0,    0, 1528
, 1392,    0, 1389,    0, 1415,    0,    0, 1417,    0,    0
, 1116, 1550, 1117,    0, 1124, 1545,    0, 1292, 1494,    0
, 1061, 1360, 1494, 1246, 1399,    0, 1483, 1251,    0,    0
, 1312, 1390,    0,    0, 1105, 1403,    0, 1398,    0, 1422
, 1290,    0, 1062,    0,    0,    0,    0, 1322,    0, 1391
,    0,    0, 1395, 1395, 1551, 1552,    0, 1508, 1512,    0
, 1483, 1254, 1323, 1119, 1121, 1122, 1123, 1423, 1483,    0
,    0, 1252, 1253)  ;
        --| Map of states (constant array index) to default reductions.
        -- NYU Reference Name: DEFAULT

    type FollowSymbolIndexArray is array ( PositiveParserInteger range <>)
        of GC.ParserInteger ;

    FollowSymbolMapIndex : constant FollowSymbolIndexArray :=
         (    1,    1,    2,    2,    3,    3,    4,   43,   44,   57
,   58,   71,   72,   85,   86,  102,  103,  119,  120,  133
,  134,  150,  151,  167,  168,  181,  182,  195,  196,  209
,  210,  223,  224,  237,  238,  251,  252,  252,  253,  254
,  255,  256,  257,  257,  258,  259,  260,  261,  262,  268
,  269,  270,  271,  272,  273,  286,  287,  300,  301,  314
,  315,  317,  318,  331,  332,  342,  343,  344,  345,  346
,  347,  352,  353,  353,  354,  354,  355,  355,  356,  356
,  357,  357,  358,  358,  359,  359,  360,  393,  394,  395
,  396,  429,  430,  436,  437,  438,  439,  440,  441,  441
,  442,  463,  464,  465,  466,  467,  468,  469,  470,  472
,  473,  474,  475,  477,  478,  478,  479,  489,  490,  491
,  492,  493,  494,  494,  495,  495,  496,  529,  530,  532
,  533,  534,  535,  544,  545,  545,  546,  549,  550,  551
,  552,  572,  573,  574,  575,  579,  580,  581,  582,  582
,  583,  585,  586,  612,  613,  614,  615,  615,  616,  616
,  617,  620,  621,  622,  623,  626,  627,  628,  629,  641
,  642,  653,  654,  655,  656,  664,  665,  672,  673,  686
,  687,  700,  701,  716,  717,  725,  726,  737,  738,  746
,  747,  758,  759,  770,  771,  782,  783,  816,  817,  850
,  851,  885,  886,  919,  920,  954,  955,  955,  956,  985
,  986,  987,  988,  988,  989,  990,  991,  992,  993,  993
,  994,  995,  996,  997,  998,  999, 1000, 1009, 1010, 1017
, 1018, 1025, 1026, 1033, 1034, 1041, 1042, 1049, 1050, 1059
, 1060, 1070, 1071, 1095, 1096, 1124, 1125, 1149, 1150, 1179
, 1180, 1208, 1209, 1237, 1238, 1244, 1245, 1274, 1275, 1304
, 1305, 1334, 1335, 1345, 1346, 1354, 1355, 1363, 1364, 1372
, 1373, 1379, 1380, 1416, 1417, 1444, 1445, 1471, 1472, 1497
, 1498, 1502, 1503, 1529, 1530, 1556, 1557, 1576, 1577, 1594
, 1595, 1621, 1622, 1648, 1649, 1649, 1650, 1676, 1677, 1703
, 1704, 1730, 1731, 1757, 1758, 1784, 1785, 1811, 1812, 1838
, 1839, 1865, 1866, 1892, 1893, 1919, 1920, 1946, 1947, 1973
, 1974, 2000, 2001, 2020, 2021, 2023, 2024, 2026, 2027, 2027
, 2028, 2031, 2032, 2033, 2034, 2034, 2035, 2055, 2056, 2057
, 2058, 2078, 2079, 2081, 2082, 2102, 2103, 2103, 2104, 2104
, 2105, 2107, 2108, 2110, 2111, 2131, 2132, 2133, 2134, 2134
, 2135, 2136, 2137, 2148, 2149, 2151, 2152, 2156, 2157, 2158
, 2159, 2160, 2161, 2163, 2164, 2164, 2165, 2165, 2166, 2177
, 2178, 2178, 2179, 2179, 2180, 2192, 2193, 2194, 2195, 2206
, 2207, 2219, 2220, 2220, 2221, 2222, 2223, 2224, 2225, 2228
, 2229, 2229, 2230, 2233, 2234, 2245, 2246, 2246, 2247, 2250
, 2251, 2252, 2253, 2273, 2274, 2274, 2275, 2301, 2302, 2328
, 2329, 2355, 2356, 2363, 2364, 2366, 2367, 2369, 2370, 2372
, 2373, 2375, 2376, 2378, 2379, 2381, 2382, 2384, 2385, 2408
, 2409, 2411, 2412, 2435, 2436, 2439, 2440, 2441, 2442, 2462
, 2463, 2467, 2468, 2468, 2469, 2491, 2492, 2493, 2494, 2501
, 2502, 2503, 2504, 2511, 2512, 2516, 2517, 2524, 2525, 2532
, 2533, 2538, 2539, 2540, 2541, 2542, 2543, 2550, 2551, 2554
, 2555, 2556, 2557, 2557, 2558, 2558, 2559, 2559, 2560, 2580
, 2581, 2582, 2583, 2603, 2604, 2605, 2606, 2608, 2609, 2614
, 2615, 2620, 2621, 2626, 2627, 2628, 2629, 2629, 2630, 2630
, 2631, 2632, 2633, 2634, 2635, 2636, 2637, 2637, 2638, 2639
, 2640, 2640, 2641, 2642, 2643, 2656, 2657, 2670, 2671, 2684
, 2685, 2698, 2699, 2703, 2704, 2704, 2705, 2709, 2710, 2714
, 2715, 2716, 2717, 2718, 2719, 2719, 2720, 2721, 2722, 2723
, 2724, 2724, 2725, 2736, 2737, 2738, 2739, 2740, 2741, 2761
, 2762, 2782, 2783, 2784, 2785, 2786, 2787, 2787, 2788, 2788
, 2789, 2791, 2792, 2793, 2794, 2796, 2797, 2803, 2804, 2805
, 2806, 2809, 2810, 2810, 2811, 2831, 2832, 2852, 2853, 2855
, 2856, 2856, 2857, 2857, 2858, 2858)  ;

    FollowSymbolMap : constant FollowSymbolArray :=
         (   96,   96,   72,    2,    4,   10,   12,   14,   15,   19
,   20,   21,   22,   23,   24,   25,   26,   27,   28,   29
,   33,   37,   39,   42,   43,   44,   45,   46,   51,   53
,   54,   55,   56,   57,   59,   60,   61,   62,   63,   65
,   67,   68,   92,   10,   21,   25,   26,   27,   42,   43
,   44,   45,   55,   56,   59,   60,   65,   10,   21,   25
,   26,   27,   42,   43,   44,   45,   55,   56,   59,   60
,   65,   10,   21,   25,   26,   27,   42,   43,   44,   45
,   55,   56,   59,   60,   65,   10,   21,   25,   26,   27
,   42,   43,   44,   45,   54,   55,   56,   59,   60,   63
,   65,   96,   10,   21,   25,   26,   27,   42,   43,   44
,   45,   54,   55,   56,   59,   60,   63,   65,   96,   10
,   21,   25,   26,   27,   42,   43,   44,   45,   55,   56
,   59,   60,   65,   10,   21,   25,   26,   27,   42,   43
,   44,   45,   54,   55,   56,   59,   60,   63,   65,   96
,   10,   21,   25,   26,   27,   42,   43,   44,   45,   54
,   55,   56,   59,   60,   63,   65,   96,   10,   21,   25
,   26,   27,   42,   43,   44,   45,   55,   56,   59,   60
,   65,   10,   21,   25,   26,   27,   42,   43,   44,   45
,   55,   56,   59,   60,   65,   10,   21,   25,   26,   27
,   42,   43,   44,   45,   55,   56,   59,   60,   65,   10
,   21,   25,   26,   27,   42,   43,   44,   45,   55,   56
,   59,   60,   65,   10,   21,   25,   26,   27,   42,   43
,   44,   45,   55,   56,   59,   60,   65,   10,   21,   25
,   26,   27,   42,   43,   44,   45,   55,   56,   59,   60
,   65,   79,   80,   88,   72,   80,    8,   80,   88,   80
,   88,   31,   33,   58,   72,   75,   80,   85,   75,   79
,   75,   79,   10,   21,   25,   26,   27,   42,   43,   44
,   45,   55,   56,   59,   60,   65,   10,   21,   25,   26
,   27,   42,   43,   44,   45,   55,   56,   59,   60,   65
,   10,   21,   25,   26,   27,   42,   43,   44,   45,   55
,   56,   59,   60,   65,   31,   71,   80,   10,   21,   25
,   26,   27,   42,   43,   44,   45,   55,   56,   59,   60
,   65,    3,   35,   36,   37,   65,   66,   67,   68,   71
,   74,   76,   72,   80,   72,   80,   18,   31,   50,   51
,   71,   80,   80,   80,   80,   80,   80,   80,   80,    7
,   16,   17,   30,   31,   33,   34,   36,   39,   47,   49
,   50,   58,   64,   69,   71,   72,   73,   74,   75,   76
,   78,   80,   81,   82,   83,   84,   85,   86,   87,   88
,   89,   90,   91,   80,   88,    7,   16,   17,   30,   31
,   33,   34,   36,   39,   47,   49,   50,   58,   64,   69
,   71,   72,   73,   74,   75,   76,   78,   80,   81,   82
,   83,   84,   85,   86,   87,   88,   89,   90,   91,   33
,   72,   75,   80,   84,   85,   88,   80,   88,   80,   88
,   65,    7,   30,   31,   33,   36,   39,   47,   58,   64
,   72,   75,   80,   81,   82,   83,   84,   85,   86,   88
,   89,   90,   91,   72,   75,   72,   75,   72,   75,   47
,   80,   88,   80,   88,   47,   80,   88,   80,    3,   35
,   36,   37,   65,   66,   67,   68,   71,   74,   76,   72
,   75,   72,   75,   38,   38,    7,    9,   30,   31,   33
,   34,   36,   39,   47,   49,   58,   64,   69,   70,   71
,   72,   73,   74,   75,   76,   77,   78,   80,   81,   82
,   83,   84,   85,   86,   87,   88,   89,   90,   91,   33
,   72,   75,   72,   75,    7,   31,   33,   39,   58,   64
,   72,   75,   80,   85,   48,   12,   37,   43,   65,   21
,   61,   10,   12,   21,   22,   25,   26,   27,   42,   43
,   44,   45,   54,   55,   56,   59,   60,   61,   63,   65
,   67,   68,   12,   65,   12,   21,   43,   61,   65,   21
,   61,   12,   21,   43,   61,    2,    4,   10,   12,   14
,   15,   19,   20,   21,   23,   24,   25,   28,   29,   33
,   37,   39,   43,   46,   51,   53,   61,   62,   65,   67
,   68,   92,   43,   61,   21,   61,   12,   37,   43,   65
,   21,   61,   12,   37,   43,   65,   84,   85,   10,   21
,   25,   26,   27,   42,   43,   45,   55,   56,   59,   60
,   65,   10,   21,   25,   26,   27,   42,   44,   45,   55
,   56,   59,   60,   10,   21,   10,   21,   26,   27,   42
,   43,   45,   56,   60,   10,   21,   26,   27,   42,   45
,   56,   60,   10,   21,   25,   26,   27,   42,   43,   44
,   45,   55,   56,   59,   60,   65,   10,   21,   25,   26
,   27,   42,   43,   44,   45,   55,   56,   59,   60,   65
,   10,   21,   25,   26,   27,   42,   43,   44,   45,   54
,   55,   56,   59,   60,   63,   65,   10,   21,   26,   27
,   42,   43,   45,   56,   60,   10,   21,   26,   27,   42
,   43,   45,   54,   56,   60,   63,   96,   10,   21,   26
,   27,   42,   43,   45,   56,   60,   10,   21,   26,   27
,   42,   43,   45,   54,   56,   60,   63,   96,   10,   21
,   26,   27,   42,   43,   45,   54,   56,   60,   63,   96
,   10,   21,   26,   27,   42,   43,   45,   54,   56,   60
,   63,   96,    7,    9,   30,   31,   33,   34,   36,   39
,   47,   49,   58,   64,   69,   70,   71,   72,   73,   74
,   75,   76,   77,   78,   80,   81,   82,   83,   84,   85
,   86,   87,   88,   89,   90,   91,    7,    9,   30,   31
,   33,   34,   36,   39,   47,   49,   58,   64,   69,   70
,   71,   72,   73,   74,   75,   76,   77,   78,   80,   81
,   82,   83,   84,   85,   86,   87,   88,   89,   90,   91
,    7,    9,   30,   31,   33,   34,   36,   39,   47,   49
,   58,   60,   64,   69,   70,   71,   72,   73,   74,   75
,   76,   77,   78,   80,   81,   82,   83,   84,   85,   86
,   87,   88,   89,   90,   91,    7,    9,   30,   31,   33
,   34,   36,   39,   47,   49,   58,   64,   69,   70,   71
,   72,   73,   74,   75,   76,   77,   78,   80,   81,   82
,   83,   84,   85,   86,   87,   88,   89,   90,   91,    7
,    9,   30,   31,   33,   34,   36,   39,   47,   49,   58
,   60,   64,   69,   70,   71,   72,   73,   74,   75,   76
,   77,   78,   80,   81,   82,   83,   84,   85,   86,   87
,   88,   89,   90,   91,   72,    7,   30,   31,   33,   34
,   36,   39,   47,   49,   58,   64,   69,   72,   73,   74
,   75,   76,   78,   80,   81,   82,   83,   84,   85,   86
,   87,   88,   89,   90,   91,   72,   75,   72,   72,   75
,   72,   75,   72,   72,   75,   72,   75,   72,   75,    7
,   31,   33,   39,   58,   64,   72,   75,   80,   85,    7
,   31,   33,   58,   72,   75,   80,   85,   31,   33,   39
,   58,   72,   75,   80,   85,   31,   33,   58,   64,   72
,   75,   80,   85,    7,   31,   33,   58,   72,   75,   80
,   85,   31,   33,   39,   58,   72,   75,   80,   85,    7
,   31,   33,   39,   58,   64,   72,   75,   80,   85,    3
,   35,   36,   37,   65,   66,   67,   68,   71,   74,   76
,    7,   30,   31,   33,   36,   39,   47,   58,   64,   69
,   72,   74,   75,   76,   80,   81,   82,   83,   84,   85
,   86,   88,   89,   90,   91,    7,   30,   31,   33,   34
,   36,   39,   47,   49,   58,   64,   69,   72,   73,   74
,   75,   76,   78,   80,   81,   82,   83,   84,   85,   86
,   88,   89,   90,   91,    7,   30,   31,   33,   36,   39
,   47,   58,   64,   69,   72,   74,   75,   76,   80,   81
,   82,   83,   84,   85,   86,   88,   89,   90,   91,    7
,   30,   31,   33,   34,   36,   39,   47,   49,   58,   64
,   69,   72,   73,   74,   75,   76,   78,   80,   81,   82
,   83,   84,   85,   86,   87,   88,   89,   90,   91,    7
,   30,   31,   33,   34,   36,   39,   47,   49,   58,   64
,   69,   72,   73,   74,   75,   76,   78,   80,   81,   82
,   83,   84,   85,   86,   88,   89,   90,   91,    7,   30
,   31,   33,   34,   36,   39,   47,   49,   58,   64,   69
,   72,   73,   74,   75,   76,   78,   80,   81,   82,   83
,   84,   85,   86,   88,   89,   90,   91,   35,   37,   65
,   66,   67,   68,   71,    7,   30,   31,   33,   34,   36
,   39,   47,   49,   58,   64,   69,   72,   73,   74,   75
,   76,   78,   80,   81,   82,   83,   84,   85,   86,   87
,   88,   89,   90,   91,    7,   30,   31,   33,   34,   36
,   39,   47,   49,   58,   64,   69,   72,   73,   74,   75
,   76,   78,   80,   81,   82,   83,   84,   85,   86,   87
,   88,   89,   90,   91,    7,   30,   31,   33,   34,   36
,   39,   47,   49,   58,   64,   69,   72,   73,   74,   75
,   76,   78,   80,   81,   82,   83,   84,   85,   86,   87
,   88,   89,   90,   91,    3,   35,   36,   37,   65,   66
,   67,   68,   71,   74,   76,    3,   35,   36,   37,   65
,   66,   67,   68,   71,    3,   35,   36,   37,   65,   66
,   67,   68,   71,    3,   35,   36,   37,   65,   66,   67
,   68,   71,   35,   37,   65,   66,   67,   68,   71,    7
,   16,   17,   30,   31,   33,   34,   36,   39,   47,   49
,   50,   58,   61,   64,   69,   70,   71,   72,   73,   74
,   75,   76,   77,   78,   80,   81,   82,   83,   84,   85
,   86,   87,   88,   89,   90,   91,    2,    4,   10,   12
,   14,   15,   19,   20,   21,   23,   24,   25,   28,   29
,   33,   37,   39,   43,   46,   51,   53,   57,   61,   62
,   65,   67,   68,   92,    2,    4,   10,   12,   14,   15
,   19,   20,   21,   23,   24,   25,   28,   29,   33,   37
,   39,   43,   46,   51,   53,   61,   62,   65,   67,   68
,   92,    2,    4,   10,   12,   14,   15,   19,   20,   21
,   23,   24,   25,   28,   29,   33,   37,   39,   46,   51
,   53,   61,   62,   65,   67,   68,   92,   19,   20,   21
,   23,   61,    2,    4,   10,   12,   14,   15,   19,   20
,   21,   23,   24,   25,   28,   29,   33,   37,   39,   43
,   46,   51,   53,   61,   62,   65,   67,   68,   92,    2
,    4,   10,   12,   14,   15,   19,   20,   21,   23,   24
,   25,   28,   29,   33,   37,   39,   43,   46,   51,   53
,   61,   62,   65,   67,   68,   92,    2,    4,   10,   12
,   14,   15,   24,   25,   28,   29,   33,   37,   46,   51
,   53,   62,   65,   67,   68,   92,    2,    4,   10,   12
,   14,   15,   24,   25,   28,   29,   33,   37,   46,   53
,   62,   65,   67,   68,    2,    4,   10,   12,   14,   15
,   19,   20,   21,   23,   24,   25,   28,   29,   33,   37
,   39,   43,   46,   51,   53,   61,   62,   65,   67,   68
,   92,    2,    4,   10,   12,   14,   15,   19,   20,   21
,   23,   24,   25,   28,   29,   33,   37,   39,   43,   46
,   51,   53,   61,   62,   65,   67,   68,   92,   51,    2
,    4,   10,   12,   14,   15,   19,   20,   21,   23,   24
,   25,   28,   29,   33,   37,   39,   43,   46,   51,   53
,   61,   62,   65,   67,   68,   92,    2,    4,   10,   12
,   14,   15,   19,   20,   21,   23,   24,   25,   28,   29
,   33,   37,   39,   43,   46,   51,   53,   61,   62,   65
,   67,   68,   92,    2,    4,   10,   12,   14,   15,   19
,   20,   21,   23,   24,   25,   28,   29,   33,   37,   39
,   43,   46,   51,   53,   61,   62,   65,   67,   68,   92
,    2,    4,   10,   12,   14,   15,   19,   20,   21,   23
,   24,   25,   28,   29,   33,   37,   39,   43,   46,   51
,   53,   61,   62,   65,   67,   68,   92,    2,    4,   10
,   12,   14,   15,   19,   20,   21,   23,   24,   25,   28
,   29,   33,   37,   39,   43,   46,   51,   53,   61,   62
,   65,   67,   68,   92,    2,    4,   10,   12,   14,   15
,   19,   20,   21,   23,   24,   25,   28,   29,   33,   37
,   39,   43,   46,   51,   53,   61,   62,   65,   67,   68
,   92,    2,    4,   10,   12,   14,   15,   19,   20,   21
,   23,   24,   25,   28,   29,   33,   37,   39,   43,   46
,   51,   53,   61,   62,   65,   67,   68,   92,    2,    4
,   10,   12,   14,   15,   19,   20,   21,   23,   24,   25
,   28,   29,   33,   37,   39,   43,   46,   51,   53,   61
,   62,   65,   67,   68,   92,    2,    4,   10,   12,   14
,   15,   19,   20,   21,   23,   24,   25,   28,   29,   33
,   37,   39,   43,   46,   51,   53,   61,   62,   65,   67
,   68,   92,    2,    4,   10,   12,   14,   15,   19,   20
,   21,   23,   24,   25,   28,   29,   33,   37,   39,   43
,   46,   51,   53,   61,   62,   65,   67,   68,   92,    2
,    4,   10,   12,   14,   15,   19,   20,   21,   23,   24
,   25,   28,   29,   33,   37,   39,   43,   46,   51,   53
,   61,   62,   65,   67,   68,   92,    2,    4,   10,   12
,   14,   15,   19,   20,   21,   23,   24,   25,   28,   29
,   33,   37,   39,   43,   46,   51,   53,   61,   62,   65
,   67,   68,   92,    2,    4,   10,   12,   14,   15,   19
,   20,   21,   23,   24,   25,   28,   29,   33,   37,   39
,   43,   46,   51,   53,   61,   62,   65,   67,   68,   92
,    2,    4,   10,   12,   14,   15,   24,   25,   28,   29
,   33,   37,   46,   51,   53,   62,   65,   67,   68,   92
,   19,   20,   21,   19,   20,   21,   21,   33,   58,   80
,   85,   43,   61,   21,    2,    4,   10,   12,   14,   15
,   24,   25,   28,   29,   33,   37,   43,   46,   51,   53
,   62,   65,   67,   68,   92,   21,   61,    2,    4,   10
,   12,   14,   15,   24,   25,   28,   29,   33,   37,   43
,   46,   51,   53,   62,   65,   67,   68,   92,   25,   33
,   62,    2,    4,   10,   12,   14,   15,   24,   25,   28
,   29,   33,   37,   43,   46,   51,   53,   62,   65,   67
,   68,   92,   80,   30,   65,   67,   80,   65,   67,   80
,    2,    4,   10,   12,   14,   15,   24,   25,   28,   29
,   33,   37,   43,   46,   51,   53,   62,   65,   67,   68
,   92,   21,   23,   21,   10,   14,   10,   25,   26,   27
,   42,   43,   45,   55,   56,   59,   60,   65,   31,   50
,   80,   18,   31,   50,   71,   80,   72,   80,   72,   80
,   31,   51,   71,   65,   65,   10,   25,   26,   27,   42
,   43,   45,   55,   56,   59,   60,   65,   80,   80,   21
,   25,   26,   27,   42,   43,   44,   45,   55,   56,   59
,   60,   65,   21,   44,   21,   25,   26,   27,   42,   43
,   45,   55,   56,   59,   60,   65,   10,   21,   25,   26
,   27,   42,   43,   45,   55,   56,   59,   60,   65,   21
,   75,   80,   75,   80,   21,   22,   25,   43,   21,   21
,   22,   25,   43,   10,   25,   26,   27,   42,   43,   45
,   55,   56,   59,   60,   65,   80,   21,   22,   25,   43
,   18,   80,    2,    4,   10,   12,   14,   15,   24,   25
,   28,   29,   33,   37,   43,   46,   51,   53,   62,   65
,   67,   68,   92,   21,    2,    4,   10,   12,   14,   15
,   19,   20,   21,   23,   24,   25,   28,   29,   33,   37
,   39,   43,   46,   51,   53,   61,   62,   65,   67,   68
,   92,    2,    4,   10,   12,   14,   15,   19,   20,   21
,   23,   24,   25,   28,   29,   33,   37,   39,   43,   46
,   51,   53,   61,   62,   65,   67,   68,   92,    2,    4
,   10,   12,   14,   15,   19,   20,   21,   23,   24,   25
,   28,   29,   33,   37,   39,   43,   46,   51,   53,   61
,   62,   65,   67,   68,   92,    4,   15,   43,   57,   61
,   65,   67,   68,   19,   21,   39,   19,   21,   39,   19
,   21,   39,   19,   21,   39,   19,   21,   39,   19,   21
,   39,   19,   21,   39,    2,    4,   10,   12,   14,   15
,   19,   21,   24,   25,   28,   29,   33,   37,   39,   43
,   46,   51,   53,   62,   65,   67,   68,   92,   19,   21
,   39,    2,    4,   10,   12,   14,   15,   19,   21,   24
,   25,   28,   29,   33,   37,   39,   43,   46,   51,   53
,   62,   65,   67,   68,   92,   19,   21,   39,   43,   19
,   39,    2,    4,   10,   12,   14,   15,   24,   25,   28
,   29,   33,   37,   43,   46,   51,   53,   62,   65,   67
,   68,   92,    4,   15,   43,   57,   61,   21,    2,    4
,   10,   12,   14,   15,   19,   24,   25,   28,   29,   33
,   37,   39,   43,   46,   51,   53,   62,   65,   67,   68
,   92,   75,   80,   26,   27,   42,   43,   45,   54,   63
,   96,   71,   80,   26,   27,   42,   43,   45,   54,   63
,   96,   26,   27,   42,   45,   54,   26,   27,   42,   43
,   45,   54,   63,   96,   26,   27,   42,   43,   45,   54
,   63,   96,   26,   27,   42,   45,   54,   63,   75,   80
,   75,   80,   26,   27,   42,   43,   45,   54,   60,   63
,   26,   42,   45,   56,   21,   61,   21,   21,   21,    2
,    4,   10,   12,   14,   15,   24,   25,   28,   29,   33
,   37,   43,   46,   51,   53,   62,   65,   67,   68,   92
,   21,   61,    2,    4,   10,   12,   14,   15,   24,   25
,   28,   29,   33,   37,   43,   46,   51,   53,   62,   65
,   67,   68,   92,   84,   85,   26,   42,   45,   26,   42
,   45,   59,   63,   65,   26,   42,   45,   59,   63,   65
,   26,   42,   45,   59,   63,   65,   31,   71,   80,   80
,   71,   80,   72,   75,   72,   75,   35,   72,   75,   85
,   72,   75,   10,   21,   25,   26,   27,   42,   43,   44
,   45,   55,   56,   59,   60,   65,   10,   21,   25,   26
,   27,   42,   43,   44,   45,   55,   56,   59,   60,   65
,   10,   21,   25,   26,   27,   42,   43,   44,   45,   55
,   56,   59,   60,   65,   10,   21,   25,   26,   27,   42
,   43,   44,   45,   55,   56,   59,   60,   65,   21,   43
,   65,   67,   68,   21,   21,   43,   65,   67,   68,   21
,   43,   65,   67,   68,   43,   61,   43,   61,   65,   21
,   61,   84,   85,   65,   10,   21,   25,   26,   27,   42
,   44,   45,   55,   56,   59,   60,   72,   75,   84,   85
,    2,    4,   10,   12,   14,   15,   24,   25,   28,   29
,   33,   37,   43,   46,   51,   53,   62,   65,   67,   68
,   92,    2,    4,   10,   12,   14,   15,   24,   25,   28
,   29,   33,   37,   43,   46,   51,   53,   62,   65,   67
,   68,   92,   21,   61,   43,   61,   21,   65,   21,   22
,   25,   21,   25,   19,   21,   39,   26,   27,   42,   45
,   54,   60,   63,   84,   85,   21,   65,   67,   68,   31
,    2,    4,   10,   12,   14,   15,   24,   25,   28,   29
,   33,   37,   43,   46,   51,   53,   62,   65,   67,   68
,   92,    2,    4,   10,   12,   14,   15,   24,   25,   28
,   29,   33,   37,   43,   46,   51,   53,   62,   65,   67
,   68,   92,    4,   15,   57,   72,   65,   65)  ;
        --| Map of states to sets of follow symbols
        -- NYU Reference Name: FOLLOW

    ------------------------------------------------------------------
    -- Action_Token_Map
    ------------------------------------------------------------------


    type Action_Token_Array_Index is array(
        PositiveParserInteger range <>) of GC.ParserInteger ;
        --| For indexing the All Action Token Array.
        --| Maps a given state into the lower and upper bounds of a slice
        --| of the All Action Index Array.

    Action_Token_MapIndex : constant Action_Token_Array_Index :=
         (    1,    1,    2,    2,    3,    2,    3,    9,   10,   11
,   12,   11,   12,   16,   17,   17,   18,   17,   18,   17
,   18,   28,   29,   28,   29,   30,   31,   30,   31,   32
,   33,   33,   34,   34,   35,   34,   35,   34,   35,   34
,   35,   34,   35,   34,   35,   34,   35,   36,   37,   36
,   37,   37,   38,   37,   38,   37,   38,   37,   38,   37
,   38,   41,   42,   44,   45,   44,   45,   45,   46,   46
,   47,   46,   47,   46,   47,   47,   48,   47,   48,   47
,   48,   75,   76,   75,   76,   75,   76,   75,   76,   87
,   88,   87,   88,   87,   88,   88,   89,   88,   89,   97
,   98,  101,  102,  101,  102,  101,  102,  101,  102,  101
,  102,  102,  103,  102,  103,  105,  106,  106,  107,  107
,  108,  108,  109,  109,  110,  110,  111,  113,  114,  117
,  118,  117,  118,  118,  119,  118,  119,  125,  126,  125
,  126,  125,  126,  125,  126,  134,  135,  134,  135,  134
,  135,  134,  135,  137,  138,  138,  139,  138,  139,  139
,  140,  140,  141,  140,  141,  153,  154,  153,  154,  155
,  156,  156,  157,  156,  157,  157,  158,  159,  160,  159
,  160,  173,  174,  182,  183,  184,  185,  184,  185,  185
,  186,  186,  187,  187,  188,  189,  190,  190,  191,  191
,  192,  191,  192,  191,  192,  191,  192,  191,  192,  192
,  193,  192,  193,  193,  194,  194,  195,  195,  196,  198
,  199,  198,  199,  198,  199,  198,  199,  199,  200,  200
,  201,  200,  201,  201,  202,  201,  202,  203,  204,  205
,  206,  206,  207,  206,  207,  208,  209,  224,  225,  228
,  229,  228,  229,  229,  230,  230,  231,  230,  231,  230
,  231,  231,  232,  231,  232,  232,  233,  232,  233,  232
,  233,  232,  233,  243,  244,  243,  244,  243,  244,  243
,  244,  243,  244,  254,  255,  265,  266,  276,  277,  281
,  282,  292,  293,  296,  297,  296,  297,  307,  308,  308
,  309,  320,  321,  332,  333,  343,  344,  354,  355,  365
,  366,  376,  377,  377,  378,  378,  379,  378,  379,  378
,  379,  378,  379,  387,  388,  387,  388,  387,  388,  387
,  388,  387,  388,  396,  397,  396,  397,  396,  397,  403
,  404,  406,  407,  406,  407,  406,  407,  406,  407,  407
,  408,  407,  408,  408,  409,  410,  411,  411,  412,  425
,  426,  427,  428,  428,  429,  429,  430,  440,  441,  440
,  441,  440,  441,  449,  450,  449,  450,  449,  450,  449
,  450,  449,  450,  449,  450,  450,  451,  451,  452,  451
,  452,  454,  455,  455,  456,  456,  457,  458,  459,  459
,  460,  459,  460,  459,  460,  459,  460,  459,  460,  459
,  460,  459,  460,  459,  460,  459,  460,  459,  460,  459
,  460,  459,  460,  459,  460,  459,  460,  459,  460,  459
,  460,  459,  460,  462,  463,  462,  463,  462,  463,  462
,  463,  462,  463,  462,  463,  462,  463,  463,  464,  463
,  464,  463,  464,  463,  464,  463,  464,  463,  464,  464
,  465,  465,  466,  467,  468,  468,  469,  468,  469,  469
,  470,  470,  471,  470,  471,  470,  471,  471,  472,  473
,  474,  473,  474,  474,  475,  474,  475,  474,  475,  476
,  477,  476,  477,  487,  488,  488,  489,  489,  490,  490
,  491,  501,  502,  512,  513,  512,  513,  524,  525,  535
,  536,  535,  536,  537,  538,  537,  538,  549,  550,  549
,  550,  550,  551,  550,  551,  550,  551,  550,  551,  551
,  552,  551,  552,  551,  552,  552,  553,  552,  553,  552
,  553,  552,  553,  552,  553,  552,  553,  552,  553,  552
,  553,  553,  554,  553,  554,  553,  554,  553,  554,  553
,  554,  553,  554,  553,  554,  553,  554,  554,  555,  565
,  566,  573,  574,  573,  574,  584,  585,  584,  585,  584
,  585,  584,  585,  584,  585,  584,  585,  595,  596,  606
,  607,  606,  607,  606,  607,  606,  607,  606,  607,  607
,  608,  608,  609,  608,  609,  619,  620,  619,  620,  619
,  620,  630,  631,  630,  631,  630,  631,  631,  632,  656
,  657,  681,  682,  681,  682,  681,  682,  681,  682,  682
,  683,  682,  683,  683,  684,  685,  686,  688,  689,  688
,  689,  688,  689,  688,  689,  691,  692,  712,  713,  712
,  713,  713,  714,  713,  714,  715,  716,  716,  717,  719
,  720,  720,  721,  722,  723,  723,  724,  724,  725,  726
,  727,  726,  727,  729,  730,  730,  731,  730,  731,  744
,  745,  747,  748,  748,  749,  749,  750,  750,  751,  751
,  752,  751,  752,  752,  753,  753,  754,  753,  754,  754
,  755,  755,  756,  756,  757,  756,  757,  756,  757,  758
,  759,  759,  760,  760,  761,  761,  762,  762,  763,  763
,  764,  763,  764,  764,  765,  765,  766,  765,  766,  765
,  766,  765,  766,  765,  766,  765,  766,  765,  766,  765
,  766,  765,  766,  765,  766,  765,  766,  776,  777,  787
,  788,  787,  788,  787,  788,  787,  788,  799,  800,  799
,  800,  810,  811,  821,  822,  821,  822,  822,  823,  822
,  823,  822,  823,  822,  823,  822,  823,  822,  823,  822
,  823,  824,  825,  825,  826,  825,  826,  827,  828,  827
,  828,  827,  828,  829,  830,  831,  832,  842,  843,  843
,  844,  844,  845,  845,  846,  846,  847,  852,  853,  866
,  867,  867,  868,  867,  868,  867,  868,  867,  868,  867
,  868,  887,  888,  905,  906,  906,  907,  906,  907,  906
,  907,  907,  908,  907,  908,  918,  919,  918,  919,  920
,  921,  924,  925,  935,  936,  936,  937,  937,  938,  939
,  940,  939,  940,  939,  940,  948,  949,  948,  949,  949
,  950,  950,  951,  952,  953,  956,  957,  957,  958,  958
,  959,  958,  959,  959,  960,  960,  961,  961,  962,  961
,  962,  961,  962,  961,  962,  961,  962,  961,  962,  962
,  963,  962,  963,  962,  963,  962,  963,  970,  971,  971
,  972,  975,  976,  976,  977,  977,  978,  978,  979,  979
,  980,  979,  980,  979,  980,  980,  981,  981,  982,  981
,  982,  981,  982,  982,  983,  982,  983,  982,  983,  982
,  983,  982,  983,  983,  984,  983,  984,  983,  984,  984
,  985,  985,  986,  987,  988,  989,  990,  989,  990,  990
,  991, 1001, 1002, 1001, 1002, 1002, 1003, 1003, 1004, 1005
, 1006, 1005, 1006, 1005, 1006, 1005, 1006, 1005, 1006, 1005
, 1006, 1005, 1006, 1005, 1006, 1005, 1006, 1007, 1008, 1008
, 1009, 1009, 1010, 1010, 1011, 1035, 1036, 1035, 1036, 1035
, 1036, 1035, 1036, 1038, 1039, 1039, 1040, 1050, 1051, 1061
, 1062, 1064, 1065, 1065, 1066, 1076, 1077, 1077, 1078, 1079
, 1080, 1079, 1080, 1080, 1081, 1085, 1086, 1085, 1086, 1085
, 1086, 1085, 1086, 1085, 1086, 1085, 1086, 1085, 1086, 1085
, 1086, 1085, 1086, 1085, 1086, 1085, 1086, 1085, 1086, 1085
, 1086, 1085, 1086, 1085, 1086, 1085, 1086, 1085, 1086, 1088
, 1089, 1090, 1091, 1090, 1091, 1090, 1091, 1090, 1091, 1090
, 1091, 1090, 1091, 1102, 1103, 1102, 1103, 1102, 1103, 1104
, 1105, 1104, 1105, 1105, 1106, 1116, 1117, 1128, 1129, 1129
, 1130, 1130, 1131, 1131, 1132, 1133, 1134, 1134, 1135, 1138
, 1139, 1138, 1139, 1138, 1139, 1139, 1140, 1140, 1141, 1151
, 1152, 1162, 1163, 1163, 1164, 1163, 1164, 1164, 1165, 1166
, 1167, 1166, 1167, 1166, 1167, 1167, 1168, 1168, 1169, 1169
, 1170, 1170, 1171, 1171, 1172, 1172, 1173, 1173, 1174, 1173
, 1174, 1173, 1174, 1173, 1174, 1174, 1175, 1175, 1176, 1175
, 1176, 1176, 1177, 1177, 1178, 1177, 1178, 1177, 1178, 1177
, 1178, 1177, 1178, 1178, 1179, 1179, 1180, 1180, 1181, 1180
, 1181, 1181, 1182, 1181, 1182, 1195, 1196, 1198, 1199, 1199
, 1200, 1200, 1201, 1201, 1202, 1201, 1202, 1202, 1203, 1203
, 1204, 1203, 1204, 1203, 1204, 1204, 1205, 1204, 1205, 1204
, 1205, 1207, 1208, 1207, 1208, 1207, 1208, 1218, 1219, 1219
, 1220, 1219, 1220, 1219, 1220, 1219, 1220, 1219, 1220, 1220
, 1221, 1220, 1221, 1221, 1222, 1222, 1223, 1222, 1223, 1222
, 1223, 1223, 1224, 1224, 1225, 1225, 1226, 1225, 1226, 1225
, 1226, 1225, 1226, 1228, 1229, 1229, 1230, 1230, 1231, 1231
, 1232, 1242, 1243, 1242, 1243, 1245, 1246, 1247, 1248, 1247
, 1248, 1247, 1248, 1248, 1249, 1248, 1249, 1248, 1249, 1248
, 1249, 1250, 1251, 1255, 1256, 1260, 1261, 1260, 1261, 1271
, 1272, 1272, 1273, 1274, 1275, 1275, 1276, 1275, 1276, 1286
, 1287, 1286, 1287, 1286, 1287, 1287, 1288, 1287, 1288, 1287
, 1288, 1288, 1289, 1296, 1297, 1296, 1297, 1296, 1297, 1297
, 1298, 1299, 1300, 1299, 1300, 1300, 1301, 1300, 1301, 1300
, 1301, 1300, 1301, 1300, 1301, 1300, 1301, 1301, 1302, 1302
, 1303, 1303, 1304, 1304, 1305, 1304, 1305, 1304, 1305, 1304
, 1305, 1304, 1305, 1304, 1305, 1315, 1316, 1315, 1316, 1315
, 1316, 1315, 1316, 1315, 1316, 1315, 1316, 1315, 1316, 1326
, 1327, 1327, 1328, 1327, 1328, 1327, 1328, 1328, 1329, 1329
, 1330, 1329, 1330, 1329, 1330, 1329, 1330, 1329, 1330, 1329
, 1330, 1329, 1330, 1329, 1330, 1329, 1330, 1329, 1330, 1329
, 1330, 1329, 1330, 1329, 1330, 1329, 1330, 1329, 1330, 1329
, 1330, 1329, 1330, 1330, 1331, 1331, 1332, 1333, 1334, 1333
, 1334, 1333, 1334, 1344, 1345, 1345, 1346, 1346, 1347, 1346
, 1347, 1348, 1349, 1350, 1351, 1351, 1352, 1352, 1353, 1357
, 1358, 1357, 1358, 1357, 1358, 1357, 1358, 1357, 1358, 1358
, 1359, 1358, 1359, 1360, 1361, 1360, 1361, 1360, 1361, 1360
, 1361, 1360, 1361, 1360, 1361, 1361, 1362, 1362, 1363, 1363
, 1364, 1365, 1366, 1376, 1377, 1378, 1379, 1378, 1379, 1378
, 1379, 1379, 1380, 1390, 1391, 1390, 1391, 1390, 1391, 1392
, 1393, 1392, 1393, 1392, 1393, 1392, 1393, 1393, 1394, 1394
, 1395, 1395, 1396, 1407, 1408, 1407, 1408, 1407, 1408, 1407
, 1408, 1407, 1408, 1407, 1408, 1407, 1408, 1408, 1409, 1409
, 1410, 1410, 1411, 1411, 1412, 1412, 1413, 1413, 1414, 1414
, 1415, 1425, 1426, 1429, 1430, 1429, 1430, 1429, 1430, 1429
, 1430, 1429, 1430, 1429, 1430, 1429, 1430, 1429, 1430, 1429
, 1430, 1429, 1430, 1429, 1430, 1429, 1430, 1431, 1432, 1431
, 1432, 1434, 1435, 1436, 1437, 1436, 1437, 1437, 1438, 1438
, 1439, 1438, 1439, 1438, 1439, 1438, 1439, 1438, 1439, 1438
, 1439, 1438, 1439, 1438, 1439, 1438, 1439, 1439, 1440, 1439
, 1440, 1440, 1441, 1441, 1442, 1444, 1445, 1445, 1446, 1445
, 1446, 1449, 1450, 1449, 1450, 1449, 1450, 1450, 1451, 1450
, 1451, 1450, 1451, 1452, 1453, 1453, 1454, 1454, 1455, 1454
, 1455, 1455, 1456, 1455, 1456, 1457, 1458, 1458, 1459, 1485
, 1486, 1489, 1490, 1490, 1491, 1490, 1491, 1490, 1491, 1501
, 1502, 1502, 1503, 1503, 1504, 1504, 1505, 1504, 1505, 1505
, 1506, 1506, 1507, 1506, 1507, 1509, 1510, 1509, 1510, 1510
, 1511, 1510, 1511, 1510, 1511, 1513, 1514, 1513, 1514, 1514
, 1515, 1514, 1515, 1514, 1515, 1514, 1515, 1514, 1515, 1515
, 1516, 1515, 1516, 1526, 1527, 1527, 1528, 1527, 1528, 1527
, 1528, 1527, 1528, 1527, 1528, 1528, 1529, 1529, 1530, 1529
, 1530, 1529, 1530, 1530, 1531, 1530, 1531, 1542, 1543, 1542
, 1543, 1543, 1544, 1543, 1544, 1544, 1545, 1545, 1546, 1545
, 1546, 1546, 1547, 1570, 1571, 1570, 1571, 1570, 1571, 1570
, 1571, 1571, 1572, 1571, 1572, 1571, 1572, 1571, 1572, 1571
, 1572, 1571, 1572, 1572, 1573, 1572, 1573, 1572, 1573, 1574
, 1575, 1585, 1586, 1586, 1587, 1587, 1588, 1591, 1592, 1591
, 1592, 1591, 1592, 1593, 1594, 1605, 1606, 1605, 1606, 1607
, 1608, 1607, 1608, 1607, 1608, 1609, 1610, 1610, 1611, 1611
, 1612, 1612, 1613, 1613, 1614, 1613, 1614, 1622, 1623, 1622
, 1623, 1622, 1623, 1623, 1624, 1625, 1626, 1626, 1627, 1627
, 1628, 1627, 1628, 1629, 1630, 1629, 1630, 1640, 1641, 1641
, 1642, 1645, 1646, 1653, 1654, 1656, 1657, 1657, 1658, 1659
, 1660, 1659, 1660, 1660, 1661, 1661, 1662, 1661, 1662, 1661
, 1662, 1661, 1662, 1661, 1662, 1663, 1664, 1663, 1664, 1674
, 1675, 1675, 1676, 1676, 1677, 1677, 1678, 1677, 1678, 1677
, 1678, 1677, 1678, 1677, 1678, 1678, 1679, 1680, 1681, 1681
, 1682, 1686, 1687, 1686, 1687, 1687, 1688, 1687, 1688, 1688
, 1689, 1689, 1690, 1690, 1691, 1701, 1702, 1702, 1703, 1702
, 1703, 1705, 1706, 1706, 1707, 1706, 1707, 1717, 1718, 1717
, 1718, 1717, 1718, 1717, 1718, 1718, 1719, 1718, 1719, 1719
, 1720, 1719, 1720, 1719, 1720, 1720, 1721, 1721, 1722, 1722
, 1723, 1722, 1723, 1723, 1724, 1723, 1724, 1723, 1724, 1723
, 1724, 1724, 1725, 1724, 1725, 1725, 1726, 1725, 1726, 1726
, 1727, 1727, 1728, 1727, 1728, 1727, 1728, 1728, 1729, 1728
, 1729, 1729, 1730, 1729, 1730, 1730, 1731, 1731, 1732, 1754
, 1755, 1755, 1756, 1755, 1756, 1756, 1757, 1757, 1758, 1757
, 1758, 1757, 1758, 1758, 1759, 1758, 1759, 1759, 1760, 1759
, 1760, 1763, 1764, 1764, 1765, 1764, 1765, 1765, 1766, 1770
, 1771, 1770, 1771, 1770, 1771, 1771, 1772, 1772, 1773, 1773
, 1774, 1773, 1774, 1774, 1775, 1774, 1775, 1774, 1775, 1775
, 1776, 1775, 1776, 1775, 1776, 1775, 1776, 1775, 1776, 1775
, 1776, 1776, 1777, 1777, 1778, 1777, 1778, 1778, 1779, 1779
, 1780, 1779, 1780, 1779, 1780, 1780, 1781, 1781, 1782, 1781
, 1782, 1782, 1783, 1783, 1784, 1783, 1784, 1784, 1785, 1784
, 1785, 1784, 1785, 1786, 1787, 1786, 1787, 1788, 1789, 1789
, 1790, 1790, 1791, 1791, 1792, 1791, 1792, 1792, 1793, 1792
, 1793, 1793, 1794, 1794, 1795, 1795, 1796, 1796, 1797, 1796
, 1797, 1796, 1797, 1798, 1799, 1798, 1799, 1798, 1799, 1799
, 1800, 1800, 1801, 1800, 1801, 1800, 1801, 1800, 1801, 1800
, 1801, 1800, 1801, 1800, 1801, 1800, 1801, 1801, 1802, 1802
, 1803, 1803, 1804, 1803, 1804, 1803)  ;

    Action_Token_Map : constant Action_Token_Array :=
         (   43,   65,   45,   63,   26,   27,   42,   43,   54,   71
,   80,   27,   42,   45,   54,   26,   63,   35,   37,   68
,   71,   74,   76,    3,   36,   65,   66,   67,   65,   67
,   11,   65,   65,   71,   31,   80,   80,   42,   56,   26
,   45,   42,   26,   45,   72,   65,   65,    7,   30,   34
,   49,   69,   70,   74,   76,   78,   81,   83,   84,   85
,   86,   87,   36,   39,   47,   64,   71,   72,   73,   75
,   77,   82,   89,   90,   91,   36,   37,   65,   66,   67
,   71,   74,   76,    3,   35,   40,   68,   72,   30,   36
,   82,   83,   89,   91,   81,   86,   90,   70,   47,   71
,   77,   75,   39,   64,    7,    7,   39,   64,    7,   39
,   74,   69,   76,   49,   73,   78,   34,   87,   35,   37
,   65,   66,   67,   68,   71,   36,   65,   66,   67,   68
,   71,    3,   35,   37,   31,   51,   71,   65,   31,   71
,   25,   26,   27,   35,   42,   43,   45,   55,   56,   59
,   60,   65,   10,   71,   80,   35,   10,   65,   67,   21
,   43,   44,   45,   55,   56,   10,   25,   26,   27,   42
,   59,   60,   65,   26,   42,   55,   56,   59,   60,   25
,   27,   45,   21,   44,   10,   65,   21,   65,   67,   11
,   11,   31,   65,   80,   80,   59,   63,   65,   43,   60
,   71,   70,   77,   84,   85,   85,   72,   75,   30,   36
,   39,   64,   81,   82,   83,   85,   86,   89,   90,   91
,    7,   72,   75,   84,   71,   77,   47,   70,   72,   75
,   80,   30,   67,   71,   74,    3,   35,   36,   37,   65
,   66,   68,   76,   36,   65,    3,   35,   37,   66,   67
,   68,   71,   74,   76,    3,   35,   36,   37,   76,   65
,   66,   67,   68,   71,   74,   35,   36,   37,   65,   68
,   71,   74,   76,    3,   66,   67,   17,   47,   65,   16
,   71,    3,   35,   36,   37,   68,   65,   66,   67,   71
,   74,   76,    6,   65,   67,   68,    3,   35,   36,   37
,   76,   65,   66,   67,   68,   71,   74,   75,   35,   58
,   65,   66,   67,   68,   74,    3,   36,   37,   71,   76
,    3,   65,   66,   67,   76,   19,   35,   36,   37,   68
,   71,   74,    3,   35,   37,   65,   67,   71,   74,   36
,   66,   68,   76,    3,   36,   37,   65,   67,   71,   74
,   76,   35,   66,   68,    3,   35,   36,   37,   65,   66
,   67,   68,   71,   74,   76,   35,   36,   37,   65,   67
,   68,   74,   76,    3,   66,   71,   58,   19,    3,   36
,   37,   66,   67,   68,   71,   35,   65,    3,   65,   35
,   36,   37,   66,   67,   68,   71,   65,   66,   68,   71
,   35,   37,   67,   77,   70,   71,   65,   65,   80,   71
,   31,   25,   26,   27,   35,   42,   59,   60,   65,   21
,   43,   44,   45,   55,   56,   71,   80,   65,   65,   35
,   36,   37,   65,   66,   74,   76,    3,   67,   68,   71
,   59,   60,   25,   26,   27,   42,   45,   55,   56,   80
,   65,   65,   67,   68,   65,   65,   65,   59,   65,   31
,   50,   80,   65,   80,   65,   51,   71,   65,   65,   31
,   65,   26,   45,   79,   75,   80,    3,   36,   37,   65
,   66,   67,   71,   35,   68,   74,   76,   71,   65,   65
,    3,   35,   37,   67,   68,   71,   74,   76,   36,   65
,   66,    3,   65,   67,   68,   76,   35,   36,   37,   66
,   71,   74,   35,   36,   67,   74,   76,    3,   37,   40
,   65,   66,   68,   71,    3,   35,   36,   37,   67,   68
,   76,   65,   66,   71,   74,   84,   85,    3,   37,   40
,   65,   68,   74,   76,   35,   36,   66,   67,   71,   75
,   86,   86,   72,   65,    3,   36,   37,   65,   66,   68
,   74,   76,   35,   67,   71,   30,   91,   36,   81,   82
,   83,   89,   90,   65,   68,   71,   74,   76,    3,   35
,   36,   37,   66,   67,    3,   36,   37,   68,   71,   76
,   35,   65,   66,   67,   74,    3,   35,   37,   68,   36
,   65,   66,   67,   71,   74,   76,   77,   79,    3,   65
,   66,   68,   74,   76,   35,   36,   37,   67,   71,    3
,   35,   36,   76,   37,   65,   66,   67,   68,   71,   74
,   77,   64,   72,   76,   78,   81,   83,   85,   87,   89
,   90,   91,    7,   30,   34,   36,   39,   49,   69,   70
,   71,   73,   74,   75,   77,   82,   30,   34,   49,   64
,   70,   71,   72,   73,   75,   76,   78,   83,   85,   87
,   89,   90,   91,    7,   36,   39,   69,   74,   77,   81
,   82,   85,   65,   11,   65,   11,   59,   65,   31,   50
,   80,    2,    4,   14,   24,   37,   43,   53,   10,   12
,   15,   25,   28,   29,   33,   46,   51,   62,   65,   67
,   68,   92,   23,   71,   80,   60,   70,   71,   77,   60
,   31,   50,   31,   65,   31,   80,   31,   71,   80,   65
,   21,   25,   27,   43,   44,   45,   65,   10,   26,   42
,   55,   56,   59,   60,   65,   67,   68,   43,   21,   22
,   21,   21,   65,   80,   31,   80,   31,   71,   31,   30
,   65,   75,   65,   43,   72,    3,   35,   65,   66,   36
,   37,   67,   68,   71,   74,   76,   36,   65,   66,   67
,   71,   74,   76,    3,   35,   37,   68,    3,   35,   37
,   66,   36,   40,   65,   67,   68,   71,   74,   76,    3
,   35,   37,   65,   66,   67,   68,   71,   74,   76,   36
,    3,   36,   65,   68,   74,   76,   35,   37,   66,   67
,   71,   75,   30,   41,   65,   72,   80,   80,   72,   72
,   75,   37,   74,    3,   35,   36,   65,   66,   67,   68
,   71,   76,   77,   65,   65,   43,   26,   42,   45,   27
,   56,   60,   10,   25,   26,   55,   27,   35,   42,   43
,   45,   54,   56,   59,   60,   65,   65,    4,   10,   12
,   15,   24,   29,   33,   37,   46,   51,   53,   62,   65
,   68,    2,   14,   25,   28,   67,   92,   12,   15,   24
,   25,   46,   53,   62,   65,   68,    2,    4,   10,   14
,   28,   29,   33,   37,   67,   51,   21,   37,   65,   71
,   74,    3,   35,   36,   66,   67,   68,   76,    9,   71
,   17,   65,   16,   47,    3,   37,   67,   68,   76,   35
,   36,   65,   66,   71,   74,   65,   65,   31,   80,    5
,   17,   32,   47,    8,   16,   35,   44,   71,   65,   77
,   75,   80,   70,   71,   80,   77,   65,   65,   25,   65
,   65,   79,    8,   16,   17,   47,   71,    5,   32,   44
,   65,   94,   65,   67,   68,   80,   41,   88,   65,   75
,   86,   75,   88,   51,   65,   72,   75,   72,   75,   80
,   36,   71,    3,   35,   37,   65,   66,   67,   68,   74
,   76,   31,   31,   11,   65,   31,   80,   80,   93,   43
,    2,   10,   12,   15,   20,   21,   23,   24,   25,   37
,   61,   62,   65,   67,   68,    4,   14,   19,   28,   29
,   33,   46,   51,   53,   92,   65,   67,   68,   65,   36
,   65,   66,   74,   76,    3,   35,   37,   67,   68,   71
,   35,   36,   65,    3,   37,   66,   67,   68,   71,   74
,   76,   61,   65,   80,   65,    3,   35,   65,   66,   68
,   71,   74,   76,   36,   37,   67,   80,   80,   65,   79
,   71,   77,   80,   88,   70,   25,   33,   62,   10,   14
,    3,   36,   37,   65,   67,   74,   80,   35,   66,   68
,   71,   76,   43,   61,   72,   35,   37,   65,   66,   68
,   71,   76,    3,   36,   67,   74,    3,   36,   37,   40
,   71,   35,   65,   66,   67,   68,   74,   76,   48,   80
,   80,   80,   77,   80,   17,   16,   47,   71,   65,   71
,   36,   37,   71,   74,   76,    3,   35,   65,   66,   67
,   68,    3,   35,   36,   65,   76,   37,   66,   67,   68
,   71,   74,   44,   80,   65,   68,   80,   80,   80,   80
,   80,   80,   80,   47,   47,   48,   79,   80,   71,   43
,   80,   10,   21,   65,   25,   26,   27,   42,   43,   44
,   45,   55,   56,   59,   60,   13,   65,   23,   94,   94
,   44,   94,   94,   80,   70,   71,   77,    3,   35,   36
,   74,   37,   65,   66,   67,   68,   71,   76,   80,   65
,   80,   80,   54,   54,   43,   70,   71,   77,   71,   31
,   80,   36,   65,   66,   67,   68,   74,   76,    3,   35
,   37,   71,   61,   77,   80,   77,   80,   58,   77,   80
,   10,   25,   33,   14,   62,   16,   17,   65,   47,   71
,    3,   35,   36,   65,   66,   67,   68,   71,   74,   76
,   37,   21,   61,   43,   65,   35,   36,   37,   67,   68
,   74,   76,    3,   65,   66,   71,   65,   21,   15,   43
,   57,   61,   65,   68,    4,   67,   80,   65,   40,   61
,   80,   80,   75,    9,   65,   66,   71,   76,    3,   35
,   36,   67,   68,   74,   37,    3,   36,   37,   65,   66
,   71,   74,   76,   35,   67,   68,   38,   80,   65,   37
,   65,   72,   80,    3,   76,   35,   36,   37,   65,   66
,   67,   68,   71,   74,   80,   43,   65,   88,   50,   80
,   88,    8,   16,   17,   47,   50,   71,   72,   72,   80
,   80,   80,   43,   80,   75,    3,   35,   65,   66,   71
,   74,   36,   37,   67,   68,   76,   18,   80,   80,   35
,   36,   37,   74,   76,    3,   65,   66,   67,   68,   71
,   19,   20,   80,   80,   12,   67,   68,   71,   74,    3
,   35,   36,   37,   40,   65,   66,   76,   30,   33,   21
,   80,   65,   65,   80,    3,   35,   37,   65,   66,   76
,   36,   67,   68,   71,   74,   80,   70,   71,   77,   19
,   39,    4,   15,   57,   19,   39,   85,   77,   34,   43
,   21,   65,   67,   68,   72,   47,   70,   71,   77,   65
,   72,   75,   21,   43,   88,   80,   31,   65,    7,   34
,   49,   72,   81,   82,   83,   87,   89,   90,   91,   30
,   36,   39,   47,   64,   69,   70,   71,   73,   74,   75
,   76,   77,   78,   79,   86,   47,   70,   77,   71,   72
,    3,   35,   68,   71,   74,   76,   36,   37,   65,   66
,   67,   88,    8,   65,   80,   71,   65,   67,   68,   31
,   65,   67,   68,   72,   80,   35,   36,   37,   71,   76
,    3,   65,   66,   67,   68,   74,   21,   80,   85,   61
,    3,   35,   36,   71,   74,   37,   52,   65,   66,   67
,   68,   76,   33,   80,   80,   85,   21,   62,   65,   67
,    2,    4,   10,   12,   14,   15,   19,   24,   25,   28
,   29,   33,   37,   39,   43,   46,   51,   53,   68,   92
,   43,   21,   84,   85,    3,   36,   37,   65,   66,   67
,   71,   35,   68,   74,   76,   21,   48,    9,   77,   70
,   71,   72,   75,   36,   37,   65,   66,   67,   74,   76
,   94,    3,   35,   68,   71,   72,   75,   65,   68,   48
,   65,   12,   43,    5,    8,   32,   44,   47,   71,   16
,   17,   35,   71,   72,   80,   80,   80,   77,   80,    3
,   35,   36,   37,   65,   67,   68,   71,   74,   76,   66
,   88,   77,   80,   70,   71,    5,    8,   32,   47,   71
,   16,   17,   44,   70,   71,   77,   71,   72,   80,   58
,   29,   84,   85,    3,   74,   35,   36,   37,   65,   66
,   67,   68,   71,   76,   33,   21,   65,   21,   15,   43
,   53,    4,   15,   57,   61,   43,   65,   80,   48,   80
,   65,   66,   67,   68,   74,    3,   35,   36,   37,   71
,   76,   43,   67,   68,   65,   38,   35,   36,   76,    3
,   37,   65,   66,   67,   68,   71,   74,   79,   65,   31
,   44,   80,   65,   88,   80,   80,   65,   80,   33,   33
,   80,    2,    4,   10,   12,   21,   24,   29,   33,   37
,   39,   51,   53,   62,   65,   68,   14,   15,   19,   25
,   28,   46,   67,   92,   53,   21,   80,   80,   47,   47
,   71,   77,   70,   65,   65,   12,   65,   21,   43,   61
,   43,   21,   43,   80,   80,   21,   65,   80,   53,   80
,   94,   88,   12,   61,   72,   80,   72,   80,   21,   33
,   80,   80,   80,   80,   37,   37,   21,   61,   33,   65
,   65,   80,   80)  ;
        --| Action_Token_Map is an array that
        --| maps from each state (using action index map) to a set of
        --| action tokens. An action token is a terminal symbol
        --| (except EOF_Token) for which in the given state an
        --| explicit (non-default) shift or reduce action
        --| is defined.
        --| Used to cut reduce the
        --| number of primary recovery candidates.

    ------------------------------------------------------------------
    -- Shift_State_Map
    ------------------------------------------------------------------

    type Shift_State_Index_Array is array(
        PositiveParserInteger range <>) of GC.ParserInteger;
       --| For indexing the All Action Token Array.
       --| Maps a given state into the lower and upper bounds of a slice
       --| of the All Action Index Array.

    Shift_State_MapIndex : constant Shift_State_Index_Array :=
         (    1,    1,    2,    2,    3,    3,    4,    4,    5,    5
,    6,    6,    7,    9,   10,   11,   12,   14,   15,   15
,   16,   19,   20,   23,   24,   24,   25,   25,   26,   26
,   27,   29,   30,   32,   33,   33,   34,   36,   37,   37
,   38,   57,   58,   58,   59,   60,   61,   61,   62,   63
,   64,   65,   66,   66,   67,   67,   68,   69,   70,   73
,   74,   93,   94,   96,   97,  101,  102,  103,  104,  106
,  107,  108,  109,  110,  111,  112,  113,  116,  117,  119
,  120,  121,  122,  127,  128,  129,  130,  136,  137,  137
,  138,  138,  139,  143,  144,  148,  149,  149,  150,  153
,  154,  156,  157,  157,  158,  161,  162,  165,  166,  166
,  167,  169,  170,  170,  171,  174,  175,  177,  178,  180
,  181,  185,  186,  186,  187,  188,  189,  190,  191,  218
,  219,  219,  220,  224,  225,  227,  228,  228,  229,  232
,  233,  247,  248,  262,  263,  263,  264,  265,  266,  278
,  279,  280,  281,  282,  283,  283,  284,  289,  290,  385
,  386,  386,  387,  387,  388,  388,  389,  391,  392,  400
,  401,  404,  405,  405,  406,  408,  409,  409,  410,  410
,  411,  411,  412,  412,  413,  413,  414,  419,  420,  419
,  420,  419,  420,  419,  420,  420,  421,  425,  426,  429
,  430,  430,  431,  431,  432,  432,  433,  435,  436,  438
,  439,  440,  441,  443,  444,  446,  447,  447,  448,  448
,  449,  449,  450,  450,  451,  451,  452,  452,  453,  457
,  458,  465,  466,  473,  474,  475,  476,  478,  479,  480
,  481,  496,  497,  498,  499,  499,  500,  500,  501,  501
,  502,  502,  503,  503,  504,  505,  506,  513,  514,  516
,  517,  518,  519,  528,  529,  529,  530,  530,  531,  531
,  532,  533,  534,  534,  535,  536,  537,  537,  538,  545
,  546,  546,  547,  547,  548,  554,  555,  556,  557,  558
,  559,  562,  563,  580,  581,  582,  583,  583,  584,  584
,  585,  585,  586,  587,  588,  588,  589,  589,  590,  591
,  592,  593,  594,  594,  595,  596,  597,  597,  598,  612
,  613,  617,  618,  618,  619,  620,  621,  622,  623,  623
,  624,  626,  627,  642,  643,  643,  644,  644,  645,  645
,  646,  646,  647,  647,  648,  649,  650,  650,  651,  651
,  652,  652,  653,  653,  654,  655,  656,  656,  657,  659
,  660,  660,  661,  662,  663,  664,  665,  666,  667,  667
,  668,  668,  669,  670,  671,  673,  674,  674,  675,  676
,  677,  677,  678,  679,  680,  681,  682,  682,  683,  683
,  684,  684,  685,  686,  687,  687,  688,  688,  689,  689
,  690,  694,  695,  695,  696,  699,  700,  703,  704,  706
,  707,  709,  710,  710,  711,  713,  714,  715,  716,  726
,  727,  727,  728,  728,  729,  729,  730,  730,  731,  731
,  732,  732,  733,  733,  734,  734,  735,  735,  736,  738
,  739,  741,  742,  742,  743,  744,  745,  745,  746,  748
,  749,  749,  750,  750,  751,  751,  752,  752,  753,  753
,  754,  754,  755,  755,  756,  766,  767,  774,  775,  777
,  778,  779,  780,  793,  794,  795,  796,  797,  798,  798
,  799,  799,  800,  800,  801,  801,  802,  802,  803,  803
,  804,  804,  805,  806,  807,  807,  808,  808,  809,  809
,  810,  811,  812,  812,  813,  813,  814,  814,  815,  815
,  816,  817,  818,  818,  819,  820,  821,  821,  822,  822
,  823,  824,  825,  830,  831,  831,  832,  832,  833,  833
,  834,  835,  836,  836,  837,  837,  838,  841,  842,  855
,  856,  856,  857,  858,  859,  862,  863,  863,  864,  864
,  865,  865,  866,  866,  867,  867,  868,  874,  875,  885
,  886,  892,  893,  898,  899,  900,  901,  901,  902,  903
,  904,  904,  905,  905,  906,  907,  908,  908,  909,  910
,  911,  911,  912,  912,  913,  913,  914,  915,  916,  916
,  917,  917,  918,  919,  920,  920,  921,  921,  922,  922
,  923,  923,  924,  924,  925,  925,  926,  926,  927,  927
,  928,  928,  929,  929,  930,  930,  931,  932,  933,  933
,  934,  934,  935,  936,  937,  937,  938,  939,  940,  940
,  941,  941,  942,  944,  945,  945,  946,  946,  947,  947
,  948,  949,  950,  951,  952,  952,  953,  953,  954,  954
,  955,  955,  956,  956,  957,  958,  959,  959,  960,  960
,  961,  961,  962,  962,  963,  964,  965,  965,  966,  966
,  967,  967,  968,  968,  969,  969,  970,  970,  971,  972
,  973,  973,  974,  975,  976,  976,  977,  978,  979,  979
,  980,  980,  981,  981,  982,  982,  983,  983,  984,  985
,  986,  986,  987,  989,  990,  993,  994,  996,  997,  997
,  998,  998,  999,  999, 1000, 1001, 1002, 1002, 1003, 1003
, 1004, 1004, 1005, 1005, 1006, 1006, 1007, 1008, 1009, 1009
, 1010, 1010, 1011, 1011, 1012, 1013, 1014, 1014, 1015, 1015
, 1016, 1017, 1018, 1018, 1019, 1019, 1020, 1021, 1022, 1022
, 1023, 1023, 1024, 1024, 1025, 1025, 1026, 1026, 1027, 1027
, 1028, 1028, 1029, 1029, 1030, 1030, 1031, 1031, 1032, 1032
, 1033, 1033, 1034, 1034, 1035, 1035, 1036, 1037, 1038, 1039
, 1040, 1040, 1041, 1041, 1042, 1042, 1043, 1043)  ;

    Shift_State_Map : constant Shift_State_Array :=
         (    1,  497,   37,  498,  548,  277,  151,  154,  157,  549
,  816,  538,  784,  928,  188,   78,  233,  401,  402,  499
,  838,  940, 1022,  706,  642,  500,  269,  550,  585,  270
,  551,  586,  827,  288,  295,  831,  832,  224,  231,  434
,  438,  439,  534,  741,  754,  846,  868,  879,  903,  920
,  926,  963,  966, 1000, 1007, 1016, 1030,  435,  415,  707
,  501,  196,  638,   13,   98,   14,  502,  503,  959,  132
,  263,  453,  844,   83,  174,  180,  234,  305,  353,  405
,  424,  426,  428,  447,  449,  451,  546,  611,  612,  729
,  884,  897,  986,  552,  587,  944,  639,  913,  997, 1031
, 1039,  163,  866,   38,  186,  553,   39,  133,   40,  504
,  794,  977,  152,  155,  158,  857,  121,  774,  839,  466
,  598,   15,   99,  107,  197,  318,  480,    2,  194,  225
,  554,  588,  679,  713,  945,  987,   16,  505,  144,  271
,  589,  873, 1004,  662,  696,  927,  937,  972,  164,  341
,  423,  813,  818,  175,  532,  605,  910,  506,  969,  999
, 1019,   17,  490,  723,  724,  198,  100,  199,  319,  755
,  285,  294,  736,  958,  200,  239,  334,  201,  420,  422
,  621,  651,  732,  742,  756,  640,   35,  240,  153,  156
,    9,   41,   75,   79,  112,  116,  122,  191,  229,  241
,  272,  278,  310,  328,  329,  333,  336,  354,  366,  367
,  385,  491,  507,  578,  682,  748,  805,  982,   42,   43
,   76,  192,  279,  311,   44,  280,  683,  159,  145,  248
,  421,  633,   11,   45,   82,  146,  176,  184,  247,  303
,  306,  418,  539,  555,  590,  668,  674,  111,  131,  253
,  258,  383,  457,  468,  475,  607,  608,  659,  819,  871
,  877,  930,  165,   46,  160,  149,  254,  259,  284,  360
,  379,  455,  476,  574,  823,  878,  931,  934,   47,  161
,  147,  249,  166,  357,  391,  584,  632,  698,  979,   12
,   84,   90,  185,  237,  238,  262,  304,  307,  327,  349
,  361,  419,  427,  429,  446,  448,  469,  547,  575,  576
,  597,  609,  614,  622,  629,  630,  634,  649,  664,  665
,  666,  667,  681,  686,  687,  688,  689,  690,  691,  692
,  701,  705,  716,  719,  721,  722,  730,  733,  734,  738
,  773,  782,  783,  795,  802,  809,  814,  821,  822,  824
,  828,  829,  836,  837,  847,  850,  885,  893,  901,  906
,  914,  915,  949,  950,  952,  954,  971,  973,  988,  991
,  992,  994,  998, 1001, 1002, 1011, 1013, 1018, 1020, 1032
, 1033, 1034, 1035, 1042, 1043,  134,  135,  136,  250,  374
,  923,  251,  252,  375,  399,  864,  907,  916,  924,  960
,  137,  255,  381,  382,  168,  599,  635,  810,  138,  139
,  140,  406,  615,  595,  711,  712,  714,  715,  933,    3
,   48,  276,  363,  537,  789,  195,  407,  652, 1008,  202
,  203,  204,   18,  205,  481,   19,  206,  482,  207,  483
,   20,  208,  484,   21,  209,  485,  210,  440,  441,  442
,  443,  444,  242,  301,  445,  572,  938,  544,  673,  708
,  796,  811,  876, 1005, 1006,  600,  604,  815,  883,  890
,  953,  990, 1021,  709,  812,  556,  817,  891,  895,  951
,   49,  123,  312,  368,  369,  370,  376,  461,  619,  625
,  650,  661,  718,  740,  825,  889,  243,  601,  359,  211
,  212,  213,  337,  557,  946,  177,  182,  430,  450,  702
,  727,  947,  956,  573,  594,  886,  699,  717,  470,  474
,  803,  820,  887,  899,  948,  957, 1028, 1029,  558,  559
,  560,  561,  591,  562,  563,  592,  564,  117,  299,  454
,  467,  545,  710,  720,  801,  669,  118,  148,  256,  565
,  670,  693,  874, 1003,  566,  671,  567,  672,  183,  317
,  338,  680,   50,  124,  264,  265,  267,  268,  286,  373
,  459,  464,  465,  542,  620,  660,  677,  678,  925,  974
,  684,  936,  797,  685,  568,  694,  695,  569,  570,  675
,  894,  790,  975,  872,  932,  935,  676,   51,  125,  171
,  330,  433,  508,  596,  617,  757,  791,  806,  869,  896
,  898,  976,  792,  807,  911,  961,  978,  875,  266,  793
,  540,  571,  697,  798, 1036, 1037,   91,  114,  340,  342
,  362,  403,  579,  583,  613,  704,  786,  799,  882,  929
,  980,  983,  880,  939,  981,  881,  941,  509,  800,  942
,  984, 1009, 1023, 1010, 1038, 1024,  126,  460,  840,   87
,   92,  187,   88,   95,  320,  486,  404,  214,  215,  580
,  216,  246,  487,  488,  101,  321,  322,   22,  102,   23
,  103,  104,   52,   53,   54,  331,  281,  273,  127,   55
,  274,  364,  541,  739,  128,  260,  380,  602,  603,  129
,  371,  377,  463,  261,  458,  462,  130,  372,  378,   56
,   57,  282,  386,  150,  384,   58,  287,  289,  290,  291
,  292,  293,  387,  388,  389,  390,   59,   60,   61,   62
,   63,  141,  142,   64,   65,   66,  173,  296,   67,  172
,  298,  169,   68,  297,   69,   70,  275,  365,   71,   72
,  143,  162,   73,  167,  170,  119,  300,  309,  400,  431
,  543,  623,  624,  631,  775,  892,  324,  492,  647,  725
,  852,  856,  919,  921,  408,  616,  917,  493,  965,  325
,  645,  737,  751,  780,  781,  841,  843,  904,  905,  912
,  918,  996, 1015,  409,  494,  410,  495,  411,  412,  510
,  511,  413,  533,  512,  513,  758,  514,  515,  516,  517
,  759,  518,  519,  520,  521,  522,  760,  523,  414,  496
,  626,  735,  833,  862,  627,  731,  750,  830,  851,  902
,  524,  636,  743,  744,  909,  745,  525,  641,  845,  962
,  995,  230,  346,  350,  352,  577,  581,  582,  752,  848
,  849,  964, 1017, 1040, 1041,  749,  189,  643,   89,   96
,  235,  753,  190,  326,  416,  526,  644,   24,  105,  108
,  217,  323,  356,  489,   80,   81,  179,  236,  332,  335
,  351,  425,  478,  479,  618,  302,  308,  606,  808,  826
,  989,  993,  394,  397,  888,  900, 1012, 1014,   77,  232
,  392,  358,  393,   25,  193,   26,  109,   27,   93,  347
,  226,   28,   97,  339,  700,  432,  218,  343,  345,  219
,  106,  703,  436,  728,  527,  646,  528,  529,  530,  531
,  648,  922,  772,  761,  762,  861,  763,  764,  967,  765
,  766,  853,  855,  860,  767,  768,  769,  834,  858,  859
,  863,  968,  770,  726,    4,    5,    6,   10,    7,   29
,   30,    8,  113,  456,  245,   36,   31,  653,  777,  654
,  655,  778,  656,  657,  779,  658,  776,  970,   32,   33
,  110,  244,  355,  593,  955,  452,   85,  178,  181,  313
,  395,  396,  610,  398,  472,  473,   86,  314,  315,  316
,  477,  220,  221,  222,  223,  663,  787,  867,  785,  870
,  985,  535,  637,  804, 1027,  257,  908,   94,  227,   74
,  283,  120,  628,  835,  842,  417,  536,  471,  344,  437
,  854,  115,  865,  788,  943,  746, 1025,  747, 1026,  771
,   34,  228,  348)  ;
        --| Shift_State_ is an array that
        --| maps from non-terminals (using shift index map) to sets
        --| of states in which
        --| a shift to the non-terminal is defined.
        --| Used to determine the number of trials in primary
        --| error recovery.

    ------------------------------------------------------------------
    -- Subprogram Bodies Global to Package ErrorParseTables
    ------------------------------------------------------------------

    function Get_Action_Token_Map ( --| return the array of action tokens
                    --| for the state passed in.
        In_Index : in StateRange
                    --| the state to return action tokens
                    --| for.
        )
        return Action_Token_Record
        is
        --| Returns
        --| This subprogram returns the action token record for the
        --| state passed in.
        Result : Action_Token_Record ;
        LowerBound, UpperBound : GC.ParserInteger ;
        --| Lower and upper bounds of the slice of Action Token Map
    begin
        LowerBound := Action_Token_MapIndex ( In_Index*2 - 1 ) ;
        UpperBound := Action_Token_MapIndex ( In_Index*2 ) ;

        Result.set_size := UpperBound - LowerBound + 1;
        Result.set := (others => DefaultValue) ;
        Result.set(Result.set'first .. Result.set_size) :=
        Action_Token_Map(LowerBound..UpperBound) ;

        return Result ;
    end Get_Action_Token_Map ;

    ------------------------------------------------------------------

    function Get_Shift_State_Map (  --| return the array of shift states
                    --| for the grammar symbol passed in.
        In_Index : in GrammarSymbolRange
                    --| the grammar symbol to return shifts
                    --| for.
        )
        --| Raises: This subprogram raises no exceptions.
        return Shift_State_Record
        --| Returns
        --| This subprogram returns the array of shift states for the
        --| grammar symbol passed in.
        is

        Result : Shift_State_Record ;
        LowerBound, UpperBound : GC.ParserInteger ;
          --| Lower and upper bounds of the slice of Shift State Map
    begin
        LowerBound := Shift_State_MapIndex ( In_Index*2 - 1 ) ;
        UpperBound := Shift_State_MapIndex ( In_Index*2 ) ;

        Result.set_size := UpperBound - LowerBound + 1;
        Result.set := (others => DefaultValue) ;
        Result.set(Result.set'first .. Result.set_size) :=
            Shift_State_Map(LowerBound..UpperBound) ;

        return Result ;
    end Get_Shift_State_Map ;

    function Get_Grammar_Symbol (   --| return the string representation
                    --| of the grammar symbol
        In_Index : in GrammarSymbolRange
        )
        return string
        is
        LowerBound, UpperBound : GC.ParserInteger ;
      --| Lower and upper bounds of the slice of Shift State Map
    begin
        LowerBound := GrammarSymbolTableIndex ( In_Index*2 - 1 ) ;
        UpperBound := GrammarSymbolTableIndex ( In_Index*2 ) ;

        return GrammarSymbolTable(
            Integer(LowerBound) .. Integer(UpperBound)) ;
    end Get_Grammar_Symbol ;

    ------------------------------------------------------------------

    function Get_Follow_Map (       --| return the array of follow symbols
                    --| of the grammar symbol passed in
        In_Index : in FollowMapRange
        )
        -- |
        -- |Raises: This subprogram raises no exceptions.
        -- |

      return FollowSymbolRecord
      is
        Result : FollowSymbolRecord ;
        LowerBound, UpperBound : GC.ParserInteger ;
        Adjusted_Index : GC.ParserInteger :=
          (In_Index - FollowMapRange'first) + 1;
    begin
        LowerBound := FollowSymbolMapIndex ( Adjusted_Index*2 - 1 ) ;
        UpperBound := FollowSymbolMapIndex ( Adjusted_Index*2 ) ;

        Result.follow_symbol_count := UpperBound - LowerBound + 1;
        Result.follow_symbol := (others => DefaultValue) ;
        Result.follow_symbol(
          Result.follow_symbol'first ..
          Result.follow_symbol_count) :=
            FollowSymbolMap(LowerBound..UpperBound) ;

        return Result ;
    end Get_Follow_Map ;

    ------------------------------------------------------------------

    function GetAction (            -- see subprogram declaration
      InStateValue  : in StateRange;
      InSymbolValue : in GrammarSymbolRange
      )
      return ActionRange
      is

        Unique : GC.ParserInteger;
            --| unique value to hash for Index.
        Index  : GC.ParserInteger;
            --| index into Action Tables.
        Action : GC.ParserInteger;
            --| value from Action Tables.
        CollisionCount : Natural := 0 ; --| Number of collisions.
    begin -- GetAction function
    --| Algorithm
    --|-
    --| Definitions of key objects from package ParseTables:
    --|
    --| ActionCount: the number of actions in the action tables.
    --|
    --| ActionTableOne: table of action values for all combinations of
    --|     states and input actions.
    --|
    --| ActionTableTwo: hash values to check against to verify that action
    --|     value at same index in ActionTableOne is correct one.
    --|
    --| ActionTableSize: last index in ActionTableOne and ActionTableTwo
    --|     before the hash collision chains.
    --|
    --| DefaultMap: default action for each state.
    --|+
    --| The action to be returned is computed from parameters InStateValue
    --| and InSymbolValue. First, determine the unique single value:
    --|
    --|     Unique := (InStateValue * GrammarSymbolCountPlusOne) +
    --|                InSymbolValue;
    --|
    --| Unique is hashed by reducing modulo ActionTableSize and adding 1:
    --|
    --|     Index := (Unique mod ActionTableSize) + 1;
    --|
    --| This hash value, Index, is used to index ActionTableOne to
    --| obtain an Action:
    --|
    --|     Action := ActionTableOne(Index);
    --|
    --| Action is then used to determine the return value:
    --|
    --| Action = 0:
    --|     return DefaultMap(InStateValue);
    --|
    --| Action < ActionCount:
    --|     if (Unique = ActionTableTwo(Index)) then
    --|         return Action;
    --|     else
    --|         return DefaultMap(InStateValue);
    --|     end if;
    --|
    --| Action >= ActionCount:
    --|     --Search the hash collision chain
    --|     Index := Action - ActionCount;
    --|     while (Action /= 0) loop
    --|         Index := Index + 1;
    --|         Action := ActionTableTwo(Index);
    --|         if (Action = Unique) then
    --|             return ActionTableOne(Index);
    --|         end if;
    --|     end loop;
    --|     return DefaultMap(InStateValue);

    ------------------------------------------------------------------

  --| The actual code used folds this algorithm into a more efficient one:
        ParserDecisionCount := Natural'succ(ParserDecisionCount) ;

        Unique := (InStateValue * GrammarSymbolCountPlusOne) +
                        InSymbolValue;
        Index := (Unique mod ActionTableSize) + 1;
        Action := ActionTableOne(Index);

        if (Action >= ActionCount) then
            Index := Action - ActionCount + 1;
            while ( (ActionTableTwo(Index) /= Unique) and then
                    (ActionTableTwo(Index) /= 0) ) loop
                Index := Index + 1;
            CollisionCount := Natural'succ(CollisionCount) ;
            end loop;
            Action := ActionTableOne(Index);
        end if;

        -- Collect statistics information.
        TotalCollisions := CollisionCount + TotalCollisions ;
        if CollisionCount > MaxCollisions then
            MaxCollisions := CollisionCount ;
        end if;

        if (ActionTableTwo(Index) /= Unique) then
            return DefaultMap(InStateValue);
        else
            return Action;
        end if;

    end GetAction; -- function

    function Get_LeftHandSide(
      GrammarRule : in LeftHandSideRange
      ) return GrammarSymbolRange is
    begin
        return LeftHandSide(GrammarRule) ;
    end Get_LeftHandSide ;

    function Get_RightHandSide(
      GrammarRule : in RightHandSideRange
      ) return GC.ParserInteger is
    begin
        return RightHandSide(GrammarRule) ;
    end Get_RightHandSide ;

end ParseTables;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--GRMCONST.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--+ GRMCONST.BDY +--

Package body Grammar_Constants is

    function setGrammarSymbolCount return ParserInteger is
    begin
        return   394 ;
    end setGrammarSymbolCount;

    function setActionCount return ParserInteger is
    begin
        return  1599 ;
    end setActionCount;

    function setStateCountPlusOne return ParserInteger is
    begin
        return  1044 ;
    end setStateCountPlusOne;

    function setLeftHandSideCount return ParserInteger is
    begin
    return   553 ;
    end setLeftHandSideCount;

    function setRightHandSideCount return ParserInteger is
    begin
        return   553 ;
    end setRightHandSideCount;

end Grammar_Constants;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--STRUTILS.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

package STRING_UTILITIES is

   -----------------------------------------------------------------
   function POSITION_OF(PATTERN : CHARACTER; SOURCE : STRING)
      return NATURAL;

   -- Return the index position in Source of the first occurrence
   -- of the character or 0 if the pattern was not found.

   -----------------------------------------------------------------
   function POSITION_OF_REVERSE(PATTERN : CHARACTER; SOURCE : STRING)
      return NATURAL;

   -- Scan the source string in reverse for the given character, and
   -- return its index position, or 0 if it was not found.

   -----------------------------------------------------------------
   function POSITION_OF(PATTERN : STRING; SOURCE : STRING)
      return NATURAL;

   -- Return the index position of the first occurrence of the pattern
   -- string in the source string, or 0 if the pattern is not found.

   -----------------------------------------------------------------
   function POSITION_OF_REVERSE(PATTERN : STRING; SOURCE : STRING)
      return NATURAL;

   -- Scan the source string in reverse for the pattern string, and
   -- return its index position, or 0 if the pattern is not found.

   -----------------------------------------------------------------
   function SKIP_BLANKS(SOURCE: STRING) return NATURAL;

   -- Return the index of the first non-blank character in the source
   -- string, or Source'Last + 1 if there are no non-blank characters.

   -----------------------------------------------------------------
   function SKIP_BLANKS_REVERSE(SOURCE: STRING) return NATURAL;

   -- Scan the source string in reverse and return the index position
   -- of the first non-blank character. Return Source'First - 1 if
   -- no non-blank characters are found.

   -----------------------------------------------------------------
   function STRIP_BLANKS(SOURCE: STRING) return STRING;

   -- Return a copy of the source string with all blanks removed.


   -----------------------------------------------------------------
   function STRIP_NON_LITERAL_BLANKS(SOURCE: STRING) return STRING;

   -- Return a copy of the source string with all blanks removed except
   -- character literal blanks and blanks in an embedded string literal.

   -----------------------------------------------------------------
   function UPPER_CASE(SOURCE : STRING) return STRING;

   -- Return an upper cased copy of the source string.

   -----------------------------------------------------------------
   function UPPER_CASE(SOURCE : CHARACTER) return CHARACTER;

   -- Return the upper case of the given character.

   -----------------------------------------------------------------
   function UPPER_CASE_NON_LITERALS(SOURCE : STRING) return STRING;

   -- Return a copy of the source string with all characters upper
   -- cased except character literals and embedded strings.

   -----------------------------------------------------------------
   procedure NEXT_WORD(SOURCE: STRING;
                       WORD_START: in out NATURAL;
                       WORD_END: in out NATURAL);

   -- Mark the starting and ending positions of the next set of
   -- non-blank characters in the source string.  If none are found,
   -- Word_Start = Word_End + 1.

   -----------------------------------------------------------------
   function INTEGER_STRING(INT_VALUE : INTEGER) return STRING;

   -- Return the image string of the integer with no leading blanks.

   -----------------------------------------------------------------
   procedure FIND_EMBEDDED_STRING(SOURCE: STRING;
                                  FIRST, LAST: out NATURAL);

   -- Find a string literal within the source string.  First and/or
   -- Last will be 0 if the opening and/or closing delimeters are not
   -- found.

   -----------------------------------------------------------------
   function STRIP_DOUBLE_DELIMITERS(SOURCE: STRING;
                                    DELIMITER: CHARACTER) return STRING;

   -- Return a copy of the input string, replacing any doubled
   -- delimiters by a single one.  The Delimiter parameter indicates
   -- whether the string delimter is a quote or a percent sign.

   -- The enclosing delimiters are NOT part of the source string.

   -----------------------------------------------------------------

end STRING_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--STRUTILS.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

package body STRING_UTILITIES is

   --------------------------------------------------------------------
   function POSITION_OF(PATTERN : CHARACTER; SOURCE : STRING)
      return NATURAL is

      -- Return the position of Pattern in Source, or 0 if
      -- not found.

   begin
      for I in SOURCE'RANGE loop
         if SOURCE(I) = PATTERN then
            return I;
         end if;
      end loop;
      return 0;
   end POSITION_OF;

   --------------------------------------------------------------------
   function POSITION_OF_REVERSE(PATTERN : CHARACTER; SOURCE : STRING)
      return NATURAL is

      -- Scan backwards for the next occurence of Pattern in Source.
      -- Return its index position, or 0 if not found.

   begin
      for I in reverse SOURCE'RANGE loop
         if SOURCE(I) = PATTERN then
            return I;
         end if;
      end loop;
      return 0;
   end POSITION_OF_REVERSE;

   --------------------------------------------------------------------
   function POSITION_OF(PATTERN : STRING; SOURCE : STRING)
      return NATURAL is

      -- Return the Pattern string in the Source string, and return
      -- its starting index,  or 0 if not found.

   begin
      for I in SOURCE'FIRST .. SOURCE'LAST - PATTERN'LENGTH + 1 loop
         if SOURCE(I .. I + PATTERN'LENGTH - 1) = PATTERN then
            return I;
         end if;
      end loop;
      return 0;
   end POSITION_OF;

   --------------------------------------------------------------------
   function POSITION_OF_REVERSE(PATTERN : STRING; SOURCE : STRING)
      return NATURAL is

      -- Scan backward for the Pattern string in the Source string.
      -- Return its starting index, or 0 if not found.

   begin
      for I in reverse SOURCE'FIRST .. SOURCE'LAST - PATTERN'LENGTH + 1 loop
         if SOURCE(I .. I + PATTERN'LENGTH - 1) = PATTERN then
            return I;
         end if;
      end loop;
      return 0;
   end POSITION_OF_REVERSE;

   --------------------------------------------------------------------
   function SKIP_BLANKS(SOURCE: STRING) return NATURAL is

      -- Return the index of the next non-blank character, or
      -- Source'Last + 1 if the string is all blanks.

   begin
      for I in SOURCE'RANGE loop
         if SOURCE(I) /= ' ' then
            return I;
         end if;
      end loop;
      return SOURCE'LAST + 1;
   end SKIP_BLANKS;

   --------------------------------------------------------------------
   function SKIP_BLANKS_REVERSE(SOURCE: STRING) return NATURAL is

      -- Scan the source string backwards for the next non-blank
      -- character.  Return Source'First - 1 if non are found.

   begin
      for I in reverse SOURCE'RANGE loop
         if SOURCE(I) /= ' ' then
            return I;
         end if;
      end loop;
      return SOURCE'FIRST - 1;
   end SKIP_BLANKS_REVERSE;

   --------------------------------------------------------------------
   function STRIP_BLANKS(SOURCE: STRING) return STRING is
      RESULT: STRING(1..SOURCE'LENGTH) := SOURCE;
      INDEX : NATURAL := RESULT'FIRST;
      LEN   : NATURAL := RESULT'LAST;
    begin
      while INDEX <= LEN loop
        if RESULT(INDEX) = ' ' then
          RESULT(INDEX .. LEN - 1) := RESULT(INDEX + 1 .. LEN);
          LEN := LEN - 1;
        else
          INDEX := INDEX + 1;
        end if;
      end loop;
      return RESULT(1..LEN);
   end STRIP_BLANKS;

   --------------------------------------------------------------------
   function STRIP_NON_LITERAL_BLANKS(SOURCE: STRING) return STRING is

      -- Strip all blanks except character literal blanks, and blankss
      -- embedded in string literals.

      RESULT: STRING(1..SOURCE'LENGTH) := SOURCE;
      INDEX : NATURAL := RESULT'FIRST;
      LEN   : NATURAL := RESULT'LAST;
      J     : NATURAL;

    begin
       while INDEX <= LEN loop
         case RESULT(INDEX) is
            when ''' =>
               if INDEX <= LEN - 2 and then RESULT(INDEX + 2) = ''' then
                  INDEX := INDEX + 2;
               end if;

            when '"' | '%' =>
               FIND_EMBEDDED_STRING(RESULT(INDEX..RESULT'LAST), INDEX, J);
               if J /= 0 then
                  INDEX := J;
               end if;

            when ' ' =>
               RESULT(INDEX .. LEN - 1) := RESULT(INDEX + 1 .. LEN);
               LEN := LEN - 1;
               INDEX := INDEX - 1;

            when others => null;
         end case;
         INDEX := INDEX + 1;
      end loop;
      return RESULT(1..LEN);
   end STRIP_NON_LITERAL_BLANKS;

   --------------------------------------------------------------------
   function UPPER_CASE(SOURCE : STRING) return STRING is
      RESULT : STRING(1 .. SOURCE'LENGTH) := SOURCE;
   begin
      for I in RESULT'RANGE loop
         if RESULT(I) in 'a' .. 'z' then
            RESULT(I) := CHARACTER'VAL(CHARACTER'POS(RESULT(I)) - 32);
         end if;
      end loop;
      return RESULT;
   end UPPER_CASE;

   --------------------------------------------------------------------
   function UPPER_CASE(SOURCE : CHARACTER) return CHARACTER is
   begin
     if SOURCE in 'a' .. 'z' then
        return CHARACTER'VAL(CHARACTER'POS(SOURCE) - 32);
     else
        return SOURCE;
     end if;
   end UPPER_CASE;

   --------------------------------------------------------------------
   function UPPER_CASE_NON_LITERALS(SOURCE : STRING) return STRING is

      -- Upper case all characters in the string except character
      -- literals and embedded string literals/

      RESULT : STRING(SOURCE'RANGE) := SOURCE;
      I, J   : NATURAL := SOURCE'FIRST;
   begin
      while I <= RESULT'LAST loop
         case RESULT(I) is
            when ''' =>
               if I < RESULT'LAST - 2 and then RESULT(I + 2) = ''' then
                  I := I + 2;
               end if;

            when '"' | '%' =>
               FIND_EMBEDDED_STRING(RESULT(I .. RESULT'LAST), I, J);
               if J /= 0 then
                  I := J;
               end if;

            when 'a' .. 'z' =>
               RESULT(I) := CHARACTER'VAL(CHARACTER'POS(RESULT(I)) - 32);

            when others => null;
         end case;

         I := I + 1;
      end loop;
      return RESULT;
   end UPPER_CASE_NON_LITERALS;

   --------------------------------------------------------------------
   procedure NEXT_WORD(SOURCE: STRING;
                       WORD_START: in out NATURAL;
                       WORD_END: in out NATURAL) is

      -- Find the starting and ending indices of the next sequence of
      -- non-blank characters in the source string.  If none are found,
      -- Word_Start will be set to Source'Last + 1, and Word_End will
      -- Source'Last.

   begin
      WORD_START := SKIP_BLANKS(SOURCE);
      WORD_END := POSITION_OF(' ', SOURCE(WORD_START..SOURCE'LAST));
      if WORD_END = 0 then
         WORD_END := SOURCE'LAST;
      else
         WORD_END := WORD_END - 1;
      end if;
   end NEXT_WORD;

   --------------------------------------------------------------------
   function INTEGER_STRING(INT_VALUE : INTEGER) return STRING is

     -- Return the left justified string image of the integer.

   begin
      if INT_VALUE < 0 then
         return INTEGER'IMAGE(INT_VALUE);
      end if;
      return INTEGER'IMAGE(INT_VALUE)(2..INTEGER'IMAGE(INT_VALUE)'LENGTH);
   end INTEGER_STRING;

   --------------------------------------------------------------------
   procedure FIND_EMBEDDED_STRING(SOURCE: STRING;
                                  FIRST, LAST: out NATURAL) is

      -- If an embedded string literal is found, First and Last will
      -- be the index positions of the opening and closing delimiters.
      -- If both the opening and closing delimiters are not found,
      -- First and/or Last will be 0.

      INDEX     : NATURAL;
      DELIMITER : CHARACTER;
   begin
      FIRST := 0;
      LAST  := 0;

      INDEX := SKIP_BLANKS(SOURCE);
      if INDEX < SOURCE'LAST and then
         (SOURCE(INDEX) = '"' or else SOURCE(INDEX) = '%') then
         DELIMITER := SOURCE(INDEX);
         FIRST := INDEX;
         INDEX := INDEX + 1;
         while INDEX <= SOURCE'LAST loop
            if SOURCE(INDEX) = DELIMITER then
               if INDEX = SOURCE'LAST or else SOURCE(INDEX+1) /= DELIMITER then
                  LAST := INDEX;
                  return;
               end if;
               INDEX := INDEX + 1;
            end if;
            INDEX := INDEX + 1;
         end loop;
      end if;
   end FIND_EMBEDDED_STRING;

   --------------------------------------------------------------------
   function STRIP_DOUBLE_DELIMITERS(SOURCE: STRING;
                                    DELIMITER: CHARACTER) return STRING is

      -- Return a copy of the source string with any doubled
      -- delimeters replaced by single delimiters.  The source string
      -- does not include enclosing delimiters.

      TMP_STRING : STRING(1 .. SOURCE'LENGTH) := SOURCE;
      INDEX      : INTEGER := TMP_STRING'FIRST - 1;
      LAST       : INTEGER := TMP_STRING'LAST;
   begin
      loop
         INDEX := POSITION_OF(DELIMITER, TMP_STRING(INDEX + 1 .. LAST));
         exit when INDEX = 0;
         TMP_STRING(INDEX + 1 .. LAST - 1) := TMP_STRING(INDEX + 2 .. LAST);
         LAST := LAST - 1;
      end loop;
      return TMP_STRING(1 .. LAST);
   end STRIP_DOUBLE_DELIMITERS;

   --------------------------------------------------------------------

end STRING_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SIOINS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with DIRECT_IO;
PACKAGE STRING_IO_INSTANTIATION IS

  subtype FILE_STRING is STRING(1..80);

  package SIO is new DIRECT_IO(FILE_STRING);
end STRING_IO_INSTANTIATION;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--STRING_IO.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
package STRING_IO is
--| overview
--| String_io is used to write to a direct access file.  All records are
--| 80 characters.

  procedure OPEN(FILENAME  : in STRING);
  --| Effects
  --| Open creates the external file Filename and opens it for direct io.

  procedure PUT(TEXT       : in STRING);
  --| Effects
  --| Put writes the string Text to Filename.

  procedure PUT_LINE(TEXT  : in STRING);
  --| Effects
  --| Put_line writes the string Text to Filename, appends blanks to fill
  --| in the line and adds a carriage return.

  procedure NEW_LINE(COUNT : in NATURAL := 1);
  --| Effects
  --| New_Line writes blank lines to Filename.

  procedure CLOSE;
  --| Effects
  --| Close closes Filename.

end STRING_IO;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--STRING_IO.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_IO_INSTANTIATION; use STRING_IO_INSTANTIATION;

package body STRING_IO is

  LIST_FILE          : SIO.FILE_TYPE; --| Name of direct_io string file.
  INPUT_STRING       : FILE_STRING; --| Buffer for current output record.
  INPUT_STRING_INDEX : NATURAL := 1; --| Index for current position in buffer.
  BLANKS             : FILE_STRING := (OTHERS => ' '); --| A blank record.
  OUT_FILE           : SIO.FILE_MODE := SIO.OUT_FILE;
  FILE_OPEN          : BOOLEAN := FALSE;

  procedure OPEN(FILENAME : in STRING) is
  begin
    INPUT_STRING := BLANKS; -- clear input buffer
    FILE_OPEN := TRUE;
    if SIO.IS_OPEN(LIST_FILE) then
      SIO.CLOSE(LIST_FILE);
    end if;
    SIO.OPEN(LIST_FILE, OUT_FILE, FILENAME);
    -- The file exists so delete it and create it.  This must be done for
    -- direct io, otherwise if the new file is smaller than the old file
    -- the bottom of the old file will be left at the bottom of the new file.
    SIO.DELETE(LIST_FILE);
    SIO.CREATE(LIST_FILE, OUT_FILE, FILENAME);
  exception
    when
      SIO.NAME_ERROR =>
        -- file doesn't exist
        SIO.CREATE(LIST_FILE, OUT_FILE, FILENAME);
  end OPEN;

  procedure PUT(TEXT : in STRING) is
  begin
    if FILE_OPEN then
      if TEXT'LENGTH > 81 - INPUT_STRING_INDEX then
        -- Text is too long to fit in buffer so write the buffer to the
        -- file and clear the buffer and reset the index.
        INPUT_STRING(INPUT_STRING_INDEX .. INPUT_STRING'LENGTH) :=
          TEXT(TEXT'FIRST .. INPUT_STRING'LENGTH - INPUT_STRING_INDEX + 1);
        INPUT_STRING_INDEX := INPUT_STRING'LENGTH + 1;
      else
        INPUT_STRING(INPUT_STRING_INDEX..INPUT_STRING_INDEX + TEXT'LENGTH - 1)
          := TEXT;
        INPUT_STRING_INDEX := INPUT_STRING_INDEX + TEXT'LENGTH;
      end if;
    end if;
  end PUT;

  procedure PUT_LINE(TEXT : in STRING) is
  begin
    if FILE_OPEN then
      PUT(TEXT); -- write Text to buffer
      SIO.WRITE(LIST_FILE, INPUT_STRING);  -- write buffer to output file
      INPUT_STRING := BLANKS; -- clear buffer
      INPUT_STRING_INDEX := 1; -- reset index
    end if;
  end PUT_LINE;

  procedure NEW_LINE(COUNT : in NATURAL := 1) is
  begin
    if FILE_OPEN then
      if COUNT > 0 then
        -- Write the buffer to the output file,
        -- clear the buffer and reset the index.
        SIO.WRITE(LIST_FILE, INPUT_STRING);
        INPUT_STRING := BLANKS;
        INPUT_STRING_INDEX := 1;
        for I in 1 .. COUNT - 1 loop
          SIO.WRITE(LIST_FILE, BLANKS); -- write a blank line
        end loop;
      end if;
    end if;
  end NEW_LINE;

  procedure CLOSE is
  begin
    if FILE_OPEN then
      if INPUT_STRING_INDEX > 1 then
        -- There is Text in the buffer so write the buffer to the output file.
        SIO.WRITE(LIST_FILE, INPUT_STRING);
      end if;
      SIO.CLOSE(LIST_FILE);
      FILE_OPEN := FALSE;
    end if;
  end CLOSE;

end STRING_IO;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--TYPEDEFS.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG; use STRING_PKG;    --| for String_Types

------------------------
package SD_TYPE_DEFINITIONS is
------------------------

--| Overview
--| TypeDefs contains global type declarations used by all of the Ada
--| Testing and Analysis Tools.  Its purpose is to provide consistency
--| and uniformity of type declarations for objects common to all of
--| the tools.

--| N/A: Errors, Raises, Modifies, Requires

--) Version:       2.0
--)
--) Last Modified: 05/10/85 JEE Converted all records with string lengths
--)                             as discriminants to String_Type
--)
--)                09/16/85 JEE Added LINE_NUMBER_RANGE
--)                             Added FIRST_BREAKPOINT and LAST_BREAKPOINT
--)                                   to PROGRAM_UNIT_NAME

  type TOOL_NAMES is ( --| The names of the Testing and Analysis Tools
  PATH_TOOL,           --| Path Analyzer
  AUTOPATH_TOOL,       --| Automatic Path Analyzer
  SMART_TOOL,          --| Self Metric Analysis and Reporting Tool
  PROFILE_TOOL,        --| Performance Analyzer
  DEBUG_TOOL           --| Symbolic Debugger
  );

  type LOGFILE_KEYS is ( --| A unique key for each log file record type
                         --| defines the format of each log file record
  PROGRAM, TOOL, TEST_TIME, TEST_ID,        --| Logfile configuration
  COMPILATION_UNIT_DEFINITION,              --| Unit definitions
  PROGRAM_UNIT_DEFINITION,                  --| Unit definitions
  UNIT_START, UNIT_STOP,                    --| Unit starts and stops
  LOOP_BREAKPOINT, OTHER_BREAKPOINT,        --| All other breakpoints
  AUTOPATH_CALL,                            --| AutoPath procedure call
  INTEGER_VARIABLE,                         --| Variable data types
  LONG_INTEGER_VARIABLE,                    --| Variable data types
  FLOAT_VARIABLE,
  LONG_FLOAT_VARIABLE,
  FIXED_POINT_VARIABLE,
  STRING_VARIABLE,
  DELAY_TIME,                               --| For delays of program units
  TIMING_OVERHEAD                           --| For Unit_Start and Unit_Stop
  );

  subtype FILENAME is STRING_TYPE;   --| filenames are string_types

  subtype TEST_IDENTIFIER is STRING_TYPE;

  subtype BREAKPOINT_TYPES is
    LOGFILE_KEYS range LOOP_BREAKPOINT .. OTHER_BREAKPOINT;
    --| The type of each breakpoint is assigned by the source instrumenter


  --| Numeric Type Definitions

  subtype PROGRAM_UNIT_NUMBER_RANGE is NATURAL;
  --| The source instrumenter assigns a unique number to each
  --| program unit within a compilation unit.

  subtype TASK_TYPE_ACTIVATION_NUMBER_RANGE is NATURAL;
  --| Each activation of a task type is assigned a unique number.

  subtype BREAKPOINT_NUMBER_RANGE is NATURAL;
  --| The source instrumenter assigns a unique number to each
  --| breakpoint in the compilation unit.

  subtype LINE_NUMBER_RANGE is NATURAL;
  --| The source instrumenter assigns a unique number to each
  --| source code line in the compilation unit.

  subtype COUNT_RANGE is NATURAL;
  --| A count is a non-negative number in the range 0 .. MAX_INT;

  type LONG_COUNT is
    record
      OVERFLOW_COUNT : COUNT_RANGE;
      CURRENT_COUNT  : COUNT_RANGE;
    end record;
    --| A Long_Count record provides a "long integer" type of count
    --| consisting of the current count and a count of the number of
    --| times the current count has overflowed.


  --| Program Unit Type definitions

  type PROGRAM_UNIT_TYPE is ( --| Ada program units can be
    PROCEDURE_TYPE,           --| procedures
    FUNCTION_TYPE,            --| functions
    TASK_TYPE,                --| tasks
    GENERIC_TYPE,             --| generics
    PACKAGE_TYPE              --| and packages
  );

  subtype ADA_NAME is STRING_TYPE;
  --| An Ada name is a string type of variable length

  type PROGRAM_UNIT_NAME is
    record
      UNIT_IDENTIFIER  : ADA_NAME;
      UNIT_TYPE        : PROGRAM_UNIT_TYPE;
      FIRST_BREAKPOINT : BREAKPOINT_NUMBER_RANGE := 0;
      LAST_BREAKPOINT  : BREAKPOINT_NUMBER_RANGE := 0;
    end record;
  --| A table of the names and program unit types of all of the
  --| program units contained within a compilation unit.
  --| FIRST_BREAKPOINT and LAST_BREAKPOINT define thr range of
  --| breakpoint numbers included in the program unit.

  type PROCEDURE_LIST is array(POSITIVE range <>) of PROGRAM_UNIT_NAME;
  --| A table of the names and program unit types of all of the
  --| program units contained within a compilation unit.

  type PROGRAM_UNIT_UNIQUE_IDENTIFIER is
    record
      ENCLOSING_UNIT_IDENTIFIER   : ADA_NAME;
      PROGRAM_UNIT_NUMBER         : PROGRAM_UNIT_NUMBER_RANGE := 0;
      UNIT_TYPE                   : PROGRAM_UNIT_TYPE;
      TASK_TYPE_ACTIVATION_NUMBER : TASK_TYPE_ACTIVATION_NUMBER_RANGE := 1;
    end record;
    --| A Program_Unit_Unique_Identifier record consists of the identifier
    --| of the enclosing unit, a unique number for the current program unit,
    --| and for task types, a unique activation number.

  subtype INPUT_PARAMETER_LIST is STRING_TYPE;

end SD_TYPE_DEFINITIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--PREDEFIO.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with TEXT_IO; use TEXT_IO;
with SYSDEP; use SYSDEP;
with CALENDAR;
package PREDEFINED_IO is

  use SYSDEP.PREDEFINED_TYPES;

   package SI2AFSD_1861_Integer_IO      is new Integer_IO (Integer);
   package SI2AFSD_1861_Long_Integer_IO is new Integer_IO (Long_Integer);
   package SI2AFSD_1861_Real_IO         is new Float_IO (Float);
   package SI2AFSD_1861_Long_Real_IO    is new Float_IO (Long_Float);
   package SI2AFSD_1861_TIME_IO         is new FIXED_IO(CALENDAR.DAY_DURATION);

end PREDEFINED_IO;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--TIMELIB1.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with CALENDAR;

----------------------
package TIME_LIBRARY_1 is
----------------------

--| Overview
--| TimeLib contains procedures and functions for getting, putting,
--| and calculating times, and dates. It augments the
--| predefined library package Calendar to simplify IO and provide
--| additional time routines common to all Ada Test and Evaluation
--| Tool Set (ATETS) tools.

--| Requires
--| All procedures and functions that perform IO use the
--| predefined library package Text_IO and require that the
--| specified file be opened by the calling program prior to use.
--| All times and durations must be of types declared in the
--| predefined library package Calendar.

--| Errors
--| No error messages or exceptions are raised by any of the TimeLib
--| procedures and functions. However, any Text_IO and Calendar
--| exceptions that may be raised are allowed to pass, unhandled,
--| back to the calling program.

--| N/A:  Raises, Modifies

--  Version         : 1.0
--  Author          : Jeff England
--  Initial Release : 05/19/85
--  Last Modified   : 05/19/85



  ----------------
  function DATE_OF(--| Convert the date to a string

    DATE : in CALENDAR.TIME  --| The date to be converted

    ) return STRING;

  --| Effects
  --| Converts the date to a string in the format MM/DD/YYYY

  --| N/A:  Raises, Requires, Modifies, Errors


  ----------------------
  function WALL_CLOCK_OF(--| Convert seconds to wall clock time

    SECONDS : in CALENDAR.DAY_DURATION  --| The time to be converted

    ) return STRING;

  --| Effects
  --| Converts the time of day or elapsed time, in seconds,
  --| to a string in the format HH:MM:SS.FF.

  --| N/A:  Raises, Requires, Modifies, Errors


end TIME_LIBRARY_1;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--TIMELIB1.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with CALENDAR, PREDEFINED_IO;

---------------------------
package body TIME_LIBRARY_1 is
---------------------------

--| Overview
--| TimeLib contains procedures and functions for getting, putting,
--| and calculating times, and dates. It augments the
--| predefined library package Calendar to simplify IO and provide
--| additional time routines common to all Ada Test and Evaluation
--| Tool Set (ATETS) tools.

--| Requires
--| All procedures and functions that perform IO use the
--| predefined library package Text_IO and require that the
--| specified file be opened by the calling program prior to use.
--| All times and durations must be of types declared in the
--| predefined library package Calendar.

--| Errors
--| No error messages or exceptions are raised by any of the TimeLib
--| procedures and functions. However, any Text_IO and Calendar
--| exceptions that may be raised are allowed to pass, unhandled,
--| back to the calling program.

--| N/A:  Raises, Modifies

--  Version         : 1.1
--  Author          : Jeff England
--  Initial Release : 05/19/85
--  Last Modified   : 06/07/85

  TIME_STRING   : STRING(1..10);

  ----------------
  function CONVERT( --| Convert an integer to a string

    INPUT_NUMBER : in INTEGER;

    WIDTH        : in INTEGER := 0

    ) return STRING is

    --| Effects:
    --| Converts an integer to a string of length Width. If the
    --| number if digits in Input_Number is less than Width then
    --| the digits are right justified in the output string and
    --| filled with zeros (0) on the left.

    TEMP_TEXT : STRING(1 .. 16);
    INDEX     : INTEGER;


  begin

    PREDEFINED_IO.SI2AFSD_1861_INTEGER_IO.PUT(TEMP_TEXT, INPUT_NUMBER);
    if WIDTH <= 0 then
      INDEX := TEMP_TEXT'LAST;
      for I in TEMP_TEXT'range loop
        if TEMP_TEXT(I) /= ' ' then
          INDEX := I;
          exit;
        end if;
      end loop;
    else
      INDEX := TEMP_TEXT'LAST - WIDTH + 1;
      for I in INDEX .. TEMP_TEXT'LAST loop
        if TEMP_TEXT(I) = ' ' then
          TEMP_TEXT(I) := '0';
        end if;
      end loop;
    end if;
    return TEMP_TEXT(INDEX .. TEMP_TEXT'LAST);

  end CONVERT;


  -----------------
  function FRACTION( --| returns the fraction portion of the time in seconds

    SECONDS : in CALENDAR.DAY_DURATION

    ) return STRING is

    TEMP_SECS : STRING(1 .. 10);

  begin
    PREDEFINED_IO.SI2AFSD_1861_TIME_IO.PUT(TEMP_SECS, SECONDS, 2, 0);
    return TEMP_SECS(TEMP_SECS'LAST - 2 .. TEMP_SECS'LAST);
  end FRACTION;


  ----------------
  function DATE_OF(--| Convert the date to a string

    DATE : in CALENDAR.TIME  --| The date to be converted

    ) return STRING is

    --| Effects
    --| Converts the date to a string in the format MM/DD/YY

    --| N/A:  Raises, Requires, Modifies, Errors

    YEAR    : CALENDAR.YEAR_NUMBER;
    MONTH   : CALENDAR.MONTH_NUMBER;
    DAY     : CALENDAR.DAY_NUMBER;
    SECONDS : CALENDAR.DAY_DURATION;

  begin

    CALENDAR.SPLIT(DATE, YEAR, MONTH, DAY, SECONDS);
    return CONVERT(INTEGER(MONTH), 2) & "/" &
           CONVERT(INTEGER(DAY),   2) & "/" &
           CONVERT(INTEGER(YEAR mod 100), 2);

  end DATE_OF;



  ----------------------
  function WALL_CLOCK_OF(--| Convert seconds to wall clock time

    SECONDS : in CALENDAR.DAY_DURATION  --| The time to be converted

    ) return STRING is

    --| Effects
    --| Converts the time of day or elapsed time, in seconds,
    --| to a string in the format HH:MM:SS.FF.

    --| N/A:  Raises, Requires, Modifies, Errors

    use CALENDAR;  -- For "-" of times and durations

    HALF_SECOND : DAY_DURATION := 0.5;

  begin

    if SECONDS < HALF_SECOND then
      HALF_SECOND := 0.0;
    end if;

    return CONVERT( INTEGER(SECONDS - HALF_SECOND)/3600, 2)         & ":" &
           CONVERT((INTEGER(SECONDS - HALF_SECOND) mod 3600)/60, 2) & ":" &
           CONVERT( INTEGER(SECONDS - HALF_SECOND) mod 60, 2)       &
           FRACTION(SECONDS);

  end WALL_CLOCK_OF;


end TIME_LIBRARY_1;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--WD_HELP.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
---------------
package WD_HELP is
---------------

--| Overview
--| Provides on-line help for the Ada Symbolic Debugger.
--| Text displayed by the procedure HELP is extracted from
--| the specified HELP_FILE_NAME.

--------------
procedure HELP ( -- Provides on-line help for Symbolic Debugger
                 -- commands and features

  HELP_FILE_NAME : in STRING; --| The name of the HELP file

  COMMAND_STRING : in STRING  --| The user's input command

  );

--| Effects
--| Extracts the user specified topic from COMMAND_STRING. If
--| no topic is specified then a menu of all available topics
--| is displayed.  If an ambiguous topic is specified then a
--| list of possible topics matching the ambiguous request is
--| listed the user's console along with the minimum acceptable
--| abbreviation for each topic.
--|
--| If a topic is specified and it is not ambiguous then information
--| about the topic is extracted from the specified HELP_FILE_NAME
--| and displayed at the user's console.


end WD_HELP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--WD_HELP.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;    use TEXT_IO;
with STRING_PKG; use STRING_PKG;

--------------------
package body WD_HELP is
--------------------

--| Overview
--| Provides on-line help for the Ada Symbolic Debugger.
--| Text displayed by the procedure HELP is extracted from
--| the specified HELP_FILE_NAME.


  HELP_FILE            : TEXT_IO.FILE_TYPE;
  FILE_IS_OPEN         : BOOLEAN := FALSE;
  COMMAND              : STRING_PKG.STRING_TYPE;
  HELP_LINE            : STRING_PKG.STRING_TYPE;
  CURRENT_TOPIC        : STRING_PKG.STRING_TYPE;
  MINIMUM_ABBREVIATION : STRING_PKG.STRING_TYPE;
  KEYBOARD_MACRO       : STRING_PKG.STRING_TYPE;
  LINE                 : STRING(1..80);
  LAST_CHAR            : NATURAL;
  TOPIC_DEFINITION     : POSITIVE;


  --------------------
  function FILE_EXISTS(  --| Returns TRUE if file exists, otherwise FALSE

    FILE_NAME : STRING   --| The name of the file to be tested

    ) return BOOLEAN is

  --| Effects
  --| Attempts to open the file HELP_FILE using TEXT_IO.OPEN.
  --| If no exception is raised then the file is closed and the
  --| function returns TRUE. If a TEXT_IO.NAME_ERROR is raised
  --| the exception is handled and the function returns FALSE.

  --| N/A: Raises, Requires, Modifies, Errors

  begin

    OPEN(HELP_FILE, IN_FILE, FILE_NAME );
    -- If NAME_ERROR exception was not raised then the file exists
    CLOSE(HELP_FILE);
    return TRUE;

  exception
    when TEXT_IO.NAME_ERROR =>
      -- The file does not exist
      return FALSE;

  end FILE_EXISTS;


  --------------
  function STRIP( --| Strips the command string of all but the topic

    WHOLE_STRING : in STRING

    ) return STRING_TYPE is

  --| Strips the command string passed by the user of all but the
  --| topic. If no topic was specified then a null string_type is
  --| returned.

    NEW_STRING : STRING_PKG.STRING_TYPE := CREATE("");
    OLD_STRING : STRING_PKG.STRING_TYPE;
    HELP_COMMAND : constant STRING := "HELP";

  begin

    -- Make the old string a STRING_TYPE
    OLD_STRING := UPPER( CREATE(WHOLE_STRING) );

    -- Strip any leading blanks
    for I in 1..LENGTH(OLD_STRING) loop
      if FETCH(OLD_STRING, I) /= ' ' then
        OLD_STRING := SUBSTR(OLD_STRING, I, LENGTH(OLD_STRING) - I + 1 );
        exit;
      end if;
    end loop;

    -- Remove the HELP command
    for I in 1..4 loop
      if LENGTH(OLD_STRING) > 0 then
        if FETCH(OLD_STRING, 1) = HELP_COMMAND(I) then
          OLD_STRING := SUBSTR(OLD_STRING, 2, LENGTH(OLD_STRING) - 1 );
        else
          exit;  -- No match
        end if;
      else
        exit;    -- No more characters
      end if;
    end loop;

    -- Strip embedded blanks, parens, and semicolons
    for I in 1..LENGTH(OLD_STRING) loop
      if FETCH(OLD_STRING,I) /= ' ' and FETCH(OLD_STRING,I) /= '(' and
         FETCH(OLD_STRING,I) /= ')' and FETCH(OLD_STRING,I) /= ';' then
        NEW_STRING := NEW_STRING & SUBSTR(OLD_STRING, I, 1);
      end if;
    end loop;

    return NEW_STRING;

  end STRIP;


  ------------------------
  procedure GET_NEXT_TOPIC is --| Separate the HELP_LINE into topic,
                              --| abbreviation, macro, and definition

  --| Effects
  --| Separates the current HELP_LINE into topic, minimum
  --| abbreviation, keyboard macro, and definition.

  --| Modifies CURRENT_TOPIC, MINIMUM_ABBREVIATION, KEYBOARD_MACRO,
  --| and TOPIC_DEFINITION

  --| N/A: Raises, Requires, Errors

    START : POSITIVE;

  begin

    -- Get the topic. It begins in column 2 and is terminated by a "\"
    for CH_POS in 2 .. LENGTH(HELP_LINE) loop
      if FETCH(HELP_LINE, CH_POS) = '\' then
        CURRENT_TOPIC := SUBSTR(HELP_LINE, 2, CH_POS - 2);
        START := CH_POS + 1;
        exit;
      end if;
    end loop;

    -- Get the minimum abbreviation. It begins in character position
    -- START and is terminated by a "\"
    for CH_POS in START + 1 .. LENGTH(HELP_LINE) loop
      if FETCH(HELP_LINE, CH_POS) = '\' then
        MINIMUM_ABBREVIATION := SUBSTR(HELP_LINE, START, CH_POS - START);
        START := CH_POS + 1;
        exit;
      end if;
    end loop;

    -- Get keyboard macro and topic definition. The keyboard macro
    -- begins in character position START and is terminated by a "\".
    for CH_POS in START + 1 .. LENGTH(HELP_LINE) loop
      if FETCH(HELP_LINE, CH_POS) = '\' then
        KEYBOARD_MACRO := SUBSTR(HELP_LINE, START, CH_POS - START);
        -- Set up starting character position of the topic definition
        TOPIC_DEFINITION := CH_POS + 1;
        exit;
      end if;
    end loop;

  end GET_NEXT_TOPIC;


  -------------------------------
  procedure SHOW_AMBIGUOUS_TOPICS is

  --| Effects
  --| Displays all HELP topics and their minimum abbreviations
  --| that match the ambiguous user specified topic.

  --| Errors
  --| Issues the error message "The topic XXX is ambiguous"
  --| where XXX is the ambiguous user specified topic.

  --| N/A: Raises, Modifies, Errors

    TOPIC_LINE : STRING_PKG.STRING_TYPE;

  begin

    PUT_LINE("The topic " & VALUE(COMMAND) & " is ambiguous. " &
             "Possiblities are:");

    -- Loop until all topics that match the ambiguous request
    -- have been displayed
    while not END_OF_FILE(HELP_FILE) loop

      -- Display the current command and its minimum abbreviation
      TOPIC_LINE := "  Topic: " & CURRENT_TOPIC;
      -- Align abbreviations in column 25
      for I in LENGTH(TOPIC_LINE)..25 loop
        TOPIC_LINE := TOPIC_LINE & " ";
      end LOOP;
      PUT_LINE( VALUE(TOPIC_LINE)  & "  Abbreviation: " &
                VALUE(MINIMUM_ABBREVIATION) );

      -- Find the next topic
      while not END_OF_FILE(HELP_FILE) loop
        GET_LINE(HELP_FILE, LINE, LAST_CHAR);
        exit when LINE(1) = '\' or LINE(1) = '$';
      end loop;

      if LINE(1) = '\' or LINE(1) = '$' then
        -- This is a new topic
        if LAST_CHAR >= LENGTH(COMMAND) + 1 then
          -- Check to see if this is a match
          HELP_LINE := CREATE(LINE(1..LAST_CHAR));
          if VALUE(SUBSTR(HELP_LINE, 2, LENGTH(COMMAND))) > VALUE(COMMAND)
          then
            -- The topic is alphabetically greater than
            -- the ambiguous command. Must be done.
            exit;
          else
            -- Separate HELP_LINE into CURRENT_TOPIC,
            -- MINIMUM_ABBREVIATION, KEYBOARD_MACRO,
            -- and TOPIC_DEFINITION
            GET_NEXT_TOPIC;
          end if;
        end if;
      end if;
    end loop;
    PUT_LINE("Enter ""HELP(topic);"" for more information");
  end SHOW_AMBIGUOUS_TOPICS;


  --------------------
  procedure SHOW_TOPIC is

  --| Displays information about the current topic at the user's
  --| console. Information about the HELP topic is extracted
  --| from the specified HELP_FILE_NAME.

    QUESTION : STRING_PKG.STRING_TYPE;
    ANSWER   : STRING(1..20);
    QUERY    : BOOLEAN;
    CHARS    : NATURAL;

  begin

    -- Display the current topic
    if LINE(1) = '\' then
      -- The topic is a UICL command
      PUT_LINE("Command: " & VALUE(CURRENT_TOPIC) & " - " &
               VALUE( SUBSTR(HELP_LINE, TOPIC_DEFINITION,
                             LENGTH(HELP_LINE) - TOPIC_DEFINITION + 1) ) );
      PUT_LINE("Abbreviation:   " & VALUE(MINIMUM_ABBREVIATION) );
      -- If the command has a keyboard macro then print it
      if not EQUAL( UPPER(KEYBOARD_MACRO), "NONE") then
        PUT_LINE("Keyboard Macro: " & VALUE(KEYBOARD_MACRO) );
      end if;
    else
      -- The topic is a "feature". No abbreviation or keyboard macro
      PUT_LINE( VALUE(SUBSTR(HELP_LINE, TOPIC_DEFINITION,
                      LENGTH(HELP_LINE) - TOPIC_DEFINITION + 1) ) );
    end if;

    while not END_OF_FILE(HELP_FILE) loop
      -- Display remaining info about this topic
      GET_LINE(HELP_FILE, LINE, LAST_CHAR);
      if LAST_CHAR > 0 then

        case LINE(1) is

          when '?' =>
            -- Pause and query the user
            QUERY := TRUE;
            QUESTION := CREATE("Enter RETURN for more information " &
                               "or ""Q"" to quit: ");
          when 'E' =>
            -- Example. Pause and query the user
            QUERY := TRUE;
            QUESTION := CREATE("Enter RETURN for examples " &
                               "or ""Q"" to quit: ");
          when '+' =>
            QUERY := FALSE;  -- Continue with no query

          when others =>
            exit;            -- Done with this topic

        end case;

        if QUERY then
          NEW_LINE;                          -- Skip 1 line
          PUT( VALUE(QUESTION)  & ">> ");   -- Ask if he wants to continue
          GET_LINE(ANSWER, CHARS);           -- Get user's response
          if CHARS >0 then                   -- There was an answer
            if ANSWER(1) = 'Q' or ANSWER(1) = 'q' then
              -- The user wants to quit
              exit;
            end if;
          end if;
        end if;

        -- Display the current line except for the control
        -- character in column 1
        if LAST_CHAR > 1 then
          PUT_LINE( LINE(2..LAST_CHAR) );
        else
          NEW_LINE;
        end if;

      end if;

    end loop;

  end SHOW_TOPIC;


  --------------
  procedure HELP ( --| Provides on-line help for Symbolic Debugger
                   --| commands and features

    HELP_FILE_NAME : in STRING; --| The name of the HELP file

    COMMAND_STRING : in STRING  --| The user's input command

    ) is

  --| Effects
  --| Extracts the user specified topic from COMMAND_STRING. If
  --| no topic is specified then a menu of all available topics
  --| is displayed.  If an ambiguous topic is specified then a
  --| list of possible topics matching the ambiguous request is
  --| listed the user's console along with the minimum acceptable
  --| abbreviation for each topic.
  --|
  --| If a topic is specified and it is not ambiguous then information
  --| about the topic is extracted from the specified HELP_FILE_NAME
  --| displayed at the user's console.

    FOUND : BOOLEAN := FALSE;

  begin

    STRING_PKG.MARK;

    if not FILE_IS_OPEN then
      if FILE_EXISTS(HELP_FILE_NAME) then
        -- The file exists but is not open yet. Open it.
        OPEN(HELP_FILE, IN_FILE, HELP_FILE_NAME);
        FILE_IS_OPEN := TRUE;
      else
        -- Help file is not found
        PUT_LINE("File " & HELP_FILE_NAME & " not found. " &
                 "No help available.");
        FOUND := TRUE;  -- Suppress "Topic not found" message
      end if;
    else
      -- The file is already open. Reset to beginning of file.
      RESET(HELP_FILE);
    end if;

    COMMAND := STRIP(COMMAND_STRING);

    if FILE_IS_OPEN and VALUE(COMMAND) = "" then
      -- HELP was entered with no argument. Display a menu of topics.
      PUT_LINE("Topics available are:");
    end if;

    -- Find the command in the help file
    while FILE_IS_OPEN loop
      exit when END_OF_FILE(HELP_FILE);
      -- Get the next line of text from the HELP file
      GET_LINE(HELP_FILE, LINE, LAST_CHAR);
      if VALUE(COMMAND) = "" then
        -- HELP command was entered with no arguments
        -- Display a menu of topics available
        if LINE(1) = '#' then
          -- # indicates a menu item line. Display it
          PUT_LINE("  " & LINE(2..LAST_CHAR) );
        else
          -- No more menu item lines
          PUT_LINE("Enter ""HELP(topic);"" for more information");
          FOUND := TRUE;
          exit;
        end if;
      elsif LINE(1) = '\' or LINE(1) = '$' then
        -- This is a new topic
        if LAST_CHAR >= LENGTH(COMMAND) + 1 then
          -- Check to see if this is a match
          HELP_LINE := CREATE(LINE(1..LAST_CHAR));
          if EQUAL(COMMAND, SUBSTR(HELP_LINE, 2, LENGTH(COMMAND))) then
            -- Found a match
            -- Check to see if the command is a unique abbreviation
            FOUND := TRUE;
            -- Separate HELP_LINE into CURRENT_TOPIC, MINIMUM_ABBREVIATION,
            -- KEYBOARD_MACRO, and TOPIC_DEFINITION
            GET_NEXT_TOPIC;
            if LENGTH(COMMAND) >= LENGTH(MINIMUM_ABBREVIATION) then
              -- It's a valid abbreviation
              SHOW_TOPIC;
              exit;
            else
              -- Ambiguous abbreviation. Show all commands
              -- that match the current abbreviation
              SHOW_AMBIGUOUS_TOPICS;
              exit;
            end if;
          elsif VALUE(SUBSTR(HELP_LINE, 2, LENGTH(COMMAND))) > VALUE(COMMAND)
          then
            -- The topic is alphabetically greater
            -- than the command. Must be done.
            exit;
          end if;
        end if;
      elsif VALUE(COMMAND) = "" then
        -- HELP command was entered with no arguments
        -- Display a menu of topics available
        if LINE(1) = '#' then
          -- # indicates a menu item line. Display it
          PUT_LINE("  " & LINE(2..LAST_CHAR) );
        else
          -- No more menu item lines
          PUT_LINE("Enter ""HELP(topic);"" for more information");
          FOUND := TRUE;
          exit;
        end if;
      end if;
    end loop;

    if not FOUND then
      PUT("The topic " & VALUE(COMMAND) & " is not found. ");
      HELP(HELP_FILE_NAME, "HELP");
    end if;

    STRING_PKG.RELEASE;

  end HELP;

end WD_HELP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SIDECLS.DAT
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SYSTEM_PARAMETERS; use SYSTEM_PARAMETERS;
with PARSETABLES;
with TEXT_IO;
with LISTS;
with STRING_PKG; use STRING_PKG;
with STACK_PKG;
with PARSERDECLARATIONS;

package SOURCE_INSTRUMENTER_DECLARATIONS is
--| Declarations for Source Instrumenter tool

--| Overview

--| This package contains declarations for the Source Instrumenter.

--| Notes

--| Abbreviations Used:
--|
--| RH: Right Hand

  package PD renames PARSERDECLARATIONS;

  subtype SOURCE_LINE_BUFFER is STRING(1 .. MAX_SOURCE_LINE_LENGTH);
  BLANK_LINE        : constant SOURCE_LINE_BUFFER := (others => ' ');

  ----------------------------------------------------------------
  --  File Declarations
  ----------------------------------------------------------------

  INSTRUMENTED_FILE : TEXT_IO.FILE_TYPE;
  --| File handle to pass to Paginated Output routines for
  --| Instrumented source

  LISTING_FILE      : TEXT_IO.FILE_TYPE;
  --| File handle for listing file

  SD_LIST_FILE      : TEXT_IO.FILE_TYPE;
  --| File type for debugger listing

  -----------------------------------------------------------------
  --    Declarations used by source_instrumenter
  -----------------------------------------------------------------

  CURRENT_LINE_NUMBER : NATURAL;

  package STRING_LISTS is
    new LISTS(STRING_PKG.STRING_TYPE);

  package TOKEN_STACK_PKG is
    new STACK_PKG(PD.PARSESTACKELEMENT);

  type REQUEST_DESCRIPTOR is
    record
      NEW_LINES : NATURAL := 0;
      --| Number of times New_Line was called before printing new lines.
      INCREASES : NATURAL := 0;
      --| Number of times Increase_Indent was called before processing
      --| any of these requests.
      DECREASES : NATURAL := 0;
      --| Number of times Decrease_Indent was called before processing
      --| any of these requests.
      CHANGES   : NATURAL := 0;
      --| Number of times Change_Indent was called before processing
      --| any of these requests.
      RESUMES   : NATURAL := 0;
      --| Number of times Resume_Normal_Indentation was called before
      --| processing any of these requests
    end record;

  package COMMENT_LISTS is
    new LISTS(PD.PARSESTACKELEMENT);

  type TOKEN_DESCRIPTOR is
    record
      TOKEN                 : PD.PARSESTACKELEMENT;
      COMMENTS              : COMMENT_LISTS.LIST;
      REQUESTS              : REQUEST_DESCRIPTOR;
      CURRENT_CHANGE_COLUMN : INDENTATION_RANGE := 0;
      -- for lining up parameter/discriminant lists
      LEFT_SIDE_LENGTH      : NATURAL := 0;  -- for lining up colons
    end record;

  package TOKEN_LISTS is
    new LISTS(TOKEN_DESCRIPTOR);

  type SCOPE_TYPE is (PACKAGE_SPECIFICATION, PACKAGE_BODY, TASK_BODY,
    SUBPROGRAM_BODY, A_BLOCK, ACCEPT_STATEMENT);

  type TYPE_CLASS is (INTEGER_TYPE, FLOAT_TYPE, FIXED_TYPE, ENUMERATION_TYPE,
    ACCESS_TYPE, ARRAY_TYPE, RECORD_TYPE, PRIVATE_TYPE, LIMITED_PRIVATE_TYPE,
    TASK_TYPE, DERIVED_TYPE);


  type IDENTIFIER_MODE is (READ_ONLY, WRITE_ONLY, READ_WRITE, CONST, NONE);

  type NAME_RECORD is
  --| for each identifier in an identifier list, save its name
  --| and its mode.
    record
      OBJECT_NAME : STRING_TYPE;
      OBJECT_MODE : IDENTIFIER_MODE;
      OBJECT_TYPE : STRING_TYPE;
    end record;

  package NAME_LISTS is
    new LISTS(NAME_RECORD);
    --| A list of name records for collecting identifier lists.

  type REC_FIELD_RECORD is
  --| for each record type save its identifier list, and its case
  --| choices.
    record
      CHOICE_TEXT : STRING_LISTS.LIST;
      REC_FIELD   : STRING_LISTS.LIST;
    end record;

  package RECORD_LISTS is
    new LISTS(REC_FIELD_RECORD);
    --| A list of rec_field_records for collecting record information.

  package LIST_STACK_PKG is
    new STACK_PKG(NAME_LISTS.LIST);
    --| A stack of lists of Name_Records.

  package STRING_STACK_PKG is
    new STACK_PKG(STRING_LISTS.LIST);
    --| A stack of lists of String_Type.

  type SPACING is (AFTER, BEFORE, AROUND, NONE);

    Spacing_Table : Array(1 .. ParseTables.Comment_TokenValue) of Spacing := (
    -- unfortunately, type of ParseTables.xxxTokenValue has non-static bound,
    -- so positional rather than named associations must be used to initialize
    -- Spacing_Table.

    -- The spacing table determines, in general, how to space each token.
    -- However, the spacing of some tokens is context dependent, and so
    -- some of the spacing is dynamically handled in other places.
    -- Spaced_Token refers to Pretty_Printer_Utilities.Spaced_Token.
    -- The special cases are described below.

     -- ParseTables.Empty_TokenValue =>
        None,
     -- ParseTables.AbortTokenValue =>
        After,
     -- ParseTables.AbsTokenValue =>  -- Spaced_Token inserts space after
        None,                         -- unless followed by '('
     -- ParseTables.AcceptTokenValue =>
        After,
     -- ParseTables.AccessTokenValue =>
        After,
     -- ParseTables.AllTokenValue =>
        None,
     -- ParseTables.AndTokenValue =>
        Around,
     -- ParseTables.ArrayTokenValue =>
        None,
     -- ParseTables.AtTokenValue =>
        Around,
     -- ParseTables.BeginTokenValue =>
        None,
     -- ParseTables.BodyTokenValue =>
        After,
     -- ParseTables.CaseTokenValue =>  -- Spaced_Token inserts space after if
        None,                          -- not followed by ';'
     -- ParseTables.ConstantTokenValue =>  -- Spaced_Token inserts space before
        After,                             -- if not following ':='
     -- ParseTables.DeclareTokenValue =>
        None,
     -- ParseTables.DelayTokenValue =>
        After,
     -- ParseTables.DeltaTokenValue =>  -- Spaced_Token inserts space before if
        None,                           -- not following ''' or 'IS', after if
                                        -- not followed by ';'
     -- ParseTables.DigitsTokenValue => -- Spaced_Token inserts space before if
        None,                           -- not following ''', or 'IS' after if
                                        -- not followed by ';'
     -- ParseTables.DoTokenValue =>
        Before,
     -- ParseTables.ElseTokenValue =>
        After,
     -- ParseTables.ElsifTokenValue =>
        After,
     -- ParseTables.EndTokenValue =>  -- Spaced_Token inserts space after if
        None,                         -- not followed by ';'
     -- ParseTables.EntryTokenValue =>
        After,
     -- ParseTables.ExceptionTokenValue =>
        None,
     -- ParseTables.ExitTokenValue =>  -- Spaced_Token inserts space after if
        None,                          -- not followed by ';'
     -- ParseTables.ForTokenValue =>
        After,
     -- ParseTables.FunctionTokenValue =>
        After,
     -- ParseTables.GenericTokenValue =>
        None,
     -- ParseTables.GotoTokenValue =>
        After,
     -- ParseTables.IfTokenValue =>  -- Spaced_Token inserts space after if
        None,                        -- not followed by ';'
     -- ParseTables.InTokenValue =>  -- Spaced_Token inserts space before if
        After,                       -- not following ':'
     -- ParseTables.IsTokenValue =>
        Around,
     -- ParseTables.LimitedTokenValue =>
        After,
     -- ParseTables.LoopTokenValue =>  -- Spaced_Token inserts space after if
        None,                          -- not followed by ';' and space before
                                       -- if not following ':'
     -- ParseTables.ModTokenValue =>  -- Spaced_Token inserts space before if
        After,                        -- not following 'AT'
     -- ParseTables.NewTokenValue =>
        After,
     -- ParseTables.NotTokenValue =>
        After,
     -- ParseTables.NullTokenValue =>
        None,
     -- ParseTables.OfTokenValue =>
        Around,
     -- ParseTables.OrTokenValue =>
        Around,
     -- ParseTables.OthersTokenValue =>
        None,
     -- ParseTables.OutTokenValue =>
        After,
     -- ParseTables.PackageTokenValue =>
        After,
     -- ParseTables.PragmaTokenValue =>
        After,
     -- ParseTables.PrivateTokenValue =>
        None,
     -- ParseTables.ProcedureTokenValue =>
        After,
     -- ParseTables.RaiseTokenValue =>  -- Spaced_Token inserts space after if
        None,                           -- not followed by ';'
     -- ParseTables.RangeTokenValue =>  -- Spaced_Token inserts space before if
        None,                           -- not following ''' or 'IS', after if
                                        -- not followed by ';'
     -- ParseTables.RecordTokenValue =>  -- Spaced_Token inserts space after if
        None,                            -- not followed by ';'
     -- ParseTables.RemTokenValue =>
        Around,
     -- ParseTables.RenamesTokenValue =>
        Around,
     -- ParseTables.ReturnTokenValue =>  -- Spaced_Token inserts space after if
        Before,                          -- not followed by ';'
     -- ParseTables.ReverseTokenValue =>
        After,
     -- ParseTables.SelectTokenValue =>  -- Spaced_Token inserts space after if
        None,                            -- not followed by ';'
     -- ParseTables.SeparateTokenValue =>
        None,
     -- ParseTables.SubtypeTokenValue =>
        After,
     -- ParseTables.TaskTokenValue =>
        After,
     -- ParseTables.TerminateTokenValue =>
        None,
     -- ParseTables.ThenTokenValue =>  -- Spaced_Token inserts space before if
        After,                         -- not preceded by "and"
     -- ParseTables.TypeTokenValue =>
        After,
     -- ParseTables.UseTokenValue =>   -- Spaced_Token inserts space before if
        After,                         -- not preceded by ';'
     -- ParseTables.WhenTokenValue =>
        After,
     -- ParseTables.WhileTokenValue =>
        After,
     -- ParseTables.WithTokenValue =>
        After,
     -- ParseTables.XorTokenValue =>
        Around,
     -- ParseTables.IdentifierTokenValue =>
        None,
     -- ParseTables.NumericTokenValue =>
        None,
     -- ParseTables.StringTokenValue =>
        None,
     -- ParseTables.CharacterTokenValue =>
        None,
     -- ParseTables.Ampersand_TokenValue =>
        Around,
     -- ParseTables.Apostrophe_TokenValue =>
        None,
     -- ParseTables.LeftParen_TokenValue =>
        None,
     -- ParseTables.RightParen_TokenValue =>
        None,
     -- ParseTables.Star_TokenValue =>
        None,
     -- ParseTables.Plus_TokenValue =>  -- Parser.Apply_Actions inserts space
        None,                           -- after if it is a binary operator,
                                        -- before if not following '('
     -- ParseTables.Comma_TokenValue =>
        After,
     -- ParseTables.Minus_TokenValue =>  -- Parser.Apply_Actions inserts space
        None,                            -- after if it is a binary operator,
                                         -- before if not following '('
     -- ParseTables.Dot_TokenValue =>
        None,
     -- ParseTables.Slash_TokenValue =>
        None,
     -- ParseTables.Colon_TokenValue =>
        Around,
     -- ParseTables.SemiColon_TokenValue =>
        After,
     -- ParseTables.LT_TokenValue =>
        Around,
     -- ParseTables.EQ_TokenValue =>
        Around,
     -- ParseTables.GT_TokenValue =>
        Around,
     -- ParseTables.Bar_TokenValue =>
        Around,
     -- ParseTables.EQGT_TokenValue =>
        Around,
     -- ParseTables.DotDot_TokenValue =>
        Around,
     -- ParseTables.StarStar_TokenValue =>
        None,
     -- ParseTables.ColonEQ_TokenValue =>
        After,
     -- ParseTables.SlashEQ_TokenValue =>
        Around,
     -- ParseTables.GTEQ_TokenValue =>
        Around,
     -- ParseTables.LTEQ_TokenValue =>
        Around,
     -- ParseTables.LTLT_TokenValue =>
        None,
     -- ParseTables.GTGT_TokenValue =>
        After,
     -- ParseTables.LTGT_TokenValue =>
        None,
     -- ParseTables.Comment_TokenValue =>
        None);

end SOURCE_INSTRUMENTER_DECLARATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SCOPE.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with STRING_PKG; use STRING_PKG;

package SCOPE_PACKAGE is

--  This package is used to maintain the current scope.  Whenever a
--  new scope is entered the current scope is pushed onto a stack and
--  becomes the current outer scope.  When a scope is ended it is deleted,
--  and the current outer scope becomes the current scope.  All information
--  needed for each scope is maintained in a record of type scope_descriptor.

  CURRENT_NESTING_LEVEL        : NATURAL := 0;
  --|  The current level of nesting.

  type SCOPE_DESCRIPTOR is
    record
      SCOPE_NAME            : STRING_TYPE;
        -- The name of the current scope
      QUALIFIED_NAME        : STRING_TYPE;
        -- The fully dot qualified name of the current scope
      QUALIFIED_NAME_STRING : STRING_TYPE;
        -- Same as qualified names, except operators are replaced by string
        -- representations of the operator(i.e. "+" becomes ""+"")
      TYPE_OF_SCOPE         : SCOPE_TYPE;
        -- Type of current scope(procedure, task, block, etc.)
      SCOPE_NUMBER          : NATURAL;
        -- Sequential count of the scope in the current comp unit
      TRACING_PREFIX        : STRING_TYPE;
        -- Prefix used when making unique subprogram names for trace procs
      IN_PRIVATE_PART       : BOOLEAN;
        -- Are we currently in the private part of a package
      IN_ACCEPT             : BOOLEAN;
        -- Are we currently in an accept statement
    end record;
  --|  Maintains the information about a unit.

  NULL_SCOPE                   : constant SCOPE_DESCRIPTOR :=
    (CREATE(""),
     CREATE(""),                -- Used to initialize a scope descriptor
     CREATE(""),
     A_BLOCK,
     0,
     CREATE(""),
     FALSE,
     FALSE);

  CURRENT_SCOPE                : SCOPE_DESCRIPTOR := NULL_SCOPE;
  --|  Contains the information about the current unit.

  CURRENT_OUTER_SCOPE          : SCOPE_DESCRIPTOR := NULL_SCOPE;
  --|  Contains the information about the enclosing unit(if any).

  CURRENT_SCOPE_QUALIFIED_NAME : STRING_TYPE;
  --|  Maintains the full dot notated name of the current unit.

  CURRENT_SCOPE_SIMPLE_NAME    : STRING_TYPE;
  --|  Contains the simple name of the current unit.  It is set in
  --|  pop identifier and then retrieved in increment_scope when a
  --|  unit body is found.

  CURRENT_SCOPE_STRING_NAME    : STRING_TYPE;
  --|  Contains the simple name of the current unit; however, if
  --|  the unit is an operator("+","-",etc.) then the name
  --|  of the scope contains double quotes around the operator.

  procedure ENTER_SCOPE(TYPE_OF_SCOPE : in SCOPE_TYPE);
  --|  This procedure is called whenever a new scope is entered
  --|  during instrumenting.  The type of scope is passed into the
  --|  procedure.  The current scope is changed to the new scope and the
  --|  old current scope becomes the outer scope.

  procedure EXIT_SCOPE;
  --|  This procedue is called when a scope is exited.   The current scope
  --|  is destroyed, and the current outer scope becomes the current scope.

  function MAKE_TRACING_PREFIX (OUTER_SCOPE  : in SCOPE_DESCRIPTOR;
                                CURRENT_NAME : in STRING_TYPE;
                                TYPE_OF_SCOPE: in SCOPE_TYPE)
    return STRING_TYPE;
  --|  This procedure makes a unique tracing prefix used for creating
  --|  the trace procedures for a scope.  The name of the tracing prefix
  --|  is based on the name of the current scope and current outer scope

  function MAKE_TRACING_PREFIX_FOR_SEPARATE (SEPARATE_NAME : in STRING_TYPE)
    return STRING_TYPE;
  --|  Same procedure as above special cased for a separate unit.

end SCOPE_PACKAGE;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SCOPE.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with STACK_PKG;
with SYSTEM_PARAMETERS; use SYSTEM_PARAMETERS;
with STRING_UTILITIES; use STRING_UTILITIES;
package body SCOPE_PACKAGE is

--  This pacakge provides the mechanism for maintaining the current
--  scope.  A stack is used to maintain outer scopes during nesting.
--  Scope descriptors are used to maintain the information about
--  each scope.

  package SCOPE_STACK_PKG is
    new STACK_PKG(SCOPE_DESCRIPTOR);
  --  The scope stack maintains the scope records when we nest scopes

  SCOPE_STACK     : SCOPE_STACK_PKG.STACK := SCOPE_STACK_PKG.CREATE;
  --|  Used to maintain the information about units when nesting occurs.
  --|  When a nested unit is encountered the enclosing units descriptor
  --|  is pushed onto the stack. When a nested unit is exited the stack
  --|  is popped to retrieve the enclosing units information.

  MAX_NAME_LENGTH : POSITIVE := 75 - SD_PREFIX'LENGTH;
  --  maximum length for a name that we generate

  ---------------------------------------------------------------------
  -- local subprogram declarations --
  ---------------------------------------------------------------------

  function TRUNCATE(S : in STRING_TYPE) return STRING_TYPE;
  -- Insures that the last character of a generated name is not an underscore

  function INCREMENT_COUNT_SUFFIX(NAME : in STRING) return STRING;
  -- A count is used to insure a unique name.  Each time a scope with the
  -- same name is encountered a unique count is added to the generated names

  function SAME_NAME(NAME1, NAME2 : in STRING_TYPE) return BOOLEAN;
  --  Returns true is the two names are equal

  ---------------------------------------------------------------------
  -- external subprograms --
  ---------------------------------------------------------------------


  procedure ENTER_SCOPE(TYPE_OF_SCOPE : in SCOPE_TYPE) is
  -- Start a new scope.  Push the outer scope onto the scope stack, and
  -- the current scope becomes the current outer scope.  Then construct
  -- the current scope.

    CURRENT_SCOPE_QUALIFIED_NAME_STRING : STRING_TYPE;
    -- Used to construct the string version of the current qualified
    -- scope name.

  begin

    -- push outer scope onto stack, and set current outer scope to current
    -- scope.

    CURRENT_NESTING_LEVEL := CURRENT_NESTING_LEVEL + 1;
    SCOPE_STACK_PKG.PUSH(SCOPE_STACK, CURRENT_OUTER_SCOPE);
    CURRENT_OUTER_SCOPE := CURRENT_SCOPE;

    --Construct the string version of the current qualified scope name
    if IS_EMPTY(CURRENT_OUTER_SCOPE.QUALIFIED_NAME_STRING) then
      -- This is the outermost level. Do not prepend with outer scope
      CURRENT_SCOPE_QUALIFIED_NAME_STRING := CURRENT_SCOPE_STRING_NAME;
    else  --  nested scope
      CURRENT_SCOPE_QUALIFIED_NAME_STRING :=
        CURRENT_OUTER_SCOPE.QUALIFIED_NAME_STRING & "." &
        CURRENT_SCOPE_STRING_NAME;
    end if;

    -- set up the current scope record

    CURRENT_SCOPE := (CURRENT_SCOPE_SIMPLE_NAME,
                      CURRENT_SCOPE_QUALIFIED_NAME,
                      CURRENT_SCOPE_QUALIFIED_NAME_STRING,
                      TYPE_OF_SCOPE,
                      CURRENT_OUTER_SCOPE.SCOPE_NUMBER,
                      MAKE_TRACING_PREFIX(CURRENT_OUTER_SCOPE,
                                          CURRENT_SCOPE_SIMPLE_NAME,
                                          TYPE_OF_SCOPE),
                      FALSE,
                      CURRENT_OUTER_SCOPE.IN_ACCEPT);

  --  If we are in an accept statement then set the scope record appropriatly

    if TYPE_OF_SCOPE = ACCEPT_STATEMENT then
      CURRENT_SCOPE.IN_ACCEPT := TRUE;
    end if;

  end ENTER_SCOPE;

  ---------------------------------------------------------------------------
  procedure EXIT_SCOPE is
   -- Exit the current scope.  Pop the stack, and set up current_scope and
   -- current_outer_scope

  begin
    CURRENT_NESTING_LEVEL := CURRENT_NESTING_LEVEL - 1;
    if CURRENT_NESTING_LEVEL = 0 then  -- Finished current comp unit
      CURRENT_SCOPE := NULL_SCOPE;
    else  -- nested procedure
      CURRENT_SCOPE := CURRENT_OUTER_SCOPE;
    end if;
    SCOPE_STACK_PKG.POP(SCOPE_STACK, CURRENT_OUTER_SCOPE);
    CURRENT_SCOPE_QUALIFIED_NAME := CURRENT_SCOPE.QUALIFIED_NAME;
  end EXIT_SCOPE;

  ---------------------------------------------------------------------------
  function MAKE_TRACING_PREFIX(OUTER_SCOPE  : in SCOPE_DESCRIPTOR;
                               CURRENT_NAME : in STRING_TYPE;
                               TYPE_OF_SCOPE: in SCOPE_TYPE)
  return STRING_TYPE is
  -- Generate a unique name for current scopes tracing procedures

    TEMP_NAME : STRING_TYPE := CURRENT_NAME;
  begin
    -- if current scope is an operator(i.e. '+') then change temp name to
    -- operator

    if FETCH(TEMP_NAME, 1) = '"' then
      TEMP_NAME := CREATE("OPERATOR");
    end if;

    -- If we are nested in a scope with the same name as ours, then
    -- generate a unique name.

    if SAME_NAME(OUTER_SCOPE.SCOPE_NAME, TEMP_NAME) then
      return CREATE(INCREMENT_COUNT_SUFFIX(VALUE(OUTER_SCOPE.TRACING_PREFIX)));
    end if;

    -- A block uses the tracing prefix name of its enclosing scope

    if TYPE_OF_SCOPE = A_BLOCK then
      return CREATE(VALUE(OUTER_SCOPE.TRACING_PREFIX));
    end if;

    --  construct the unique name

    if LENGTH(TEMP_NAME) <= MAX_NAME_LENGTH then
      return TEMP_NAME & "_" & SD_PREFIX;
    end if;

    -- name is too long call truncate to shorten it

    return TRUNCATE(TEMP_NAME) & "_" & SD_PREFIX;

  end MAKE_TRACING_PREFIX;

  ---------------------------------------------------------------------------
  function MAKE_TRACING_PREFIX_FOR_SEPARATE(SEPARATE_NAME: in STRING_TYPE)
  -- Special case of above procedure for a scope that is a separate

  return STRING_TYPE is

    CURRENT_NAME  : STRING_TYPE;
    PREVIOUS_NAME : STRING_TYPE;
    START         : POSITIVE := 1;
    DOT           : NATURAL := 0;
    COUNT         : NATURAL := 0;

  begin
    -- We need to determine a unique name for our tracing prefix, based
    -- on whether any names in the separate clause have the same name.
    -- Each time two components in the separate clause have the same
    -- name the count is update.  count is used to create a unique name.

    PREVIOUS_NAME := CREATE("");
    while START < LENGTH(SEPARATE_NAME) loop
      DOT := MATCH_C(SEPARATE_NAME, '.', START);
      if DOT = 0 then
        DOT := LENGTH(SEPARATE_NAME) + 1;
      end if;
      CURRENT_NAME := UPPER(SUBSTR(SEPARATE_NAME, START, DOT - START));
      if SAME_NAME(PREVIOUS_NAME, CURRENT_NAME) then
        COUNT := COUNT + 1;  -- scopes have the same name
      else
        COUNT := 0;  -- scopes have different names
      end if;
      START := DOT + 1;
      PREVIOUS_NAME := CURRENT_NAME;
    end loop;

    -- Replace operators with the word operator

    if FETCH(CURRENT_NAME, 1) = '"' then
      CURRENT_NAME := CREATE("OPERATOR");
    end if;

    --  If the name is too long then truncate it

    if LENGTH(CURRENT_NAME) > MAX_NAME_LENGTH then
      CURRENT_NAME := TRUNCATE(CURRENT_NAME);
    end if;

    -- If count is zero then we have a unique name

    if COUNT = 0 then
      return(CURRENT_NAME & "_" & SD_PREFIX);
    end if;

    -- We don't have a unique name so add count to name to make it unique

    return(CURRENT_NAME & "_" & SD_PREFIX & INTEGER_STRING(COUNT) & "_");

  end MAKE_TRACING_PREFIX_FOR_SEPARATE;

  ---------------------------------------------------------------------
  -- local subprogram bodies --
  ---------------------------------------------------------------------

  --------------------------------------------------------------------------
  function TRUNCATE(S : in STRING_TYPE) return STRING_TYPE is
  -- Insure that the last character of the name is not an underscore

    LAST : POSITIVE := MAX_NAME_LENGTH;
  begin
    if FETCH(S, MAX_NAME_LENGTH) = '_' then
      LAST := LAST - 1;   -- last character is an underscore so delete it
    end if;
    return SUBSTR(S, 1, LAST);
  end TRUNCATE;

  --------------------------------------------------------------------------
  function INCREMENT_COUNT_SUFFIX(NAME : in STRING) return STRING is
  -- Extract count suffix from name and update it so it can be added to
  -- current tracing prefix

    LAST_COUNT : NATURAL := 0;
    INDEX      : NATURAL := NAME'LAST - 1;
  begin
    while NAME(INDEX) /= '_' loop  -- find beginning index of count
      INDEX := INDEX - 1;
    end loop;

    -- convert count from string into an integer

    LAST_COUNT := INTEGER'VALUE(NAME(INDEX + 1 .. NAME'LAST-1));

    if LAST_COUNT = 1861 then  -- count was not used on outer scopes name
      return NAME & "1_";
    end if;

   -- update count and add it to the end of name

    LAST_COUNT := LAST_COUNT + 1;
    return NAME(1 .. INDEX) & INTEGER_STRING(LAST_COUNT) & "_";
  end INCREMENT_COUNT_SUFFIX;

  --------------------------------------------------------------------------
  function SAME_NAME(NAME1, NAME2 : in STRING_TYPE) return BOOLEAN is
    -- Assumes Name1 and Name2 are both upper cased before the call
  begin
    if EQUAL(NAME1, NAME2) then  -- Are names equal?
      return TRUE;
    end if;

    if LENGTH(NAME1) > MAX_NAME_LENGTH and    -- are names the same up to
       LENGTH(NAME2) > MAX_NAME_LENGTH then   -- the max_name_length?
       for I in 1 .. MAX_NAME_LENGTH loop
         if FETCH(NAME1, I) /= FETCH(NAME2, I) then
           return FALSE;  --  names differ on this char
         end if;
       end loop;
       return TRUE;  -- names are the same for first max_name_length chars
    end if;
    return FALSE;
  end SAME_NAME;

  ---------------------------------------------------------------------------

end SCOPE_PACKAGE;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SDBUFFERS.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with TEXT_IO; use TEXT_IO;
with DIRECT_IO;
with LISTS;
with STRING_PKG; use STRING_PKG;

package SD_BUFFER_FILES is

  --| Overview
  --|     This package contains file management procedures needed by the
  --| Source Instrumenter for saving type and variable tracing information.
  --| The Source Instrumenter prepares programs for testing by the Ada Test
  --| and Analysis Tool Set.
  --|
  --|     A general purpose scratch file is maintained for saving procedure
  --| bodies created by the instrumenter until the end of the current
  --| declarative part, where they can then be copied into the instrumented
  --| source file.  The specifications for these procedures are added
  --| directly to the instrumented source file and do not need to be saved.
  --|
  --|     Four new files may be created for each package specification to
  --| contain the instrumenting information needed by the source instrumenter
  --| for tracing variables and types declared in the package specification.
  --| The procedures in this package manage these files and allows the Source
  --| Instrumenter to access the correct file when necessary.  A table which
  --| equates a unique filename prefix with each package name is maintained by
  --| this package, and saved in an external file when the instrumentation is
  --| finished.
  --|
  --|
  --| Requires
  --| The following declarations for file naming are used:
  --|
  --| "File_Prefix_Limit" is currently set to 8 characters, and indicates
  --| the number of characters in a filename to the left of the dot.
  --|
  --| "File_Suffix_Limit" is currently set to 4 characters; a dot and
  --| a 3 character file extension.
  --|
  --| The external file which saves the package_name - file_name information
  --| is named "SDFNAMES.MAP"
  --|
  --| The current extensions used for the package tracing files are:
  --|  ".DPS"  -- For the Public_Spec_File
  --|  ".DPB"  -- For the Public_Body_File
  --|  ".DVS"  -- For the Private_Spec_File
  --|  ".DVB"  -- For the Private_Body_File
  --|
  --| These may be changed if they cause conflicts or are otherwise unsuitable
  --| for the host system.

  --| N/A: Errors, Raises, Modifies


  --------------------------------------------------------------------------

  package DIO is
    new DIRECT_IO(SOURCE_LINE_BUFFER);
  use DIO;

  subtype STRING_LIST is STRING_LISTS.LIST;

  BUFFER_FILE,
  --| a temporary "scratch" file used by the source instrumenter
  --| to save type tracing procedure bodies until end of the
  --| current declarative part

  PUBLIC_SPEC_FILE,
  --| file which has the package spec for tracing types and variables
  --| declared in the visible part of a package.

  PUBLIC_BODY_FILE,
  --| the corresponding package body

  PRIVATE_SPEC_FILE,
  --| file which has the procedure declarations for tracing types
  --| and variables declared in the private part of a package

  PRIVATE_BODY_FILE   : DIO.FILE_TYPE;
  --| the corresponding procedure bodies

  type FILE_INDICATOR is
     (PUBLIC_SPEC, PUBLIC_BODY, PRIVATE_SPEC, PRIVATE_BODY);
  --| indicates which file to copy into the instrumented source file

  type FILE_GROUP is (PUBLIC_FILES, PRIVATE_FILES, ALL_FILES);
  --| used by various procedures when the operation is not always
  --| performed on all files

  ------------------------------------------------------------------------
  -- The following procedures manage the Buffer_File
  ------------------------------------------------------------------------

  procedure INITIALIZE;

  --| Effects

  --| This procedure initializes Buffer_File as a temporary Direct_IO file.
  --| The Source Instrumenter writes text to this file in sections which
  --| correspond to scoping levels in the source program.  Initialize
  --| also creates an Index_Stack to keep track of the Starting Indices for
  --| the sections.

  -----------------------------------------------------------------------------

  procedure START_NEW_SECTION;

  --| Effects

  --| This procedure marks a new section in the buffer file by pushing
  --| the current Starting_Index onto the Index_Stack and assigning the
  --| current DIO.Index to Starting_Index.

  ----------------------------------------------------------------------------

  procedure RELEASE_SECTION;

  --| Effects

  --| This procedure releases a section in Buffer_File by setting the Index
  --| to Starting_Index and popping the previous Starting_Index off the
  --| stack.

  -----------------------------------------------------------------------------

  procedure WRITELN_TO_BUFFER(DIO_FILE : in DIO.FILE_TYPE := BUFFER_FILE;
                              LINE     : in SOURCE_LINE_BUFFER);
  --| Effects

  --| This procedure writes the line and a carriage return to the specified
  --| file.  If no file is specified, the line is written to the Buffer_File.

  -----------------------------------------------------------------------------

  procedure SAVE_BUFFER_FILE(INSTRUMENTED_FILE : in TEXT_IO.FILE_TYPE);

  --| Effects

  --| This procedure saves the section starting at the current Starting_Index
  --| to the instrumented source file.



  ----------------------------------------------------------------------------
  -- The following procedures manage the package tracing files.
  ----------------------------------------------------------------------------

  procedure CREATE_PACKAGE_FILES(PACKAGE_NAME : in STRING;
                                 WHICH_FILES  : in FILE_GROUP);

  --| Effects

  --| This procedure obtains a filename prefix based on the current package
  --| name, appends the appropriate suffix, and creates the Direct_IO files.
  --| The source instrumenter saves package tracing information in these files.
  --| The Which_Files parameter will normally be "All_Files".  However, if a
  --| package specification is nested in another package specification, then
  --| only new private files are created. The information from the public part
  --| of the nested package is included in the public files of the enclosing
  --| package.

  ----------------------------------------------------------------------------

  procedure CLOSE_PACKAGE_FILES(WHICH_FILES : in FILE_GROUP);

  --| Effects

  --| This procedure closes the specified group of package files.
  --| Usually "Which_Files" parameter will be "All_Files".  If a package is
  --| nested in another package, then the outer package's private files will
  --| be closed (temporarily) and reopened after the inner package is done.
  --|
  --| The public information for the nested package is included in the
  --| enclosing package's public files.  Therefore, it isn't necessary to
  --| close and reopen the public_files.

  ---------------------------------------------------------------------------

  procedure REOPEN_FILES(PACKAGE_NAME : in STRING;
                         WHICH_FILES  : in FILE_GROUP);

  --| Effects

  --| This procedure reopens the private files for the specified package,
  --| which were closed to process a nested package.  The file index is set
  --| to the end of the file so further writes to this files will be appended.

  ----------------------------------------------------------------------------

  function PACKAGE_FILES_EXIST(PACKAGE_NAME : in STRING;
                               WHICH_FILES  : in FILE_GROUP) return BOOLEAN;

  --| Effects

  --| This function determines if the specified group of instrumenting
  --| information files exist for a package.  Both the spec and the body
  --| files must exist.  If one exists without the other, which could
  --| happed if the user deleted or misplaced one of the files, it is
  --| deleted, and False is returned.

  -----------------------------------------------------------------------------

  procedure COPY_PACKAGE_FILES(WHICH_FILE   : in FILE_INDICATOR;
                               PACKAGE_NAME : in STRING;
                               SI_FILE      : in TEXT_IO.FILE_TYPE);

  --| Effects

  --| This procedure copies the contents of the indicated file into the
  --| instrumented source file.

  -----------------------------------------------------------------------------

  procedure COPY_AND_DELETE(FROM, INTO: in out DIO.FILE_TYPE);

  --| Effects

  --| Reset the first file (FROM) to the beginning, and copy it to the end
  --| of the second file (INTO).  Then delete FROM.

  ----------------------------------------------------------------------------

  procedure DELETE_PACKAGE_FILES(PACKAGE_NAME     : in STRING;
                                 WHICH_FILES      : in FILE_GROUP := ALL_FILES;
                                 CURRENT_FILENAME : in STRING := "";
                                 DELETE_ENTRY     : in BOOLEAN := TRUE);

  --| Effects

  --| This procedure determines the name of the external files if the
  --| Current_Filename_Prefix is not already known, and deletes the
  --| "Which_Files" group of files, if they exist.

  ----------------------------------------------------------------------------

  procedure PURGE_PACKAGE_FILES(PROGRAM_NAME : in STRING);

  --| Effects

  ---------------------------------------------------------

  procedure SAVE_SPEC_WITH_LIST(UNIT_NAME : in STRING;
                                WITH_LIST : in STRING_LIST);
  --| Effects

  --| This procecufe saves the list of library unit names that were
  --| in the with_clause for the indicated package specification.

  ---------------------------------------------------------

  function GET_SPEC_WITH_LIST(UNIT_NAME : in STRING) return STRING_LIST;

  --| Effects

  --| This function retrieves the saved list of library unit names
  --| that were in the with_clause for the indicated unit and returns
  --| it to the calling procedure as a list of string_types.

  -----------------------------------------------------------------------------

  procedure SAVE_EXTERNAL_FILE;

  --| Effects

  --| This procedure writes the internal table of package_name-file_name
  --| information to the permanent external table file.

  -----------------------------------------------------------------------------

end SD_BUFFER_FILES;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SDBUFFERS.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with SYSTEM_PARAMETERS; use SYSTEM_PARAMETERS;
with CALENDAR;
with STACK_PKG;
with TIME_LIBRARY_1; use TIME_LIBRARY_1;
with SYSTEM_PARAMETERS;

package body SD_BUFFER_FILES is
  use STRING_LISTS;

  package SP renames SYSTEM_PARAMETERS;

  subtype DATE_STRING is STRING(1 .. 8);
  subtype TIME_STRING is STRING(1 .. 8);
  subtype FILENAME_PREFIX_STRING is STRING(1 .. FILE_PREFIX_LIMIT);

  NO_FILENAME : constant FILENAME_PREFIX_STRING := (others => ' ');
  NO_DATE     : constant DATE_STRING := (others => ' ');
  NO_TIME     : constant TIME_STRING := (others => ' ');
  NO_NAME     : constant STRING_PKG.STRING_TYPE := CREATE("");

  type TABLE_ENTRY_RECORD is  --| Record format for table entries
    record
      PACKAGE_ADA_NAME : STRING_PKG.STRING_TYPE := NO_NAME;
      --| Fully qualified package name
      PACKAGE_FILENAME : FILENAME_PREFIX_STRING := NO_FILENAME;
      --| Filename prefix
      WITHED_UNITS     : STRING_PKG.STRING_TYPE := NO_NAME;
      --| List of units named in the context clause of a specification
      DATE_CREATED     : DATE_STRING := NO_DATE;
      --| Date the file was created
      TIME_CREATED     : TIME_STRING := NO_TIME;
      --| Time the file was created
    end record;


  -- Function EQUAL for the instantiation of the Lists package
  function TABLE_EQUAL(X, Y : in TABLE_ENTRY_RECORD) return BOOLEAN;

  package INTERNAL_LIST_PACKAGE is
    new LISTS(TABLE_ENTRY_RECORD, TABLE_EQUAL);
  use INTERNAL_LIST_PACKAGE;

  INTERNAL_TABLE         : INTERNAL_LIST_PACKAGE.LIST;
  --| A linked list of table entry records, for equating package names
  --| with their filename prefix for instrumenting information files.  The
  --| list is built by reading the external file.

  INTERNAL_TABLE_CREATED : BOOLEAN := FALSE;
  INTERNAL_TABLE_CHANGED : BOOLEAN := FALSE;

  EXTERNAL_FILE          : TEXT_IO.FILE_TYPE;
  --| The external file of package name, filename prefix information.
  --| The internal table is written to the external file at the end
  --| of instrumentation.

  TERMINATOR             : constant CHARACTER := '*';
  --| Mark the end of a table_entry_record field in the external file

  subtype LONG_STRING is STRING(1 .. 255);
  --| Used for reading a line of text from one of the files.  It is
  --| assumed that most lines will be less than 255 characters and
  --| this choice should be adequate most of the time.  Procedures
  --| which do the reading must allow for cases where lines are longer
  --| than 255.


  --| Varaibles for marking and releasing sections in the Buffer_File

  package INDEX_STACK_PKG is
    new STACK_PKG(DIO.POSITIVE_COUNT);
  INDEX_STACK    : INDEX_STACK_PKG.STACK;
  STARTING_INDEX : DIO.POSITIVE_COUNT;


  ------------------------------------------------------------------------
  --  Local procedure specificatons
  -------------------------------------------------------------------------


  ----------------------------------------------------------------------------

  procedure CREATE_INTERNAL_TABLE;
  --| Reads the external file and builds an internal version of it
  --| as a linked list.

  --------------------------------------------------------------------------

  function FILENAME_IN_TABLE(FILENAME : in FILENAME_PREFIX_STRING)
      return BOOLEAN;

  --| Searches the Internal_Table for the occurrence of the
  --| specified filename prefix.

  ----------------------------------------------------------------------------

  function MAKE_FILENAME_PREFIX(PACKAGE_NAME : in STRING)
      return FILENAME_PREFIX_STRING;

  --| Formulates and returns a unique filename prefix for each package name.

  ----------------------------------------------------------------------------

  function CONVERT_LIST_TO_STRING_TYPE(L : in STRING_LIST) return STRING_TYPE;
  --| Converts a list of string_types to a single string_type
  --| with each element separated by one blank.

  ---------------------------------------------------------

  function CONVERT_STRING_TO_LIST(S : in STRING) return STRING_LIST;
  --| Converts a literal string into a list of string_types.

  ---------------------------------------------------------

  function GET_FIXED_LENGTH_TABLE_ENTRY(LENGTH : in POSITIVE) return STRING;
  --| Returns a string of the next "length" characters read
  --| from the external file.

  ---------------------------------------------------------

  function GET_VARIABLE_LENGTH_TABLE_ENTRY return STRING_TYPE;
  --| Reads any number of characters in the external file until
  --| the terminator character ('*') is found and returns them
  --| as a string_type.

  ---------------------------------------------------------

  procedure GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME : in STRING;
                                     TABLE_ENTRY  : out TABLE_ENTRY_RECORD;
                                     FOUND        : in out BOOLEAN);
  --| Scan the internal table for an entry for Package_Name,
  --| and if found, pass it back to the calling procedure.

  ---------------------------------------------------------

  function START_PACKAGE(PACKAGE_NAME : in STRING)
      return FILENAME_PREFIX_STRING;

  --| Create an entry in the Internal_Table for this package,
  --| and return the unique filename prefix.

  ---------------------------------------------------------

  function GET_FILENAME_PREFIX(PACKAGE_NAME : in STRING)
      return FILENAME_PREFIX_STRING;

  --| If the package is in the table, return its filename prefix.
  --| If there isn't an entry return No_Filename.

  ---------------------------------------------------------


  ---------------------------------------------------------------
  --  External procedures for managing the package tracing files.
  ---------------------------------------------------------------


  procedure CREATE_PACKAGE_FILES(PACKAGE_NAME : in STRING;
                                 WHICH_FILES  : in FILE_GROUP) is
  --| Set up the requested set of package tracing files.

    FILENAME_PREFIX : constant STRING :=
       VALUE(SP.CURRENT_PROGRAM_LIBRARY) & START_PACKAGE(PACKAGE_NAME);

  begin
    if WHICH_FILES /= PRIVATE_FILES then
      -- create the public_spec file
      begin
        DIO.OPEN(PUBLIC_SPEC_FILE, INOUT_FILE,
                 FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);
        DIO.DELETE(PUBLIC_SPEC_FILE);
        DIO.CREATE(PUBLIC_SPEC_FILE, INOUT_FILE,
                   FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);
      exception
        when DIO.NAME_ERROR =>
          DIO.CREATE(PUBLIC_SPEC_FILE, INOUT_FILE,
                     FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);
      end;

      -- create the public_body file
      begin
        DIO.OPEN(PUBLIC_BODY_FILE, INOUT_FILE,
                 FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);
        DIO.DELETE(PUBLIC_BODY_FILE);
        DIO.CREATE(PUBLIC_BODY_FILE, INOUT_FILE,
                   FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);
      exception
        when DIO.NAME_ERROR =>
          DIO.CREATE(PUBLIC_BODY_FILE, INOUT_FILE,
                     FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);
      end;
    end if; -- Which_Files /= Private_Files


    if WHICH_FILES /= PUBLIC_FILES then
      -- create the private_spec file
      begin
        DIO.OPEN(PRIVATE_SPEC_FILE, INOUT_FILE,
                 FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);
        DIO.DELETE(PRIVATE_SPEC_FILE);
        DIO.CREATE(PRIVATE_SPEC_FILE, INOUT_FILE,
                   FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);
      exception
        when DIO.NAME_ERROR =>
          DIO.CREATE(PRIVATE_SPEC_FILE, INOUT_FILE,
                     FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);
      end;

      -- create the private_body file
      begin
        DIO.OPEN(PRIVATE_BODY_FILE, INOUT_FILE,
                 FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
        DIO.DELETE(PRIVATE_BODY_FILE);
        DIO.CREATE(PRIVATE_BODY_FILE, INOUT_FILE,
                   FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
      exception
        when DIO.NAME_ERROR =>
          DIO.CREATE(PRIVATE_BODY_FILE, INOUT_FILE,
                     FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
      end;
    end if;   -- Which_Files /= Public_Files

  end CREATE_PACKAGE_FILES;

  ---------------------------------------------------------

  procedure CLOSE_PACKAGE_FILES(WHICH_FILES : in FILE_GROUP) is
  --| Close the specified group of package tracing files.

  begin
    if WHICH_FILES /= PRIVATE_FILES then
      DIO.CLOSE(PUBLIC_SPEC_FILE);
      DIO.CLOSE(PUBLIC_BODY_FILE);
    end if;

    if WHICH_FILES /= PUBLIC_FILES then
      DIO.CLOSE(PRIVATE_SPEC_FILE);
      DIO.CLOSE(PRIVATE_BODY_FILE);
    end if;

  exception
    when others =>
      null;
  end CLOSE_PACKAGE_FILES;

  ----------------------------------------------------------------------

  procedure REOPEN_FILES(PACKAGE_NAME : in STRING;
                         WHICH_FILES  : in FILE_GROUP) is

    FILENAME_PREFIX : constant STRING :=
       VALUE(SP.CURRENT_PROGRAM_LIBRARY) & GET_FILENAME_PREFIX(PACKAGE_NAME);

    FILE_INDEX              : DIO.COUNT;

  begin
    if WHICH_FILES /= PUBLIC_FILES then

      DIO.OPEN(PRIVATE_SPEC_FILE, INOUT_FILE,
               FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);

      FILE_INDEX := DIO.SIZE(PRIVATE_SPEC_FILE);
      if FILE_INDEX /= 0 then
        DIO.SET_INDEX(PRIVATE_SPEC_FILE, FILE_INDEX + 1);
      end if;

      DIO.OPEN(PRIVATE_BODY_FILE, INOUT_FILE,
               FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
      FILE_INDEX := DIO.SIZE(PRIVATE_BODY_FILE);
      if FILE_INDEX /= 0 then
        DIO.SET_INDEX(PRIVATE_BODY_FILE, FILE_INDEX + 1);
      end if;
    end if;

    if WHICH_FILES /= PRIVATE_FILES then

      DIO.OPEN(PUBLIC_SPEC_FILE, INOUT_FILE,
               FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);

      FILE_INDEX := DIO.SIZE(PUBLIC_SPEC_FILE);
      if FILE_INDEX /= 0 then
        DIO.SET_INDEX(PUBLIC_SPEC_FILE, FILE_INDEX + 1);
      end if;

      DIO.OPEN(PUBLIC_BODY_FILE, INOUT_FILE,
               FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);
      FILE_INDEX := DIO.SIZE(PUBLIC_BODY_FILE);
      if FILE_INDEX /= 0 then
        DIO.SET_INDEX(PUBLIC_BODY_FILE, FILE_INDEX + 1);
      end if;
    end if;

  exception
    when others =>
      null;

  end REOPEN_FILES;

  ---------------------------------------------------------------------------

  function PACKAGE_FILES_EXIST(PACKAGE_NAME : in STRING;
                               WHICH_FILES  : in FILE_GROUP) return BOOLEAN is
  --| See if the requested set of instrumenting information files
  --| exist for the given package.  Both the spec and body file must
  --| exist, as the body contains the bodies for the subprograms
  --| declared in the spec file.  If one exists without the other,
  --| delete it and return false.

    FILENAME_PREFIX     : constant STRING :=
       VALUE(SP.CURRENT_PROGRAM_LIBRARY) & GET_FILENAME_PREFIX(PACKAGE_NAME);

    PUBLIC_SPEC_EXISTS  : BOOLEAN := TRUE;
    PUBLIC_BODY_EXISTS  : BOOLEAN := TRUE;
    PRIVATE_SPEC_EXISTS : BOOLEAN := TRUE;
    PRIVATE_BODY_EXISTS : BOOLEAN := TRUE;
    DIO_FILE            : DIO.FILE_TYPE;

  begin
    if FILENAME_PREFIX = VALUE(SP.CURRENT_PROGRAM_LIBRARY) & NO_FILENAME then
      -- they don't exist
      return FALSE;
    end if;

    -- The internal table has an entry for the given package name.
    -- Make sure that the necessary files exist and can be opened.
    -- If some of the files exist and not the others, delete those
    -- that do and update the table.  This could happen if the user
    -- has deleted the files other than by re-instrumenting...

    if WHICH_FILES /= PRIVATE_FILES then
      -- check if the public spec and body files exist
      begin
        DIO.OPEN(DIO_FILE, IN_FILE, FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);
        DIO.CLOSE(DIO_FILE);
      exception
        when others =>
          PUBLIC_SPEC_EXISTS := FALSE;
      end;

      begin
        DIO.OPEN(DIO_FILE, IN_FILE, FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);
        DIO.CLOSE(DIO_FILE);
      exception
        when others =>
          PUBLIC_BODY_EXISTS := FALSE;
      end;

      if WHICH_FILES = PUBLIC_FILES then
        if not (PUBLIC_SPEC_EXISTS and PUBLIC_BODY_EXISTS) then
          DELETE_PACKAGE_FILES(PACKAGE_NAME, PUBLIC_FILES, FILENAME_PREFIX);
          return FALSE;
        end if;
        return TRUE;
      end if;
    end if;     -- Which_Files /= Private_Files

    if WHICH_FILES /= PUBLIC_FILES then
      -- check if the private spec and body files exist
      begin
        DIO.OPEN(DIO_FILE, IN_FILE, FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);
        DIO.CLOSE(DIO_FILE);
      exception
        when others =>
          PRIVATE_SPEC_EXISTS := FALSE;
      end;

      begin
        DIO.OPEN(DIO_FILE, IN_FILE, FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
        DIO.CLOSE(DIO_FILE);
      exception
        when others =>
          PRIVATE_BODY_EXISTS := FALSE;
      end;

      if WHICH_FILES = PRIVATE_FILES then
        if not (PRIVATE_SPEC_EXISTS and PRIVATE_BODY_EXISTS) then
          DELETE_PACKAGE_FILES(PACKAGE_NAME, PRIVATE_FILES, FILENAME_PREFIX);
          return FALSE;
        end if;
        return TRUE;
      end if;
    end if;     -- Which_Files /= Public_Files


    -- if we've gotten this far without hitting one of the
    -- returns then Which_Files = All_Files
    if not (PUBLIC_SPEC_EXISTS and
            PUBLIC_BODY_EXISTS  and
            PRIVATE_SPEC_EXISTS and
            PRIVATE_BODY_EXISTS) then
      DELETE_PACKAGE_FILES(PACKAGE_NAME, ALL_FILES, FILENAME_PREFIX);
      return FALSE;
    end if;

    return TRUE;

  end PACKAGE_FILES_EXIST;

  -----------------------------------------------------------------------------

  procedure DELETE_PACKAGE_FILES(PACKAGE_NAME     : in STRING;
                                 WHICH_FILES      : in FILE_GROUP := ALL_FILES;
                                 CURRENT_FILENAME : in STRING := "";
                                 DELETE_ENTRY     : in BOOLEAN := TRUE) IS

  --| Delete the indicated set of package tracing files.  If all the
  --| files are deleted, then also delete the internal table entry for
  --| the package.

    DIO_FILE        : DIO.FILE_TYPE;
    FILENAME_PREFIX : STRING(1 .. LENGTH(SP.CURRENT_PROGRAM_LIBRARY) +
                                  FILE_PREFIX_LIMIT);
    TABLE_ENTRY     : TABLE_ENTRY_RECORD;
    ENTRY_EXISTS    : BOOLEAN := FALSE;

  begin

    -- if this procedure is called from Package_Files_Exist then
    -- the filename prefix has already been looked up, and is
    -- passed as Current_Filename.

    if CURRENT_FILENAME = "" then
      FILENAME_PREFIX := VALUE(SP.CURRENT_PROGRAM_LIBRARY) &
                               GET_FILENAME_PREFIX(PACKAGE_NAME);
    else
      FILENAME_PREFIX := CURRENT_FILENAME;
    end if;

    -- if the files can be opened, then they exist.  Delete them.
    -- Otherwise, there is nothing to delete so ignore it.
    if FILENAME_PREFIX /= VALUE(SP.CURRENT_PROGRAM_LIBRARY) & NO_FILENAME then

      if WHICH_FILES /= PRIVATE_FILES then
        -- delete the public_spec_file
        begin
          DIO.OPEN(DIO_FILE, OUT_FILE,
                   FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);
          DIO.DELETE(DIO_FILE);
        exception
          when DIO.NAME_ERROR =>
            null;
        end;

        -- delete the public_body_file
        begin
          DIO.OPEN(DIO_FILE, OUT_FILE,
                   FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);
          DIO.DELETE(DIO_FILE);
        exception
          when DIO.NAME_ERROR =>
            null;
        end;
      end if; -- Which_Files /= Private_Files

      if WHICH_FILES /= PUBLIC_FILES then
        -- delete the private_spec_file
        begin
          DIO.OPEN(DIO_FILE, OUT_FILE,
                   FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);
          DIO.DELETE(DIO_FILE);
        exception
          when DIO.NAME_ERROR =>
            null;
        end;

        -- delete the private_body_file
        begin
          DIO.OPEN(DIO_FILE, OUT_FILE,
                   FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
          DIO.DELETE(DIO_FILE);
        exception
          when DIO.NAME_ERROR =>
            null;
        end;
      end if; -- Which_Files /= Public_Files

      if WHICH_FILES = ALL_FILES and DELETE_ENTRY then
        GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME, TABLE_ENTRY, ENTRY_EXISTS);
        if ENTRY_EXISTS then
          DELETEITEM(INTERNAL_TABLE, TABLE_ENTRY);
          INTERNAL_TABLE_CHANGED := TRUE;
        end if;
      end if;

    end if; -- Filename /= No_Filename
  end DELETE_PACKAGE_FILES;

  ----------------------------------------------------------------------------

  procedure PURGE_PACKAGE_FILES(PROGRAM_NAME : in STRING) is
    ITERATOR   : INTERNAL_LIST_PACKAGE.LISTITER;
    NEXT_ENTRY : TABLE_ENTRY_RECORD;
  begin
    if not INTERNAL_TABLE_CREATED then
      CREATE_INTERNAL_TABLE;
    end if;

    ITERATOR := INTERNAL_LIST_PACKAGE.MAKELISTITER(INTERNAL_TABLE);
    while INTERNAL_LIST_PACKAGE.MORE(ITERATOR) loop
      INTERNAL_LIST_PACKAGE.NEXT(ITERATOR, NEXT_ENTRY);
      if MATCH_S(NEXT_ENTRY.PACKAGE_ADA_NAME & ".", PROGRAM_NAME & ".") = 1 then
        DELETE_PACKAGE_FILES(VALUE(NEXT_ENTRY.PACKAGE_ADA_NAME),
                             ALL_FILES,
                             VALUE(SP.CURRENT_PROGRAM_LIBRARY) &
                                   NEXT_ENTRY.PACKAGE_FILENAME,
                             FALSE);
        DELETEITEM(INTERNAL_TABLE, NEXT_ENTRY);
        INTERNAL_TABLE_CHANGED := TRUE;
      end if;
    end loop;
    SAVE_EXTERNAL_FILE;
  end PURGE_PACKAGE_FILES;

  -----------------------------------------------------------------------------

  procedure COPY_PACKAGE_FILES(WHICH_FILE   : in FILE_INDICATOR;
                               PACKAGE_NAME : in STRING;
                               SI_FILE      : in TEXT_IO.FILE_TYPE) is
  --| Copy the indicated package tracing file into the instrumented
  --| source file.

    DIO_FILE                : DIO.FILE_TYPE;

    FILE_START_INDEX        : DIO.COUNT := 1;
    FILE_END_INDEX          : DIO.COUNT;
    LINE                    : SOURCE_LINE_BUFFER;
    FILENAME_PREFIX : constant STRING :=
       VALUE(SP.CURRENT_PROGRAM_LIBRARY) & GET_FILENAME_PREFIX(PACKAGE_NAME);

  begin
    case WHICH_FILE is
      when PUBLIC_SPEC =>
        OPEN(DIO_FILE, IN_FILE, FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);

      when PUBLIC_BODY =>
        OPEN(DIO_FILE, IN_FILE, FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);

      when PRIVATE_SPEC =>
        OPEN(DIO_FILE, IN_FILE, FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);

      when PRIVATE_BODY =>
        OPEN(DIO_FILE, IN_FILE, FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
    end case;

    TEXT_IO.NEW_LINE (SI_FILE);

    -- while not DIO.end_of_file (DIO_File) loop
    -- Compiler Bug?
    -- When trying to copy the private files, end_of_file is true immediately,
    -- even though the file index = 1, file size > 1, the file exists and
    -- can be read.  So read it explicitly from start to end.

    FILE_START_INDEX := 1;
    FILE_END_INDEX := DIO.SIZE(DIO_FILE);
    for I in FILE_START_INDEX .. FILE_END_INDEX loop
      DIO.READ(DIO_FILE, LINE);
      TEXT_IO.PUT_LINE(SI_FILE, LINE);
    end loop;
    DIO.CLOSE(DIO_FILE);

  exception
    when others =>
      null;

  end COPY_PACKAGE_FILES;

  -----------------------------------------------------------------------------

  procedure COPY_AND_DELETE(FROM, INTO: in out DIO.FILE_TYPE) is

    FILE_START_INDEX  : DIO.COUNT := 1;
    FILE_END_INDEX    : DIO.COUNT;
    LINE              : SOURCE_LINE_BUFFER;

  begin
    -- The FROM file has to be reset to the start.  The INTO file is
    -- already at the end.  In fact, currently this procedure is only
    -- called from CLOSE_TRACING_PACKAGES, and the INTO files (private
    -- files) have just been reopened.

    DIO.SET_INDEX(FROM, FILE_START_INDEX);
    FILE_END_INDEX := DIO.SIZE(FROM);
    for I in FILE_START_INDEX .. FILE_END_INDEX loop
      DIO.READ(FROM, LINE);
      DIO.WRITE(INTO, LINE);
    end loop;

    DIO.DELETE(FROM);

  end COPY_AND_DELETE;

  ---------------------------------------------------------

  procedure SAVE_SPEC_WITH_LIST(UNIT_NAME : in STRING;
                                WITH_LIST : in STRING_LIST) is
  --| This procedure is called by the source instrumenter when
  --| a package specification has a with list.  Convert the
  --| string_list to a string_type, and save it so that it
  --| can be retrieved when the package body is found.

    TABLE_ENTRY  : TABLE_ENTRY_RECORD;
    FOUND        : BOOLEAN;
    LIST_TO_SAVE : STRING_TYPE;
  begin
    GET_INTERNAL_TABLE_ENTRY(UNIT_NAME, TABLE_ENTRY, FOUND);
    if not FOUND then  -- make an entry
      TABLE_ENTRY.PACKAGE_ADA_NAME := MAKE_PERSISTENT(UNIT_NAME);
    else
      INTERNAL_LIST_PACKAGE.DELETEITEM(INTERNAL_TABLE, TABLE_ENTRY);
    end if;

    TABLE_ENTRY.WITHED_UNITS :=
       MAKE_PERSISTENT(CONVERT_LIST_TO_STRING_TYPE(WITH_LIST));
    ATTACH(INTERNAL_TABLE, TABLE_ENTRY);
    INTERNAL_TABLE_CHANGED := TRUE;
  end SAVE_SPEC_WITH_LIST;

  ---------------------------------------------------------

  function GET_SPEC_WITH_LIST(UNIT_NAME : in STRING) return STRING_LIST is
  --| Retrieve the with_list that was saved for the package
  --| specification, convert it to a string_list, and return
  --| it to the source instrumenter.

    TEMP        : STRING_LIST := STRING_LISTS.CREATE;
    TABLE_ENTRY : TABLE_ENTRY_RECORD;
    FOUND       : BOOLEAN;
  begin
    GET_INTERNAL_TABLE_ENTRY(UNIT_NAME, TABLE_ENTRY, FOUND);
    if FOUND and then not STRING_PKG.IS_EMPTY(TABLE_ENTRY.WITHED_UNITS) then
      TEMP := CONVERT_STRING_TO_LIST(VALUE(TABLE_ENTRY.WITHED_UNITS));
    end if;
    return TEMP;
  end GET_SPEC_WITH_LIST;

  -----------------------------------------------------------------------------

  procedure SAVE_EXTERNAL_FILE is
  --| Write the internal table list to the extenal file if it has changed.

    TABLE_POINTER : INTERNAL_LIST_PACKAGE.LISTITER;
    TABLE_ENTRY   : TABLE_ENTRY_RECORD;
    FILENAME      : constant STRING :=
       VALUE(SP.CURRENT_PROGRAM_LIBRARY) & EXTERNAL_FILENAME;

  begin
    if INTERNAL_TABLE_CREATED and INTERNAL_TABLE_CHANGED then
      begin
        OPEN(EXTERNAL_FILE, OUT_FILE, FILENAME);
        RESET(EXTERNAL_FILE);
      exception
        when TEXT_IO.NAME_ERROR =>
          CREATE(EXTERNAL_FILE, OUT_FILE, FILENAME);
      end;

      if INTERNAL_LIST_PACKAGE.ISEMPTY(INTERNAL_TABLE) then
         DELETE(EXTERNAL_FILE);
      else
        TABLE_POINTER := MAKELISTITER(INTERNAL_TABLE);
        while MORE(TABLE_POINTER) loop
          NEXT(TABLE_POINTER, TABLE_ENTRY);

          PUT(EXTERNAL_FILE, VALUE(TABLE_ENTRY.PACKAGE_ADA_NAME));
          PUT(EXTERNAL_FILE, TERMINATOR);

          PUT(EXTERNAL_FILE, TABLE_ENTRY.PACKAGE_FILENAME);
          PUT(EXTERNAL_FILE, TERMINATOR);

          PUT(EXTERNAL_FILE, VALUE(TABLE_ENTRY.WITHED_UNITS));
          PUT(EXTERNAL_FILE, TERMINATOR);

          PUT(EXTERNAL_FILE, TABLE_ENTRY.DATE_CREATED);
          PUT(EXTERNAL_FILE, TERMINATOR);

          PUT(EXTERNAL_FILE, TABLE_ENTRY.TIME_CREATED);
          PUT(EXTERNAL_FILE, TERMINATOR);
          NEW_LINE(EXTERNAL_FILE);
        end loop;

        CLOSE(EXTERNAL_FILE);
        INTERNAL_LIST_PACKAGE.DESTROY(INTERNAL_TABLE);
      end if;
      INTERNAL_TABLE_CREATED := FALSE;
      INTERNAL_TABLE_CHANGED := FALSE;
    end if;
  end SAVE_EXTERNAL_FILE;

  ---------------------------------------------------------------
  --  External procedures for managing the temporary buffer file.
  ----------------------------------------------------------------

  procedure INITIALIZE is
  begin
    if DIO.IS_OPEN(BUFFER_FILE) then
      DIO.RESET(BUFFER_FILE);
    else
      DIO.CREATE(BUFFER_FILE);
    end if;
    INDEX_STACK := INDEX_STACK_PKG.CREATE;
    STARTING_INDEX := DIO.INDEX(BUFFER_FILE);
  end INITIALIZE;

  ----------------------------------------------------------------

  procedure START_NEW_SECTION is

  begin
    INDEX_STACK_PKG.PUSH(INDEX_STACK, STARTING_INDEX);
    STARTING_INDEX := DIO.INDEX(BUFFER_FILE);
  end START_NEW_SECTION;

  ---------------------------------------------------------------

  procedure RELEASE_SECTION is

  begin
    SET_INDEX(BUFFER_FILE, STARTING_INDEX);
    INDEX_STACK_PKG.POP(INDEX_STACK, STARTING_INDEX);
  end RELEASE_SECTION;

  ----------------------------------------------------------------

  procedure WRITELN_TO_BUFFER(DIO_FILE : in DIO.FILE_TYPE := BUFFER_FILE;
                              LINE     : in SOURCE_LINE_BUFFER) is

  begin
    DIO.WRITE(DIO_FILE, LINE);
  end WRITELN_TO_BUFFER;

  ----------------------------------------------------------------------

  procedure SAVE_BUFFER_FILE(INSTRUMENTED_FILE : in TEXT_IO.FILE_TYPE) is

    CURRENT_INDEX : DIO.COUNT;
    LINE          : SOURCE_LINE_BUFFER;

  begin
    CURRENT_INDEX := DIO.INDEX(BUFFER_FILE) - 1;
    if STARTING_INDEX <= CURRENT_INDEX then
      TEXT_IO.PUT_LINE(INSTRUMENTED_FILE, "");
    end if;

    for I in STARTING_INDEX .. CURRENT_INDEX loop
      DIO.READ(BUFFER_FILE, LINE, I);
      TEXT_IO.PUT_LINE(INSTRUMENTED_FILE, LINE);
    end loop;
  end SAVE_BUFFER_FILE;

  ------------------------------------------------------------------------
  --  Local procedure bodies
  -------------------------------------------------------------------------

  function TABLE_EQUAL(X, Y : in TABLE_ENTRY_RECORD) return BOOLEAN is

  begin
    return EQUAL(X.PACKAGE_ADA_NAME, Y.PACKAGE_ADA_NAME) and then
           X.PACKAGE_FILENAME = Y.PACKAGE_FILENAME and then
           X.DATE_CREATED = Y.DATE_CREATED and then
           X.TIME_CREATED = Y.TIME_CREATED;
  end TABLE_EQUAL;

  ---------------------------------------------------------

  function CONVERT_LIST_TO_STRING_TYPE(L : in STRING_LIST)
       return STRING_TYPE is

  --| Iterate through a list of string_types and collect
  --| all of the objects into one string_type, with each
  --| one separated by a blank.

    ITERATOR    : STRING_LISTS.LISTITER;
    NEXT_OBJECT : STRING_TYPE;
    TEMP        : STRING_TYPE := NO_NAME;
    SPACE       : STRING_TYPE := CREATE(" ");
  begin
    ITERATOR := STRING_LISTS.MAKELISTITER(L);
    while MORE(ITERATOR) loop
      NEXT(ITERATOR, NEXT_OBJECT);
      if EQUAL(TEMP, NO_NAME) then
        TEMP := NEXT_OBJECT;
      else
        TEMP := TEMP & SPACE & NEXT_OBJECT;
      end if;
    end loop;
    return TEMP;
  end CONVERT_LIST_TO_STRING_TYPE;

  ---------------------------------------------------------

  function CONVERT_STRING_TO_LIST(S : in STRING) return STRING_LIST is

  --| Make a list of string_types out of a literal string.  Scan
  --| the input string for the next blank, or the end, and create
  --| a string_type object out of it to attach to the list.

    START : POSITIVE := 1;
    TEMP  : STRING_LIST;

  begin
    TEMP := STRING_LISTS.CREATE;
    for I in S'FIRST .. S'LAST + 1 loop
      if (I = S'LAST + 1 or else S(I) = ' ') and then START < I then
        STRING_LISTS.ATTACH(TEMP, CREATE(S(START .. I - 1)));
        START := I + 1;
      end if;
    end loop;
    return TEMP;
  end CONVERT_STRING_TO_LIST;

  ---------------------------------------------------------

  function GET_FIXED_LENGTH_TABLE_ENTRY(LENGTH : in POSITIVE)
       return STRING is

  --| Read the next LENGTH characters from the external file
  --| and return them as a string.

    RETURN_STRING : STRING(1 .. LENGTH);
    CH            : CHARACTER;
    INDEX         : POSITIVE;
  begin
    for I in RETURN_STRING'range loop
      GET(EXTERNAL_FILE, CH);
      RETURN_STRING(I) := CH;
    end loop;

    -- read past the terminator
    if CH /= TERMINATOR then
      GET(EXTERNAL_FILE, CH);
    end if;
    return RETURN_STRING;
  end GET_FIXED_LENGTH_TABLE_ENTRY;

  ---------------------------------------------------------

  function GET_VARIABLE_LENGTH_TABLE_ENTRY return STRING_TYPE is
  --| Scan the external file until a terminator ('*') is found,
  --| and return a string_type of the characters scanned.

    RETURN_STRING : STRING_TYPE;
    CH            : CHARACTER := ' ';
    TMP_STRING    : LONG_STRING;
    INDEX         : NATURAL := 0;
  begin
    RETURN_STRING := CREATE("");
    while CH /= TERMINATOR loop
      for I in LONG_STRING'range loop
        GET(EXTERNAL_FILE, CH);
        exit when CH = TERMINATOR;
        INDEX := I;
        TMP_STRING(INDEX) := CH;
      end loop;
      RETURN_STRING := RETURN_STRING & CREATE(TMP_STRING(1 .. INDEX));
    end loop;
    return RETURN_STRING;
  end GET_VARIABLE_LENGTH_TABLE_ENTRY;

  ---------------------------------------------------------

  procedure CREATE_INTERNAL_TABLE is

  --| Read the external file and build an internal version of it
  --| as a linked list.

    TABLE_ENTRY : TABLE_ENTRY_RECORD;
  begin
    INTERNAL_TABLE := INTERNAL_LIST_PACKAGE.CREATE;
    TEXT_IO.OPEN(EXTERNAL_FILE, IN_FILE,
                 VALUE(SP.CURRENT_PROGRAM_LIBRARY) & EXTERNAL_FILENAME);

    while not TEXT_IO.END_OF_FILE(EXTERNAL_FILE) loop
      TABLE_ENTRY.PACKAGE_ADA_NAME :=
         MAKE_PERSISTENT(GET_VARIABLE_LENGTH_TABLE_ENTRY);
      TABLE_ENTRY.PACKAGE_FILENAME :=
         GET_FIXED_LENGTH_TABLE_ENTRY(FILE_PREFIX_LIMIT);
      TABLE_ENTRY.WITHED_UNITS :=
         MAKE_PERSISTENT(GET_VARIABLE_LENGTH_TABLE_ENTRY);
      TABLE_ENTRY.DATE_CREATED :=
         GET_FIXED_LENGTH_TABLE_ENTRY(DATE_STRING'LENGTH);
      TABLE_ENTRY.TIME_CREATED :=
         GET_FIXED_LENGTH_TABLE_ENTRY(TIME_STRING'LENGTH);
      TEXT_IO.SKIP_LINE(EXTERNAL_FILE);
      ATTACH(INTERNAL_TABLE, TABLE_ENTRY);
    end loop;

    INTERNAL_TABLE_CREATED := TRUE;
    TEXT_IO.CLOSE(EXTERNAL_FILE);

  exception
    when TEXT_IO.NAME_ERROR =>
      INTERNAL_TABLE_CREATED := TRUE;
  end CREATE_INTERNAL_TABLE;

  ---------------------------------------------------------

  function FILENAME_IN_TABLE(FILENAME : in FILENAME_PREFIX_STRING)
      return BOOLEAN is

  --| Search the Internal_Table to see if the filename prefix
  --| string already exists.

    TABLE_POINTER : INTERNAL_LIST_PACKAGE.LISTITER;
    TABLE_ENTRY   : TABLE_ENTRY_RECORD;

  begin
    TABLE_POINTER := INTERNAL_LIST_PACKAGE.MAKELISTITER(INTERNAL_TABLE);

    while MORE(TABLE_POINTER) loop
      NEXT(TABLE_POINTER, TABLE_ENTRY);
      if TABLE_ENTRY.PACKAGE_FILENAME = FILENAME then
        return TRUE;
      end if;
    end loop;

    return FALSE;

  end FILENAME_IN_TABLE;

  ---------------------------------------------------------

  function MAKE_FILENAME_PREFIX(PACKAGE_NAME : in STRING)
      return FILENAME_PREFIX_STRING is

  --| Formulate a unique filename prefix for each package name.

    TEMP, FILENAME_STRING : FILENAME_PREFIX_STRING := (others => 'X');
    FILENAME_INDEX        : NATURAL := 1;
    subtype A_TO_Z is CHARACTER range 'A' .. 'Z';

    function NEXT_CHARACTER(CH : in A_TO_Z) return A_TO_Z is
    begin
      if CH not in A_TO_Z or else CH = A_TO_Z'LAST then
        return A_TO_Z'FIRST;
      else
        return A_TO_Z'SUCC(CH);
      end if;
    end NEXT_CHARACTER;

  begin

    -- Extract the first "file_prefix_limit" characters from the
    -- package name to form the basic prefix of the filename.

    for I in 1 .. PACKAGE_NAME'LENGTH loop
      if PACKAGE_NAME(I) /= '_' and PACKAGE_NAME(I) /= '.' then
        FILENAME_STRING(FILENAME_INDEX) := PACKAGE_NAME(I);
        FILENAME_INDEX := FILENAME_INDEX + 1;
        exit when FILENAME_INDEX > FILE_PREFIX_LIMIT;
      end if;
    end loop;

    --  Now check the Internal_Table to be sure that the Filename_String
    --  is unique.  If not, try all permutations of A to Z until a unique
    --  name is found.  This scheme allows 26**8 unique names.

    TEMP := FILENAME_STRING;
    loop
      if not FILENAME_IN_TABLE(TEMP) then
         return TEMP;
      end if;
      for I in reverse 1 .. FILE_PREFIX_LIMIT loop
        TEMP(I) := NEXT_CHARACTER(TEMP(I));
        exit when TEMP(I) /= FILENAME_STRING(I);
      end loop;
      exit when TEMP = FILENAME_STRING;
    end loop;

    TEXT_IO.PUT_LINE
      ("Symbolic Debugger terminating:");
    TEXT_IO.PUT_LINE("Unable to create a unique" &
                     INTEGER'IMAGE(FILE_PREFIX_LIMIT) &
                     " character filename for");
    TEXT_IO.PUT_LINE(PACKAGE_NAME);

    raise STORAGE_ERROR; -- for lack of a better one at the moment.

  end MAKE_FILENAME_PREFIX;

  ---------------------------------------------------------

  procedure GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME : in STRING;
                                     TABLE_ENTRY  : out TABLE_ENTRY_RECORD;
                                     FOUND        : in out BOOLEAN) is

    ITERATOR      : INTERNAL_LIST_PACKAGE.LISTITER;
    NEXT_ENTRY    : TABLE_ENTRY_RECORD;
    NAME_TO_MATCH : STRING_PKG.STRING_TYPE;

  begin
    if not INTERNAL_TABLE_CREATED then
      CREATE_INTERNAL_TABLE;
    end if;

    STRING_PKG.MARK;
    NAME_TO_MATCH := UPPER(PACKAGE_NAME);

    TABLE_ENTRY := NEXT_ENTRY;
    FOUND := FALSE;

    ITERATOR := INTERNAL_LIST_PACKAGE.MAKELISTITER(INTERNAL_TABLE);
    while MORE(ITERATOR) and not FOUND loop
      NEXT(ITERATOR, NEXT_ENTRY);
      if EQUAL(NEXT_ENTRY.PACKAGE_ADA_NAME, NAME_TO_MATCH) then
        TABLE_ENTRY := NEXT_ENTRY;
        FOUND := TRUE;
      end if;
    end loop;

    STRING_PKG.RELEASE;
  end GET_INTERNAL_TABLE_ENTRY;

  ---------------------------------------------------------

  function START_PACKAGE(PACKAGE_NAME : in STRING)
      return FILENAME_PREFIX_STRING is

  --| Create a table entry for the package and return its unique
  --| filename prefix.  This is called at the start of procedure
  --| Create_Package_Files.

    ENTRY_EXISTS          : BOOLEAN := FALSE;
    CURRENT_TABLE_ENTRY   : TABLE_ENTRY_RECORD;
    CURRENT_DATE_AND_TIME : CALENDAR.TIME;
    CURRENT_DATE          : DATE_STRING;
    CURRENT_TIME          : STRING(1 .. 11);

  begin

    GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME, CURRENT_TABLE_ENTRY, ENTRY_EXISTS);

    if not ENTRY_EXISTS then
      CURRENT_TABLE_ENTRY.PACKAGE_ADA_NAME :=
         MAKE_PERSISTENT(UPPER(PACKAGE_NAME));
      CURRENT_TABLE_ENTRY.PACKAGE_FILENAME :=
         MAKE_FILENAME_PREFIX(PACKAGE_NAME);
    else
      -- If the table entry exists, delete it so a new one can be added
      -- with updated date and time fields.
      DELETEITEM(INTERNAL_TABLE, CURRENT_TABLE_ENTRY);

    end if;

    CURRENT_DATE_AND_TIME := CALENDAR.CLOCK;
    CURRENT_DATE := DATE_OF(CALENDAR.CLOCK);
    CURRENT_TIME := WALL_CLOCK_OF(CALENDAR.SECONDS(CURRENT_DATE_AND_TIME));

    CURRENT_TABLE_ENTRY.DATE_CREATED := CURRENT_DATE;
    CURRENT_TABLE_ENTRY.TIME_CREATED :=
       CURRENT_TIME(1 .. TIME_STRING'LENGTH);

    ATTACH(INTERNAL_TABLE, CURRENT_TABLE_ENTRY);
    INTERNAL_TABLE_CHANGED := TRUE;

    return CURRENT_TABLE_ENTRY.PACKAGE_FILENAME;

  end START_PACKAGE;

  ---------------------------------------------------------------------------

  function GET_FILENAME_PREFIX(PACKAGE_NAME : in STRING)
      return FILENAME_PREFIX_STRING is

  --| Return the filename prefix for the specified package, or
  --| NO_FILENAME if there isn't an entry for the package.

    TABLE_ENTRY  : TABLE_ENTRY_RECORD;
    ENTRY_EXISTS : BOOLEAN := FALSE;

  begin

    GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME, TABLE_ENTRY, ENTRY_EXISTS);

    if not ENTRY_EXISTS then
      return NO_FILENAME;
    else
      return TABLE_ENTRY.PACKAGE_FILENAME;
    end if;

  end GET_FILENAME_PREFIX;

  -------------------------------------------------------------------------


end SD_BUFFER_FILES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--CATALOG.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO; use TEXT_IO;
with LISTS;
with STRING_PKG; use STRING_PKG;
with SYSTEM_PARAMETERS; use SYSTEM_PARAMETERS;

package CATALOG_PKG is

--| Overview
--| This package contains cataloging procedures needed by the debugger
--| for source file tracing.  The Source Instrumenter prepares programs
--| for use with the debugger.
--|
--| A procedure is supplied for storing the indicated source file in the
--| library creating a unique name for cataloging.  Another procedure is
--| provided for deleting the file from the library removing the
--| corrosponding reference in the catalog.
--|
--| A file is created for each compilation_unit to contain the listing
--| file needed by the debugger for display.  The procedures in this
--| package manage these files.  A table which equates a unique filename
--| prefix with each package name is maintained in an external file.
--|
--| Requires
--| The following declarations for file naming are used:
--|
--| "File_Prefix_Limit" is currently set to 8 characters, and indicates
--| the number of characters in a filename to the left of the dot.
--|
--| "File_Suffix_Limit" is currently set to 4 characters; a dot and
--| a 3 character file extension.
--|
--| N/A: Errors, Raises, Modifies


--------------------------------------------------------------------------

  PUBLIC_FILE        : FILE_TYPE;
  --| the corresponding package body

  PUBLIC_FILE_SUFFIX : constant STRING(1 .. FILE_SUFFIX_LIMIT) :=
                       CATALOG_FILENAME_EXTENSION;

  EXTERNAL_FILENAME  : constant STRING := PROGRAM_LIBRARY_CATALOG;

  subtype FILENAME_PREFIX_STRING is STRING(1 .. FILE_PREFIX_LIMIT);

  ----------------------------------------------------------------------------
  -- The following procedures manage the package tracing files.
  ----------------------------------------------------------------------------

  function CATALOG_FILE(PACKAGE_NAME : in STRING) return
           FILENAME_PREFIX_STRING;

  --| Effects

  --| This procedure obtains a filename prefix based on the current package
  --| name, appends the appropriate suffix, and creates the Text_IO files.
  --| The source instrumenter saves package tracing information in these files.

  ----------------------------------------------------------------------------

  procedure REMOVE_CATALOG_FILE(PACKAGE_NAME : in STRING);

  --| Effects

  --| This procedure determines the name of the external files if the
  --| Current_Filename_Prefix is not already known, and deletes the
  --| files if they exist.

  -----------------------------------------------------------------------------

end CATALOG_PKG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--CATALOG.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with CALENDAR;
with TIME_LIBRARY_1; use TIME_LIBRARY_1;

package body CATALOG_PKG is

  subtype DATE_STRING is STRING(1 .. 8);
  subtype TIME_STRING is STRING(1 .. 8);

  NO_DATE     : constant DATE_STRING := (others => ' ');
  NO_TIME     : constant TIME_STRING := (others => ' ');
  NO_NAME     : constant STRING_PKG.STRING_TYPE := CREATE("");

  NO_FILENAME : constant FILENAME_PREFIX_STRING := (others => ' ');

  type TABLE_ENTRY_RECORD is  --| Record format for table entries
    record
      PACKAGE_ADA_NAME : STRING_PKG.STRING_TYPE := NO_NAME;
      --| Fully qualified package name
      PACKAGE_FILENAME : FILENAME_PREFIX_STRING := NO_FILENAME;
      --| Filename prefix
      DATE_CREATED     : DATE_STRING := NO_DATE;
      --| Date the file was created
      TIME_CREATED     : TIME_STRING := NO_TIME;
      --| Time the file was created
    end record;

  -- Function EQUAL for the instantiation of the Lists package
  function TABLE_EQUAL(X, Y : in TABLE_ENTRY_RECORD) return BOOLEAN;

  package INTERNAL_LIST_PACKAGE is
    new LISTS(TABLE_ENTRY_RECORD, TABLE_EQUAL);
  use INTERNAL_LIST_PACKAGE;

  INTERNAL_TABLE         : INTERNAL_LIST_PACKAGE.LIST;
  --| A linked list of table entry records, for equating package names
  --| with their filename prefix for instrumenting information files.  The
  --| list is built by reading the external file.

  INTERNAL_TABLE_CREATED : BOOLEAN := FALSE;
  INTERNAL_TABLE_CHANGED : BOOLEAN := FALSE;

  EXTERNAL_FILE          : TEXT_IO.FILE_TYPE;
  --| The external file of package name, filename prefix information.
  --| The internal table is written to the external file each time a
  --| change occurs.

  TERMINATOR             : constant CHARACTER := '*';
  --| Mark the end of a table_entry_record field in the external file

  subtype LONG_STRING is STRING(1 .. 255);
  --| Used for reading a line of text from one of the files.  It is
  --| assumed that most lines will be less than 255 characters and
  --| this choice should be adequate most of the time.  Procedures
  --| which do the reading must allow for cases where lines are longer
  --| than 255.


  ------------------------------------------------------------------------
  --  Local procedure specificatons
  -------------------------------------------------------------------------

  procedure CREATE_INTERNAL_TABLE;

  --| overview
  --| Reads the external file and builds an internal version of it
  --| as a linked list.

  --------------------------------------------------------------------------

  function FILENAME_IN_TABLE(FILENAME : in FILENAME_PREFIX_STRING) return
    BOOLEAN;

  --| overview
  --| Searches the Internal_Table for the occurrence of the
  --| specified filename prefix.

  ----------------------------------------------------------------------------

  function MAKE_FILENAME_PREFIX(PACKAGE_NAME : in STRING) return
    FILENAME_PREFIX_STRING;

  --| overview
  --| Formulates and returns a unique filename prefix for each package name.

  ----------------------------------------------------------------------------

  function GET_FIXED_LENGTH_TABLE_ENTRY(LENGTH : in POSITIVE) return STRING;

  --| overview
  --| Retuns a string of the next "length" characters read from the
  --| external file.

  ----------------------------------------------------------------------------

  function GET_VARIABLE_LENGTH_TABLE_ENTRY return STRING_TYPE;

  --| overview
  --| Reads any number of characters in the external file until the
  --| terminator character ('*') is found and returns them as a string_type.

  ----------------------------------------------------------------------------

  procedure GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME : in STRING;
                                     TABLE_ENTRY  : out TABLE_ENTRY_RECORD;
                                     FOUND        : in out BOOLEAN);

  --| overview
  --| Scan the internal table for an entry for Package_Name,
  --| and if found, pass it back to the calling procedure.

  ---------------------------------------------------------

  function GET_FILENAME_PREFIX(PACKAGE_NAME : in STRING)
           return FILENAME_PREFIX_STRING;

  --| overview
  --| If the package is in the table, return its filename prefix.  If
  --| there isn't an entry return No_Filename.

  ---------------------------------------------------------

  procedure DELETE_INTERNAL_TABLE_ENTRY(PACKAGE_NAME : in STRING);

  --| overview
  --| Delete the entry for this package from the Internal_Table.

  ---------------------------------------------------------

  procedure SAVE_EXTERNAL_FILE;

  --| effects
  --| This procedure writes the internal table of package_name-file_name
  --| information to the permanent external table file.

  ---------------------------------------------------------------
  --  External procedures for managing the package tracing files.
  ---------------------------------------------------------------

  function CATALOG_FILE(PACKAGE_NAME : in STRING)
           return FILENAME_PREFIX_STRING is

    --| overview
    --| Create a table entry for the package and return its unique
    --| filename prefix.

    ENTRY_EXISTS          : BOOLEAN := FALSE;
    CURRENT_TABLE_ENTRY   : TABLE_ENTRY_RECORD;
    CURRENT_DATE_AND_TIME : CALENDAR.TIME;
    CURRENT_DATE          : DATE_STRING;
    CURRENT_TIME          : STRING(1 .. 11);

  begin

    GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME, CURRENT_TABLE_ENTRY, ENTRY_EXISTS);

    if not ENTRY_EXISTS then
      CURRENT_TABLE_ENTRY.PACKAGE_ADA_NAME := MAKE_PERSISTENT(UPPER(PACKAGE_NAME
        ));
      CURRENT_TABLE_ENTRY.PACKAGE_FILENAME := MAKE_FILENAME_PREFIX(PACKAGE_NAME)
        ;
    else
    -- If the table entry exists, delete it so a new one can be added
    -- with updated date and time fields.
      DELETEITEM(INTERNAL_TABLE, CURRENT_TABLE_ENTRY);

    end if;

    CURRENT_DATE_AND_TIME := CALENDAR.CLOCK;
    CURRENT_DATE := DATE_OF(CALENDAR.CLOCK);
    CURRENT_TIME := WALL_CLOCK_OF(CALENDAR.SECONDS(CURRENT_DATE_AND_TIME));

    CURRENT_TABLE_ENTRY.DATE_CREATED := CURRENT_DATE;
    CURRENT_TABLE_ENTRY.TIME_CREATED := CURRENT_TIME(1 .. TIME_STRING'LENGTH);

    ATTACH(INTERNAL_TABLE, CURRENT_TABLE_ENTRY);
    INTERNAL_TABLE_CHANGED := TRUE;

    SAVE_EXTERNAL_FILE;
    return CURRENT_TABLE_ENTRY.PACKAGE_FILENAME;

  end CATALOG_FILE;

  ---------------------------------------------------------

  procedure REMOVE_CATALOG_FILE(PACKAGE_NAME : in STRING) is

    --| overview
    --| Delete the indicated set of package tracing files.  If all the
    --| files are deleted, then also delete the internal table entry for
    --| the package.

    CATALOG_FILE            : FILE_TYPE;
    PACKAGE_FILENAME_PREFIX : FILENAME_PREFIX_STRING;

  begin

    PACKAGE_FILENAME_PREFIX := GET_FILENAME_PREFIX(PACKAGE_NAME);

    -- if the files can be opened, then they exist.  Delete them.
    -- Otherwise, there is nothing to delete so ignore it.

    if PACKAGE_FILENAME_PREFIX /= NO_FILENAME then

      begin
        OPEN(CATALOG_FILE, OUT_FILE, VALUE(CURRENT_PROGRAM_LIBRARY)
           & PACKAGE_FILENAME_PREFIX
          & PUBLIC_FILE_SUFFIX);
        DELETE(CATALOG_FILE);

      exception
        when NAME_ERROR =>
          null;

      end;

      DELETE_INTERNAL_TABLE_ENTRY(PACKAGE_NAME);
      SAVE_EXTERNAL_FILE;

    end if;

  -- Filename /= No_Filename
  end REMOVE_CATALOG_FILE;

  ------------------------------------------------------------------------
  --  Local procedure bodies
  -------------------------------------------------------------------------

  procedure SAVE_EXTERNAL_FILE is

  --| overview
  --| Write the internal table list to the extenal file if it has changed.

    TABLE_POINTER : INTERNAL_LIST_PACKAGE.LISTITER;
    TABLE_ENTRY   : TABLE_ENTRY_RECORD;

  begin

    if INTERNAL_TABLE_CREATED and INTERNAL_TABLE_CHANGED then
      begin
        OPEN(EXTERNAL_FILE, OUT_FILE, VALUE(CURRENT_PROGRAM_LIBRARY)
             & EXTERNAL_FILENAME);
        RESET(EXTERNAL_FILE);
      exception
        when TEXT_IO.NAME_ERROR =>
          CREATE(EXTERNAL_FILE, OUT_FILE, VALUE(CURRENT_PROGRAM_LIBRARY)
               & EXTERNAL_FILENAME)
            ;
      end;

      TABLE_POINTER := MAKELISTITER(INTERNAL_TABLE);

      while MORE(TABLE_POINTER) loop
        NEXT(TABLE_POINTER, TABLE_ENTRY);

        PUT(EXTERNAL_FILE, VALUE(TABLE_ENTRY.PACKAGE_ADA_NAME));
        PUT(EXTERNAL_FILE, TERMINATOR);

        PUT(EXTERNAL_FILE, TABLE_ENTRY.PACKAGE_FILENAME);
        PUT(EXTERNAL_FILE, TERMINATOR);

        PUT(EXTERNAL_FILE, TABLE_ENTRY.DATE_CREATED);
        PUT(EXTERNAL_FILE, TERMINATOR);

        PUT(EXTERNAL_FILE, TABLE_ENTRY.TIME_CREATED);
        PUT(EXTERNAL_FILE, TERMINATOR);
        NEW_LINE(EXTERNAL_FILE);
      end loop;

      if ISEMPTY(INTERNAL_TABLE) then
        DELETE(EXTERNAL_FILE);
      else
        CLOSE(EXTERNAL_FILE);
      end if;

      INTERNAL_LIST_PACKAGE.DESTROY(INTERNAL_TABLE);
      INTERNAL_TABLE_CREATED := FALSE;
      INTERNAL_TABLE_CHANGED := FALSE;
    end if;
  end SAVE_EXTERNAL_FILE;

  -----------------------------------------------------------------------------

  procedure CREATE_INTERNAL_TABLE is

    --| overview
    --| Read the external file and build an internal version of it
    --| as a linked list.

    TABLE_ENTRY : TABLE_ENTRY_RECORD;

  begin

    INTERNAL_TABLE := INTERNAL_LIST_PACKAGE.CREATE;
    TEXT_IO.OPEN(EXTERNAL_FILE, IN_FILE, VALUE(CURRENT_PROGRAM_LIBRARY)
          & EXTERNAL_FILENAME)
      ;

    while not TEXT_IO.END_OF_FILE(EXTERNAL_FILE) loop
      TABLE_ENTRY.PACKAGE_ADA_NAME := MAKE_PERSISTENT(
        GET_VARIABLE_LENGTH_TABLE_ENTRY);
      TABLE_ENTRY.PACKAGE_FILENAME := GET_FIXED_LENGTH_TABLE_ENTRY(
        FILE_PREFIX_LIMIT);
      TABLE_ENTRY.DATE_CREATED := GET_FIXED_LENGTH_TABLE_ENTRY(DATE_STRING'
        LENGTH);
      TABLE_ENTRY.TIME_CREATED := GET_FIXED_LENGTH_TABLE_ENTRY(TIME_STRING'
        LENGTH);
      TEXT_IO.SKIP_LINE(EXTERNAL_FILE);
      ATTACH(INTERNAL_TABLE, TABLE_ENTRY);
    end loop;

    INTERNAL_TABLE_CREATED := TRUE;
    TEXT_IO.CLOSE(EXTERNAL_FILE);

  exception
    when TEXT_IO.NAME_ERROR =>
      INTERNAL_TABLE_CREATED := TRUE;

  end CREATE_INTERNAL_TABLE;

  ---------------------------------------------------------

  function FILENAME_IN_TABLE(FILENAME : in FILENAME_PREFIX_STRING)
           return BOOLEAN is

    --| overview
    --| Search the Internal_Table to see if the filename prefix
    --| string already exists.

    TABLE_POINTER : INTERNAL_LIST_PACKAGE.LISTITER;
    TABLE_ENTRY   : TABLE_ENTRY_RECORD;

  begin

    TABLE_POINTER := INTERNAL_LIST_PACKAGE.MAKELISTITER(INTERNAL_TABLE);

    while MORE(TABLE_POINTER) loop
      NEXT(TABLE_POINTER, TABLE_ENTRY);
      if TABLE_ENTRY.PACKAGE_FILENAME = FILENAME then
        return TRUE;
      end if;
    end loop;

    return FALSE;

  end FILENAME_IN_TABLE;

  ---------------------------------------------------------

  function MAKE_FILENAME_PREFIX(PACKAGE_NAME : in STRING)
           return FILENAME_PREFIX_STRING is

  --| overview
  --| Formulate a unique filename prefix for each package name.

  TEMP, FILENAME_STRING : FILENAME_PREFIX_STRING := (others => 'X');
  FILENAME_INDEX        : NATURAL := 1;
  subtype A_TO_Z is CHARACTER range 'A' .. 'Z';
  NUMBER_OF_TRIES       : INTEGER := 1;

  function NEXT_CHARACTER(CH : in CHARACTER) return A_TO_Z is

  begin
    if CH not in A_TO_Z or else CH = A_TO_Z'LAST then
      return A_TO_Z'FIRST;
    else
      return A_TO_Z'SUCC(CH);
    end if;
  end NEXT_CHARACTER;

  begin

  -- Extract the first "file_prefix_limit" characters from the
  -- package name to form the basic prefix of the filename.

    for I in 1 .. PACKAGE_NAME'LENGTH loop
      if PACKAGE_NAME(I) /= '_' and PACKAGE_NAME(I) /= '.' then
        FILENAME_STRING(FILENAME_INDEX) := PACKAGE_NAME(I);
        FILENAME_INDEX := FILENAME_INDEX + 1;
        exit when FILENAME_INDEX > FILE_PREFIX_LIMIT;
      end if;
    end loop;

    --  Now check the Internal_Table to be sure that the Filename_String
    --  is unique.  If not, try all permutations of A to Z until a unique
    --  name is found.  This scheme allows 26**8 unique names.

    TEMP := FILENAME_STRING;
    loop
      if not FILENAME_IN_TABLE(TEMP) then
         return TEMP;
      end if;
      for I in reverse 1 .. FILE_PREFIX_LIMIT loop
        TEMP(I) := NEXT_CHARACTER(TEMP(I));
        exit when NUMBER_OF_TRIES < 26;
        NUMBER_OF_TRIES := 1;
      end loop;
      NUMBER_OF_TRIES := NUMBER_OF_TRIES + 1;
      exit when TEMP = FILENAME_STRING;
    end loop;

  end MAKE_FILENAME_PREFIX;

  ---------------------------------------------------------

  procedure GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME : in STRING;
                                     TABLE_ENTRY  : out TABLE_ENTRY_RECORD;
                                     FOUND        : in out BOOLEAN) is

    ITERATOR      : INTERNAL_LIST_PACKAGE.LISTITER;
    NEXT_ENTRY    : TABLE_ENTRY_RECORD;
    NAME_TO_MATCH : STRING_PKG.STRING_TYPE;

  begin

    if not INTERNAL_TABLE_CREATED then
      CREATE_INTERNAL_TABLE;
    end if;

    STRING_PKG.MARK;
    NAME_TO_MATCH := UPPER(PACKAGE_NAME);

    TABLE_ENTRY := NEXT_ENTRY;
    FOUND := FALSE;

    ITERATOR := INTERNAL_LIST_PACKAGE.MAKELISTITER(INTERNAL_TABLE);
    while MORE(ITERATOR) and not FOUND loop
      NEXT(ITERATOR, NEXT_ENTRY);
      if EQUAL(NEXT_ENTRY.PACKAGE_ADA_NAME, NAME_TO_MATCH) then
        TABLE_ENTRY := NEXT_ENTRY;
        FOUND := TRUE;
      end if;
    end loop;

    STRING_PKG.RELEASE;

  end GET_INTERNAL_TABLE_ENTRY;

  ---------------------------------------------------------

  function GET_FILENAME_PREFIX(PACKAGE_NAME : in STRING)
           return FILENAME_PREFIX_STRING is

    --| overview
    --| Return the filename prefix for the specified package, or
    --| NO_FILENAME if there isn't an entry for the package.

    TABLE_ENTRY  : TABLE_ENTRY_RECORD;
    ENTRY_EXISTS : BOOLEAN := FALSE;

  begin

    GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME, TABLE_ENTRY, ENTRY_EXISTS);

    if not ENTRY_EXISTS then
      return NO_FILENAME;
    else
      return TABLE_ENTRY.PACKAGE_FILENAME;
    end if;

  end GET_FILENAME_PREFIX;

  -------------------------------------------------------------------------

  procedure DELETE_INTERNAL_TABLE_ENTRY(PACKAGE_NAME : in STRING) is

    --| overview
    --| Delete an entry from the internal table.

    TABLE_ENTRY  : TABLE_ENTRY_RECORD;
    ENTRY_EXISTS : BOOLEAN := FALSE;

  begin

    GET_INTERNAL_TABLE_ENTRY(PACKAGE_NAME, TABLE_ENTRY, ENTRY_EXISTS);

    if ENTRY_EXISTS then
      DELETEITEM(INTERNAL_TABLE, TABLE_ENTRY);
      INTERNAL_TABLE_CHANGED := TRUE;
    end if;

  end DELETE_INTERNAL_TABLE_ENTRY;

  -----------------------------------------------------------

  function GET_FIXED_LENGTH_TABLE_ENTRY(LENGTH : in POSITIVE) return STRING is

    --| overview
    --| Read the next LENGTH characters from the external file and
    --| return them as a string.

    RETURN_STRING : STRING(1 .. LENGTH);
    CH            : CHARACTER;
    INDEX         : POSITIVE;

  begin
    for I in RETURN_STRING'range loop
      GET(EXTERNAL_FILE, CH);
      RETURN_STRING(I) := CH;
    end loop;

    -- read past the terminator
    if CH /= TERMINATOR then
      GET(EXTERNAL_FILE, CH);
    end if;

    return RETURN_STRING;

  end GET_FIXED_LENGTH_TABLE_ENTRY;

  ----------------------------------------------------------------------

  function GET_VARIABLE_LENGTH_TABLE_ENTRY return STRING_TYPE is

    --| overview
    --| Scan the external file until a terminator ('*') is found and
    --| return a string_type of the characters scanned.

    RETURN_STRING : STRING_TYPE;
    CH            : CHARACTER := ' ';
    TMP_STRING    : LONG_STRING;
    INDEX         : NATURAL := 0;

  begin
    RETURN_STRING := CREATE("");
    while CH /= TERMINATOR loop

      for I in LONG_STRING'range loop
        GET(EXTERNAL_FILE, CH);
        exit when CH = TERMINATOR;
        INDEX := I;
        TMP_STRING(INDEX) := CH;
      end loop;

      RETURN_STRING := RETURN_STRING & CREATE(TMP_STRING(1 .. INDEX));

    end loop;

    return RETURN_STRING;

  end GET_VARIABLE_LENGTH_TABLE_ENTRY;

  ----------------------------------------------------------------------

  function TABLE_EQUAL(X, Y : in TABLE_ENTRY_RECORD) return BOOLEAN is

  begin
    return EQUAL(X.PACKAGE_ADA_NAME, Y.PACKAGE_ADA_NAME) and then X.
      PACKAGE_FILENAME = Y.PACKAGE_FILENAME and then X.DATE_CREATED = Y.
      DATE_CREATED and then X.TIME_CREATED = Y.TIME_CREATED;
  end TABLE_EQUAL;

---------------------------------------------------------------------
end CATALOG_PKG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SRCBUFF.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

package SD_SOURCE_BUFFERING is

  -- These procedures are used in conjunction with the procedures in
  -- SD_BUFFER_FILES to insure that all lines being added to the
  -- instrumented source file are no longer than MAX_SOURCE_LINE_LENGTH.
  -- There are many times when the length of a line might exceed this
  -- limit, as for example, when the fully qualified name of the
  -- current scope is prepended to a variable name in the scope.

  -- If a line is going to be too long, it is wrapped around to the
  -- next line at an appropriate place.  If we are in the middle of
  -- a string literal, a closing quote, ampersand, and beginning quote
  -- on the next line are added.

  -- When a line is ready to be written, it is passed to the
  -- SD_BUFFER_FILES package if it is not something that can be
  -- written directly to the instrumented source at this time.

  -- The spec buffer is used to format subprogram declaration and
  -- package specifications.

  -- The body buffer is used to format code that is part of subprogram
  -- and package bodies added for variable tracing.

  -- The source buffer is used to format code that will go directly
  -- into the instrumented source.

  ------------------------------------------------------------------

  procedure WRITE_BODY_BUFFER(SOURCE : in STRING);

  -- Add SOURCE to the body buffer.  The buffer is only written out
  -- when it is full.

  ------------------------------------------------------------------

  procedure WRITE_LINE_BODY_BUFFER(SOURCE : in STRING);

  -- This first calls WRITE_BODY_BUFFER and then writes out the buffer.

  ------------------------------------------------------------------

  procedure WRITE_SPEC_BUFFER(SOURCE : in STRING);

  -- Add SOURCE to the spec buffer. The buffer is only written out
  -- when it is full.

  ------------------------------------------------------------------

  procedure WRITE_LINE_SPEC_BUFFER(SOURCE : in STRING);

  -- This first calls WRITE_SPEC_BUFFER, and then writes out the buffer.

  ------------------------------------------------------------------

  procedure WRITE_INST_SOURCE(SOURCE : in STRING);

  -- Add SOURCE to the source buffer.  The buffer is only written out
  -- when it is full.

  ------------------------------------------------------------------

  procedure WRITE_LINE_INST_SOURCE(SOURCE : in STRING);

  -- This first calls WRIT_INST_SOURCE and then writes the buffer
  -- directly to the instrumented source file.

  ------------------------------------------------------------------

  procedure CLEAR_SOURCE_BUFFER;

  -- Write out the current source buffer, but don't add a carriage
  -- return to the instrumented source.

  ------------------------------------------------------------------

end SD_SOURCE_BUFFERING;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SRCBUFF.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


with TEXT_IO; use TEXT_IO;
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with STRING_UTILITIES; use STRING_UTILITIES;
with SCOPE_PACKAGE; use SCOPE_PACKAGE;
with SD_BUFFER_FILES; use SD_BUFFER_FILES;

package body SD_SOURCE_BUFFERING is

  type BUFFER_INDICATOR is (SPC, BDY, SRC);
  type BUFFER_REC(WHICH_BUFFER : BUFFER_INDICATOR) is
    record
      TEXT  : SOURCE_LINE_BUFFER := BLANK_LINE;
      INDEX : NATURAL range 0 .. SOURCE_LINE_BUFFER'LAST := 0;
    end record;

  SPEC_BUFFER   : BUFFER_REC(SPC);
  BODY_BUFFER   : BUFFER_REC(BDY);
  SOURCE_BUFFER : BUFFER_REC(SRC);

  -----------------------------------------------------------------------------
  -- Local subprogram specifications --
  -----------------------------------------------------------------------------

  -----------------------------------------------------------------------------

  function IS_DOUBLE_DELIMITER(SOURCE : in STRING;
                               INDEX  : in NATURAL) return BOOLEAN;

  -- This is checked when looking for a place to break a line.  Don't
  -- break it in the middle of a double delimiter.

  -----------------------------------------------------------------------------

  function IS_CHARACTER_LITERAL(SOURCE : in STRING;
                                INDEX  : in NATURAL) return BOOLEAN;


  -- This is checked when looking for a place to break a line.  Don't
  -- break it in the middle of a character literal.

  -----------------------------------------------------------------------------

  function FIND_WRAP_POINT(DELIMITERS : in STRING;
                           LINE       : in STRING) return NATURAL;

  -- Find the best place to break the LINE.  The characters in the
  -- DELIMITERS parameter are what to look for in determining the
  -- best wrap point.

  -----------------------------------------------------------------------------
  procedure WRITE_BUFFER(BUFFER : in out BUFFER_REC);

  -- Write the contents of the indicated buffer to either the instrumented
  -- source file or to one of the buffer files in SD_BUFFER_FILES.

  -----------------------------------------------------------------------------

  procedure ADD_TO_BUFFER(SOURCE : in STRING;
                          BUFFER : in out BUFFER_REC);

  -- Add the SOURCE string to the indicated buffer, and update the buffer
  -- index.  It has already been determined that there is enough room in
  -- the buffer for SOURCE.

  -----------------------------------------------------------------------------

  procedure BUFFER_LINE(LINE   : in STRING;
                        BUFFER : in out BUFFER_REC);

  -- Add LINE to the indicated buffer, breaking it at appropriate places if
  -- it won't all fit in the room left.

  -----------------------------------------------------------------------------

  procedure BUFFER_STRING(SOURCE : in STRING;
                          BUFFER : in out BUFFER_REC);

  -- Add the string literal SOURCE to the indicated buffer, breaking it at
  -- appropriate places if it won't all fit in the room left.

  -----------------------------------------------------------------------------

  -----------------------------------------------------------------------------
  -- External subprogram bodies --
  -----------------------------------------------------------------------------

  procedure WRITE_BODY_BUFFER(SOURCE : in STRING) is

    -- Add SOURCE to the body buffer

    QUOTE1, QUOTE2 : NATURAL;
  begin
    if SOURCE'LENGTH <= BODY_BUFFER.TEXT'LAST - BODY_BUFFER.INDEX then
      -- It will fit, so add it to the buffer and return.
      ADD_TO_BUFFER(SOURCE, BODY_BUFFER);
      return;
    else
      -- if SOURCE contains a literal string then it has to be
      -- buffered separately.  Buffer everything up to the first
      -- quote as a regular line, then buffer the string, the
      -- call this procedure again to buffer the rest of it.
      QUOTE1 := POSITION_OF('"', SOURCE);
      if QUOTE1 >= SOURCE'FIRST then
        QUOTE2 := POSITION_OF('"', SOURCE(QUOTE1 + 1 .. SOURCE'LAST));
        BUFFER_LINE(SOURCE(SOURCE'FIRST .. QUOTE1 - 1), BODY_BUFFER);
        BUFFER_STRING(SOURCE(QUOTE1 .. QUOTE2), BODY_BUFFER);
        WRITE_BODY_BUFFER(SOURCE(QUOTE2 + 1 .. SOURCE'LAST));
      else
        -- no string literals are involved
        BUFFER_LINE(SOURCE, BODY_BUFFER);
      end if;
    end if;
  end WRITE_BODY_BUFFER;

  -----------------------------------------------------------------------------
  procedure WRITE_LINE_BODY_BUFFER(SOURCE : in STRING) is

    -- Buffer SOURCE and then write out the body buffer.

  begin
    WRITE_BODY_BUFFER(SOURCE);
    WRITE_BUFFER(BODY_BUFFER);
  end WRITE_LINE_BODY_BUFFER;

  -----------------------------------------------------------------------------
  procedure WRITE_SPEC_BUFFER(SOURCE : in STRING) is

    -- This works the same way as WRITE_BODY_BUFFER, except that the
    -- spec buffer is the parameter passed to local processing procedures
    -- instead of the body buffer.

    QUOTE1, QUOTE2 : NATURAL;
  begin
    if SOURCE'LENGTH <= SPEC_BUFFER.TEXT'LAST - SPEC_BUFFER.INDEX  then
      ADD_TO_BUFFER(SOURCE, SPEC_BUFFER);
      return;
    else
      QUOTE1 := POSITION_OF('"', SOURCE);
      if QUOTE1 >= SOURCE'FIRST then
        QUOTE2 := POSITION_OF('"', SOURCE(QUOTE1 + 1 .. SOURCE'LAST));
        BUFFER_LINE(SOURCE(SOURCE'FIRST .. QUOTE1 - 1), SPEC_BUFFER);
        BUFFER_STRING(SOURCE(QUOTE1 .. QUOTE2), SPEC_BUFFER);
        WRITE_SPEC_BUFFER(SOURCE(QUOTE2 + 1 .. SOURCE'LAST));
      else
        BUFFER_LINE(SOURCE, SPEC_BUFFER);
      end if;
    end if;
  end WRITE_SPEC_BUFFER;

  -----------------------------------------------------------------------------
  procedure WRITE_LINE_SPEC_BUFFER(SOURCE : in STRING) is

    -- Buffer SOURCE and then write out the spec buffer.

  begin
    WRITE_SPEC_BUFFER(SOURCE);
    WRITE_BUFFER(SPEC_BUFFER);
  end WRITE_LINE_SPEC_BUFFER;

  -----------------------------------------------------------------------------
  procedure WRITE_INST_SOURCE(SOURCE : in STRING) is

    -- This works the same way as WRITE_BODY_BUFFER, except that the
    -- source buffer is the parameter passed to local processing procedures
    -- instead of the body buffer.

    QUOTE1, QUOTE2 : NATURAL;
  begin
    if SOURCE'LENGTH <= SOURCE_BUFFER.TEXT'LAST - SOURCE_BUFFER.INDEX then
      ADD_TO_BUFFER(SOURCE, SOURCE_BUFFER);
      return;
    else
      QUOTE1 := POSITION_OF('"', SOURCE);
      if QUOTE1 >= SOURCE'FIRST then
        QUOTE2 := POSITION_OF('"', SOURCE(QUOTE1 + 1 .. SOURCE'LAST));
        BUFFER_LINE(SOURCE(SOURCE'FIRST .. QUOTE1 - 1), SOURCE_BUFFER);
        BUFFER_STRING(SOURCE(QUOTE1 .. QUOTE2), SOURCE_BUFFER);
        WRITE_INST_SOURCE(SOURCE(QUOTE2 + 1 .. SOURCE'LAST));
      else
        BUFFER_LINE(SOURCE, SOURCE_BUFFER);
      end if;
    end if;
  end WRITE_INST_SOURCE;

  -----------------------------------------------------------------------------
  procedure WRITE_LINE_INST_SOURCE(SOURCE : in STRING) is

    -- Buffer SOURCE and then write out the source buffer.

  begin
    WRITE_INST_SOURCE(SOURCE);
    WRITE_BUFFER(SOURCE_BUFFER);
  end WRITE_LINE_INST_SOURCE;

  -----------------------------------------------------------------------------
  procedure CLEAR_SOURCE_BUFFER is

    -- If there is anything in the source buffer, write it to the instrumented
    -- file and clear the source buffer.  Do not write a carriage return to
    -- the instrumented source.

  begin
    if SOURCE_BUFFER.INDEX > 0 THEN
      TEXT_IO.PUT(INSTRUMENTED_FILE,
                  SOURCE_BUFFER.TEXT(1..SOURCE_BUFFER.INDEX));
      SOURCE_BUFFER.TEXT := BLANK_LINE;
      SOURCE_BUFFER.INDEX := 0;
    end if;
  end CLEAR_SOURCE_BUFFER;

  -----------------------------------------------------------------------------
  -- Local subprogram bodies --
  -----------------------------------------------------------------------------

  -----------------------------------------------------------------------------
  function IS_DOUBLE_DELIMITER(SOURCE : in STRING;
                               INDEX  : in NATURAL) return BOOLEAN is
    S2     : STRING(1 .. 2);
    RESULT : BOOLEAN := FALSE;
  begin
    if INDEX < SOURCE'LAST then
      S2 := SOURCE(INDEX .. INDEX + 1);
      RESULT := S2 = ".." or else
                S2 = ":=" or else
                S2 = "/=" or else
                S2 = ">=" or else
                S2 = "<=" or else
                S2 = "<>" or else
                S2 = "<<" or else
                S2 = ">>" or else
                S2 = "**";
    end if;
    return RESULT;
  end IS_DOUBLE_DELIMITER;

  -----------------------------------------------------------------------------
  function IS_CHARACTER_LITERAL(SOURCE : in STRING;
                                INDEX  : in NATURAL) return BOOLEAN is
    RESULT : BOOLEAN := FALSE;
  begin
    if INDEX > SOURCE'FIRST and then INDEX < SOURCE'LAST then
      RESULT := SOURCE(INDEX - 1) = ''' and SOURCE(INDEX + 1) = ''';
    end if;
    return RESULT;
  end IS_CHARACTER_LITERAL;

  -----------------------------------------------------------------------------
  function FIND_WRAP_POINT(DELIMITERS : in STRING;
                           LINE       : in STRING) return NATURAL is

    -- Scan LINE backwards looking for each character in DELIMITERS.
    -- Return the highest index found, so that we can put as much of
    -- LINE as possible into the current buffer.  If no delimeters
    -- are found, return LINE'FIRST - 1.

    BEST_SO_FAR : NATURAL := LINE'FIRST - 1;
    INDEX       : NATURAL;
  begin
    for I in DELIMITERS'RANGE loop
      INDEX := POSITION_OF_REVERSE(DELIMITERS(I), LINE);
      if INDEX > BEST_SO_FAR and then
         not IS_DOUBLE_DELIMITER(LINE, INDEX) and then
         not IS_CHARACTER_LITERAL(LINE, INDEX) then
           BEST_SO_FAR := INDEX;
      end if;
    end loop;
    return BEST_SO_FAR;
  end FIND_WRAP_POINT;

  -----------------------------------------------------------------------------
  procedure WRITE_BUFFER(BUFFER : in out BUFFER_REC) is
  begin
    if BUFFER.WHICH_BUFFER = SRC then
      -- write it directly to the instrumented source file
      TEXT_IO.PUT_LINE(INSTRUMENTED_FILE, BUFFER.TEXT(1 .. BUFFER.INDEX));

    elsif BUFFER.WHICH_BUFFER = BDY then
      if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
        -- Add it to the package bodies being created for tracing the
        -- current package specification
        if CURRENT_SCOPE.IN_PRIVATE_PART then
          SD_BUFFER_FILES.WRITELN_TO_BUFFER(PRIVATE_BODY_FILE, BUFFER.TEXT);
        else
          SD_BUFFER_FILES.WRITELN_TO_BUFFER(PUBLIC_BODY_FILE, BUFFER.TEXT);
        end if;
      else
        -- This is not for a package spec, so write it to the temporary
        -- buffer, which is written to the instrumented source file at
        -- the end of the current declarative part.
        SD_BUFFER_FILES.WRITELN_TO_BUFFER(BUFFER_FILE, BUFFER.TEXT);
      end if;

    else -- buffer = spec buffer

      if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
        -- Add it to the package specs being created for tracing the
        -- current package specification
        if CURRENT_SCOPE.IN_PRIVATE_PART then
          SD_BUFFER_FILES.WRITELN_TO_BUFFER(PRIVATE_SPEC_FILE, BUFFER.TEXT);
        else
          SD_BUFFER_FILES.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE, BUFFER.TEXT);
        end if;
      else
        -- Write the buffer directly to the instrumented source file.
        TEXT_IO.PUT_LINE(INSTRUMENTED_FILE, BUFFER.TEXT(1 .. BUFFER.INDEX));
      end if;
    end if;

    BUFFER.TEXT := BLANK_LINE;
    BUFFER.INDEX := 0;
  end WRITE_BUFFER;

  -----------------------------------------------------------------------------
  procedure ADD_TO_BUFFER(SOURCE : in STRING;
                          BUFFER : in out BUFFER_REC) is
  begin
    BUFFER.TEXT(BUFFER.INDEX + 1 .. BUFFER.INDEX + SOURCE'LENGTH) := SOURCE;
    BUFFER.INDEX := BUFFER.INDEX + SOURCE'LENGTH;
  end ADD_TO_BUFFER;

  -----------------------------------------------------------------------------
  procedure BUFFER_LINE(LINE   : in STRING;
                        BUFFER : in out BUFFER_REC) is

    -- This is the procedure called by WRITE_BODY/SPEC/SOURCE_BUFFER to
    -- add the LINE to the specified buffer, wrapping the line and
    -- writing out the current contents of the buffer when necessary.

    LINE_INDEX  : POSITIVE := LINE'FIRST;
    LINE_LEFT   : NATURAL := LINE'LENGTH;
    BUFFER_LEFT : NATURAL;
    WRAP_POINT  : NATURAL;
    MAX_INDEX   : NATURAL;

  begin
    while LINE_INDEX <= LINE'LAST loop
      BUFFER_LEFT := BUFFER.TEXT'LAST - BUFFER.INDEX;
      if BUFFER_LEFT = 0 then
        WRITE_BUFFER(BUFFER);
      elsif LINE_LEFT <= BUFFER_LEFT then
        ADD_TO_BUFFER(LINE(LINE_INDEX .. LINE'LAST), BUFFER);
        return;
      else
        MAX_INDEX := LINE_INDEX + BUFFER_LEFT - 1;
        if IS_DOUBLE_DELIMITER(LINE, MAX_INDEX) or else
           IS_CHARACTER_LITERAL(LINE, MAX_INDEX) then
             MAX_INDEX := MAX_INDEX - 1;
        end if;
        WRAP_POINT := FIND_WRAP_POINT(" .,:();",
                                      LINE(LINE_INDEX .. MAX_INDEX));
        ADD_TO_BUFFER(LINE(LINE_INDEX .. WRAP_POINT), BUFFER);
        WRITE_BUFFER(BUFFER);
        LINE_INDEX := WRAP_POINT + 1;
        LINE_LEFT := LINE'LAST - WRAP_POINT;
      end if;
    end loop;
  end BUFFER_LINE;

  -----------------------------------------------------------------------------
  procedure BUFFER_STRING(SOURCE : in STRING;
                          BUFFER : in out BUFFER_REC) is

    -- This is the procedure called by WRITE_BODY/SPEC/SOURCE_BUFFER to
    -- add the a string literal to the specified buffer, concatenating
    -- the string over multiple lines when necessary.

    SOURCE_INDEX : POSITIVE := SOURCE'FIRST;
    WRAP_POINT   : NATURAL := SOURCE'FIRST;
    SOURCE_LEFT  : NATURAL := SOURCE'LENGTH;
    BUFFER_LEFT  : NATURAL := BUFFER.TEXT'LAST - BUFFER.INDEX;
    MAX_INDEX    : NATURAL;

  begin
    if BUFFER_LEFT <= 5 then
      -- We need to add 3 characters after the opening quote:
      -- a closing quote, a blank and an ampersand.  If there are only
      -- 5 spaces left, we could put only the first character of the
      -- string on this line.  Dump the buffer and start the string on
      -- the next line.
      WRITE_BUFFER(BUFFER);
      BUFFER_LEFT := BUFFER.TEXT'LAST - BUFFER.INDEX;
    end if;
    while SOURCE_INDEX < SOURCE'LAST loop
      if SOURCE_LEFT <= BUFFER_LEFT then
        ADD_TO_BUFFER(SOURCE(SOURCE_INDEX .. SOURCE'LAST), BUFFER);
        return;
      else
        MAX_INDEX := SOURCE_INDEX + BUFFER_LEFT - 4;
        -- allow room for the closing quote and ampersand.

        WRAP_POINT := FIND_WRAP_POINT(" ,.", SOURCE(SOURCE_INDEX .. MAX_INDEX));

        if WRAP_POINT < SOURCE_INDEX  then
          -- none of the delimiters were found, so we'll break the string
          -- in the middle of a word.
          WRAP_POINT := MAX_INDEX;
        end if;

        ADD_TO_BUFFER(SOURCE(SOURCE_INDEX .. WRAP_POINT) & """ &", BUFFER);
        WRITE_BUFFER(BUFFER);
        ADD_TO_BUFFER("""", BUFFER);
        SOURCE_INDEX := WRAP_POINT + 1;
        SOURCE_LEFT := SOURCE'LAST - SOURCE_INDEX;
        BUFFER_LEFT := BUFFER.TEXT'LAST - BUFFER.INDEX;
      end if;
    end loop;
  end BUFFER_STRING;
  -----------------------------------------------------------------------------

end SD_SOURCE_BUFFERING;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SYSDEP2.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

PACKAGE sysdep2 IS

  --|  The following two procedures are used by the virtual terminal
  --|  pacakge to set and reset the terminal characteristics. The
  --|  actual procedures are written in MACRO.  The OBJ for the procs
  --|  can be entered as the body for this package.

    FUNCTION setterminfo (chan : short_integer) RETURN integer;
    PRAGMA interface( MACRO, setterminfo );
    PRAGMA import_function( internal    =>     setterminfo,
                            parameter_types => (short_integer),
                            result_type =>     integer,
                            external =>        "SETTERMINFO" );

    FUNCTION resetterminfo (chan : short_integer) RETURN integer;
    PRAGMA interface( MACRO, resetterminfo );
    PRAGMA import_function( internal    =>     resetterminfo,
                            parameter_types => (short_integer),
                            result_type =>     integer,
                            external =>        "RESETTERMINFO" );


  --|  This procedure is used to shut down the debugger.  It is used when a
  --|  quit, or <cntl>-c is entered by the user.  It is used to shut down
  --|  all tasks, including uninstrumented user tasks.

    PROCEDURE do_exit (STATUS : out INTEGER;
                       EXIT_STATUS : in INTEGER := 1);
    PRAGMA INTERFACE( VMS, do_exit);
    PRAGMA import_valued_procedure(do_exit,
                                   "SYS$EXIT",
                                    mechanism => (VALUE, VALUE));

END sysdep2;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SYSDEP.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with sysdep2,
    text_io,
    system,
    tasking_services,
    starlet,
    condition_handling,
    system_parameters,
    string_pkg;


USE
    sysdep2,
    text_io,
    system,
    tasking_services,
    starlet,
    system_parameters,
    condition_handling;

PACKAGE BODY sysdep IS

  --|  This package contains system dependent procedures.  This version
  --|  is for the VAX with VMS 4.0 using the Ada compilation system.


----------------------------------------------------------------------
--  The following are used by the virtual terminal package
----------------------------------------------------------------------

    TYPE status_enum IS (io_ok, io_not_ok );
      --|  status of the last io operation

    PROCEDURE alloc (
    status    : OUT integer;
    devnam    : IN  string;
    phylen    : OUT integer;
    phybuf    : OUT string;
    acmode    : IN  integer := 0 );

    PRAGMA interface (EXTERNAL, alloc);

    PRAGMA import_valued_procedure (alloc, "SYS$ALLOC",
    (integer, string,        integer,   string,        integer),
    (value,   descriptor(s), reference, descriptor(s), value));


    PROCEDURE assign (
    status    : OUT integer;
    devnam    : IN  string;
    chan    : OUT short_integer;
    acmode    : IN  integer := 0;
    mbxnam    : IN  string := string'NULL_PARAMETER);

    PRAGMA interface (external, assign);

    PRAGMA import_valued_procedure (assign, "SYS$ASSIGN",
    (integer, string,        short_integer,   integer, string),
    (value,   descriptor(s), reference,       value,   descriptor(s)));


    PROCEDURE dassgn (
    status    : OUT condition_handling.cond_value_type;
    chan    : IN  starlet.channel_type);

    PRAGMA interface (external, dassgn);

    PRAGMA import_valued_procedure (dassgn, "sys$dassgn",
    (condition_handling.cond_value_type, starlet.channel_type),
    (value, value));

    PROCEDURE trnlog (
    status    : OUT integer;
    lognam    : IN  string;
    rsllen    : OUT short_integer;
    rslbuf    : OUT string;
    table    : IN  integer := 0;
    acmode    : OUT integer;
    dsbmsk    : IN  integer := 0 );

    PRAGMA interface (external, trnlog);

    PRAGMA import_valued_procedure (trnlog, "SYS$TRNLOG",
    (integer, string, short_integer, string, integer, integer, integer),
    (value, descriptor(s), reference, descriptor(s), value, reference,
           value));


    terminal_in_channel : short_integer;
    terminal_out_channel : short_integer;

    PROCEDURE open IS
    status : integer;
    BEGIN

        assign
            ( status,
              "SYS$OUTPUT:",
          terminal_out_channel );

        IF status /= 1
        THEN
            text_io.put_line
               ( "In open (assign sys$output)  status : " &
                 integer'image( status ) );
        END IF;

     END open;


    PROCEDURE close IS
    status : integer;
    BEGIN

        dassgn( condition_handling.cond_value_type( status ),
                starlet.channel_type(  terminal_out_channel ) );

        dassgn( condition_handling.cond_value_type( status ),
                starlet.channel_type(  terminal_in_channel ) );

    END close;


    PROCEDURE put ( data : IN string ) IS
    status : integer;
    temp_buffer : string( 1..data'LENGTH );
    ios_block : starlet.iosb_type;
    BEGIN

         tasking_services.task_qiow
             ( status => condition_handling.cond_value_type( status ),
               chan => starlet.channel_type( terminal_out_channel ),
               func => starlet.io_writevblk,
               iosb => ios_block,
               p1 => system.to_unsigned_longword( data(data'FIRST)'ADDRESS ),
               p2 => system.unsigned_longword( data'LENGTH )
             );

        IF status /= 1
        THEN
            text_io.put_line
               ( "In put  status : " &
                 integer'image( status ) );
        END IF;
    END put;

    PROCEDURE low_level_get
             ( data : OUT character; io_status : OUT status_enum  ) IS
    status : integer;
    length : CONSTANT positive := 1;
    temp_buffer : string( 1..1 );
    ios_block : starlet.iosb_type;
    BEGIN

         tasking_services.task_qiow
             ( status => condition_handling.cond_value_type( status ),
               chan => starlet.channel_type( terminal_in_channel ),
               func => ( starlet.io_readvblk OR
                         starlet.io_m_nofiltr),
               iosb => ios_block,
               p1 => system.to_unsigned_longword( temp_buffer(1)'ADDRESS ),
               p2 => system.unsigned_longword( length )
             );

         IF (status /= 1) OR
            (ios_block.status /= 1)
         THEN
             io_status := io_not_ok;
         ELSE
             io_status := io_ok;
             data := temp_buffer(1);
         END IF;
    END low_level_get;

-------------------------------------------------------------------
--  The following procedures were added to allow us to return control
--  to the test program when we are not inputting something.  This is
--  so the program can get input from the terminal
--------------------------------------------------------------------

    procedure START_INPUT is
      status : integer;
    begin
        assign
        ( status,
          "SYS$INPUT:",
              terminal_in_channel );

      status := setterminfo( terminal_in_channel );
    end START_INPUT;

-------------------------------------------------------------------

    procedure STOP_INPUT is
      STATUS : INTEGER;
    begin
        status := resetterminfo( terminal_in_channel );

        dassgn( condition_handling.cond_value_type( status ),
                starlet.channel_type(  terminal_in_channel ) );

    end STOP_INPUT;

-------------------------------------------------------------------
--  This procedure was changed to get only one character at a time.
--  This is so the program being tested can get its own output from
--  the terminal. If we get too many characters, we might pick up
--  input intended for the target program.
--------------------------------------------------------------------

    PROCEDURE get ( data : IN OUT string;
                    last : OUT natural ) IS
      buffer : character;
      status : status_enum;
      returned_status : integer;
      INSTATUS : INTEGER;
    BEGIN

      low_level_get( buffer, status );

      if Character'Pos(Buffer) = 3 then
        set_scroll_region(1, 24);
        instatus := resetterminfo(terminal_in_channel);
        close;
        SYSDEP2.DO_EXIT(RETURNED_STATUS);
      end if;

      data(1) := buffer;
      last := 1;
   END get;

    PROCEDURE tcf_name ( name : OUT string;
                         last : OUT natural ) IS
    status : integer;
    temp_buffer : string( 1..80 ) := string'( 1..80 => ' ' );
    short_temp_length : short_integer;
    integer_temp_length : integer;
    ac_mode : integer;
    BEGIN
      NAME(1 .. STRING_PKG.LENGTH(SYSTEM_PARAMETERS.BASE_PROGRAM_LIBRARY)
        + 7) := STRING_PKG.VALUE(SYSTEM_PARAMETERS.BASE_PROGRAM_LIBRARY)
        & "TCF.DAT";
      LAST := STRING_PKG.LENGTH(SYSTEM_PARAMETERS.BASE_PROGRAM_LIBRARY) +
        7;
    END tcf_name;



    PROCEDURE  terminal_name ( name : OUT string;
                               last : OUT natural ) IS
    status : integer;
    temp_buffer : string( 1..80 ) := string'( 1..80 => ' ' );
    short_temp_length : short_integer;
    integer_temp_length : integer;
    ac_mode : integer;
    BEGIN
        trnlog( status, "TERM", short_temp_length, temp_buffer, 0, ac_mode );
        integer_temp_length := integer( short_temp_length );
        IF status /= 1
        THEN
            last := 0;
        ELSE
            name( name'FIRST..name'FIRST+integer_temp_length-1 ) :=
                   temp_buffer( 1..integer_temp_length );
            last := name'FIRST+integer_temp_length-1;
        END IF;
    END terminal_name;

    FUNCTION valid_character ( item : IN character ) RETURN boolean IS
    BEGIN
        CASE item IS
            WHEN ascii.dc3 => RETURN false; -- xon
            WHEN ascii.dc1 => RETURN false; -- xoff
            WHEN OTHERS => RETURN true;
        END CASE;
    END valid_character;


  function FINDTABCOLUMN( -- see subprogram specification
                         INCOLUMN : in SOURCE_COLUMN) return SOURCE_COLUMN is

  --| Effects
  --| Tabs are positioned every eight columns starting at column 1.

    TAB_WIDTH : constant := 8;  --| number of columns a tab takes up.

  begin
    return (INCOLUMN + (TAB_WIDTH - (INCOLUMN mod TAB_WIDTH)));
  end FINDTABCOLUMN;

  procedure SD_COMPILE(FILENAME : in STRING) is
     --|  This procedure will spawn a process to compile the file
     --|  specified by FILENAME.
  begin
    SPAWN("ADA " & FILENAME);
  end SD_COMPILE;

  procedure SD_LINK(COMPILATION_UNIT : in STRING) is
     --|  This procedure will spawn a process to link the unit
     --|  specified by COMPILATION_UNIT.
  begin
    SPAWN("ACS LINK " & COMPILATION_UNIT);
  end SD_LINK;

  procedure SD_RUN(COMPILATION_UNIT : in STRING) is
     --|  This procedure will spawn a process to run the program
     --|  specified by COMPILATION_UNIT.
  begin
    SPAWN("RUN " & COMPILATION_UNIT);
  end SD_RUN;

  procedure SD_SYS(COMMAND: in STRING) is
    --|  This procedure will spawn a process to execute the command
    --|  specified in COMMAND.
  begin
    SPAWN(COMMAND);
  end SD_SYS;

procedure SET_SCROLL_REGION(TOP    : in POSITIVE;
                            BOTTOM : in POSITIVE) is

--|  This procedure is used to define the bottom lines of the screen
--|  as a scroll region.  Since we do not have control of the output
--|  from the target program, this will cause that output to scroll
--|  in the area at the bottom of the screen.

  function STRING_OF(VALUE : in INTEGER) return STRING is
    TEMP_STRING : constant STRING := INTEGER'image(VALUE);
  begin
    return TEMP_STRING((TEMP_STRING'first + 1) .. TEMP_STRING'last);
  end;

begin
  PUT_LINE(ASCII.ESC & "[" & STRING_OF(TOP) & ";" & STRING_OF(BOTTOM)
    & "r" & ASCII.CR);
end;

END sysdep;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--CHANGE.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with PARSERDECLARATIONS;

package CHANGE_TEXT is
--| Subprograms for the manipulation of source text

--| Overview

--| This package provides several subprograms which manipulate source text
--| in various ways.
--|
--| Change_Case alters the case of the text passed in,
--| Change_Sharp changes the extended delimiter character '#' to the basic
--|     character ':' in the text of a based literal.
--| String_Value returns the text of a string with the extended and basic
--|     string delimiters represented appropriately within the string.

    package PD  renames PARSERDECLARATIONS;

    type CASE_NAME is (UPPERCASE, LOWERCASE);

    -----------------------------------------------------------------------

    function CHANGE_CASE(TOKEN_TEXT : in PD.SOURCE_TEXT;--| text to be changed
                         TO_CASE    : in CASE_NAME      --| case in which to
                                                        --| represent Token_Text
                         ) return STRING;
    --| Changes the case of Token_Text

    --| Effects

    --| The Token_Text is changed according to the To_Case passed in.  When
    --| To_Case is SID.Bold, the return value is the same as if lowercase
    --| had been requested.  The actual bold printing is handled in procedure
    --| Bold_Print rather than here for two reasons:
    --|
    --|      1.  Tokens which would ordinarily be bold printed should be only
    --|          lowercased when bold printing is selected with
    --|          Paginated_Format off.  This is to prevent control characters
    --|          from being inserted into a file which is supposed to be
    --|          valid Ada.
    --|
    --|      2.  In determining the length of a token for placement in the
    --|          output, control characters which have no printable form,
    --|          and therefore do not take up any columns on the page, should
    --|          not be counted.
    --|

    -----------------------------------------------------------------------

    function CHANGE_SHARP(TOKEN_TEXT : in PD.SOURCE_TEXT) return STRING;
    --| Changes the extended character '#' to the basic character ':'

    --| Effects

    --| This function changes all of the '#' characters in the passed-in
    --| Token_Text to ':' characters.  Its primary use should be for changing
    --| these characters in the text of a based literal.


    -----------------------------------------------------------------------

    function STRING_VALUE(TOKEN_TEXT : in PD.SOURCE_TEXT) return STRING;
    --| Returns the correct text for a string, based on its delimiters

    --| Effects

    --| This function returns a string with the correct delimiters (basic
    --| or extended) and embedded delimiter characters represented correctly.
    --| For example, the input string "Here is a % character" when output
    --| with Basic Delimiters must be converted to %Here is a %% character"
    --| with the embedded delimiter character doubled.  This ensures that
    --| valid Ada strings are reproduced.

    -----------------------------------------------------------------------

    function CONVERT_PERIODS_TO_UNDERSCORES(INPUT_STRING: in STRING)
                                                  return STRING;
    --| Effects
    --|
    --| This procedure will convert all periods in a string to underscores.

    -----------------------------------------------------------------

    function TOKEN_TEXT(TOKEN : in PD.PARSESTACKELEMENT) return STRING;

    --| Effects

    --| Returns the canonical "text" of a token (in extended character set)

    -----------------------------------------------------------------

    function SPACED_TOKEN(CURRENT, PREVIOUS : in PD.PARSESTACKELEMENT;
                          BEGINNING_OF_LINE : in BOOLEAN) return STRING;
    --| Effects
    --| Returns the text of a token with appropriate spaces around it, in
    --| accordance with SID.Spacing_Table and any extra spaces that are
    --| necessary.

end Change_Text;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--CHANGE.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with GRAMMAR_CONSTANTS; use GRAMMAR_CONSTANTS;
with SYSTEM_PARAMETERS, PARSETABLES; use SYSTEM_PARAMETERS;
with SOURCE_INSTRUMENTER_DECLARATIONS;
package body CHANGE_TEXT is

--| Subprograms for the manipulation of source text

--| Overview

--| Change_Text, Change_Sharp and String_Value are all functions which which
--| take a parameter of type PD.Source_Text which is an access to a string
--| type and return a string.  Each dereferences its parameter, performs the
--| appropriate manipulations and returns the manipulated string.

    package SP renames SYSTEM_PARAMETERS;
    package PT renames PARSETABLES;
    package SID renames SOURCE_INSTRUMENTER_DECLARATIONS;

    -----------------------------------------------------------------------
    -- Local Subprogram Specifications
    -----------------------------------------------------------------------

    function UPPERCASE (CHAR : in CHARACTER) return CHARACTER;
    --| Returns the uppercase value of the passed in character

    --| Effects

    --| If Char is alphabetic, its uppercase value is returned.  Otherwise,
    --| Char is returned unchanged.

    -----------------------------------------------------------------------

    function LOWERCASE (CHAR : in CHARACTER) return CHARACTER;
    --| Returns the lowercase value of the passed in character

    --| Effects

    --| If Char is alphabetic, its lowercase value is returned.  Otherwise,
    --| Char is returned unchanged.

    -----------------------------------------------------------------------
    -- External Subprogram Bodies
    -----------------------------------------------------------------------

    function CHANGE_CASE (TOKEN_TEXT : in PD.SOURCE_TEXT;
                          TO_CASE    : in CASE_NAME) return STRING is

        PRECEDING_UNDERSCORE : BOOLEAN := TRUE;
        --| Flags that the preceding character is an underscore, indicating
        --| that the following character should be capitalized.  Initialized
        --| to True so that the first character of the Token will be
        --| capitalized.

    begin

        -- case selectors match enumeration type Case_Name
        case TO_CASE is
            when UPPERCASE =>
                for I in TOKEN_TEXT.ALL'FIRST .. TOKEN_TEXT.ALL'LAST loop
                    TOKEN_TEXT.ALL(I) := UPPERCASE(TOKEN_TEXT.ALL(I));
                end loop;
                return TOKEN_TEXT.ALL;
            when LOWERCASE  =>
                for I in TOKEN_TEXT.ALL'FIRST .. TOKEN_TEXT.ALL'LAST loop
                    TOKEN_TEXT.ALL(I) := LOWERCASE(TOKEN_TEXT.ALL(I));
                end loop;
                return TOKEN_TEXT.ALL;
        end case;
    end CHANGE_CASE;

    -----------------------------------------------------------------------

    function CHANGE_SHARP (TOKEN_TEXT : in PD.SOURCE_TEXT) return STRING is
    begin
        for I in TOKEN_TEXT.ALL'FIRST .. TOKEN_TEXT.ALL'LAST loop
            if TOKEN_TEXT.ALL(I) = '#' then
                TOKEN_TEXT.ALL(I) := ':';
            end if;
        end loop;
        return TOKEN_TEXT.ALL;
    end CHANGE_SHARP;

    -----------------------------------------------------------------------

    function STRING_VALUE (TOKEN_TEXT : in PD.SOURCE_TEXT) return STRING is
        MARK : POSITIVE; --| Marks a point in the input string as the start of
                         --| where to copy the next section of string.
        STRING_TEXT : PD.SOURCE_TEXT; --| String being built
        DELIMITER_CHARACTER : CHARACTER := '"'; --| String delimiter character
        DELIMITER_STRING : STRING(1 .. 1) := """";
        --| String to insert into the string being built as delimiter character

    begin
        if SP.DELIMITERS = SP.BASIC then
            DELIMITER_CHARACTER := '%';
            DELIMITER_STRING := "%";
        else
            DELIMITER_CHARACTER := '"';
            DELIMITER_STRING := """";
        end if;
        STRING_TEXT := new STRING'(DELIMITER_STRING);
        MARK := TOKEN_TEXT'FIRST;
        for I in TOKEN_TEXT'FIRST .. TOKEN_TEXT'LAST loop
            if TOKEN_TEXT.ALL(I) = DELIMITER_CHARACTER then
                STRING_TEXT := new STRING'(
                    STRING_TEXT.ALL & TOKEN_TEXT.ALL(MARK .. I) &
                    DELIMITER_STRING);
                MARK := I + 1;
            end if;
        end loop;
        return STRING_TEXT.ALL & TOKEN_TEXT.ALL(MARK .. TOKEN_TEXT.ALL'LAST) &
            DELIMITER_STRING;
    end STRING_VALUE;

    -----------------------------------------------------------------------
    -- Local Subprogram Bodies
    -----------------------------------------------------------------------

    function UPPERCASE (CHAR : in CHARACTER) return CHARACTER is
    begin
        if CHAR in 'a' .. 'z' then
            return CHARACTER'VAL(CHARACTER'POS(CHAR) - CHARACTER'POS('a') +
                CHARACTER'POS('A'));
        else
            return CHAR;
        end if;
    end UPPERCASE;

    -----------------------------------------------------------------------

    function LOWERCASE (CHAR : in CHARACTER) return CHARACTER is
    begin
        if CHAR in 'A' .. 'Z' then
            return CHARACTER'VAL(CHARACTER'POS(CHAR) - CHARACTER'POS('A') +
                CHARACTER'POS('a'));
        else
            return CHAR;
        end if;
    end LOWERCASE;

    -----------------------------------------------------------------------

    function CONVERT_PERIODS_TO_UNDERSCORES(INPUT_STRING: in STRING)
                                                         return STRING is
      OUTPUT_STRING: STRING(1..INPUT_STRING'length);
    begin
      for INDEX in INPUT_STRING'range loop
        if INPUT_STRING(INDEX) = '.' then
          OUTPUT_STRING(INDEX) := '_';
        else
          OUTPUT_STRING(INDEX) := INPUT_STRING(INDEX);
        end if;
      end loop;
      return OUTPUT_STRING;
    end;

  function TOKEN_TEXT(TOKEN : in PD.PARSESTACKELEMENT) return STRING is
  begin
    if (TOKEN.GRAM_SYM_VAL in PD.SINGLEDELIMITERRANGE) or (TOKEN.GRAM_SYM_VAL
      in PD.DOUBLEDELIMITERRANGE) then
      if TOKEN.GRAM_SYM_VAL = PT.BAR_TOKENVALUE then
        if SP.DELIMITERS = SP.BASIC then
          return ("!");
        else
          return ("|");
        end if;
      else
        return PT.GET_GRAMMAR_SYMBOL(TOKEN.GRAM_SYM_VAL);
      end if;
    elsif TOKEN.GRAM_SYM_VAL = PT.STRINGTOKENVALUE then
      return STRING_VALUE(TOKEN.LEXED_TOKEN.TEXT);
    elsif TOKEN.GRAM_SYM_VAL = PT.CHARACTERTOKENVALUE then
      return (TOKEN.LEXED_TOKEN.TEXT.all & "'");
    elsif TOKEN.GRAM_SYM_VAL = PT.COMMENT_TOKENVALUE then
      return ("--" & TOKEN.LEXED_TOKEN.TEXT.all);
    elsif TOKEN.GRAM_SYM_VAL in PD.RESERVEDWORDRANGE then
      return CHANGE_CASE(TOKEN.LEXED_TOKEN.TEXT, LOWERCASE);
    elsif TOKEN.GRAM_SYM_VAL = PT.IDENTIFIERTOKENVALUE then
      return CHANGE_CASE(TOKEN.LEXED_TOKEN.TEXT, UPPERCASE);
    elsif (TOKEN.GRAM_SYM_VAL = PT.NUMERICTOKENVALUE) and
          (SP.DELIMITERS = SP.BASIC) then
      return CHANGE_SHARP(TOKEN.LEXED_TOKEN.TEXT);
    else
      return TOKEN.LEXED_TOKEN.TEXT.all;
    end if;
  end TOKEN_TEXT;

  -----------------------------------------------------------------

  function SPACED_TOKEN(CURRENT, PREVIOUS : in PD.PARSESTACKELEMENT;
                        BEGINNING_OF_LINE : in BOOLEAN) return
    STRING is
    PRECEDING_SPACE : BOOLEAN := FALSE;
  begin

    -- Given context of Current and Previous grammar symbols, determine
    -- whether space should precede current token.
    -- This can't be a case statement because of non-static bound of
    -- GrammarSymbolRange, which is the type of all names of the
    -- form PT.xxxTokenValue
    if (CURRENT.GRAM_SYM_VAL = PT.MODTOKENVALUE) then
      if PREVIOUS.GRAM_SYM_VAL /= PT.ATTOKENVALUE then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (CURRENT.GRAM_SYM_VAL = PT.USETOKENVALUE) then
      if PREVIOUS.GRAM_SYM_VAL /= PT.SEMICOLON_TOKENVALUE then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (CURRENT.GRAM_SYM_VAL = PT.COLONEQ_TOKENVALUE) then
      if PREVIOUS.GRAM_SYM_VAL /= PT.CONSTANTTOKENVALUE then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (CURRENT.GRAM_SYM_VAL = PT.THENTOKENVALUE) then
      if PREVIOUS.GRAM_SYM_VAL /= PT.ANDTOKENVALUE then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (CURRENT.GRAM_SYM_VAL = PT.INTOKENVALUE) or
          (CURRENT.GRAM_SYM_VAL = PT.LOOPTOKENVALUE) then
      if PREVIOUS.GRAM_SYM_VAL /= PT.COLON_TOKENVALUE then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (CURRENT.GRAM_SYM_VAL = PT.PLUS_TOKENVALUE) or
          (CURRENT.GRAM_SYM_VAL = PT.MINUS_TOKENVALUE) then
      if PREVIOUS.GRAM_SYM_VAL /= PT.LEFTPAREN_TOKENVALUE then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (CURRENT.GRAM_SYM_VAL = PT.WHENTOKENVALUE) then
      if PREVIOUS.GRAM_SYM_VAL /= PT.SEMICOLON_TOKENVALUE then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (CURRENT.GRAM_SYM_VAL = PT.RANGETOKENVALUE) or
          (CURRENT.GRAM_SYM_VAL = PT.DIGITSTOKENVALUE) or
          (CURRENT.GRAM_SYM_VAL = PT.DELTATOKENVALUE) then
      if (PREVIOUS.GRAM_SYM_VAL /= PT.APOSTROPHE_TOKENVALUE) and
         (PREVIOUS.GRAM_SYM_VAL /= PT.ISTOKENVALUE) then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (CURRENT.GRAM_SYM_VAL = PT.NOTTOKENVALUE) and
          (PREVIOUS.GRAM_SYM_VAL = PT.IDENTIFIERTOKENVALUE) then
      PRECEDING_SPACE := TRUE;
    elsif (PREVIOUS.GRAM_SYM_VAL = PT.CASETOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.DELTATOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.DIGITSTOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.ENDTOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.EXITTOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.IFTOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.LOOPTOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.RETURNTOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.RAISETOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.RANGETOKENVALUE) or
          (PREVIOUS.GRAM_SYM_VAL = PT.SELECTTOKENVALUE) then
      if (CURRENT.GRAM_SYM_VAL /= PT.SEMICOLON_TOKENVALUE) and
          -- Empty Token handles pop of loop or block identifier.
         (CURRENT.GRAM_SYM_VAL /= PT.EMPTY_TOKENVALUE) then
        PRECEDING_SPACE := TRUE;
      end if;
    elsif (PREVIOUS.GRAM_SYM_VAL = PT.ABSTOKENVALUE) then
      if CURRENT.GRAM_SYM_VAL /= PT.LEFTPAREN_TOKENVALUE then
        PRECEDING_SPACE := TRUE;
      end if;
    end if;

    -- Return the spaced token
    case SID.SPACING_TABLE(CURRENT.GRAM_SYM_VAL) is
      when SID.AFTER =>
        if BEGINNING_OF_LINE or not PRECEDING_SPACE then
          return TOKEN_TEXT(CURRENT) & " ";
        else
          return " " & TOKEN_TEXT(CURRENT) & " ";
        end if;
      when SID.BEFORE =>
        if BEGINNING_OF_LINE then
          return TOKEN_TEXT(CURRENT);
        else
          return " " & TOKEN_TEXT(CURRENT);
        end if;
      when SID.AROUND =>
        if BEGINNING_OF_LINE then
          return TOKEN_TEXT(CURRENT) & " ";
        else
          return " " & TOKEN_TEXT(CURRENT) & " ";
        end if;
      when SID.NONE =>
        if BEGINNING_OF_LINE or not PRECEDING_SPACE then
          return TOKEN_TEXT(CURRENT);
        else
          return " " & TOKEN_TEXT(CURRENT);
        end if;
    end case;
  end SPACED_TOKEN;

end Change_Text;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--GENUTILS.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG; use STRING_PKG;
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;

package SD_GENERATION_UTILITIES is

   -- This package contains the procedures which generate the
   -- code for tracing variables which is added to the instrumented
   -- source file.

   --------------------------------------------------------------------------

   procedure GENERATE_FINDVAR_SPEC;
   -- Generate the procedure specification for this scope's "Find_Variable"
   -- procedure.

   --------------------------------------------------------------------------

   procedure GENERATE_FINDVAR_BODY(VARIABLE_LIST : NAME_LISTS.LIST;
                                   PACKAGE_LIST  : STRING_LISTS.LIST;
                                   WITH_LIST     : STRING_LISTS.LIST;
                                   USE_LIST      : STRING_LISTS.LIST);

   -- Generate the body of the "Find_Variable" procedure  for a scope that
   -- is not a package specification.

   -----------------------------------------------------------------------

   procedure GENERATE_PACKAGE_FINDVAR(VARIABLE_LIST : NAME_LISTS.LIST;
                                      PACKAGE_LIST  : STRING_LISTS.LIST;
                                      USE_LIST      : STRING_LISTS.LIST);

   -- Generate the body of the "Find_Variable" procedure for a package
   -- specification.

   --------------------------------------------------------------------------

   procedure GENERATE_LOCAL_BREAK(PROGRAM_UNIT_NUMBER : NATURAL;
                                  IS_A_TASK           : BOOLEAN);

   -- Generate an instantion of the Local_Break template.

   --------------------------------------------------------------------------

   procedure GENERATE_DUMMY_LOCALS(PARAM_LIST : in out NAME_LISTS.LIST);

   -- Create a local variable for each OUT mode formal parameter.
   -- This is necessary because setting procedures have parameters
   -- of mode IN OUT. The dummy variable will be passed to the
   -- setting procedure, and then its value will be assigned to the
   -- formal parameter.

   --------------------------------------------------------------------------

   procedure GENERATE_TRACING_SPECS(TYPE_NAME : STRING);

   -- Generate specifications for the tracing procedures that will
   -- be created for this type.  It is not a type for which there
   -- are generic tracing templates, so we will have to create the
   -- procedures.  The procedure bodies will be written to the buffer
   -- file and copied into the instrumented source file later.

   --------------------------------------------------------------------------

   procedure GENERATE_TRACING_INSTANTIATION(TYPE_NAME : STRING;
                                            TYPE_KIND : TYPE_CLASS);

   -- The current type is one for which there are tracing templates,
   -- so generate instantiations for the procedures.


   --------------------------------------------------------------------------

   procedure GENERATE_ANON_TYPE(ANON_TEXT : STRING_LISTS.LIST);

   -- Generate a type definition for an anonymous array types.  The
   -- set and display procedures are called with an explicit type conversion
   -- of the anonymous array object to this type.

   --------------------------------------------------------------------------

   procedure GENERATE_DERIVED_TRACE(TYPE_NAME   : STRING;
                                    PARENT_NAME : STRING);

   -- Generate procedure bodies for tracing a derived type.  The
   -- set and display procedures are called with an explicit type
   -- conversion of the variable to its parent type.


   --------------------------------------------------------------------------

   procedure GENERATE_ARRAY_TRACE(TYPE_NAME  : STRING;
                                  DIMENSIONS : NATURAL);

   -- Generate procedure bodies for tracing array types.  Different
   -- code is generated for tracing one dimensional and multi-dimensional
   -- arrays.


   --------------------------------------------------------------------------

   procedure GENERATE_RECORD_TRACE(TYPE_NAME        : STRING;
                                   LIST_OF_FIELDS   : RECORD_LISTS.LIST;
                                   LIST_OF_DISCRIMS : STRING_LISTS.LIST;
                                   CASE_DISCRIM     : STRING_TYPE);

   -- Generate the bodies of the procedures to set and display record
   -- types.

   --------------------------------------------------------------------------

   procedure GENERATE_ACCESS_TRACE(TYPE_NAME : STRING);

   -- Generate the bodies of the procedures to set and display access
   -- types.

   --------------------------------------------------------------------------

end SD_GENERATION_UTILITIES;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--GENUTILS.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SYSTEM_PARAMETERS; use SYSTEM_PARAMETERS;
with SCOPE_PACKAGE; use SCOPE_PACKAGE;
with TEXT_IO; use TEXT_IO;
with SD_BUFFER_FILES; use SD_BUFFER_FILES;
with STRING_UTILITIES; use STRING_UTILITIES;
with SD_SOURCE_BUFFERING; use SD_SOURCE_BUFFERING;

package body SD_GENERATION_UTILITIES is

   -- This package has the procedures which generate code to the
   -- instrumented source to accomplish variable tracing.

   --------------------------------------------------------------------------
   -- Procedure Local_Break --

   -- Each scope has a Local_Break which is called before each executable
   -- statement.  If the breakpoint for this statement has been set,
   -- the User_Interface task is called and the user can issue any
   -- interactive requests.  If the request is to set or display a variable,
   -- procedure F is called.

   --------------------------------------------------------------------------
   -- Procedure F --

   -- One uniquely named procedure "F" (short for "find variable") is
   -- generated in each scope.  This procedure checks to see if the
   -- variable the user wants to trace is declared in this scope.
   -- If so, F calls set or display with the specified variable as the
   -- parameter, and then raises an exception so that no further scopes
   -- are searched.  The exception is handled and Local_Break resumes.
   --
   -- If the variaible was not found here, other Fs are called:
   --   1. If this is a package body, check the package body variables,
   --      check the private variables, and check the package spec.
   --   2. Check any local packages.
   --   3. Check the outer scope.
   -- If the variable still hasn't been found, an error message is issued.
   --
   -- The procedure name is formed by prefixing F with the scope name, a
   -- special prefix, and sometimes "SPEC" or "PRIV".  The name has to
   -- be unique so one F can call other Fs.
   --
   -- The actual content of each procedure "F" will vary depending on the
   -- type of scope, and whether there are local packages and enclosing
   -- scopes. A typical example of "F" for a procedure P with variables
   -- X and Y is given below, with commentary in parentheses.
   --
   -- procedure P_SI2AFSD_1861_F(S: String) is
   --  (the use list will be a parameter if this is for a package spec.
   --   S has any loop params and their current value.)

   -- begin
   --   SD_Runtime_Utilities.Searching_Scope("P.");
   --     (Initialize variable scanner and value string if this is a new
   --      variable. See if the user explicitly gave this scope.)
   --
   --   SD_Runtime_Utilities.Check_Loop_Param(S);
   --      (S is a string representing the current FOR loop parameter and
   --       its current value, if we are in a FOR loop. If the user wants
   --       to display the loop parameter, then get the value part of S,
   --       and stop searching.)
   --
   --   case SD_Runtime_Utilities.Search_For_Variable("X Y ") is
   --      (The string parameter is generated from the current visible
   --       variable list.  Search_For_Variable returns the number
   --       of which item in the list it matched or 0 if no match.)
   --
   --       when 1 => (assume X can be set and displayed)
   --          (All set and display procedures have the same names.)
   --          if SD_Runtime_Utilities.Command = PUT_VAR then
   --            SI2AFSD_1861_D ("P.X", P.X);
   --          else
   --            SI2AFSD_1861_S (P.X);
   --          end if;
   --          raise Stop_Searching;
   --          (Exit by exception so no further searching is done.)
   --
   --       when 2 => (assume Y is a constant)
   --          if SD_Runtime_Utilities.Command = PUT_VAR then
   --            SI2AFSD_1861_D ("P.Y", P.Y);
   --          else
   --            Error_Message("Constants can't be set");
   --          end if;
   --
   --       when others =>
   --          null;
   --          (If this is a package body, call F to search its
   --           private and public variables.
   --           Call F to search any local packages.)
   --   end case;

   --   (if there is an outer scope then)
   --   if SD_Runtime_Utilities.Search_Outer_Scope then
   --        (Determines whether to keep looking according
   --         to the current scope and what the user typed in.)
   --      OUTER_SCOPE_NAME_SI2AFSD_1861_F;
   --   else
   --      Error_Message("Variable not found");
   --   end if;
   --
   --   (If there is no outer scope then search through library units
   --    given in the with clause before giving the error message.)
   --
   --   exception
   --     when Constraint_Error =>
   --        Error_Message("Constraint_Error raised");
   --     when others => null;
   --        (If the variable was found in this scope, Stop_Searching is
   --         raised. Handle it here and go back to interacting with the user.)
   -- end;

   --------------------------------------------------------------------------
   -- Set and Display and Make_String procedures

   -- Procedures to set and display a variable will be added for each type
   -- definition encountered in the user's program.  The set procedure is
   -- named SI2AFSD_1861_S; the display procedure is named SI2AFSD_1861_D;
   -- the make_string function is named SI2AFSD_1861_M and returns a string.

   -- The Make_String function returns the string image of the current value
   -- for discrete values, or a null string otherwise.  This is used
   -- for matching array indices.

   -- When F calls the set or display procedure for a variable, it is
   -- guaranteed that these subprograms for that type have been created and
   -- are visible.  The compiler will resolve the overloading.

   -- The tracing procedures for all predefined types are provided in the
   -- package SD_TRACE_PREDEFINED_TYPES.  Generic templated are provided in
   -- SD_GENERIC_TEMPLATES for enumeration types, numeric types, and private
   -- types. Only an instantiation is generated to the instrumented source.

   --------------------------------------------------------------------------


   --------------------------------------------------------------------------

   type OUT_PARAM_TYPE_CLASS is
      (PREDEFINED_STRING, PREDEFINED_SCALAR, USER_DEFINED);

   type DISPLAY_OR_SET is (DISPLAY, SET);


   --------------------------------------------------------------------------
   -- local subprogram declarations --
   --------------------------------------------------------------------------

   --------------------------------------------------------------------------
   procedure GENERATE_LIST_PARAMETER(L : NAME_LISTS.LIST);

   -- Generate a literal string consisting of the Object_Name field of
   -- each item in the list, followed by one blank.

   --------------------------------------------------------------------------
   procedure GENERATE_LIST_PARAMETER(L : STRING_LISTS.LIST);

   -- Generate a literal string consisting of each item in the list,
   -- followed by one blank.

   --------------------------------------------------------------------------
   function CHECK_TYPE_NAME(TYPE_NAME : STRING) return OUT_PARAM_TYPE_CLASS;

   -- Check the type name for an OUT mode parameter.  If it is STRING,
   -- return PREDEFINED_STRING; if it is a known predefined scalar type,
   -- return; otherwise return USER_DEFINED.

   --------------------------------------------------------------------------
   procedure GENERATE_F_CASE_STMT(VARIABLE_LIST : NAME_LISTS.LIST;
                                  PACKAGE_LIST  : STRING_LISTS.LIST;
                                  USE_LIST      : STRING_LISTS.LIST);

   -- Generate the case statement of procedure F.

   --------------------------------------------------------------------------
   procedure GENERATE_F_CASE_BRANCH(CURRENT_VAR : NAME_RECORD;
                                    VAR_NUMBER  : POSITIVE;
                                    IN_ACCEPT   : BOOLEAN);

   -- Generate a branch in the case statement for the current variable.

   --------------------------------------------------------------------------
   procedure GENERATE_NOT_FOUND_BRANCH(PACKAGE_LIST : STRING_LISTS.LIST;
                                       USE_LIST     : STRING_LISTS.LIST);

   -- Generate the "when others =>" branch of the case statement.  If the
   -- current scope is a package body, call F for its private declarations,
   -- and then call F for its spec.  If there were any local packages
   -- in the current scope, then call F for them.  Otherwise, generate
   -- "null;".

   --------------------------------------------------------------------------
   procedure GENERATE_TRACE_LOCAL_PACKAGES(PACKAGE_LIST : STRING_LISTS.LIST;
                                           USE_LIST     : STRING_LISTS.LIST);

   -- If there are local packages to trace, generate the call to their
   -- procedure F.

   --------------------------------------------------------------------------
   procedure GENERATE_TRACE_WITHED_UNITS(WITH_LIST : STRING_LISTS.LIST;
                                         USE_LIST  : STRING_LISTS.LIST);

   -- If there are any packages in the context clause, generate a call to
   -- their procedure F.

   --------------------------------------------------------------------------
   procedure GENERATE_ONE_DIMENSION_ARRAY_TRACE(TYPE_NAME : STRING);

   -- Generate the D and S procedures for a one dimensional array.

   --------------------------------------------------------------------------
   procedure GENERATE_N_DIMENSION_ARRAY_TRACE(TYPE_NAME  : STRING;
                                              DIMENSIONS : INTEGER);

   -- Generate the D and S procedures for a multi_dimensional array.

   --------------------------------------------------------------------------
   procedure WRITE_CHOICE_TEXT(TEXT : STRING_LISTS.LIST);

   -- Recreate the choice text from a variant record.  The text has been
   -- saved as a list of string_types.  Each item in the text will be
   -- separated by one blank.

   --------------------------------------------------------------------------
   procedure GENERATE_TRACE_RECORD_FIELD(FIELDS      : STRING_LISTS.LIST;
                                         PROC        : DISPLAY_OR_SET;
                                         FOUND_CASE  : BOOLEAN;
                                         FOUND_FIELD : out BOOLEAN);

   -- Generate the if statment that determines if the current record field
   -- should be traced.

   --------------------------------------------------------------------------


   --------------------------------------------------------------------------
   -- External subprogram bodies --
   --------------------------------------------------------------------------

   --------------------------------------------------------------------------
   procedure GENERATE_FINDVAR_SPEC is

      -- Generate the procedure specification for this scope's procedure "F".

   begin
      if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
         if CURRENT_SCOPE.IN_PRIVATE_PART then
            WRITE_LINE_SPEC_BUFFER(
               "procedure " & VALUE(CURRENT_SCOPE.TRACING_PREFIX) &
               "PRIV_F(S: STRING := """");");
         else
            WRITE_LINE_SPEC_BUFFER(
               "procedure " & VALUE(CURRENT_SCOPE.TRACING_PREFIX) &
               "SPEC_F(UL: STRING);");
         end if;
      else
         TEXT_IO.NEW_LINE(INSTRUMENTED_FILE);
         WRITE_LINE_INST_SOURCE(
            "procedure " & VALUE(CURRENT_SCOPE.TRACING_PREFIX) &
            "F(S: STRING := """");");
      end if;
   end GENERATE_FINDVAR_SPEC;

   --------------------------------------------------------------------------
   procedure GENERATE_FINDVAR_BODY(VARIABLE_LIST : NAME_LISTS.LIST;
                                   PACKAGE_LIST  : STRING_LISTS.LIST;
                                   WITH_LIST     : STRING_LISTS.LIST;
                                   USE_LIST      : STRING_LISTS.LIST) is

      -- Generate the body of procedure "F" for a scope that is not
      -- a package specification.

   begin
      WRITE_LINE_BODY_BUFFER(
        "procedure " & VALUE(CURRENT_SCOPE.TRACING_PREFIX) &
        "F(S: STRING := """") is");
      WRITE_LINE_BODY_BUFFER("begin");

      WRITE_LINE_BODY_BUFFER(
        "SD_Runtime_Utilities.Searching_Scope(" &
        """STANDARD." & VALUE(CURRENT_SCOPE.QUALIFIED_NAME_STRING) &
        "."");");
      WRITE_LINE_BODY_BUFFER("SD_Runtime_Utilities.Check_Loop_Param(S);");
      GENERATE_F_CASE_STMT(VARIABLE_LIST, PACKAGE_LIST, USE_LIST);

      if not IS_EMPTY(CURRENT_OUTER_SCOPE.SCOPE_NAME) then
         WRITE_LINE_BODY_BUFFER(
           "if SD_Runtime_Utilities.Search_Outer_Scope then");
         if CURRENT_NESTING_LEVEL = 1 then
           GENERATE_TRACE_WITHED_UNITS(WITH_LIST, USE_LIST);
         end if;
         WRITE_LINE_BODY_BUFFER(
           "  " & VALUE(CURRENT_OUTER_SCOPE.TRACING_PREFIX) & "F;");
         WRITE_LINE_BODY_BUFFER("else");
         WRITE_LINE_BODY_BUFFER(
          "  SD_Runtime_Utilities.Error_Message(""Variable not found"");");
         WRITE_LINE_BODY_BUFFER("end if;");

      else
         GENERATE_TRACE_WITHED_UNITS(WITH_LIST, USE_LIST);
         WRITE_LINE_BODY_BUFFER(
           "SD_Runtime_Utilities.Error_Message(""Variable not found"");");
      end if;

      WRITE_LINE_BODY_BUFFER("exception");
      WRITE_LINE_BODY_BUFFER("  when Constraint_Error =>");
      WRITE_LINE_BODY_BUFFER(
        "    SD_Runtime_Utilities.Error_Message(" &
        """Constraint error raised"");");
      WRITE_LINE_BODY_BUFFER("  when others => null;");
      WRITE_LINE_BODY_BUFFER( "end;");
   end GENERATE_FINDVAR_BODY;

   -----------------------------------------------------------------------
   procedure GENERATE_PACKAGE_FINDVAR(VARIABLE_LIST : NAME_LISTS.LIST;
                                      PACKAGE_LIST  : STRING_LISTS.LIST;
                                      USE_LIST      : STRING_LISTS.LIST) is

      -- Generate the body of procedure "F" for a package specification.
      -- It is basically the same as the procedure for other types of
      -- scopes except:
      -- 1: The use list is a parameter
      -- 2: The determination of whether to look here is made by calling
      --    Runtime_Utilities "Search_This_Package" instead of
      --    "Search_This_Scope".
      -- 3: Local packages are searched regardless of whether the enclosing
      --    package is searched because they may be visible by specific dot
      --    notation, or a nested package may be named in a use clause.
      -- 4: No exception handler for stop searching is included so that the
      --    calling procedure "F" will handle the exception and quit searching.
      -- 5: If this is for the private part of a package, searching is
      --    unconditional.  The procedure won't be called if it shouldn't
      --    be searched.

   begin
      if CURRENT_SCOPE.IN_PRIVATE_PART then
         WRITE_LINE_BODY_BUFFER(
           "procedure " & VALUE(CURRENT_SCOPE.TRACING_PREFIX) &
           "PRIV_F(S: STRING := """") is");
         WRITE_LINE_BODY_BUFFER("begin");
         GENERATE_F_CASE_STMT(VARIABLE_LIST, PACKAGE_LIST, USE_LIST);
      else
         WRITE_LINE_BODY_BUFFER(
           "procedure " & VALUE(CURRENT_SCOPE.TRACING_PREFIX) &
           "SPEC_F(UL: String) is");
         WRITE_LINE_BODY_BUFFER("begin");
         WRITE_LINE_BODY_BUFFER(
           "if SD_Runtime_Utilities.Search_This_Package(" &
           """STANDARD." & VALUE(CURRENT_SCOPE.QUALIFIED_NAME) & "."",UL) then");
         GENERATE_F_CASE_STMT(VARIABLE_LIST, PACKAGE_LIST, USE_LIST);
         WRITE_LINE_BODY_BUFFER("end if;");
      end if;

      if not STRING_LISTS.ISEMPTY(PACKAGE_LIST) then
         GENERATE_TRACE_LOCAL_PACKAGES(PACKAGE_LIST, USE_LIST);
      end if;
      WRITE_LINE_BODY_BUFFER("end;");
   end GENERATE_PACKAGE_FINDVAR;

   --------------------------------------------------------------------------
   procedure GENERATE_LOCAL_BREAK(PROGRAM_UNIT_NUMBER : NATURAL;
                                  IS_A_TASK           : BOOLEAN) is
   begin
      WRITE_SPEC_BUFFER("procedure " & SD_PREFIX & "Local_Break is new ");

      if IS_A_TASK then
         WRITE_LINE_SPEC_BUFFER("SD_Task_Local_Break(");
         WRITE_SPEC_BUFFER(
           "  " & PREFIX & "Current_Compilation_Unit," &
           NATURAL'IMAGE(PROGRAM_UNIT_NUMBER) & "," & PREFIX & "Task_Number,");
      else
         WRITE_LINE_SPEC_BUFFER("SD_Local_Break(");
         WRITE_SPEC_BUFFER(
           "  " & PREFIX & "Current_Compilation_Unit," &
           NATURAL'IMAGE(PROGRAM_UNIT_NUMBER) & ",");
      end if;
      WRITE_LINE_SPEC_BUFFER(VALUE(CURRENT_SCOPE.TRACING_PREFIX) & "F);");
   end GENERATE_LOCAL_BREAK;

   --------------------------------------------------------------------------
   procedure GENERATE_DUMMY_LOCALS(PARAM_LIST : in out NAME_LISTS.LIST) is

      -- Create a local variable for each OUT mode formal parameter.
      -- This is necessary because setting procedures have parameters
      -- of mode IN OUT. The dummy variable will be passed to the
      -- setting procedure, and then its value will be assigned to the
      -- formal parameter.

      ITERATOR   : NAME_LISTS.LISTITER;
      NEXT_PARAM : NAME_RECORD;
      FIRST_ONE  : BOOLEAN := TRUE;
      PARAM_TYPE : OUT_PARAM_TYPE_CLASS;
   begin
      ITERATOR := NAME_LISTS.MAKELISTITER(PARAM_LIST);
      while NAME_LISTS.MORE(ITERATOR) loop
         NAME_LISTS.NEXT(ITERATOR, NEXT_PARAM);
         if NEXT_PARAM.OBJECT_MODE = WRITE_ONLY then
            PARAM_TYPE := CHECK_TYPE_NAME(VALUE(NEXT_PARAM.OBJECT_TYPE));
            if PARAM_TYPE = USER_DEFINED then
               NAME_LISTS.DELETEITEM(PARAM_LIST, NEXT_PARAM);
               FLUSH(NEXT_PARAM.OBJECT_TYPE);
               NEXT_PARAM.OBJECT_TYPE := CREATE("");
               NAME_LISTS.ATTACH(NEXT_PARAM, PARAM_LIST);
            else
               if FIRST_ONE then
                  TEXT_IO.NEW_LINE(INSTRUMENTED_FILE);
                  FIRST_ONE := FALSE;
               end if;
               WRITE_SPEC_BUFFER(
                 SD_PREFIX & "DUMMY_" & VALUE(NEXT_PARAM.OBJECT_NAME) & " :");
               WRITE_SPEC_BUFFER(VALUE(NEXT_PARAM.OBJECT_TYPE));
               if PARAM_TYPE = PREDEFINED_STRING then
                  WRITE_SPEC_BUFFER(
                    "(" & VALUE(NEXT_PARAM.OBJECT_NAME) & "'Range)");
               end if;
               WRITE_LINE_SPEC_BUFFER(";");
            end if;
         end if;
      end loop;
   end GENERATE_DUMMY_LOCALS;

   --------------------------------------------------------------------------
   procedure GENERATE_TRACING_SPECS(TYPE_NAME : STRING) is

      -- Generate specifications for the tracing procedures that will
      -- be created for this type.  It is not a type for which there
      -- are generic tracing templates, so we will have to create the
      -- procedures.  The procedure bodies will be written to the buffer
      -- file and copied into the instrumented source file later.

   begin
      if CURRENT_SCOPE.TYPE_OF_SCOPE /= PACKAGE_SPECIFICATION then
         TEXT_IO.NEW_LINE(INSTRUMENTED_FILE);
      end if;

      WRITE_LINE_SPEC_BUFFER(
        "procedure " & SD_PREFIX & "D(Name: String; Var: " & TYPE_NAME & ");" );

      WRITE_LINE_SPEC_BUFFER(
        "procedure " & SD_PREFIX & "S(Var: in out " & TYPE_NAME & ");" );

      WRITE_LINE_SPEC_BUFFER(
        "function " & SD_PREFIX & "M(Var: " & TYPE_NAME & ") return String;");

   end GENERATE_TRACING_SPECS;

   --------------------------------------------------------------------------
   procedure GENERATE_TRACING_INSTANTIATION(TYPE_NAME : STRING;
                                            TYPE_KIND : TYPE_CLASS) is

      -- The current type is one for which there are tracing templates,
      -- so generate instantiations for the procedures.

   begin
      if CURRENT_SCOPE.TYPE_OF_SCOPE /= PACKAGE_SPECIFICATION then
         TEXT_IO.NEW_LINE(INSTRUMENTED_FILE);
      end if;

      for I in 1..3 loop
         case I is
            when 1 =>
               WRITE_SPEC_BUFFER(
                 "procedure " & SD_PREFIX & "D is new SD_Display_");
            when 2 =>
               WRITE_SPEC_BUFFER(
                 "procedure " & SD_PREFIX & "S is new SD_Set_");
            when 3 =>
               WRITE_SPEC_BUFFER(
                 "function " & SD_PREFIX & "M is new SD_Make_String_");
            when others => null;
         end case;
         case TYPE_KIND is
            when ENUMERATION_TYPE =>
               WRITE_SPEC_BUFFER("Enum_Type");
            when INTEGER_TYPE =>
               WRITE_SPEC_BUFFER("Integer_Type");
            when FLOAT_TYPE =>
               WRITE_SPEC_BUFFER("Float_Type");
            when FIXED_TYPE =>
               WRITE_SPEC_BUFFER("Fixed_Type");
            when TASK_TYPE | PRIVATE_TYPE | LIMITED_PRIVATE_TYPE =>
               WRITE_SPEC_BUFFER("NoNo");
            when others => null;
         end case;
         WRITE_LINE_SPEC_BUFFER("(" & TYPE_NAME & ");");
      end loop;
   end GENERATE_TRACING_INSTANTIATION;

   --------------------------------------------------------------------------
   procedure GENERATE_ANON_TYPE(ANON_TEXT : STRING_LISTS.LIST) is
      ITER      : STRING_LISTS.LISTITER;
      NEXT_TEXT : STRING_TYPE;
   begin
      ITER := STRING_LISTS.MAKELISTITER(ANON_TEXT);
      while STRING_LISTS.MORE(ITER) loop
         STRING_LISTS.NEXT(ITER, NEXT_TEXT);
         WRITE_SPEC_BUFFER(VALUE(NEXT_TEXT) & " ");
      end loop;
      WRITE_LINE_SPEC_BUFFER("");
   end GENERATE_ANON_TYPE;

   --------------------------------------------------------------------------
   procedure GENERATE_DERIVED_TRACE(TYPE_NAME   : STRING;
                                    PARENT_NAME : STRING) is

     -- Generate procedure bodies for tracing a derived type.  The
     -- set and display procedures are called with an explicit type
     -- conversion of the variable to its parent type.

   begin
      WRITE_LINE_BODY_BUFFER(
        "procedure " & SD_PREFIX & "D(Name: String; Var: " &
        TYPE_NAME & ") is");
      WRITE_LINE_BODY_BUFFER("begin");
      WRITE_LINE_BODY_BUFFER(
        "  " & SD_PREFIX & "D(Name," & PARENT_NAME & "(Var));");
      WRITE_LINE_BODY_BUFFER("end;");

      WRITE_LINE_BODY_BUFFER(
        "procedure " & SD_PREFIX & "S(Var: in out " & TYPE_NAME & ") is");
      WRITE_LINE_BODY_BUFFER("begin");
      WRITE_LINE_BODY_BUFFER(
        "  " & SD_PREFIX & "S(" & PARENT_NAME & "(Var));" );
      WRITE_LINE_BODY_BUFFER("end;");

      WRITE_LINE_BODY_BUFFER(
        "function " & SD_PREFIX & "M(Var: " & TYPE_NAME & ") return String is");
      WRITE_LINE_BODY_BUFFER("begin");
      WRITE_LINE_BODY_BUFFER(
        "  return " & SD_PREFIX & "M(" & PARENT_NAME & "(Var));");
      WRITE_LINE_BODY_BUFFER("end;");
   end GENERATE_DERIVED_TRACE;

   --------------------------------------------------------------------------
   procedure GENERATE_ARRAY_TRACE(TYPE_NAME  : STRING;
                                  DIMENSIONS : NATURAL) is
   begin
      if DIMENSIONS > 1 then
         GENERATE_N_DIMENSION_ARRAY_TRACE(TYPE_NAME, DIMENSIONS);
      else
         GENERATE_ONE_DIMENSION_ARRAY_TRACE(TYPE_NAME);
      end if;

      WRITE_LINE_BODY_BUFFER(
        "function " & SD_PREFIX & "M(Var: " & TYPE_NAME & ") return String is");
      WRITE_LINE_BODY_BUFFER("begin");
      WRITE_LINE_BODY_BUFFER("  return """";");
      WRITE_LINE_BODY_BUFFER("end;");

   end GENERATE_ARRAY_TRACE;

   --------------------------------------------------------------------------
   procedure GENERATE_RECORD_TRACE(TYPE_NAME        : STRING;
                                   LIST_OF_FIELDS   : RECORD_LISTS.LIST;
                                   LIST_OF_DISCRIMS : STRING_LISTS.LIST;
                                   CASE_DISCRIM     : STRING_TYPE) is

      -- Generate the bodies of the procedures to set and display record
      -- types.

     DISC_LIST_ITER    : STRING_LISTS.LISTITER;
     NEXT_DISC         : STRING_TYPE;
     FIELD_LIST_ITER   : RECORD_LISTS.LISTITER;
     NEXT_FIELD_RECORD : REC_FIELD_RECORD;
     NULL_RECORD       : BOOLEAN := TRUE;
     FOUND_FIELD       : BOOLEAN := FALSE;
     FOUND_CASE        : BOOLEAN;

   begin
      for PROC in DISPLAY_OR_SET loop
         if PROC = DISPLAY then
            WRITE_LINE_BODY_BUFFER(
              "procedure " & SD_PREFIX & "D(Name: String; Var: " &
              TYPE_NAME & ") is");
         else
            WRITE_LINE_BODY_BUFFER(
              "procedure " & SD_PREFIX & "S(Var: in out " & TYPE_NAME & ") is");
         end if;

         WRITE_LINE_BODY_BUFFER(
           "  Field : String_Pkg.String_Type" &
           " := Sd_Runtime_Utilities.Find_Record_Field;");
         WRITE_LINE_BODY_BUFFER("  Found : Boolean := False;");
         WRITE_LINE_BODY_BUFFER("begin");

         if not STRING_LISTS.ISEMPTY(LIST_OF_DISCRIMS) then
           NULL_RECORD := FALSE;
           if PROC = DISPLAY then
              GENERATE_TRACE_RECORD_FIELD(
                LIST_OF_DISCRIMS, DISPLAY, FALSE, FOUND_FIELD);
           else
              WRITE_LINE_BODY_BUFFER("if String_Pkg.Is_Empty(Field) then");
              WRITE_LINE_BODY_BUFFER("  SD_Runtime_Utilities.Error_Message(" &
                """Assigning whole records with discriminants " &
                "is unimplemented"");");
              WRITE_BODY_BUFFER("elsif ");

              DISC_LIST_ITER := STRING_LISTS.MAKELISTITER(LIST_OF_DISCRIMS);
              loop
                STRING_LISTS.NEXT(DISC_LIST_ITER, NEXT_DISC);
                WRITE_BODY_BUFFER(
                  "String_Pkg.Equal(Field,""" & VALUE(NEXT_DISC) & """) ");
                if STRING_LISTS.MORE(DISC_LIST_ITER) then
                  WRITE_LINE_BODY_BUFFER("or else");
                else
                  WRITE_LINE_BODY_BUFFER("then");
                  exit;
                end if;
              end loop;

              WRITE_LINE_BODY_BUFFER(
                "  SD_Runtime_Utilities.Error_Message(" &
                """Discriminants may not be set"");");
              WRITE_LINE_BODY_BUFFER("end if;");
           end if;
         end if;

         FOUND_CASE := FALSE;
         FIELD_LIST_ITER := RECORD_LISTS.MAKELISTITER(LIST_OF_FIELDS);
         while RECORD_LISTS.MORE(FIELD_LIST_ITER) loop
           RECORD_LISTS.NEXT(FIELD_LIST_ITER, NEXT_FIELD_RECORD);
           if not STRING_LISTS.ISEMPTY(NEXT_FIELD_RECORD.CHOICE_TEXT) then
             if not FOUND_CASE then
               WRITE_LINE_BODY_BUFFER("case VAR." & VALUE(CASE_DISCRIM) & " is");
               FOUND_CASE := TRUE;
             end if;
             WRITE_CHOICE_TEXT(NEXT_FIELD_RECORD.CHOICE_TEXT);
           end if;
           GENERATE_TRACE_RECORD_FIELD(
             NEXT_FIELD_RECORD.REC_FIELD, PROC, FOUND_CASE, FOUND_FIELD);
           if FOUND_FIELD then
             NULL_RECORD := FALSE;
           end if;
         end loop;

         if FOUND_CASE then
           WRITE_LINE_BODY_BUFFER("end case;");
         end if;

         if not NULL_RECORD then
           WRITE_LINE_BODY_BUFFER("if not Found then");
           WRITE_LINE_BODY_BUFFER(
             "  Sd_Runtime_Utilities.Unscan_Variable(""Variable not found"");");
           WRITE_LINE_BODY_BUFFER("end if;");
         else
           WRITE_LINE_BODY_BUFFER(
             "  Sd_Runtime_Utilities.Error_Message(""Null record"");");
         end if;

         WRITE_LINE_BODY_BUFFER("end;");
      end loop;

      WRITE_LINE_BODY_BUFFER(
        "function " & SD_PREFIX & "M(Var: " & TYPE_NAME & ") return String is");
      WRITE_LINE_BODY_BUFFER("begin");
      WRITE_LINE_BODY_BUFFER("  return """";");
      WRITE_LINE_BODY_BUFFER("end;");

   end GENERATE_RECORD_TRACE;

   --------------------------------------------------------------------------
   procedure GENERATE_ACCESS_TRACE(TYPE_NAME : STRING) is
      -- Generate the bodies of the procedures to set and display access
      -- types.
   begin
      WRITE_LINE_BODY_BUFFER(
        "procedure " & SD_PREFIX & "D(Name: String; Var: " &
        TYPE_NAME & ") is");
      WRITE_LINE_BODY_BUFFER("begin");
      WRITE_LINE_BODY_BUFFER("  if VAR = NULL then");
      WRITE_LINE_BODY_BUFFER(
        "    SD_Runtime_Utilities.General_Message(Name & "" = NULL"");");
      WRITE_LINE_BODY_BUFFER("  else");

      WRITE_LINE_BODY_BUFFER("  case Sd_Runtime_Utilities.Check_Access_Var is");
      WRITE_LINE_BODY_BUFFER("    when 0 => ");
      WRITE_LINE_BODY_BUFFER("      SI2AFSD_1861_D(Name, Var.all'address);");
      WRITE_LINE_BODY_BUFFER("    when 1 => ");
      WRITE_LINE_BODY_BUFFER("      SI2AFSD_1861_D(Name &"".ALL"", Var.All);");
      WRITE_LINE_BODY_BUFFER("    when others => ");
      WRITE_LINE_BODY_BUFFER("      SI2AFSD_1861_D(Name, Var.All);");
      WRITE_LINE_BODY_BUFFER("  end case;");
      WRITE_LINE_BODY_BUFFER("  end if;");
      WRITE_LINE_BODY_BUFFER("end;");

      WRITE_LINE_BODY_BUFFER(
        "procedure " & SD_PREFIX & "S(Var: in out " & TYPE_NAME & ") is");
      WRITE_LINE_BODY_BUFFER("begin");
      WRITE_LINE_BODY_BUFFER(
        " if SD_Runtime_Utilities.Check_Access_Var = 0 then");
      WRITE_LINE_BODY_BUFFER("    SD_Runtime_Utilities.General_Message(" &
        """Access values cannot be set"");");
      WRITE_LINE_BODY_BUFFER("  elsif Var /= NULL then");
      WRITE_LINE_BODY_BUFFER("    SI2AFSD_1861_S(Var.All);");
      WRITE_LINE_BODY_BUFFER("  else");
      WRITE_LINE_BODY_BUFFER(
        "    SD_Runtime_Utilities.Error_Message(""Access value is null"");");
      WRITE_LINE_BODY_BUFFER("  end if;");

      WRITE_LINE_BODY_BUFFER("end;");

      WRITE_LINE_BODY_BUFFER(
        "function " & SD_PREFIX & "M(Var: " & TYPE_NAME & ") return String is");
      WRITE_LINE_BODY_BUFFER("begin");
      WRITE_LINE_BODY_BUFFER("  return """";");
      WRITE_LINE_BODY_BUFFER("end;");

   end GENERATE_ACCESS_TRACE;


   --------------------------------------------------------------------------
   -- Local subprogram bodies --
   --------------------------------------------------------------------------

   ---------------------------------------------------------------------------
   procedure GENERATE_LIST_PARAMETER(L : NAME_LISTS.LIST) is

      -- Generate a literal string consisiting of the object_name field of
      -- each item in the list.  Each name in the generated string is followed
      -- by one blank space.  This string becomes an actual parameter to one
      -- of the SD_Runtime_Utilities procedures.

      ITERATOR  : NAME_LISTS.LISTITER;
      NEXT_NAME : NAME_RECORD;
      TEMP      : STRING_TYPE;
   begin
      STRING_PKG.MARK;
      TEMP := CREATE("""");
      ITERATOR := NAME_LISTS.MAKELISTITER(L);
      while NAME_LISTS.MORE(ITERATOR) loop
         NAME_LISTS.NEXT(ITERATOR, NEXT_NAME);
         TEMP := TEMP & NEXT_NAME.OBJECT_NAME & " ";
      end loop;
      TEMP := TEMP & """";
      WRITE_BODY_BUFFER(VALUE(TEMP));
      STRING_PKG.RELEASE;
   end GENERATE_LIST_PARAMETER;

   --------------------------------------------------------------------------
   procedure GENERATE_LIST_PARAMETER(L : STRING_LISTS.LIST) is

      -- Generate a literal string consisiting of the name in each item
      -- in the list.  Each name in the generated string is followed by
      -- one blank space.  This string becomes an actual parameter to one
      -- of the SD_Runtime_Utilities procedures.

      ITERATOR  : STRING_LISTS.LISTITER;
      NEXT_NAME : STRING_TYPE;
      TEMP      : STRING_TYPE;
   begin
      STRING_PKG.MARK;
      TEMP := CREATE("""");
      ITERATOR := STRING_LISTS.MAKELISTITER(L);
      while STRING_LISTS.MORE(ITERATOR) loop
         STRING_LISTS.NEXT(ITERATOR, NEXT_NAME);
         TEMP := TEMP & VALUE(NEXT_NAME) & " ";
      end loop;
      TEMP := TEMP & """";
      WRITE_BODY_BUFFER(VALUE(TEMP));
      STRING_PKG.RELEASE;
   end GENERATE_LIST_PARAMETER;

   --------------------------------------------------------------------------
   function CHECK_TYPE_NAME(TYPE_NAME : STRING) return OUT_PARAM_TYPE_CLASS is
      DOT    : NATURAL := POSITION_OF_REVERSE('.', TYPE_NAME);
      S      : STRING(1 .. TYPE_NAME'LAST - DOT) :=
                 TYPE_NAME(DOT + 1 .. TYPE_NAME'LAST);
      RESULT : OUT_PARAM_TYPE_CLASS := USER_DEFINED;
   begin
      if S = "STRING" then
         RESULT := PREDEFINED_STRING;
      elsif S = "INTEGER" or else
            S = "NATURAL" or else
            S = "POSITIVE" or else
            S = "BOOLEAN" or else
            S = "CHARACTER" or else
            S = "FLOAT" or else
            S = "LONG_INTEGER" or else
            S = "SHORT_INTEGER" or else
            S = "LONG_FLOAT" or else
            S = "SHORT_FLOAT" then
         RESULT := PREDEFINED_SCALAR;
      end if;
      return RESULT;
   end CHECK_TYPE_NAME;
   -----------------------------------------------------------------------
   procedure GENERATE_F_CASE_STMT(VARIABLE_LIST : NAME_LISTS.LIST;
                                  PACKAGE_LIST  : STRING_LISTS.LIST;
                                  USE_LIST      : STRING_LISTS.LIST) is

      -- Generate the case statement in procedure "F" that calls the
      -- set and display procedures for the variables declared in the
      -- current scope.

      ITERATOR : NAME_LISTS.LISTITER;
      NEXT_VAR : NAME_RECORD;
      COUNTER  : POSITIVE := 1;

   begin
      WRITE_BODY_BUFFER("case SD_Runtime_Utilities.Search_For_Variable(");
      GENERATE_LIST_PARAMETER(VARIABLE_LIST);
      WRITE_LINE_BODY_BUFFER(") is");
      ITERATOR := NAME_LISTS.MAKELISTITER(VARIABLE_LIST);
      while NAME_LISTS.MORE(ITERATOR) loop
         NAME_LISTS.NEXT(ITERATOR, NEXT_VAR);
         GENERATE_F_CASE_BRANCH(NEXT_VAR, COUNTER, CURRENT_SCOPE.IN_ACCEPT);
         COUNTER := COUNTER + 1;
      end loop;
      GENERATE_NOT_FOUND_BRANCH(PACKAGE_LIST, USE_LIST);
      WRITE_LINE_BODY_BUFFER( "end case;");
   end GENERATE_F_CASE_STMT;

   -----------------------------------------------------------------------
   procedure GENERATE_F_CASE_BRANCH(CURRENT_VAR : NAME_RECORD;
                                    VAR_NUMBER  : POSITIVE;
                                    IN_ACCEPT   : BOOLEAN ) is

      -- Generate a branch in the case statement of procedure "F" to
      -- set or display this variable, or to issue an error message if
      -- setting and/or displaying is not allowed for this variable.
      -- Then raise the exception to cause searching to stop.

      VAR_NAME     : STRING_TYPE;

      LEN          : INTEGER := LENGTH(CURRENT_SCOPE.QUALIFIED_NAME_STRING) +
                                LENGTH(CURRENT_VAR.OBJECT_NAME) + 1;
      DISPLAY_NAME : STRING(1..LEN) :=
         VALUE(CURRENT_SCOPE.QUALIFIED_NAME_STRING) & "." &
         VALUE(CURRENT_VAR.OBJECT_NAME);

      ANON_TYPE    : BOOLEAN :=
        POSITION_OF("." & SD_PREFIX & "ANON",
                    VALUE(CURRENT_VAR.OBJECT_TYPE)) /= 0;
   begin
      STRING_PKG.MARK;

      if IN_ACCEPT then
         VAR_NAME := CURRENT_SCOPE.SCOPE_NAME & "." & CURRENT_VAR.OBJECT_NAME;
      else
         VAR_NAME := "STANDARD." & CURRENT_SCOPE.QUALIFIED_NAME & "." &
                      CURRENT_VAR.OBJECT_NAME;
      end if;

      WRITE_LINE_BODY_BUFFER("when" & INTEGER'IMAGE(VAR_NUMBER) & " =>");

      case CURRENT_VAR.OBJECT_MODE is

         when READ_WRITE =>
            WRITE_LINE_BODY_BUFFER(
              "  if SD_Runtime_Utilities.Command = " &
              "SD_Runtime_Declarations.Set_Var then");
            WRITE_BODY_BUFFER("    " & SD_PREFIX & "S(");
            if ANON_TYPE then
               WRITE_LINE_BODY_BUFFER(
                 VALUE(CURRENT_VAR.OBJECT_TYPE) &
                 "(" & VALUE(VAR_NAME) & "));");
            else
               WRITE_LINE_BODY_BUFFER(VALUE(VAR_NAME) & ");" );
            end if;
            WRITE_LINE_BODY_BUFFER("  else");
            WRITE_BODY_BUFFER("    " & SD_PREFIX & "D(""" & DISPLAY_NAME
               & """,");
            if ANON_TYPE then
               WRITE_LINE_BODY_BUFFER(
                 VALUE(CURRENT_VAR.OBJECT_TYPE) &
                 "(" & VALUE(VAR_NAME) & "));");
            else
               WRITE_LINE_BODY_BUFFER(VALUE(VAR_NAME) & ");");
            end if;

            WRITE_LINE_BODY_BUFFER("  end if;");

         when READ_ONLY | CONST =>
            WRITE_LINE_BODY_BUFFER(
              "  if SD_Runtime_Utilities.Command = " &
              "SD_Runtime_Declarations.Set_Var then");
            WRITE_LINE_BODY_BUFFER(
              "    SD_Runtime_Utilities.General_Message(" &
              """Constants or IN parameters cannot be set"");");
            WRITE_LINE_BODY_BUFFER("  else");
            WRITE_BODY_BUFFER("    " & SD_PREFIX & "D(""" & DISPLAY_NAME
               & """, ");
            if ANON_TYPE then
               WRITE_LINE_BODY_BUFFER(
                 VALUE(CURRENT_VAR.OBJECT_TYPE) &
                 "(" & VALUE(VAR_NAME) & "));");
            elsif CURRENT_VAR.OBJECT_MODE = CONST then
               WRITE_LINE_BODY_BUFFER("Float(" & VALUE(VAR_NAME) & "));");
            else
               WRITE_LINE_BODY_BUFFER(VALUE(VAR_NAME) & ");");
            end if;
            WRITE_LINE_BODY_BUFFER("  end if;");

         when WRITE_ONLY =>
            WRITE_LINE_BODY_BUFFER(
               "  if SD_Runtime_Utilities.Command /= " &
               "SD_Runtime_Declarations.Set_Var then");
            WRITE_LINE_BODY_BUFFER(
              "    SD_Runtime_Utilities.General_Message(" &
              """OUT parameters can not be displayed"");");
            WRITE_LINE_BODY_BUFFER("  else");
            if IS_EMPTY(CURRENT_VAR.OBJECT_TYPE) then
               WRITE_LINE_BODY_BUFFER(
                 "    SD_Runtime_Utilities.General_Message(" &
                 """Setting OUT parameters of user defined " &
                 "types is unimplemented"");");
            else
               WRITE_LINE_BODY_BUFFER(
                 "    " & SD_PREFIX & "S(" & SD_PREFIX & "DUMMY_" &
                 VALUE(CURRENT_VAR.OBJECT_NAME) & ");");
               WRITE_LINE_BODY_BUFFER(
                 "    " & VALUE(VAR_NAME) & " := " &
                 SD_PREFIX & "DUMMY_" & VALUE(CURRENT_VAR.OBJECT_NAME) & ";");
            end if;
            WRITE_LINE_BODY_BUFFER("  end if;");

         when others =>
            WRITE_LINE_BODY_BUFFER(
              "  SD_Runtime_Utilities.Error_Message(" &
              """Variable cannot be set or displayed"");");
      end case;
      WRITE_LINE_BODY_BUFFER("  raise SD_Runtime_Utilities.Stop_Searching;");
      STRING_PKG.RELEASE;
   end GENERATE_F_CASE_BRANCH;

   -----------------------------------------------------------------------
   procedure GENERATE_NOT_FOUND_BRANCH(PACKAGE_LIST : STRING_LISTS.LIST;
                                       USE_LIST     : STRING_LISTS.LIST) is

      -- Generate the "when others =>" branch of the case statement for
      -- procedure "F".  If the current unit is a package body, search
      -- its private declarations, and then its public declarations. If
      -- there were any local packages declared, then search them.
      -- Otherwise, generate a null.

      WROTE_SOMETHING : BOOLEAN := FALSE;

   begin
      WRITE_LINE_BODY_BUFFER("when others =>");
      if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY then
         if SD_BUFFER_FILES.PACKAGE_FILES_EXIST
            (VALUE(CURRENT_SCOPE.QUALIFIED_NAME), PRIVATE_FILES)
         then
            WRITE_LINE_BODY_BUFFER(
              VALUE(CURRENT_SCOPE.TRACING_PREFIX) & "PRIV_F;");
            WROTE_SOMETHING := TRUE;
         end if;
         if SD_BUFFER_FILES.PACKAGE_FILES_EXIST
            (VALUE(CURRENT_SCOPE.QUALIFIED_NAME), PUBLIC_FILES)
         then
            WRITE_BODY_BUFFER(VALUE(CURRENT_SCOPE.TRACING_PREFIX) & "SPEC_F(");
            GENERATE_LIST_PARAMETER(USE_LIST);
            WRITE_LINE_BODY_BUFFER(");");
            WROTE_SOMETHING := TRUE;
         end if;
      end if;

      if not STRING_LISTS.ISEMPTY(PACKAGE_LIST) and
         CURRENT_SCOPE.TYPE_OF_SCOPE /= PACKAGE_SPECIFICATION then
         -- if the current unit is a package specification, local
         -- packages will be traced after the case statement instead
         -- of in the "when others" branch.
         GENERATE_TRACE_LOCAL_PACKAGES(PACKAGE_LIST, USE_LIST);
         WROTE_SOMETHING := TRUE;
      end if;

      if not WROTE_SOMETHING then
         WRITE_LINE_BODY_BUFFER("  null;");
      end if;

   end GENERATE_NOT_FOUND_BRANCH;

   -----------------------------------------------------------------------
   procedure GENERATE_TRACE_LOCAL_PACKAGES(PACKAGE_LIST : STRING_LISTS.LIST;
                                           USE_LIST     : STRING_LISTS.LIST) is

      -- Loop through the list of local packages and generate a call to
      -- search their specs for the variable.  Local packages are traced
      -- when the variable was not found among the current unit's local
      -- variables.

      ITERATOR  : STRING_LISTS.LISTITER;
      NEXT_NAME : STRING_TYPE;
   begin
      ITERATOR := STRING_LISTS.MAKELISTITER(PACKAGE_LIST);
      while STRING_LISTS.MORE(ITERATOR) loop
         STRING_LISTS.NEXT(ITERATOR, NEXT_NAME);
         WRITE_BODY_BUFFER(
           VALUE(MAKE_TRACING_PREFIX(CURRENT_SCOPE,NEXT_NAME,
           CURRENT_SCOPE.TYPE_OF_SCOPE)) & "SPEC_F(");
         GENERATE_LIST_PARAMETER(USE_LIST);
         WRITE_LINE_BODY_BUFFER(");");
      end loop;
   end GENERATE_TRACE_LOCAL_PACKAGES;

   -----------------------------------------------------------------------
   procedure GENERATE_TRACE_WITHED_UNITS(WITH_LIST : STRING_LISTS.LIST;
                                         USE_LIST  : STRING_LISTS.LIST) is

      -- Generate procedure calls to search for variables in packages
      -- that are in the with list.  Note that a unit won't be in the
      -- with list if it wasn't instrumented.

      ITERATOR  : STRING_LISTS.LISTITER;
      NEXT_NAME : STRING_TYPE;

   begin
      ITERATOR := STRING_LISTS.MAKELISTITER(WITH_LIST);
      while STRING_LISTS.MORE(ITERATOR) loop
         STRING_LISTS.NEXT(ITERATOR, NEXT_NAME);
         WRITE_BODY_BUFFER(
           SD_PREFIX & VALUE(NEXT_NAME) & "." &
           VALUE(NEXT_NAME) & "_"  & SD_PREFIX & "SPEC_F(");
         GENERATE_LIST_PARAMETER(USE_LIST);
         WRITE_LINE_BODY_BUFFER(");");
      end loop;
   end GENERATE_TRACE_WITHED_UNITS;

   -----------------------------------------------------------------------
   procedure GENERATE_ONE_DIMENSION_ARRAY_TRACE(TYPE_NAME : STRING) is

      -- Generate Display and Set procedures for a one dimensional
      -- array when the index type is not known.

   begin
      for PROC in DISPLAY_OR_SET loop
         if PROC = DISPLAY then
            WRITE_LINE_BODY_BUFFER(
              "procedure " & SD_PREFIX & "D(Name: String; Var: " &
              TYPE_NAME & ") is");
         else
            WRITE_LINE_BODY_BUFFER(
              "procedure " & SD_PREFIX & "S(Var: in out " & TYPE_NAME & ") is");
         end if;
         WRITE_LINE_BODY_BUFFER("  X: SD_Runtime_Utilities.Array_Info;");
         WRITE_LINE_BODY_BUFFER("  Y: Boolean;");
         WRITE_LINE_BODY_BUFFER("begin");
         WRITE_LINE_BODY_BUFFER("for i in Var'Range loop");
         WRITE_LINE_BODY_BUFFER(
           "  SD_Runtime_Utilities.Check_This_Element(" &
           SD_PREFIX & "M(i),X,Y);");
         WRITE_LINE_BODY_BUFFER("  if Y then");
         if PROC = DISPLAY then
            WRITE_LINE_BODY_BUFFER(
              "    " & SD_PREFIX & "D(Name & ""("" & " &
              SD_PREFIX & "M(i) & "")"", Var(i));");
         else
            WRITE_LINE_BODY_BUFFER("    " & SD_PREFIX & "S(Var(i));");
         end if;
         WRITE_LINE_BODY_BUFFER("  end if;");
         WRITE_LINE_BODY_BUFFER("  exit when X.Stop_Tracing_Array;");
         WRITE_LINE_BODY_BUFFER("end loop;");
         WRITE_LINE_BODY_BUFFER("SD_Runtime_Utilities.Check_Array(X);");
         WRITE_LINE_BODY_BUFFER("end;");
      end loop;
   end GENERATE_ONE_DIMENSION_ARRAY_TRACE;

   -----------------------------------------------------------------------
   procedure GENERATE_N_DIMENSION_ARRAY_TRACE(TYPE_NAME  : STRING;
                                              DIMENSIONS : INTEGER) is
   begin
      for PROC in DISPLAY_OR_SET loop
         if PROC = DISPLAY then
            WRITE_LINE_BODY_BUFFER(
              "procedure " & SD_PREFIX & "D(Name: String; Var: " &
              TYPE_NAME & ") is");
         else
            WRITE_LINE_BODY_BUFFER(
              "procedure " & SD_PREFIX & "S(Var: in out " & TYPE_NAME & ") is");
         end if;
         WRITE_LINE_BODY_BUFFER("  X: SD_Runtime_Utilities.Array_Info;");
         WRITE_LINE_BODY_BUFFER("  Y: Boolean;");
         WRITE_LINE_BODY_BUFFER("begin");
         for I in 1 .. DIMENSIONS loop
            WRITE_LINE_BODY_BUFFER("SD_Runtime_Utilities.Get_N_Dim_Index(X);");
            if I = 1 then
               WRITE_LINE_BODY_BUFFER("Outer:");
            end if;
            WRITE_LINE_BODY_BUFFER(
              "for i" & INTEGER_STRING(I) &
              " in Var'Range(" & INTEGER_STRING(I) & ") loop");
            WRITE_LINE_BODY_BUFFER(
              "SD_Runtime_Utilities.Check_N_Dim_Element(" &
              SD_PREFIX & "M(i" & INTEGER_STRING(I) & "),X,Y);");
            WRITE_LINE_BODY_BUFFER("if Y then");
         end loop;

         WRITE_LINE_BODY_BUFFER("if not X.FOUND_RIGHT_PAREN then");
         WRITE_LINE_BODY_BUFFER("  SD_Runtime_Utilities.Error_Message(" &
                                """Invalid array index"");");
         WRITE_LINE_BODY_BUFFER("end if;");

         if PROC = DISPLAY then
            WRITE_BODY_BUFFER(SD_PREFIX & "D(Name & ""("" & ");
            for I in 1 .. DIMENSIONS loop
               WRITE_BODY_BUFFER(SD_PREFIX & "M(i" & INTEGER_STRING(I) & ")");
               if I = DIMENSIONS then
                  WRITE_BODY_BUFFER(" & "")"",");
               else
                  WRITE_BODY_BUFFER(" & "","" & ");
               end if;
            end loop;
            WRITE_BODY_BUFFER("Var(");
         else
            WRITE_BODY_BUFFER(SD_PREFIX & "S(Var(");
         end if;

         for I in 1 .. DIMENSIONS loop
            WRITE_BODY_BUFFER("i" & INTEGER_STRING(I));
            if I < DIMENSIONS then
               WRITE_BODY_BUFFER(",");
            end if;
         end loop;
         WRITE_LINE_BODY_BUFFER("));");
         WRITE_LINE_BODY_BUFFER("exit Outer when not X.Trace_Whole_Array;");
         for I in 1 .. DIMENSIONS loop
            WRITE_LINE_BODY_BUFFER("end if;");
            WRITE_BODY_BUFFER("end loop");
            if I = DIMENSIONS then
               WRITE_BODY_BUFFER(" Outer");
            end if;
            WRITE_LINE_BODY_BUFFER(";");
            if I < DIMENSIONS then
               WRITE_LINE_BODY_BUFFER(
                 "exit Outer when not X.Trace_Whole_Array;");
            end if;
         end loop;
         WRITE_LINE_BODY_BUFFER("if not X.Found_An_Element then");
         WRITE_LINE_BODY_BUFFER(
           "  SD_Runtime_Utilities.Unscan_Variable(" &
           """Invalid index expression"");");
         WRITE_LINE_BODY_BUFFER("end if;");
         WRITE_LINE_BODY_BUFFER("end;");
      end loop;
   end GENERATE_N_DIMENSION_ARRAY_TRACE;

   --------------------------------------------------------------------------
   procedure WRITE_CHOICE_TEXT(TEXT : STRING_LISTS.LIST) is
      ITER       : STRING_LISTS.LISTITER;
      NEXT_TOKEN : STRING_TYPE;
      TEMP       : STRING_TYPE;
   begin
      STRING_PKG.MARK;
      TEMP := CREATE("    ");
      ITER := STRING_LISTS.MAKELISTITER(TEXT);
      while STRING_LISTS.MORE(ITER) loop
         STRING_LISTS.NEXT(ITER, NEXT_TOKEN);
         TEMP := TEMP & NEXT_TOKEN & " ";
      end loop;
      WRITE_LINE_BODY_BUFFER(VALUE(TEMP));
      STRING_PKG.RELEASE;
   end WRITE_CHOICE_TEXT;

   -----------------------------------------------------------------------
   procedure GENERATE_TRACE_RECORD_FIELD(FIELDS      : STRING_LISTS.LIST;
                                         PROC        : DISPLAY_OR_SET;
                                         FOUND_CASE  : BOOLEAN;
                                         FOUND_FIELD : out BOOLEAN) is

      ITER       : STRING_LISTS.LISTITER;
      NEXT_FIELD : STRING_TYPE;
   begin
      FOUND_FIELD := FALSE;
      ITER := STRING_LISTS.MAKELISTITER(FIELDS);
      while STRING_LISTS.MORE(ITER) loop
         STRING_LISTS.NEXT(ITER, NEXT_FIELD);
         if EQUAL(NEXT_FIELD, "NULL") then
            if FOUND_CASE then
               WRITE_LINE_BODY_BUFFER("null;");
            end if;
         else
            FOUND_FIELD := TRUE;
            WRITE_LINE_BODY_BUFFER(
              "if String_Pkg.Is_Empty(Field) or else String_Pkg.Equal(Field," &
              """" & VALUE(NEXT_FIELD) & """) then");
            if PROC = DISPLAY then
               WRITE_LINE_BODY_BUFFER(
                 "  " & SD_PREFIX & "D(Name & ""." & VALUE(NEXT_FIELD) &
                 """,Var." & VALUE(NEXT_FIELD) & ");");
            else
               WRITE_LINE_BODY_BUFFER(
                 "  " & SD_PREFIX & "S(Var." & VALUE(NEXT_FIELD) & ");");
            end if;
            WRITE_LINE_BODY_BUFFER("  Found := True;");
            WRITE_LINE_BODY_BUFFER("end if;");
         end if;
      end loop;
   end GENERATE_TRACE_RECORD_FIELD;

   -----------------------------------------------------------------------

end SD_GENERATION_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SIUTILS.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with PARSERDECLARATIONS;
with LISTS;
package SOURCE_INSTRUMENTER_UTILITIES is
--| Utilities for Source Instrumenter


--| Overview

--| This package contains all the utility subprograms for the source
--| instrumenter called from Parser.Parse and Parser.Apply_Actions.  Each
--| utility is described in detail below in its specification.

  package PD renames PARSERDECLARATIONS;

  COMMENT_BUFFER : COMMENT_LISTS.LIST;
  --| List of comments in between two tokens

  type POP_TO_WHERE is (TO_OUTPUT, TO_NOWHERE);
  --| Used in popping closing identifiers/designators

  type IDENTIFIER_LIST_TYPE is (OBJECT_LIST, RECORD_FIELD_LIST,
    DISCRIMINANT_LIST, PARAMETER_LIST, RENAMING_LIST, EXCEPTION_LIST,
    GENERIC_OBJECT_LIST);

  -----------------------------------------------------------------
  --| Procedures for output formatting
  -----------------------------------------------------------------

  -----------------------------------------------------------------

  procedure INITIALIZE;  --| Initializes the utilities

  -----------------------------------------------------------------

  procedure PUT( --| Puts the token in the buffer or in the output file
                NEXT_TOKEN : in out PD.PARSESTACKELEMENT);
  --| Token that was just pushed on parse stack

  --| Effects

  --| Put examines the Buffering flag in to see whether buffering is turned on.
  --| If buffering is turned on, the token is placed in the buffer; if not,
  --| Print_Token is called to print the token.

  -----------------------------------------------------------------

  procedure PUT_SPACE(SPACES : in NATURAL := 1);
  --| Puts a space in the output file.

  --| Effects

  --| The specified number of spaces is put into the output file.  The
  --| current column information is also updated.

  -----------------------------------------------------------------

  procedure PRINT_COMMENTS(BUFFER : in out COMMENT_LISTS.LIST);
  --| Outputs buffered comments

  --| Effects

  --| If comment formatting is off, comments are output at the same
  --| line and column position as they appeared in the source.  If this
  --| is not possible, the comment is positioned at the next line and the
  --| source column.  If comment formatting is on, comments in the
  --| declarative parts are printed alongside declarations; comments in
  --| the body are preceded by a blank line and indented to the level of
  --| the source if possible.  If a comment cannot be indented to the level
  --| of the source, it is handled the same way as comments with comment
  --| formatting off.

  -----------------------------------------------------------------

  procedure NEW_LINE;  --| Requests a new line in the buffer or output

  --| Effects

  --| New_Line examines the Buffering flag in Pretty_Printer_Declarations
  --| to see whether buffering is turned on, and requests a new line
  --| in the buffer or the output.

  -----------------------------------------------------------------

  procedure INCREASE_INDENT;  --| Increases indent

  --| Effects

  --| Requests an increase of the indent by PPD.Indentation_Level.

  --| Requires

  --| It is expected that New_Line will be called with each call to
  --| Increase_Indent, in order to keep the Current_Column information
  --| up to date.

  -----------------------------------------------------------------

  procedure DECREASE_INDENT;  --| Decreases indent

  --| Effects

  --| Requests a decrease of the indent by PPD.Indentation_Level.

  --| Requires

  --| It is expected that New_Line will have been called before each call to
  --| Increase_Indent, in order to keep the Current_Column information
  --| up to date.

  -----------------------------------------------------------------

  procedure CHANGE_INDENT;  --| Changes the indent

  --| Effects

  --| Requests a change in  the indent by an amount other than
  --| Indentation_Level.  Indent is changed to the current column.
  --| This procedure is used to line up parameter lists or discriminant
  --| specification lists.

  --| Requires

  --| This pair of procedures (Change_Indent, Resume_Normal_Indentation)
  --| are expected to be called without any intervening Increase_Indent
  --| or Decrease_Indent calls.

  -----------------------------------------------------------------

  procedure RESUME_NORMAL_INDENTATION;  --| Changes the indent back

  --| Effects

  --| Changes the indent back to what it was before Change_Indent was
  --| called.

  --| Requires

  --| This pair of procedures (Change_Indent, Resume_Normal_Indentation)
  --| are expected to be called without any intervening Increase_Indent
  --| or Decrease_Indent calls.

  -----------------------------------------------------------------

  procedure POP_IDENTIFIER(WHERE : in POP_TO_WHERE := TO_NOWHERE);

  --| Effects

  --| Pops an identifier off the stack of identifiers/designators.  Stack is
  --| used for keeping track of beginning and closing identifiers/designators
  --| so that default closing identifiers/designators can be output.

  -----------------------------------------------------------------

  procedure PUSH_IDENTIFIER;

  --| Effects

  --| Pushes an identifier/designator on the identifier stack, which is used
  --| for keeping track of beginning and closing identifiers/designators, so
  --| that default closing identifiers can be filled in.

  -----------------------------------------------------------------

  procedure PUSH_EMPTY_TOKEN;

  --| Effects

  --| Pushes the empty token on the stack of beginning/closing
  --| identifiers/designators.  This procedure exists to handle loop and
  --| block identifiers which are optional at both the beginning and end
  --| of the block.  If the identifier is left off, the empty
  --| empty token is pushed as the loop or block identifer in order
  --| to synchronize the stack when it is automatically popped at
  --| the end of a loop or block.

  -----------------------------------------------------------------


  -----------------------------------------------------------------
  --| Procedures for source instrumenting
  -----------------------------------------------------------------


  procedure USE_PACKAGE_NAME;

  --| Effects

  --| The current expanded name is the package name in the
  --| use clause.  Turn off the Saving_Expanded_Name flag.

  -----------------------------------------------------------------

  procedure WITH_LIBRARY_UNIT;

  --| Effects

  --| The current saved token is the name of a library unit
  --| in a with clause.  Add its name to the with_list.

  -----------------------------------------------------------------

  procedure START_SAVING_EXPANDED_NAME;

  --| Effects

  --| Turn on the Saving_Expanded_Name flag to start saving
  --| tokens for an expanded name.

  -----------------------------------------------------------------

  procedure SAVE_SEPARATE_NAME;

  --| Effects

  --| The current expanded name is the name of the parent unit.
  --| Turn off the Saving_Expanded_Name flag.

  -----------------------------------------------------------------

  procedure SAVE_GENERIC_NAME;

  --| Effects

  --| The current expanded name is the generic unit name.
  --| Turn off the Saving_Expanded_Name flag.

  ------------------------------------------------------------------

  procedure SUBPROGRAM_TYPE(INTYPE : in STRING);

  --| Effects

  --| This is called by Apply_Actions when it is known whether
  --| the current subprogram is a procedure or function.

  ------------------------------------------------------------------

  procedure START_BEGIN_END_BLOCK;

  -- Called at the begining of each begin end block. If were not in
  -- a block or a package body then add an entering unit call

  ------------------------------------------------------------------

  procedure END_BLOCK_SEQUENCE_OF_STATEMENTS;

  --  Called at the end of a begin-end block.  If we are not in a
  --  block or a package body then create an exiting unit.

  ------------------------------------------------------------------

  procedure START_DO_SEQUENCE_OF_STATEMENTS;

  -- Called at the "do" following an accept statement.  Create a block
  -- and add tracing procedues for an parameters to the accept.

  ------------------------------------------------------------------

  procedure END_DO_SEQUENCE_OF_STATEMENTS;

  -- Called at the end of the block for an accept statement.  Close the
  -- block that we created, and create a breakpoint.

  ------------------------------------------------------------------

  procedure ADD_BREAKPOINT;

  -- Add a breakpoint to the instrumented source.

  ------------------------------------------------------------------

  procedure START_RETURN_STATEMENT;

  -- We are at a return statement.  Add a breakpoint and an exiting
  -- unit.

  ------------------------------------------------------------------

  procedure START_BLOCK(HAS_NAME : in BOOLEAN);

  -- Called when a block is encountered.  If the block has no name
  -- then one is created for it.  Scope names are set up to reflect
  -- the block name, and the scope package is called to set up a
  -- new scope.

  ------------------------------------------------------------------

  procedure END_FOR_LOOP;

  -- Called at the end of a for loop.  Cleanup is done on the loop
  -- variable tracing information.

  -----------------------------------------------------------------

  procedure ADD_PACKAGE_BODY_BEGIN;

  --  The package has no begin end block. If it is a compilation unit
  --  Then add a begin to the instrumented file, and call
  --  create_unit_information for the package.

  ------------------------------------------------------------------

  procedure START_EXCEPTION_BRANCH;

  --  We are beginning an exception branch.  Next the handler in a
  --  block and check to see if we caused the exception

  ------------------------------------------------------------------

  procedure END_EXCEPTION_SEQUENCE_OF_STATEMENTS;

  --  Close the block that we created.  Include a when others exception
  --  handler that does an exiting unit and reraises the exception

  ------------------------------------------------------------------

  procedure ADD_OTHERS_HANDLER;

  -- Add and others exception handler that calls exiting unit.

  ------------------------------------------------------------------

  procedure END_BLOCK_STATEMENT;

  -- Exit the scope created for a block statement

  ------------------------------------------------------------------

  procedure ADD_EXCEPTION_HANDLER;

  -- Add an exception handler with an others branch that does an
  -- exiting unit.

  -----------------------------------------------------------------

  procedure END_COMPILATION_UNIT;

  --| Effects

  --| Finish processing the current compilation unit, and reset
  --| local variables in case more compilation units follow.

  -----------------------------------------------------------------

  procedure INCREMENT_SCOPE(TYPE_OF_SCOPE : in SCOPE_TYPE);

  --| Effects

  --| This is called following the "is" of a program unit
  --| declaration.  Stack any information from the outer scope.
  --| If the new scope is a package specification
  --| then initialize the buffer files
  --| which will contain the information for tracing the
  --| types and variables declared in the package.

  -----------------------------------------------------------------

  procedure DECREMENT_SCOPE;

  --| Effects

  --| This is called following the "end [identifier];" of
  --| a program unit declaration.  If the program unit was
  --| a package specification then close the tracing packages.
  --| Pop any stacked information from the enclosing scope.

  -----------------------------------------------------------------

  procedure START_DECLARATIVE_PART;

  --| Effects

  --| This is called at the start of a declarative part for
  --| a body.  Add the procedure declaration for tracing local variables.
  --| If the unit is a package body, then retrieve the
  --| declarations for tracing the private part of its
  --| specification.

  ----------------------------------------------------------------

  procedure END_DECLARATIVE_PART;

  --| Effects

  --| Copy the subprogram bodies
  --| for type tracing into the instrumented source.  They were
  --| buffered until the end of the declarative part because
  --| bodies cannot be added until the "later declarative"
  --| part.  Procedure declarations for all of the bodies will
  --| have already been written to the instrumented source.

  -----------------------------------------------------------------
  procedure ADD_IDENTIFIER_TO_LIST;

  --| Effects

  --| Add the current identifier to the identifier list.

  -----------------------------------------------------------------

  procedure SET_IDENTIFIER_MODE(MODE : in IDENTIFIER_MODE);

  --| Effects

  --| This procedure is called when the mode of current
  --| identifier list is known.  The type of the list is
  --| not known yet, so save the mode.
  --| The modes are:
  --|   READ_ONLY  : IN parameters and constants
  --|   WRITE_ONLY : OUT parameters
  --|   READ_WRITE : IN OUT parameters and variables
  --|   NONE       : task type varaibles, exception identifiers

  -----------------------------------------------------------------

  procedure PROCESS_IDENTIFIER_LIST(LIST_TYPE : in IDENTIFIER_LIST_TYPE);

  --| Effects

  --| This is called at the end of the current identifier list.
  --| Update the mode and type for all identifiers in the list,
  --| and save the list for later processing, depending on the
  --| List_Type.

  -----------------------------------------------------------------

  procedure SAVE_TYPE_IDENTIFIER;

  --| Effects

  --| The current identifier is the name of the type in
  --| a type declaration.  Save it for later use.

  -----------------------------------------------------------------

  procedure SAVE_TYPE_CLASS(TYPE_KIND : in TYPE_CLASS);

  -- Remember what category of type defintion was encountered.

  -----------------------------------------------------------------

  procedure END_TYPE_DECLARATION;

  -- Signal the end of a type declaration. Generate the tracing
  -- procedures for the type.

  -----------------------------------------------------------------

  procedure START_ANONYMOUS_ARRAY_DEFINITION;

  -- An anonymous array is encountered.  Start generating trace procedures
  -- for the anonymous array

  procedure END_ANONYMOUS_ARRAY_DEFINITION;

  --  Finish trace procedures for anonymous array

  -----------------------------------------------------------------

  procedure END_TYPEMARK;

  --| Effects

  --| The current expanded name is a typemark name, (before
  --| any constraints which may follow).  Turn off the
  --| Saving_Expanded_Name flag.

  -----------------------------------------------------------------

  procedure START_PRIVATE_PART;

  --| Effects

  --| Initialize the private type tracing files.

  -----------------------------------------------------------------

  procedure START_RECORD_VARIANT;

  -- Perform processing required when a record variant is encountered

  -----------------------------------------------------------------

  procedure END_RECORD_VARIANT;

  -- Complete processing for the record variant

  -----------------------------------------------------------------

  procedure NULL_RECORD_FIELD;

  -- Called when a null record field is encountered.  This is  saved
  -- so that we can put in a place holder if neccesary

  -----------------------------------------------------------------

  procedure SAVE_CASE_IDENTIFIER;

  -- Save the identifier used in a record case statment

  -----------------------------------------------------------------

  procedure SAVE_LOOP_PARAMETER;

  -- Save information about a loop parameter.  Needed to enable tracing
  -- of the loop parameter.

  -----------------------------------------------------------------

  procedure START_GENERIC_SPECIFICATION;

  -- Start processing a generic spec

  -----------------------------------------------------------------
  procedure END_GENERIC_SPECIFICATION;

  -- Stop processing a generic spec.  Reset flag indicating the a
  -- generic is being processed.

  -----------------------------------------------------------------

  procedure END_GENERIC_TYPE;

  --  Add tracing procedures for the generic type.

  -----------------------------------------------------------------

  procedure INCREMENT_ARRAY_INDEX;

  -- Used when processing a multi-dimension array.  Keeps count of
  -- the number of dimensions in the array.

  -----------------------------------------------------------------

  procedure START_ARRAY_INDEX;

  -- Used to start counting the number of dimensions in an array

  -----------------------------------------------------------------

  procedure END_ARRAY_INDEX;

  -- Stop counting the number of dims.  The current number is correct

  -----------------------------------------------------------------

end SOURCE_INSTRUMENTER_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--BKPT.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG; use STRING_PKG;
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with SD_TYPE_DEFINITIONS; use SD_TYPE_DEFINITIONS;

package CREATE_BREAKPOINT is

--| Overview
--|
--| This package is used to insert calls into the source.  It maintains
--| a scope stack to maintain the current scope.  The create procedures
--| are used to do the actual insertion of code.  The other procedures
--| are used to tell this package when programs are started and ended

  BREAKPOINT_PRINTED_LAST        : BOOLEAN;  -- Used to prevent two consecutive
                                             -- breakpoints

  BREAKPOINT_NUMBER_FOR_PRINTING : STRING(1 .. 6) := "      ";
                                                -- breakpoint number in string
                                                -- format for printing in
                                                -- listing file

  procedure NEW_COMPILATION_UNIT(UNIT_NAME    : in ADA_NAME;
                                 TYPE_OF_UNIT : in PROGRAM_UNIT_TYPE);

  --| Effects
  --|
  --| This procedure is used to define a new compilation unit.
  --| Each time a new compilation unit is entered, this procedure
  --| is called.  Any information about a previous compilation unit
  --| is cleared and the new compilation unit becomes the current
  --| compilation unit.

  procedure START_PROGRAM_UNIT(UNIT_NAME    : in ADA_NAME;
                               TYPE_OF_UNIT : in PROGRAM_UNIT_TYPE);

  --| Effects
  --|
  --| This procedure is used to define a new program unit.  Each time a new
  --| program unit is entered, this procedure is called.  The procedure
  --| name and type are used in constructing entering/exiting units and
  --| breakpoints.

  procedure CREATE_ENTERING_UNIT;

  --| Effects
  --|
  --| This procedure is called whenever an entering_unit procedure
  --| call needs to be added to the instrumented source.  The information
  --| about the current compilation unit and current program unit are used
  --| to construct the Entering_Unit procedure call.

  procedure CREATE_EXITING_UNIT;

  --| Effects
  --|
  --| This procedure creates an exiting unit call for the current program
  --| unit.  This unit will be called before each return statement, at
  --| the end of the program unit, and at the end of each exception
  --| handler.

  procedure END_PROGRAM_UNIT;

  --| Effects
  --|
  --| This procedure tells when a program unit has ended.  The current
  --| unit is set to the enclosing scope (if there is one).  All future
  --| calls to the create procedures will use this new unit.

  procedure CREATE_BREAKPOINT(LOOP_LIST : in STRING_LISTS.LIST);

  --| Effects
  --|
  --| This procedure is called each time a breakpoint needs to be added.
  --| This procedure may be called at the same point in the source, so a
  --| flag is maintained to tell when the last line output was a breakpoint.
  --| If it was, then another breakpoint is added.  This flag is reset in
  --| Source_Instrumenter_Utilities each time a new line of user code
  --| is output.

  procedure CREATE_UNIT_INFORMATION;

  --| Effects
  --|
  --| This procedure is called when a Unit_Information procedure call
  --| needs to be added to the source.  This procedure uses the current
  --| compilation unit and the list of procedures defined for that unit.

  --| Requires
  --|
  --| This procedure must be the last one called for a compilation unit.

  function GET_PROGRAM_UNIT return STRING;

  --| Returns a string containing the program unit record for the current
  --| task. Used for printing the record in the instrumented source.

  function GET_PROGRAM_UNIT_NON_TASK return STRING;

  --|  Same as above for program units that are not tasks.

end CREATE_BREAKPOINT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--BKPT.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STACK_PKG;
with LISTS;
with TEXT_IO; use TEXT_IO;
with CHANGE_TEXT;
with SD_SOURCE_BUFFERING;
with SYSTEM_PARAMETERS;
with SCOPE_PACKAGE;

package body CREATE_BREAKPOINT is

--|  Overview
--|
--|  This package takes care of creating calls to the RTM.  It creates
--|  breakpoints, Entering_units, and Exiting units with the appropriate
--|  parameters.  It also exports a function that returns a
--|  program_unit_unique_identifier for the current unit.  This function
--|  is called to create the identifier for the calls create in tracing
--|  variables
--|
--|  There are several routines called by the source instrumenter to tell
--|  this package when a unit is entered or exited.  These calls are:
--|  New_compilation_unit, Start_Program_Unit, and End_program_unit.
--|  The information passed to these procedures allows the package to
--|  determine the name, type, and other info about the current unit
--|  and current compilation unit.
--|
--|  Four other procedure are used to output instrumented source.  They are
--|  Create_entering_Unit, Create_exiting_unit, Create_Breakpoint, and
--|  Create_Unit_Information.  These procedures when called will output
--|  the appropriate call to the run time monitor.
--|
--|  The current program unit is identified by three elements: The compilation
--|  unit containing it, a unique number assigned to the unit, and the type of
--|  unit.  The current compilation unit is always maintained in
--|  CURRENT_COMPILATION_UNIT, and the other elements are maintained in
--|  a record.  These records are stacked for nested procedures in order
--|  to maintain the current unit properly.
--|
--|  A list of the units in the current compilation unit is also maintained.
--|  This list is used in the Unit_Information call to the Run time monitor to
--|  identify the units in a compilation unit.  This is the only place where
--|  the unit names are used.  All other places use the three elements used
--|  above.  When the name of a unit is needed. Its unique number is used to
--|  select the correct element of the list containing the program unit name.


  use STRING_PKG;
  package SP  renames SYSTEM_PARAMETERS;
  package SID renames SOURCE_INSTRUMENTER_DECLARATIONS;
  package SDB renames SD_SOURCE_BUFFERING;

  type PROGRAM_UNIT_INFORMATION is   --|  Information needed to identify a unit
    record
      UNIT_NAME   : ADA_NAME;
      UNIT_TYPE   : PROGRAM_UNIT_TYPE;         --|  type of unit
    end record;

  type UNIT_DESCRIPTOR is
    record
      UNIT_NAME            : ADA_NAME;
      UNIT_TYPE            : PROGRAM_UNIT_TYPE;
      FIRST_BREAKPOINT     : BREAKPOINT_NUMBER_RANGE;
      LAST_BREAKPOINT      : BREAKPOINT_NUMBER_RANGE;
    end record;

  CURRENT_COMPILATION_UNIT : ADA_NAME;
    --|  The name of the current compilation unit being processed

  BREAKPOINT_NUMBER        : BREAKPOINT_NUMBER_RANGE;
    --|  The number of breakpoints that have been created

  CURRENT_PROGRAM_UNIT     : PROGRAM_UNIT_INFORMATION;
    --|  Contains the information about the program unit currently being processed

  CURRENT_NESTING_LEVEL    : NATURAL;
    --|  The current level of nesting

  package PROGRAM_UNIT_STACK_PACKAGE is      -- Used to Maintain the current
    new STACK_PKG(PROGRAM_UNIT_INFORMATION); -- unit info through nesting

  package PROGRAM_UNIT_LIST_PACKAGE is       -- Used to keep a list of the units
    new LISTS(UNIT_DESCRIPTOR);            -- in the current comp unit

  PROGRAM_UNIT_LIST  : PROGRAM_UNIT_LIST_PACKAGE.LIST;
    --|  The list of units in the current compilation unit

  PROGRAM_UNIT_STACK : PROGRAM_UNIT_STACK_PACKAGE.STACK;
    --|  The stack used to maintain the current unit

-------------------------------------------------------------------------

  procedure NEW_COMPILATION_UNIT(UNIT_NAME    : in ADA_NAME;
                                 TYPE_OF_UNIT : in PROGRAM_UNIT_TYPE) is

--|  Effects
--|
--|  This procedure is used to define the current compilation unit.  Since a
--|  compilation can contain several compilation units, all variables
--|  must be re-initialized when a new compilation unit is started.

  begin
    CURRENT_NESTING_LEVEL := 1;
    PROGRAM_UNIT_STACK := PROGRAM_UNIT_STACK_PACKAGE.CREATE;
    PROGRAM_UNIT_LIST := PROGRAM_UNIT_LIST_PACKAGE.CREATE;
    CURRENT_COMPILATION_UNIT := MAKE_PERSISTENT(UNIT_NAME);
    BREAKPOINT_NUMBER := 0;

--  If the compilation unit is a procedure or function then the procedure
--  or function is program unit number one.  In a package the first nested
--  unit will be unit number 1.

    CURRENT_PROGRAM_UNIT := (UNIT_NAME, TYPE_OF_UNIT);

  end NEW_COMPILATION_UNIT;

-------------------------------------------------------------------------

  procedure START_PROGRAM_UNIT(UNIT_NAME    : in ADA_NAME;
                               TYPE_OF_UNIT : in PROGRAM_UNIT_TYPE) is

--|  Effects
--|
--|  This procedure defines a new program unit for the current compilation
--|  unit.  The nesting level is updated, the information about the enclosing
--|  unit is pushed on the stack, the new unit is defined to be the current
--|  unit and it is added to the list of units.

  begin
    CURRENT_NESTING_LEVEL := CURRENT_NESTING_LEVEL + 1;
    PROGRAM_UNIT_STACK_PACKAGE.PUSH(PROGRAM_UNIT_STACK, CURRENT_PROGRAM_UNIT);
    CURRENT_PROGRAM_UNIT := (UNIT_NAME, TYPE_OF_UNIT);
  end START_PROGRAM_UNIT;

-------------------------------------------------------------------------

  procedure CREATE_ENTERING_UNIT is

--|  Effects
--|
--|  This procedure outputs the entering unit call to the run time monitor
--|  for the current unit.  The call is put to the instrumented file only

    CURRENT_UNIT : UNIT_DESCRIPTOR;

  begin

    -- Currently, entering unit call is not made for package body
    -- initialization at outer level.  This may be added back later
    -- if the problems can be overcome

    if CURRENT_PROGRAM_UNIT.UNIT_TYPE /= PACKAGE_TYPE then
      CURRENT_UNIT := (CURRENT_PROGRAM_UNIT.UNIT_NAME,
        CURRENT_PROGRAM_UNIT.UNIT_TYPE,
        BREAKPOINT_NUMBER + 1,
        0);
      PROGRAM_UNIT_LIST_PACKAGE.ATTACH(PROGRAM_UNIT_LIST, CURRENT_UNIT);
    end if;

    if not (CURRENT_PROGRAM_UNIT.UNIT_TYPE = PACKAGE_TYPE and
            CURRENT_NESTING_LEVEL > 1) then
      NEW_LINE(SID.INSTRUMENTED_FILE);
      SDB.WRITE_INST_SOURCE(SP.PREFIX & "RTM.Entering_Unit(");
      if CURRENT_PROGRAM_UNIT.UNIT_TYPE = TASK_TYPE then
        SDB.WRITE_INST_SOURCE(GET_PROGRAM_UNIT);
      else
        SDB.WRITE_INST_SOURCE(GET_PROGRAM_UNIT_NON_TASK);
      end if;
      SDB.WRITE_INST_SOURCE(");");
      SDB.CLEAR_SOURCE_BUFFER;

      if CURRENT_PROGRAM_UNIT.UNIT_TYPE = PACKAGE_TYPE then
        NEW_LINE(SID.INSTRUMENTED_FILE);
      end if;
    end if;

  end CREATE_ENTERING_UNIT;

-------------------------------------------------------------------------

  procedure CREATE_EXITING_UNIT is

--|  Effects
--|
--|  This procedure creates the exiting unit call to the run time monitor.
--|

  begin

    -- Currently, exiting unit call is not made for package body
    -- initialization at outer level.  This may be added back later
    -- if the problems can be overcome

    if not (CURRENT_PROGRAM_UNIT.UNIT_TYPE = PACKAGE_TYPE and
            CURRENT_NESTING_LEVEL > 1) then
      SDB.WRITE_INST_SOURCE(SP.PREFIX & "RTM.Exiting_Unit(");
      if CURRENT_PROGRAM_UNIT.UNIT_TYPE = TASK_TYPE then
        SDB.WRITE_INST_SOURCE(GET_PROGRAM_UNIT);
      else
        SDB.WRITE_INST_SOURCE(GET_PROGRAM_UNIT_NON_TASK);
      end if;
      SDB.WRITE_LINE_INST_SOURCE(");");
      BREAKPOINT_PRINTED_LAST := FALSE;
    end if;
  end CREATE_EXITING_UNIT;

-------------------------------------------------------------------------

  procedure END_PROGRAM_UNIT is

--|  Effects
--|
--|  This is procedure is called to inform the create_breakpoint package
--|  that the current unit has ended.  If we are nested then the outer
--|  scope information is popped from the stack.  If the unit that
--|  we have just complete processing is a procedure that is a compilation
--|  unit, then output the call_unit_Information unit is created.
--|

  begin
    CURRENT_NESTING_LEVEL := CURRENT_NESTING_LEVEL - 1;

    if CURRENT_NESTING_LEVEL = 0 then

  --  If this is an non-nested procedure then create a call_unit_info
  --  procedure.

      if CURRENT_PROGRAM_UNIT.UNIT_TYPE = PROCEDURE_TYPE or
         CURRENT_PROGRAM_UNIT.UNIT_TYPE = FUNCTION_TYPE or
         CURRENT_PROGRAM_UNIT.UNIT_TYPE = TASK_TYPE then
        NEW_LINE(SID.INSTRUMENTED_FILE);
        SDB.WRITE_LINE_INST_SOURCE(
          "with SD_RUN_TIME_MONITOR; use SD_RUN_TIME_MONITOR;");
        SDB.WRITE_LINE_INST_SOURCE(
          "with SD_TYPE_DEFINITIONS, STRING_PKG; use SD_TYPE_DEFINITIONS;");
        SDB.WRITE_LINE_INST_SOURCE(
          "package body SD_" &
           CHANGE_TEXT.CONVERT_PERIODS_TO_UNDERSCORES(
             VALUE(CURRENT_COMPILATION_UNIT))
           & " is");
        SDB.WRITE_LINE_INST_SOURCE( "begin");
        CREATE_UNIT_INFORMATION;
        SDB.WRITE_LINE_INST_SOURCE( "end;");
      end if;
    else   -- we are nested so pop the outer scope from the stack
      PROGRAM_UNIT_STACK_PACKAGE.POP(PROGRAM_UNIT_STACK, CURRENT_PROGRAM_UNIT);
    end if;
  end END_PROGRAM_UNIT;

-------------------------------------------------------------------------

  procedure CREATE_BREAKPOINT(LOOP_LIST : in STRING_LISTS.LIST) is

--|  Effects
--|
--|  This procedure will create a breakpoint in the souce code.
--|  To prevent multiple breakpoints from being printed a flag is maintained
--|  that identifies whether a breakpoint was the last item printed to the
--|  instrumented source.  If this flag is true then no breakpoint is added.

    BREAKPOINT_LENGTH : INTEGER;
      --|  The length of the string representation of the current bkpt number

    BLANK_STRING      : STRING(1 .. 5) := "     ";
      --|  The string into which the bkpt number is put for printing in the
      --|  listing file.

    ITER              : STRING_LISTS.LISTITER;
    NEXT_NAME         : STRING_TYPE;
    TEMP              : STRING_TYPE;
  begin

--  Currently breakpoints are not added to package initializations

    if CURRENT_PROGRAM_UNIT.UNIT_TYPE /= PACKAGE_TYPE
       and not BREAKPOINT_PRINTED_LAST then

      -- Increment the breakpoint number and then make a string
      -- representation of the number for use in the listing

      BREAKPOINT_NUMBER := BREAKPOINT_NUMBER + 1;
      BREAKPOINT_LENGTH := INTEGER'IMAGE(BREAKPOINT_NUMBER)'LENGTH;
      BREAKPOINT_NUMBER_FOR_PRINTING := INTEGER'IMAGE(BREAKPOINT_NUMBER) &
        BLANK_STRING(BREAKPOINT_LENGTH .. 5);
      BREAKPOINT_NUMBER_FOR_PRINTING := BREAKPOINT_NUMBER_FOR_PRINTING(2 .. 6)
        & " ";

      --  output the breakpoint

      SD_SOURCE_BUFFERING.WRITE_INST_SOURCE
        (SP.SD_PREFIX & "Local_Break(" &
         INTEGER'IMAGE(BREAKPOINT_NUMBER) & "," &
         INTEGER'IMAGE(SID.CURRENT_LINE_NUMBER));

      STRING_PKG.MARK;
      if STRING_LISTS.ISEMPTY(LOOP_LIST) then
        TEMP := CREATE("");
      else
        TEMP := CREATE(",");
        ITER := STRING_LISTS.MAKELISTITER(LOOP_LIST);
        loop
          STRING_LISTS.NEXT(ITER, NEXT_NAME);
          TEMP := TEMP & """ " & NEXT_NAME & " """ &
                  " & " & SP.SD_PREFIX & "M(" &
                  NEXT_NAME & ")";
          exit when not STRING_LISTS.MORE(ITER);
          TEMP := TEMP & " & ";
        end loop;
      end if;
      SD_SOURCE_BUFFERING.WRITE_LINE_INST_SOURCE(VALUE(TEMP) & ");");
      STRING_PKG.RELEASE;

      BREAKPOINT_PRINTED_LAST := TRUE;

    end if;
  end CREATE_BREAKPOINT;

-------------------------------------------------------------------------

  procedure CREATE_UNIT_INFORMATION is

--|  Effects
--|
--|  This procedure is called to output the unit information call to the
--|  instrumented file.  This call must be made after all procedures in
--|  the compilation unit are defined.  No further calls can be made for
--|  the compilation unit after the unit information call is made.
--|  The unit Information includes a list of the names and types of the
--|  program units contained in the compilation unit.

    NEXT_PROGRAM_UNIT          : UNIT_DESCRIPTOR;
      --|  Used to contain the next program unit when iterating the p.u. list

    PROGRAM_UNIT_LIST_ITERATOR : PROGRAM_UNIT_LIST_PACKAGE.LISTITER;
      --|  The iterator used in iterating the program unit list

    PROGRAM_UNIT_NUMBER        : POSITIVE := 1;
      --|  Used to maintain unit number for program unit list

  begin
    SDB.WRITE_LINE_INST_SOURCE(
      SP.PREFIX & "RTM.Unit_Information(""" &
      VALUE(CURRENT_COMPILATION_UNIT) & """, " &
      NATURAL'IMAGE(BREAKPOINT_NUMBER) &  ", (");

    --  Iterate throught the list of program units printing each to
    --  the listing file

    if not PROGRAM_UNIT_LIST_PACKAGE.ISEMPTY(PROGRAM_UNIT_LIST) then
      PROGRAM_UNIT_LIST_ITERATOR := PROGRAM_UNIT_LIST_PACKAGE.MAKELISTITER(
        PROGRAM_UNIT_LIST);
      while PROGRAM_UNIT_LIST_PACKAGE.MORE(PROGRAM_UNIT_LIST_ITERATOR) loop
        PROGRAM_UNIT_LIST_PACKAGE.NEXT(PROGRAM_UNIT_LIST_ITERATOR,
          NEXT_PROGRAM_UNIT);
        SDB.WRITE_INST_SOURCE(
          INTEGER'IMAGE(PROGRAM_UNIT_NUMBER) & " => (STRING_PKG.CREATE(""" &
          VALUE(NEXT_PROGRAM_UNIT.UNIT_NAME) & """)," &
          PROGRAM_UNIT_TYPE'IMAGE(NEXT_PROGRAM_UNIT.UNIT_TYPE) & "," &
          INTEGER'IMAGE(NEXT_PROGRAM_UNIT.FIRST_BREAKPOINT) & "," &
          INTEGER'IMAGE(NEXT_PROGRAM_UNIT.LAST_BREAKPOINT) & ")");
        if PROGRAM_UNIT_LIST_PACKAGE.MORE(PROGRAM_UNIT_LIST_ITERATOR) then
          SDB.WRITE_LINE_INST_SOURCE( ",");
        end if;
        PROGRAM_UNIT_NUMBER := PROGRAM_UNIT_NUMBER + 1;
      end loop;
    else
      SDB.WRITE_INST_SOURCE(
        "1 => (STRING_PKG.CREATE(""" & VALUE(CURRENT_COMPILATION_UNIT) &
        """),PACKAGE_TYPE,1,1)");
    end if;
    SDB.WRITE_LINE_INST_SOURCE( "));");
  end CREATE_UNIT_INFORMATION;

-------------------------------------------------------------------------

  function GET_PROGRAM_UNIT return STRING is

--|  Effects
--|
--|  Returns the program unit for the current unit.  The program unit
--|  description is returned as a string for printing in the instrumented
--|  file.  This call is used to add the program unit description to
--|  put value calls for variable tracing as well as for breakpoints
--|  and entering/exiting units

  begin
    return SP.PREFIX & "CURRENT_COMPILATION_UNIT, " &
      INTEGER'IMAGE(SCOPE_PACKAGE.CURRENT_SCOPE.SCOPE_NUMBER) & ", " &
      SP.PREFIX & "Task_Number";
  end GET_PROGRAM_UNIT;

-------------------------------------------------------------------------

  function GET_PROGRAM_UNIT_NON_TASK return STRING is

--|  Effects
--|
--|  Returns the program unit for the current unit.  The program unit
--|  description is returned as a string for printing in the instrumented
--|  file.  This call is used to add the program unit description to
--|  put value calls for variable tracing as well as for breakpoints
--|  and entering/exiting units

    PROGRAM_UNIT_NUMBER : INTEGER;

  begin
    if CURRENT_NESTING_LEVEL = 1 and CURRENT_PROGRAM_UNIT.UNIT_TYPE =
             PACKAGE_TYPE then
      PROGRAM_UNIT_NUMBER := 0;
    else
      PROGRAM_UNIT_NUMBER := SCOPE_PACKAGE.CURRENT_SCOPE.SCOPE_NUMBER;
    end if;
    return SP.PREFIX & "CURRENT_COMPILATION_UNIT, " &
      INTEGER'IMAGE(PROGRAM_UNIT_NUMBER);
  end GET_PROGRAM_UNIT_NON_TASK;

end CREATE_BREAKPOINT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SIUTILS.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

-- packages needed by parsing
with PARSETABLES;
with GRAMMAR_CONSTANTS; use GRAMMAR_CONSTANTS;  -- to get visibility on =
with PARSERDECLARATIONS; use PARSERDECLARATIONS;
with SYSTEM_PARAMETERS; use SYSTEM_PARAMETERS;

-- packages for abstract data types --
with UNCHECKED_DEALLOCATION;
with STACK_PKG;
with STRING_PKG; use STRING_PKG;

-- packages needed for source instrumenting --
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with CREATE_BREAKPOINT;
with SD_TYPE_DEFINITIONS; use SD_TYPE_DEFINITIONS;
with SCOPE_PACKAGE; use SCOPE_PACKAGE;
with SD_GENERATION_UTILITIES;

-- packages needed for source instrumenter output --
with CHANGE_TEXT;
with SD_BUFFER_FILES; use SD_BUFFER_FILES;
with SD_SOURCE_BUFFERING;
with TEXT_IO;
with STRING_IO;
with CATALOG_PKG;

package body SOURCE_INSTRUMENTER_UTILITIES is
--| Utilities for the Source Instrumenter

  package SID renames SOURCE_INSTRUMENTER_DECLARATIONS;
  package SP renames SYSTEM_PARAMETERS;
  package CT renames CHANGE_TEXT;
  package PT renames PARSETABLES;
  package SDBF renames SD_BUFFER_FILES;
  package SDSB renames SD_SOURCE_BUFFERING;
  package SDGU renames SD_GENERATION_UTILITIES;

  -----------------------------------------------------------------
  -- Local declarations for formatting output
  -----------------------------------------------------------------

  IDENTIFIER_STACK      : TOKEN_STACK_PKG.STACK;
  --| Stack of identifiers/designators

  BEGINNING_OF_LINE     : BOOLEAN := TRUE;
  --| Tells whether the current column is at the beginning of a line

  CURRENT_COLUMN        : SP.COLUMN_RANGE := SP.COLUMN_RANGE'FIRST;
  --| Current column in output file

  CURRENT_INDENT        : SP.INDENTATION_RANGE := 0;
  --| Current indentation in output file

  TEMPORARY_INDENT      : SP.INDENTATION_RANGE := 0;
  --| Temporary indentation in output file, when statement or declaration
  --| with no embedded requests for newlines is too big to fit on one line.

  PREVIOUS_INDENT       : SP.INDENTATION_RANGE := 0;
  --| Saved indent for returning to after parameters or discriminants are
  --| lined up.

  CURRENT_CHANGE_COLUMN : SP.INDENTATION_RANGE := 0;
  --| Column to change indent to

  UNPERFORMED_INDENTS   : NATURAL := 0;
  --| The number of indents "requested" after the RH_Margin has been exceeded
  --| for situations where nesting is so deep that it is not
  --| worthwhile to further indent.

  EMPTY_TOKEN           : PD.PARSESTACKELEMENT :=
    (GRAM_SYM_VAL => PT.EMPTY_TOKENVALUE,
     LEXED_TOKEN  => (TEXT => new STRING'(""),
                      SRCPOS_LINE => 0,
                      SRCPOS_COLUMN => 0));

  IDENTIFIER_TOKEN      : PD.PARSESTACKELEMENT :=
    (GRAM_SYM_VAL => PT.IDENTIFIERTOKENVALUE,
     LEXED_TOKEN  => (TEXT => new STRING'(""),
                      SRCPOS_LINE => 0,
                      SRCPOS_COLUMN => 0));

  COLON_TOKEN           : PD.PARSESTACKELEMENT :=
    (GRAM_SYM_VAL => PT.COLON_TOKENVALUE,
     LEXED_TOKEN  => (TEXT => new STRING'(":"),
                      SRCPOS_LINE => 0,
                      SRCPOS_COLUMN => 0));

  INITIALIZED_DESCRIPTOR : TOKEN_DESCRIPTOR :=
    (TOKEN=> (GRAM_SYM_VAL => PT.EMPTY_TOKENVALUE,
              LEXED_TOKEN  => (TEXT => new STRING'(""),
                               SRCPOS_LINE => 0,
                               SRCPOS_COLUMN => 0)),
     COMMENTS => COMMENT_LISTS.CREATE,
     REQUESTS => (0, 0, 0, 0, 0),
     CURRENT_CHANGE_COLUMN => 0,
     LEFT_SIDE_LENGTH => 0);

  PREVIOUS_TOKEN        : PD.PARSESTACKELEMENT := EMPTY_TOKEN;
  --| Previous Token from the input stream

  SAVED_TOKEN           : PD.PARSESTACKELEMENT := EMPTY_TOKEN;
  --| Previous identifier or string literal, saved so that it may be stacked
  --| and closing identifiers printed.

  REQUESTS : REQUEST_DESCRIPTOR;

  CURRENT_BUFFERED_TOKEN : TOKEN_DESCRIPTOR;

  BUFFERED_TOKENS              : TOKEN_LISTS.LIST;
  -- Used at beginning of compilation unit.  Tokens are buffered untill
  -- we know what the current unit is

  BUFFERING_TOKENS             : BOOLEAN := TRUE;
  --|  Whether not we are currently buffering

  CURRENT_BLOCK_NUMBER         : NATURAL := 0;
  --|  The number of current block(within the compilation unit).  Used to
  --|  assign an unique ID for unnamed blocks.

  SUBPROGRAM_UNIT_TYPE         : PROGRAM_UNIT_TYPE;
  --|  Saves the type of the current subprogram.

  CREATE_SUBUNIT               : BOOLEAN := FALSE;
  --|  Whether or not a subunit containing a unit_information call should
  --|  be created for the current compilation unit.

  SEPARATE_UNIT                : BOOLEAN := FALSE;
  --|  Whether or not the current compilation unit is a subunit.

  CURRENT_COMPILATION_UNIT     : STRING_TYPE;
  --|  The name of the current compilation unit

  PARENT_UNIT_NAME             : STRING_TYPE;
  NUMBER_OF_PROGRAM_UNITS      : NATURAL := 0;
  GENERIC_STARTED              : BOOLEAN := FALSE;

  -----------------------------------------------------------------
  -- Declarations for type and identifier tracing
  -----------------------------------------------------------------

  OUTPUT_SOURCE                : BOOLEAN := TRUE;
  --| The user may set this flag to False if he does not want the
  --| source for top level package specs included in the instrumented
  --| source file.  If the source is not included, then the package
  --| spec itself won't get re-compiled when the instrumented source
  --| is compiled.  This allows for instrumenting a package spec
  --| without changing it.

  EXPANDED_NAME                : STRING_TYPE;
  --| An Expanded_Name is a qualified name, as in X.Y.Z
  --| Expanded_Name is a string_type collection of the tokens
  --| which make up the complete qualified name.  This is used
  --| in various places when a name which needs to be saved is
  --| not a simple identifier.

  SAVE_EXPANDED_NAME         : BOOLEAN := FALSE;
  --| This is set to true by applyactions at the start of an
  --| expanded name.  The text of all following tokens is
  --| appened to Expanded_Name until SAVE_EXPANDED_NAME is
  --| again set to false.

  NOT_INCOMPLETE_TYPE          : BOOLEAN := FALSE;

  CURRENT_TYPE_IDENTIFIER      : STRING_TYPE;
  --| Save the last "Expanded_Name" that was built.  It is
  --| the name of the current type being declared, and will
  --| be needed to generate the tracing procedure.

  CURRENT_TYPE_CLASS           : TYPE_CLASS;

  CURRENT_MODE       : IDENTIFIER_MODE := NONE;
  --| This is set by a call from applyactions when the mode
  --| of the current identifier list is known (following the
  --| colon in "identifer_list : ....".  Parsing has not
  --| reached the end of the list yet, so the mode must
  --| be saved.

  -- variables for array tracing --
  PARSING_ARRAY_INDEX    : BOOLEAN;
  NUMBER_OF_DIMENSIONS   : NATURAL;
  ANON_ARRAY_TEXT        : STRING_LISTS.LIST;
  SAVE_ANON_ARRAY_TEXT   : BOOLEAN := FALSE;
  ANON_NUMBER            : NATURAL := 0;

  -- variables for record tracing --
  CURRENT_RECORD_FIELD   : REC_FIELD_RECORD;
  SAVE_RECORD_VARIANT    : BOOLEAN := FALSE;
  CASE_DISCRIMINANT      : STRING_TYPE;
  SAVE_CASE_DISCRIMINANT : BOOLEAN := FALSE;
  ---------------------------------

  CURRENT_LIST       : NAME_LISTS.LIST;
  --| A temporary list to collect identifiers until the type
  --| of identifier list is known.

  PARAM_LIST         : NAME_LISTS.LIST;
  --| A list of formal parameters and their mode (in, out, or
  --| in out)

  VISIBLE_LIST       : NAME_LISTS.LIST;
  --| A list of local variables and their mode (constant
  --| or variable)

  REC_FIELD_LIST     : RECORD_LISTS.LIST;
  --| A list of the fields in the current record

  DISCRIM_LIST       : STRING_LIST;
  --| A list of the discriminants in the current record

  PACKAGE_LIST       : STRING_LIST;
  --| A list of packages declared in the current scope

  WITH_LIST          : STRING_LIST;
  --| A list of instrumented library units from the current
  --| context clause.

  USE_LIST           : STRING_LIST;
  --| A list of the packages named in a use clause.

  LOOP_LIST          : STRING_LIST;

  VISIBLE_LIST_STACK : LIST_STACK_PKG.STACK;
  --| The list of visible variables for the current scope
  --| is stacked when a nested scope is entered.

  USE_LIST_STACK     : STRING_STACK_PKG.STACK;
  --| The list of used units for the current scope is stacked
  --| when a new scope is entered.

  PACKAGE_LIST_STACK : STRING_STACK_PKG.STACK;
  --| The list of names of packages declared in the current
  --| scope is stacked when a new scope is entered.

  GENERIC_TYPE_LIST  : STRING_LISTS.LIST;

  -----------------------------------------------------------------
  -- Local subprogram specifications for pretty printing
  -----------------------------------------------------------------

  procedure FREE is
    new UNCHECKED_DEALLOCATION(STRING, PD.SOURCE_TEXT);

    -----------------------------------------------------------------

  procedure PRINT_TOKEN(NEXT_TOKEN : in out PD.PARSESTACKELEMENT);
  --| Prints Next_Token and updates column information

  -----------------------------------------------------------------

  procedure PRINT_NEW_LINE;
  --| Puts a newline in the output and updates column information.

  -----------------------------------------------------------------

  procedure PROCESS_REQUESTS;
  -- Perform requests associated with current token

  -----------------------------------------------------------------

  procedure SPACE(FILE : in TEXT_IO.FILE_TYPE;
                  COUNT : in INTEGER);
  -- Add the specified number of spaces to the file

  -----------------------------------------------------------------

  procedure SPACE(COUNT : in INTEGER);
  -- Add the specified number of spaces to the listing file

  -----------------------------------------------------------------
  -- Local subprogram specifications for source instrumenting
  -----------------------------------------------------------------

  -----------------------------------------------------------------

  procedure PRINT_BUFFERED_TOKENS;
  --|  Prints any tokens that have been buffered

  -----------------------------------------------------------------

  function MAKE_ANON_TYPE_NAME return STRING_TYPE;
  -- Used in processing anonymous array types

  -----------------------------------------------------------------

  procedure RETRIEVE_SPEC_WITH_LIST;
  --| Get the names of any instrumented units that were named in
  --| the context clause of the package specification and merge
  --| the names into the with_list for the package body.

  -----------------------------------------------------------------

  procedure DISCARD_LIST(WHICH_LIST : in out NAME_LISTS.LIST);
  --| A general purpose procedure which flushes the string_type
  --| fields of a name_record before destroying the list.

  -----------------------------------------------------------------

  procedure DISCARD_LIST(WHICH_LIST : in out RECORD_LISTS.LIST);
  --| A general purpose procedure which flushes the string_type
  --| fields of a rec_field_record before destroying the list.

  -----------------------------------------------------------------

  procedure DISCARD_LIST(WHICH_LIST : in out STRING_LISTS.LIST);
  --| A general purpose procedure which flushes the string_type
  --| fields before destroying the list.

  -----------------------------------------------------------------

  procedure ADD_WITHS_TO_BODY;
  --| Add the necessary with and use clauses to a subprogram or
  --| package body.

  -----------------------------------------------------------------

  procedure ADD_WITHS_TO_TRACE_PACKAGES;
  --| Add the necessary with and use clauses to the packages
  --| generated to trace a package specification.  This procedure
  --| is called by Initialize_Trace_Packages.

  -----------------------------------------------------------------

  procedure INITIALIZE_TRACE_PACKAGES;
  --| Start the packages that are created by the instrumenter for
  --| tracing package specifications.

  -----------------------------------------------------------------

  procedure CLOSE_TRACE_PACKAGES;
  --| Finish and save the packages that are created for tracing
  --| package specificatiosn.

  -----------------------------------------------------------------

  procedure DISPLAY_MESSAGE;
  --| This procedure displays the help message from
  --| ASK_USER_ABOUT_PACKAGE;

  -----------------------------------------------------------------

  function ASK_USER_ABOUT_PACKAGE return BOOLEAN;
  --| Ask the user if he really wants to recompile a library unit
  --| that is a package specification.
  --| If the answer is NO, then the text of the package specification
  --| will not be included in the instrumented source.


  -----------------------------------------------------------------
  -- External Subprogram Bodies for pretty printing
  -----------------------------------------------------------------

  procedure INITIALIZE is
  begin
    IDENTIFIER_STACK := TOKEN_STACK_PKG.CREATE;
    BEGINNING_OF_LINE := TRUE;
    CURRENT_COLUMN := 1;
    CURRENT_INDENT := 0;
    TEMPORARY_INDENT := 0;
    PREVIOUS_INDENT := 0;
    CURRENT_CHANGE_COLUMN := 0;
    UNPERFORMED_INDENTS := 0;

    EMPTY_TOKEN := (GRAM_SYM_VAL => PT.EMPTY_TOKENVALUE,
                    LEXED_TOKEN  => (TEXT=> new STRING'(""),
                                     SRCPOS_LINE => 0,
                                     SRCPOS_COLUMN => 0));
    PREVIOUS_TOKEN := EMPTY_TOKEN;
    SAVED_TOKEN := EMPTY_TOKEN;
    REQUESTS := (0, 0, 0, 0, 0);

    BUFFERING_TOKENS := TRUE;
    BUFFERED_TOKENS := TOKEN_LISTS.CREATE;
    CURRENT_BUFFERED_TOKEN := INITIALIZED_DESCRIPTOR;

    CURRENT_LINE_NUMBER := 1;
    CURRENT_NESTING_LEVEL := 0;
    CURRENT_SCOPE := NULL_SCOPE;
    CURRENT_OUTER_SCOPE := NULL_SCOPE;

    CURRENT_BLOCK_NUMBER := 0;
    NUMBER_OF_PROGRAM_UNITS := 0;
    NUMBER_OF_DIMENSIONS := 0;
    ANON_NUMBER := 0;

    OUTPUT_SOURCE := TRUE;
    CREATE_SUBUNIT := FALSE;
    SEPARATE_UNIT := FALSE;
    NOT_INCOMPLETE_TYPE := FALSE;
    PARSING_ARRAY_INDEX := FALSE;
    SAVE_EXPANDED_NAME := FALSE;
    SAVE_ANON_ARRAY_TEXT := FALSE;
    SAVE_RECORD_VARIANT := FALSE;
    SAVE_CASE_DISCRIMINANT := FALSE;
    GENERIC_STARTED := FALSE;

    USE_LIST        := STRING_LISTS.CREATE;
    WITH_LIST       := STRING_LISTS.CREATE;
    PACKAGE_LIST    := STRING_LISTS.CREATE;
    PARAM_LIST      := NAME_LISTS.CREATE;
    VISIBLE_LIST    := NAME_LISTS.CREATE;
    DISCRIM_LIST    := STRING_LISTS.CREATE;
    LOOP_LIST       := STRING_LISTS.CREATE;
    ANON_ARRAY_TEXT := STRING_LISTS.CREATE;
    REC_FIELD_LIST  := RECORD_LISTS.CREATE;
    CURRENT_LIST    := NAME_LISTS.CREATE;
    CURRENT_RECORD_FIELD.REC_FIELD   := STRING_LISTS.CREATE;
    CURRENT_RECORD_FIELD.CHOICE_TEXT := STRING_LISTS.CREATE;
    GENERIC_TYPE_LIST := STRING_LISTS.CREATE;

    VISIBLE_LIST_STACK  := LIST_STACK_PKG.CREATE;
    PACKAGE_LIST_STACK  := STRING_STACK_PKG.CREATE;
    USE_LIST_STACK      := STRING_STACK_PKG.CREATE;

    SDBF.INITIALIZE;

  end INITIALIZE;

  -----------------------------------------------------------------

  procedure PUT(NEXT_TOKEN : in out PD.PARSESTACKELEMENT) is
    TEMP_TOKEN : TOKEN_DESCRIPTOR;
  begin

  -- If we are buffering tokens the add previous token to buffer

    if BUFFERING_TOKENS and
      (CURRENT_BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL /= PT.COMMENT_TOKENVALUE) then
      CURRENT_BUFFERED_TOKEN.REQUESTS := REQUESTS;
      CURRENT_BUFFERED_TOKEN.CURRENT_CHANGE_COLUMN := CURRENT_CHANGE_COLUMN;
      CURRENT_CHANGE_COLUMN := 0;
      REQUESTS := (0, 0, 0, 0, 0);
      TOKEN_LISTS.ATTACH(BUFFERED_TOKENS, CURRENT_BUFFERED_TOKEN);
      CURRENT_BUFFERED_TOKEN := INITIALIZED_DESCRIPTOR;
    end if;

    -- function designator can be string literal or identifier, so save
    -- both, so closing identifier/designator can be printed.
    if (NEXT_TOKEN.GRAM_SYM_VAL = PT.IDENTIFIERTOKENVALUE) or
       (NEXT_TOKEN.GRAM_SYM_VAL = PT.STRINGTOKENVALUE) then
      SAVED_TOKEN := NEXT_TOKEN;
    end if;

    if SAVE_EXPANDED_NAME then
      EXPANDED_NAME := EXPANDED_NAME & UPPER(CT.TOKEN_TEXT(NEXT_TOKEN));
    end if;

    if SAVE_ANON_ARRAY_TEXT then
      STRING_LISTS.ATTACH(ANON_ARRAY_TEXT,
        MAKE_PERSISTENT(CT.TOKEN_TEXT(NEXT_TOKEN)));
    end if;

    if SAVE_CASE_DISCRIMINANT then
      CASE_DISCRIMINANT := MAKE_PERSISTENT(SAVED_TOKEN.LEXED_TOKEN.TEXT.ALL);
      SAVE_CASE_DISCRIMINANT := FALSE;
    end if;

    if SAVE_RECORD_VARIANT then
      -- this is the 'when =>' portion of a case statement in a record
      -- declaration
      STRING_LISTS.ATTACH(CURRENT_RECORD_FIELD.CHOICE_TEXT,
        MAKE_PERSISTENT(CT.TOKEN_TEXT(NEXT_TOKEN)));
    end if;

    if BUFFERING_TOKENS then
      CURRENT_BUFFERED_TOKEN := INITIALIZED_DESCRIPTOR;
      CURRENT_BUFFERED_TOKEN.TOKEN := NEXT_TOKEN;
      CURRENT_BUFFERED_TOKEN.COMMENTS := COMMENT_BUFFER;
    else
      PRINT_COMMENTS(COMMENT_BUFFER);
      PRINT_TOKEN(NEXT_TOKEN);
    end if;
    CREATE_BREAKPOINT.BREAKPOINT_PRINTED_LAST := FALSE;
  end PUT;

  -----------------------------------------------------------------

  procedure PUT_SPACE(SPACES : in NATURAL := 1) is
    BLANK : constant STRING := "                    " &
      "                                                            ";
  begin
    if BUFFERING_TOKENS then
      if CURRENT_BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL /= PT.COMMENT_TOKENVALUE
        then
        TOKEN_LISTS.ATTACH(BUFFERED_TOKENS, CURRENT_BUFFERED_TOKEN);
        CURRENT_BUFFERED_TOKEN := INITIALIZED_DESCRIPTOR;
        CURRENT_BUFFERED_TOKEN.TOKEN := EMPTY_TOKEN;
        CURRENT_BUFFERED_TOKEN.TOKEN.LEXED_TOKEN.TEXT :=
           new STRING'(BLANK(1 .. SPACES));
      else
        null; --?????
      end if;
    else
      if CURRENT_COLUMN + SPACES - 1 > SP.PAGE_WIDTH then
        PRINT_NEW_LINE;
        TEMPORARY_INDENT := SP.INDENTATION_LEVEL;
        CURRENT_COLUMN := CURRENT_INDENT + TEMPORARY_INDENT + 1;
      end if;

      if BEGINNING_OF_LINE then
        SPACE(SID.LISTING_FILE, CURRENT_COLUMN - 1);
        SPACE(CURRENT_COLUMN - 1);
        if OUTPUT_SOURCE then
          SPACE(SID.INSTRUMENTED_FILE, CURRENT_COLUMN - 1);
        end if;
      end if;
      SPACE(SID.LISTING_FILE, SPACES);
      SPACE(SPACES);
      if OUTPUT_SOURCE then
        SPACE(SID.INSTRUMENTED_FILE, SPACES);
      end if;
      CURRENT_COLUMN := CURRENT_COLUMN + SPACES;
    end if;
  end PUT_SPACE;

  -----------------------------------------------------------------

  procedure PRINT_COMMENTS(BUFFER : in out COMMENT_LISTS.LIST) is

    ITER               : COMMENT_LISTS.LISTITER;  --| Iterates down comment list
    COMMENT_TOKEN      : PD.PARSESTACKELEMENT;    --| Element in list of comments
    NEW_LINES          : NATURAL := 0;            --| number of new_lines
                                                  --| between comments
    SAVE_OUTPUT_SOURCE : BOOLEAN := OUTPUT_SOURCE;

  begin
    OUTPUT_SOURCE := FALSE;
    ITER := COMMENT_LISTS.MAKELISTITER(BUFFER);
    while COMMENT_LISTS.MORE(ITER) loop
      COMMENT_LISTS.NEXT(ITER, COMMENT_TOKEN);

      -- Print new lines between this comment token and
      -- previous token in source, unless new lines were already printed
      -- for comment formatting.
      NEW_LINES :=
        COMMENT_TOKEN.LEXED_TOKEN.SRCPOS_LINE -
        PREVIOUS_TOKEN.LEXED_TOKEN.SRCPOS_LINE;
      for I in 1 .. NEW_LINES loop
        PRINT_NEW_LINE;
      end loop;

      -- try to indent to level of source
      if ((SP.PAGE_WIDTH - CURRENT_COLUMN) >=
           CT.TOKEN_TEXT(COMMENT_TOKEN)'LENGTH) then
        if BEGINNING_OF_LINE then
          SPACE(SID.LISTING_FILE,
                   CURRENT_COLUMN - 1 +
                   CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING'LENGTH);
          SPACE(CURRENT_COLUMN - 1 +
                  CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING'LENGTH);
        else
          -- put extra space in so comment is separated from previous token
          PUT_SPACE;
        end if;
      else
        if NEW_LINES > 0 then
          CURRENT_COLUMN := 1;
        end if;

        -- if comment can't go where it was in source, put it at same
        -- column on next line.
        if COMMENT_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN < CURRENT_COLUMN then
          TEXT_IO.NEW_LINE(SID.LISTING_FILE);
          CURRENT_LINE_NUMBER := CURRENT_LINE_NUMBER + 1;
          STRING_IO.NEW_LINE;
          SPACE(SID.LISTING_FILE,
                   COMMENT_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN - 1 +
                   CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING'LENGTH);
          SPACE(COMMENT_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN - 1 +
                   CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING'LENGTH);
        else
          SPACE(SID.LISTING_FILE,
                   COMMENT_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN -
                   CURRENT_COLUMN +
                   CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING'LENGTH);
          SPACE(COMMENT_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN - CURRENT_COLUMN +
                   CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING'LENGTH);
        end if;
      end if;
      TEXT_IO.PUT(SID.LISTING_FILE, CT.TOKEN_TEXT(COMMENT_TOKEN));
      STRING_IO.PUT(CT.TOKEN_TEXT(COMMENT_TOKEN));

      FREE(COMMENT_TOKEN.LEXED_TOKEN.TEXT);
      PREVIOUS_TOKEN := COMMENT_TOKEN;
    end loop;

    -- process any requests not handled earlier
    PROCESS_REQUESTS;

    OUTPUT_SOURCE := SAVE_OUTPUT_SOURCE;

    -- if there were some comments in buffer put new line after them
    if (not COMMENT_LISTS.ISEMPTY(BUFFER)) then
      PRINT_NEW_LINE;
    else
      for I in 1 .. REQUESTS.NEW_LINES loop
        PRINT_NEW_LINE;
      end loop;
    end if;
    REQUESTS.NEW_LINES := 0;

    COMMENT_LISTS.DESTROY(BUFFER);

  end PRINT_COMMENTS;

  -----------------------------------------------------------------

  procedure NEW_LINE is

  --| Effects
  --|
  --| Requests a new_line for the output.  The newline is not actually
  --| printed here, in order that comments are put in the appropriate
  --| place.  The actual newline is printed in Print_New_Line.
  begin
      REQUESTS.NEW_LINES := REQUESTS.NEW_LINES + 1;
  end NEW_LINE;

  -----------------------------------------------------------------

  procedure INCREASE_INDENT is

  --| Effects
  --|
  --| Requests an increase in indentation.  The increase is not actually
  --| processed here, in order that comments are put in the appropriate
  --| place.  The actual increase is processed in Process_Increase_Requests.
  begin
      REQUESTS.INCREASES := REQUESTS.INCREASES + 1;
  end INCREASE_INDENT;

  -----------------------------------------------------------------

  procedure DECREASE_INDENT is

  --| Effects
  --|
  --| Requests a decrease in indentation.  The decrease is not actually
  --| processed here, in order that comments are put in the appropriate
  --| place.  The actual decrease is processed in Process_Decrease_Requests.
  begin
      REQUESTS.DECREASES := REQUESTS.DECREASES + 1;
  end DECREASE_INDENT;

  -----------------------------------------------------------------

  procedure CHANGE_INDENT is

  --| Effects
  --|
  --| Requests a change in indentation.  The change is not actually
  --| processed here, in order that comments are put in the appropriate
  --| place.  The actual change is processed in Process_Change_Requests.
  begin
      REQUESTS.CHANGES := REQUESTS.CHANGES + 1;
      if CURRENT_COLUMN in SP.INDENTATION_RANGE then
        CURRENT_CHANGE_COLUMN := CURRENT_COLUMN;
      elsif CURRENT_INDENT + SP.INDENTATION_LEVEL + 2 < SP.RH_MARGIN then
        CURRENT_CHANGE_COLUMN := CURRENT_INDENT + SP.INDENTATION_LEVEL + 2;
      else
        CURRENT_CHANGE_COLUMN := CURRENT_INDENT;
      end if;
  end CHANGE_INDENT;

  -----------------------------------------------------------------

  procedure RESUME_NORMAL_INDENTATION is

  --| Effects
  --|
  --| Requests a resume of the previous indentation.  This is not actually
  --| processed here, in order that comments are put in the appropriate
  --| place.  The actual resume is processed in Process_Resume_Requests.
  begin
      REQUESTS.RESUMES := REQUESTS.RESUMES + 1;
  end RESUME_NORMAL_INDENTATION;

  -----------------------------------------------------------------

  procedure SPACE(FILE : in TEXT_IO.FILE_TYPE;
                  COUNT : in INTEGER) is
    SPACE_STRING : STRING(1 .. COUNT) := (1 .. COUNT => ' ');
  begin
    if COUNT > 0 then
      TEXT_IO.PUT(FILE, SPACE_STRING);
    end if;
  end SPACE;

  -----------------------------------------------------------------

  procedure SPACE(COUNT : in INTEGER) is
    SPACE_STRING : STRING(1 .. COUNT) := (1 .. COUNT => ' ');
  begin
    if COUNT > 0 then
     STRING_IO.PUT(SPACE_STRING);
    end if;
  end SPACE;

  -----------------------------------------------------------------

  procedure POP_IDENTIFIER(WHERE : in POP_TO_WHERE := TO_NOWHERE) is
    POPPED_TOKEN : PD.PARSESTACKELEMENT;  --| The token popped off stack
  begin
    if (WHERE = TO_NOWHERE) then
      TOKEN_STACK_PKG.POP(IDENTIFIER_STACK);
    else
      TOKEN_STACK_PKG.POP(IDENTIFIER_STACK, POPPED_TOKEN);
      if MATCH_S(CREATE(POPPED_TOKEN.LEXED_TOKEN.TEXT.ALL),SD_PREFIX) = 1 then
        TEXT_IO.PUT(SID.INSTRUMENTED_FILE," " &
           POPPED_TOKEN.LEXED_TOKEN.TEXT.ALL);
      else
        PUT(POPPED_TOKEN);
      end if;
    end if;

    -- In case this was a subprogram declaration, then discard the
    -- parameter list that was built.
    DISCARD_LIST(PARAM_LIST);
    SAVE_EXPANDED_NAME := FALSE;
  end POP_IDENTIFIER;

  -----------------------------------------------------------------

  procedure PUSH_IDENTIFIER is
  begin

    -- set source line and column to 0 so that new column and line may
    -- be assigned when the pushed token is output as a closing designator
    -- or identifier.
    SAVED_TOKEN.LEXED_TOKEN.SRCPOS_LINE := 0;
    SAVED_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN := 0;
    CURRENT_SCOPE_SIMPLE_NAME := CREATE(CT.TOKEN_TEXT(SAVED_TOKEN));
    TOKEN_STACK_PKG.PUSH(IDENTIFIER_STACK, SAVED_TOKEN);
  end PUSH_IDENTIFIER;

  -----------------------------------------------------------------

  procedure PUSH_EMPTY_TOKEN is
  begin
    TOKEN_STACK_PKG.PUSH(IDENTIFIER_STACK, EMPTY_TOKEN);
  end PUSH_EMPTY_TOKEN;

  -----------------------------------------------------------------


  -----------------------------------------------------------------
  -- Local subprogram bodies for pretty printing
  -----------------------------------------------------------------

  procedure PRINT_TOKEN(NEXT_TOKEN : in out PD.PARSESTACKELEMENT) is

    TOKEN_LENGTH : NATURAL := 0;
    BLANK_LINES  : INTEGER := 0;

  begin

    -- give line and column position to tokens being inserted that weren't
    -- in the source.
    if NEXT_TOKEN.LEXED_TOKEN.SRCPOS_LINE = 0 then
      NEXT_TOKEN.LEXED_TOKEN.SRCPOS_LINE :=
        PREVIOUS_TOKEN.LEXED_TOKEN.SRCPOS_LINE;
      NEXT_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN :=
        PREVIOUS_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN;
    end if;

    -- print out any blank lines that appeared in source between the
    -- previous token and this one.
    BLANK_LINES := NEXT_TOKEN.LEXED_TOKEN.SRCPOS_LINE -
                   PREVIOUS_TOKEN.LEXED_TOKEN.SRCPOS_LINE - 1;

    if BLANK_LINES > 0 then
      -- print extra new line if not at beginning of line, so blank line
      -- will be printed rather than just a new line
      if not BEGINNING_OF_LINE then
        PRINT_NEW_LINE;
      end if;
      TEXT_IO.NEW_LINE(SID.LISTING_FILE, TEXT_IO.COUNT(BLANK_LINES));
    end if;

    TOKEN_LENGTH := CT.SPACED_TOKEN(NEXT_TOKEN, PREVIOUS_TOKEN,
        BEGINNING_OF_LINE)'LENGTH;

    -- If adding this token will make the line longer than the
    -- page width then go to the next line and indent.
    if (CURRENT_COLUMN + TOKEN_LENGTH - 1) > SP.PAGE_WIDTH then
      PRINT_NEW_LINE;
      TEMPORARY_INDENT := SP.INDENTATION_LEVEL;
      CURRENT_COLUMN := CURRENT_INDENT + TEMPORARY_INDENT + 1;
    end if;

    -- output spaces if at the beginning of the line to get to the current
    -- indentation level.
    if BEGINNING_OF_LINE then
      TEXT_IO.PUT(SID.LISTING_FILE,
             CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING);
      STRING_IO.PUT(CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING);
      CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING := "      ";
      SPACE(SID.LISTING_FILE, CURRENT_COLUMN - 1);
      SPACE(CURRENT_COLUMN - 1);
      if OUTPUT_SOURCE then
        SPACE(SID.INSTRUMENTED_FILE, CURRENT_COLUMN - 1);
      end if;
    end if;

    -- Output token
    declare
      PRINT_TOKEN : constant string :=
        CT.SPACED_TOKEN(NEXT_TOKEN,PREVIOUS_TOKEN,BEGINNING_OF_LINE);
    begin
      TEXT_IO.PUT(SID.LISTING_FILE, PRINT_TOKEN);
      STRING_IO.PUT(PRINT_TOKEN);
      if OUTPUT_SOURCE then
        TEXT_IO.PUT(SID.INSTRUMENTED_FILE, PRINT_TOKEN);
      end if;
    end;

    BEGINNING_OF_LINE := FALSE;

    -- if the token was too big to fit even on the new line allocated it,
    -- set the current_column to the next line
    if TOKEN_LENGTH > SP.PAGE_WIDTH - CURRENT_INDENT then
      PRINT_NEW_LINE;
      TEMPORARY_INDENT := SP.INDENTATION_LEVEL;
      CURRENT_COLUMN := CURRENT_INDENT + TEMPORARY_INDENT + 1;
    else
      CURRENT_COLUMN := CURRENT_COLUMN + TOKEN_LENGTH;
    end if;

    if NEXT_TOKEN.GRAM_SYM_VAL /= PT.EMPTY_TOKENVALUE then
      PREVIOUS_TOKEN := NEXT_TOKEN;
    end if;
  end PRINT_TOKEN;

  -----------------------------------------------------------------

 procedure PRINT_NEW_LINE is
  begin
    TEMPORARY_INDENT := 0;
    CURRENT_COLUMN := CURRENT_INDENT + 1;
    if OUTPUT_SOURCE then
      TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
    end if;
    TEXT_IO.NEW_LINE(SID.LISTING_FILE);
    CURRENT_LINE_NUMBER := CURRENT_LINE_NUMBER + 1;
    STRING_IO.NEW_LINE;
    BEGINNING_OF_LINE := TRUE;
  end PRINT_NEW_LINE;

  -----------------------------------------------------------------

  procedure PROCESS_REQUESTS is
  begin
    for I in 1 .. REQUESTS.INCREASES loop
      if CURRENT_INDENT + SP.INDENTATION_LEVEL < SP.RH_MARGIN then
        CURRENT_INDENT := CURRENT_INDENT + SP.INDENTATION_LEVEL;
      else
        UNPERFORMED_INDENTS := UNPERFORMED_INDENTS + 1;
      end if;
    end loop;
    REQUESTS.INCREASES := 0;

    for I in 1 .. REQUESTS.DECREASES loop
      if UNPERFORMED_INDENTS = 0 then
        CURRENT_INDENT := CURRENT_INDENT - SP.INDENTATION_LEVEL;
      else
        UNPERFORMED_INDENTS := UNPERFORMED_INDENTS - 1;
      end if;
    end loop;
    REQUESTS.DECREASES := 0;

    if REQUESTS.CHANGES > 0 then
      PREVIOUS_INDENT := CURRENT_INDENT;
      CURRENT_INDENT := CURRENT_CHANGE_COLUMN - 1;

      -- Since new line does not always occur before change_indent,
      -- need to update current column info.
      TEMPORARY_INDENT := 0;
      CURRENT_COLUMN := CURRENT_INDENT + 1;
    end if;
    REQUESTS.CHANGES := 0;

    if REQUESTS.RESUMES > 0 then
      CURRENT_INDENT := PREVIOUS_INDENT;
    end if;
    REQUESTS.RESUMES := 0;
  end PROCESS_REQUESTS;

  -----------------------------------------------------------------
  --  External Procedures for Source Instrumenter
  -----------------------------------------------------------------


  -----------------------------------------------------------------
  procedure USE_PACKAGE_NAME is

  --| Effects
  --|
  --| The current expanded name is the package name in the
  --| use clause.

  begin
    SAVE_EXPANDED_NAME := FALSE;
    STRING_LISTS.ATTACH(USE_LIST, MAKE_PERSISTENT(EXPANDED_NAME));
  end USE_PACKAGE_NAME;

  -----------------------------------------------------------------

  procedure WITH_LIBRARY_UNIT is

  --| Effects
  --|
  --| If the library unit is instrumented
  --| then add the name to the "with_list".  Its tracing package
  --| will have to be added to the context clause in the instrumented
  --| source.

  begin
    if SDBF.PACKAGE_FILES_EXIST(SAVED_TOKEN.LEXED_TOKEN.TEXT.all,
                                PUBLIC_FILES) then
      STRING_LISTS.ATTACH(WITH_LIST,
        UPPER(CREATE(SAVED_TOKEN.LEXED_TOKEN.TEXT.all)));
    end if;
  end WITH_LIBRARY_UNIT;

  ------------------------------------------------------------------

  procedure START_SAVING_EXPANDED_NAME is

  --| Effects
  --|
  --| Start saving tokens for an expanded name.

  begin
    FLUSH(EXPANDED_NAME);
    SAVE_EXPANDED_NAME := TRUE;
  end START_SAVING_EXPANDED_NAME;

  -----------------------------------------------------------------

  procedure SAVE_SEPARATE_NAME is

  --| Effects
  --|
  --| The current expanded name is the name of the parent unit.
  --| Use it to set the Current_Scope and turn off the
  --| "SAVE_EXPANDED_NAME" flag.

  begin
    SAVE_EXPANDED_NAME := FALSE;
    SEPARATE_UNIT := TRUE;

    FLUSH(PARENT_UNIT_NAME);
    PARENT_UNIT_NAME := MAKE_PERSISTENT(EXPANDED_NAME);

    CURRENT_SCOPE :=
      (UPPER(SAVED_TOKEN.LEXED_TOKEN.TEXT.all),
       MAKE_PERSISTENT(EXPANDED_NAME),
       MAKE_PERSISTENT(EXPANDED_NAME),
       A_BLOCK,
       0,
       MAKE_TRACING_PREFIX_FOR_SEPARATE(EXPANDED_NAME),
       FALSE,
       FALSE);
  end SAVE_SEPARATE_NAME;

  -----------------------------------------------------------------

  procedure SAVE_GENERIC_NAME is

  begin
    SAVE_EXPANDED_NAME := FALSE;
  end SAVE_GENERIC_NAME;

  ------------------------------------------------------------------

  procedure SUBPROGRAM_TYPE(INTYPE : in STRING) is

  --|  Effects
  --|
  --|  Saves the type of the current subprogram.  At increment scope
  --|  if the current unit is a subprogram then subprogram_unit_type
  --|  will be used to determine what kind of subprogram it is.

  begin
    if INTYPE = "procedure" then
      SUBPROGRAM_UNIT_TYPE := PROCEDURE_TYPE;
    else
      SUBPROGRAM_UNIT_TYPE := FUNCTION_TYPE;
      SAVE_EXPANDED_NAME := FALSE;
    end if;
  end SUBPROGRAM_TYPE;

  ------------------------------------------------------------------

  procedure START_BEGIN_END_BLOCK is

  --|  Effects
  --|
  --|  If this is a package body then add the call to UNIT_INFORMATION (we
  --|  are in the package body begin-end).  If the current unit is not
  --|  a block then output an entering unit call and a breakpoint.

  begin

    if CURRENT_SCOPE.TYPE_OF_SCOPE /= A_BLOCK then
      if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY and
         CURRENT_NESTING_LEVEL = 1 then
        PRINT_COMMENTS(COMMENT_BUFFER);
        CREATE_BREAKPOINT.CREATE_UNIT_INFORMATION;
      end if;
      CREATE_BREAKPOINT.CREATE_ENTERING_UNIT;
    end if;
  end START_BEGIN_END_BLOCK;

  ------------------------------------------------------------------

  procedure END_BLOCK_SEQUENCE_OF_STATEMENTS is

  --|  Effects
  --|
  --|  If we are not in a block then output an exiting unit call and
  --|  a breakpoint.

  begin
    if CURRENT_SCOPE.TYPE_OF_SCOPE /= A_BLOCK then
      PRINT_COMMENTS(COMMENT_BUFFER);
      CREATE_BREAKPOINT.CREATE_BREAKPOINT(LOOP_LIST);
      CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
    end if;
  end END_BLOCK_SEQUENCE_OF_STATEMENTS;

  -----------------------------------------------------------------

  procedure START_DO_SEQUENCE_OF_STATEMENTS is
  begin
    if not NAME_LISTS.ISEMPTY(PARAM_LIST) then
      CURRENT_SCOPE_STRING_NAME := CURRENT_SCOPE_SIMPLE_NAME;
      CURRENT_SCOPE_QUALIFIED_NAME :=
        CURRENT_SCOPE.QUALIFIED_NAME & "." & CURRENT_SCOPE_SIMPLE_NAME;
      ENTER_SCOPE(ACCEPT_STATEMENT);
      TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
      TEXT_IO.PUT(SID.INSTRUMENTED_FILE, "DECLARE");
      SDGU.GENERATE_DUMMY_LOCALS(PARAM_LIST);
      SDBF.START_NEW_SECTION;
      SDGU.GENERATE_FINDVAR_BODY(PARAM_LIST, PACKAGE_LIST, WITH_LIST, USE_LIST);
      SDBF.SAVE_BUFFER_FILE(SID.INSTRUMENTED_FILE);
      SDBF.RELEASE_SECTION;
      SDGU.GENERATE_LOCAL_BREAK(CURRENT_SCOPE.SCOPE_NUMBER, FALSE);
      DISCARD_LIST(PARAM_LIST);
      TEXT_IO.PUT(SID.INSTRUMENTED_FILE, "BEGIN");
    end if;
  end START_DO_SEQUENCE_OF_STATEMENTS;

  -----------------------------------------------------------------

  procedure END_DO_SEQUENCE_OF_STATEMENTS is
  begin
    if EQUAL(CURRENT_SCOPE.SCOPE_NAME,
             TOKEN_STACK_PKG.TOP(IDENTIFIER_STACK).LEXED_TOKEN.TEXT.ALL) then
      TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
      CURRENT_LINE_NUMBER := CURRENT_LINE_NUMBER + 1;
      CREATE_BREAKPOINT.CREATE_BREAKPOINT(LOOP_LIST);
      CURRENT_LINE_NUMBER := CURRENT_LINE_NUMBER - 1;
      TEXT_IO.PUT(SID.INSTRUMENTED_FILE, "END;");
      EXIT_SCOPE;
    end if;
  end END_DO_SEQUENCE_OF_STATEMENTS;

  -----------------------------------------------------------------

  procedure END_BLOCK_STATEMENT is

  --|  Effects
  --|
  --|  Pop the scope for the block.

  begin
    EXIT_SCOPE;
  end END_BLOCK_STATEMENT;

  -----------------------------------------------------------------

  procedure ADD_BREAKPOINT is

  --|  Effects
  --|
  --|  This procedure is called before every statement within a begin-end.

  begin
    PRINT_COMMENTS(COMMENT_BUFFER);
    CREATE_BREAKPOINT.CREATE_BREAKPOINT(LOOP_LIST);
  end ADD_BREAKPOINT;

  -----------------------------------------------------------------

  procedure START_RETURN_STATEMENT is

   --  Current statement is a return statement.  Add a breakpoint and
   --  an exiting unit.

  begin
    PRINT_COMMENTS(COMMENT_BUFFER);
    CREATE_BREAKPOINT.CREATE_BREAKPOINT(LOOP_LIST);
    CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
  end START_RETURN_STATEMENT;

  ------------------------------------------------------------------

  procedure START_BLOCK (HAS_NAME: in BOOLEAN) is

  --|  Effects
  --|
  --|  Make the block the current scope.  If the block had no name then
  --|  make up a unique name for it.

    function INTEGER_STRING(NUM : INTEGER) return STRING is
    begin
      return INTEGER'IMAGE(NUM)(2..INTEGER'IMAGE(NUM)'LENGTH);
    end INTEGER_STRING;

  begin
    if not HAS_NAME then
      -- The block does not have a name, so make one for it.
      CURRENT_BLOCK_NUMBER := CURRENT_BLOCK_NUMBER + 1;
      CURRENT_SCOPE_SIMPLE_NAME :=
        CREATE(SD_PREFIX & "BLOCK" & INTEGER_STRING(CURRENT_BLOCK_NUMBER));

      IDENTIFIER_TOKEN.LEXED_TOKEN.TEXT :=
        new STRING'(VALUE(CURRENT_SCOPE_SIMPLE_NAME));
      IDENTIFIER_TOKEN.LEXED_TOKEN.SRCPOS_LINE := 0;
      IDENTIFIER_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN := 0;
      TOKEN_STACK_PKG.PUSH(IDENTIFIER_STACK, IDENTIFIER_TOKEN);
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
        IDENTIFIER_TOKEN.LEXED_TOKEN.TEXT.ALL & ":");
    end if;
    CURRENT_SCOPE_STRING_NAME := CURRENT_SCOPE_SIMPLE_NAME;
    CURRENT_SCOPE_QUALIFIED_NAME :=
      CURRENT_SCOPE_QUALIFIED_NAME & "." & CURRENT_SCOPE_SIMPLE_NAME;
    ENTER_SCOPE(A_BLOCK);
  end START_BLOCK;

  -----------------------------------------------------------------

  procedure SAVE_LOOP_PARAMETER is
    TEMP : STRING_TYPE;
  begin
    STRING_PKG.MARK;
    TEMP := CREATE(TOKEN_STACK_PKG.TOP(IDENTIFIER_STACK).LEXED_TOKEN.TEXT.ALL);
    if not IS_EMPTY(TEMP) THEN
      TEMP := TEMP & ".";
    end if;
    STRING_LISTS.ATTACH
      (MAKE_PERSISTENT(TEMP & SAVED_TOKEN.LEXED_TOKEN.TEXT.ALL), LOOP_LIST);
    STRING_PKG.RELEASE;
  end SAVE_LOOP_PARAMETER;

  ------------------------------------------------------------------

  procedure END_FOR_LOOP is
    TEMP : STRING_TYPE := STRING_LISTS.FIRSTVALUE(LOOP_LIST);
  begin
    FLUSH(TEMP);
    STRING_LISTS.DELETEHEAD(LOOP_LIST);
  end END_FOR_LOOP;

  -----------------------------------------------------------------


  procedure ADD_PACKAGE_BODY_BEGIN is

  --|  Effects
  --|
  --|  If a package body that is a compilation unit does not have a
  --|  begin end block then add one that makes a call to unit
  --|  information.

  begin
    if CURRENT_NESTING_LEVEL = 1 then
      PRINT_COMMENTS(COMMENT_BUFFER);
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "begin");
      CREATE_BREAKPOINT.CREATE_UNIT_INFORMATION;
    end if;
  end ADD_PACKAGE_BODY_BEGIN;

  ------------------------------------------------------------------

  procedure START_EXCEPTION_BRANCH is

  --|  Effects
  --|
  --|  We are starting an exception branch in the source.  We must nest this
  --|  in a begin-end block so that we can handle any exceptions raised
  --|  during execution of the exception handler.

  begin
    if CURRENT_SCOPE.TYPE_OF_SCOPE /= A_BLOCK then
      if not (CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY and
              CURRENT_NESTING_LEVEL > 1) then
        TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "begin");
        TEXT_IO.PUT(SID.INSTRUMENTED_FILE,
         "if SD_RTM'CALLABLE then ");
      end if;
    end if;
  end START_EXCEPTION_BRANCH;

  ------------------------------------------------------------------

  procedure END_EXCEPTION_SEQUENCE_OF_STATEMENTS is

  --|  Effects
  --|
  --|  The block that contains the exception handler must now be finished.
  --|  Add an others hanler for the block that calls exiting unit and then
  --|  re-raises the exception.  This will inform the RTM that the unit
  --|  has exited, and then by re-raising the exception will allow the
  --|  user's code to execute normally.

  begin
    if CURRENT_SCOPE.TYPE_OF_SCOPE /= A_BLOCK then
      if not (CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY and
              CURRENT_NESTING_LEVEL > 1) then
        PRINT_COMMENTS(COMMENT_BUFFER);
        CREATE_BREAKPOINT.CREATE_BREAKPOINT(LOOP_LIST);
        CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,"end if;");
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "exception");
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "  when others =>");
        CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "raise;");
        TEXT_IO.PUT(SID.INSTRUMENTED_FILE, "end;");
      end if;
    end if;
  end END_EXCEPTION_SEQUENCE_OF_STATEMENTS;

  ------------------------------------------------------------------

  procedure ADD_OTHERS_HANDLER is

  --|  The source did not have an others handler so add one.  The others
  --|  handler that we add will call exiting unit and then re-raise the
  --|  exception.

  begin
    if CURRENT_SCOPE.TYPE_OF_SCOPE /= A_BLOCK then
      if not (CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY and
              CURRENT_NESTING_LEVEL > 1) then
        TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "  when others =>");
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
         "    if SD_RTM'CALLABLE then ");
        CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "      raise;");
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "  end if;");
      end if;
    end if;
  end ADD_OTHERS_HANDLER;

  ------------------------------------------------------------------

  procedure ADD_EXCEPTION_HANDLER is

  --|  Effects
  --|
  --|  The source had no exception handler so add an exception handler
  --|  with an others branch.  In the others branch call exiting
  --|  unit and then re-raise the exception.

  begin
    if CURRENT_SCOPE.TYPE_OF_SCOPE /= A_BLOCK then
      if not (CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY and
              CURRENT_NESTING_LEVEL > 1) then
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "exception");
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "  when others =>");
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
         "    if SD_RTM'CALLABLE then ");
        CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "      raise;");
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "    end if;");
      end if;
    end if;
  end ADD_EXCEPTION_HANDLER;

  -----------------------------------------------------------------

  procedure END_COMPILATION_UNIT is

  begin

    -- if the compilation unit was a subprogram declaration, then
    -- print any buffered tokens, and discard the with_list if
    -- there is one.
    if BUFFERING_TOKENS then
      PRINT_BUFFERED_TOKENS;
    end if;

    PROCESS_REQUESTS;


    -- The current version of the file which maps package names to
    -- type tracing information files might have changed if there
    -- were any package specs in the program, so update it.
    SDBF.SAVE_EXTERNAL_FILE;

    -- End the current compilation unit with a new line, and restart
    -- buffering in case there are more compilation units to come.
    PRINT_NEW_LINE;

    if CURRENT_NESTING_LEVEL = 0 then
      STRING_IO.CLOSE;
    end if;

    STRING_LISTS.DESTROY(WITH_LIST);
    FLUSH(PARENT_UNIT_NAME);
    FLUSH(EXPANDED_NAME);
    FLUSH(CURRENT_TYPE_IDENTIFIER);

    OUTPUT_SOURCE := TRUE;
    BUFFERING_TOKENS := TRUE;
    TOKEN_LISTS.DESTROY(BUFFERED_TOKENS);
    BUFFERED_TOKENS := TOKEN_LISTS.CREATE;
    CURRENT_LINE_NUMBER := 1;
    GENERIC_STARTED := FALSE;
    NUMBER_OF_PROGRAM_UNITS := 0;

    -- Source_Instrument does a mark before instrumenting the current
    -- file, and a release afterward.
    STRING_PKG.RELEASE;
    STRING_PKG.MARK;
  end END_COMPILATION_UNIT;

  ----------------------------------------------------------------------------

  procedure INCREMENT_SCOPE(TYPE_OF_SCOPE : in SCOPE_TYPE) is

    TYPE_OF_UNIT       : PROGRAM_UNIT_TYPE;

  begin

    case TYPE_OF_SCOPE is
      when PACKAGE_SPECIFICATION | PACKAGE_BODY =>
        TYPE_OF_UNIT := PACKAGE_TYPE;
      when TASK_BODY =>
        TYPE_OF_UNIT := TASK_TYPE;
      when SUBPROGRAM_BODY =>
        TYPE_OF_UNIT := SUBPROGRAM_UNIT_TYPE;
      when others =>
        null;
    end case;

    if FETCH(CURRENT_SCOPE_SIMPLE_NAME,1) = '"' then
      CURRENT_SCOPE_STRING_NAME := """" & CURRENT_SCOPE_SIMPLE_NAME & """";
    else
      CURRENT_SCOPE_STRING_NAME := CURRENT_SCOPE_SIMPLE_NAME;
    end if;

    if CURRENT_NESTING_LEVEL = 0 then
      if not SEPARATE_UNIT then
        CURRENT_SCOPE_QUALIFIED_NAME := CURRENT_SCOPE_SIMPLE_NAME;
      else
        CURRENT_SCOPE_QUALIFIED_NAME :=
          PARENT_UNIT_NAME & "." & CURRENT_SCOPE_SIMPLE_NAME;
      end if;

      STRING_IO.OPEN(
        VALUE(SP.CURRENT_PROGRAM_LIBRARY) &
        CATALOG_PKG.CATALOG_FILE(VALUE(CURRENT_SCOPE_QUALIFIED_NAME)) &
        SP.CATALOG_FILENAME_EXTENSION);

    else  -- Current_Nesting_Level /= 0
      CURRENT_SCOPE_QUALIFIED_NAME :=
        CURRENT_SCOPE.QUALIFIED_NAME & "." & CURRENT_SCOPE_SIMPLE_NAME;
    end if;

    ENTER_SCOPE(TYPE_OF_SCOPE);

    if TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then

      -- Delete any old type tracing files. New ones will be made if
      -- type tracing is on.
      SDBF.DELETE_PACKAGE_FILES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                                ALL_FILES);

      if CURRENT_NESTING_LEVEL = 1 and not GENERIC_STARTED then
        -- ask user if he wants to recompile this package spec --
        OUTPUT_SOURCE := ASK_USER_ABOUT_PACKAGE;
      end if;

      INITIALIZE_TRACE_PACKAGES;
    end if;     -- type of scope = package spec

    if CURRENT_NESTING_LEVEL = 1 then
      CREATE_SUBUNIT := (TYPE_OF_SCOPE = SUBPROGRAM_BODY);
      CURRENT_COMPILATION_UNIT := CURRENT_SCOPE_QUALIFIED_NAME;
      if TYPE_OF_SCOPE = SUBPROGRAM_BODY or TYPE_OF_SCOPE = TASK_BODY then
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "package SD_" &
          CT.CONVERT_PERIODS_TO_UNDERSCORES(VALUE(CURRENT_COMPILATION_UNIT))
          & " is end;");
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,"with SD_" &
          CT.CONVERT_PERIODS_TO_UNDERSCORES(VALUE(CURRENT_COMPILATION_UNIT))
          & ";");
      end if;
      if TYPE_OF_SCOPE = SUBPROGRAM_BODY or
         TYPE_OF_SCOPE = PACKAGE_BODY or
         TYPE_OF_SCOPE = TASK_BODY then
        ADD_WITHS_TO_BODY;
      end if;
      CREATE_BREAKPOINT.NEW_COMPILATION_UNIT(CURRENT_SCOPE_QUALIFIED_NAME,
                                             TYPE_OF_UNIT);
    elsif TYPE_OF_SCOPE /= PACKAGE_SPECIFICATION then
      CREATE_BREAKPOINT.START_PROGRAM_UNIT(CURRENT_SCOPE.QUALIFIED_NAME_STRING,
                                           TYPE_OF_UNIT);
    end if;

    SAVE_EXPANDED_NAME := FALSE;
    PRINT_BUFFERED_TOKENS;

    GENERIC_STARTED := FALSE;
    SEPARATE_UNIT := FALSE;
  end INCREMENT_SCOPE;

  ---------------------------------------------------------------

  procedure DECREMENT_SCOPE is

  begin
    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
      CLOSE_TRACE_PACKAGES;
    end if;

    if CURRENT_SCOPE.TYPE_OF_SCOPE /= PACKAGE_SPECIFICATION or
       CURRENT_NESTING_LEVEL = 1 then
      CREATE_BREAKPOINT.END_PROGRAM_UNIT;
    end if;

    EXIT_SCOPE;
  end DECREMENT_SCOPE;

  -------------------------------------------------------------------

  procedure START_DECLARATIVE_PART is

  --|Effects
  --|
  --|If we are in a subprogram that is a compilation unit, then define
  --|a unique call_unit_info for that unit.  For all units define a
  --|task number used in calls to the RTM.
  --|Stack the outer scope's tracing information, re-initialize
  --|everything for the current scope, and generate the putvar procedure
  --|declaration.

  begin

    if CURRENT_NESTING_LEVEL = 1 then
      TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
      SDSB.WRITE_INST_SOURCE(
        PREFIX & "CURRENT_COMPILATION_UNIT: constant String := " &
        """" & VALUE(CURRENT_COMPILATION_UNIT) & """;");
      SDSB.CLEAR_SOURCE_BUFFER;
    end if;

    if CURRENT_SCOPE.TYPE_OF_SCOPE = A_BLOCK then
     -- the block has a declarative part so change the tracing prefix to
     -- the block name
      CURRENT_SCOPE.TRACING_PREFIX := MAKE_TRACING_PREFIX(CURRENT_OUTER_SCOPE,
         CURRENT_SCOPE.SCOPE_NAME, SUBPROGRAM_BODY);
    end if;

    if CURRENT_SCOPE.TYPE_OF_SCOPE = TASK_BODY then
      TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
      TEXT_IO.PUT(SID.INSTRUMENTED_FILE,
        PREFIX & "TASK_NUMBER: NATURAL := 1;");
    end if;

    LIST_STACK_PKG.PUSH(VISIBLE_LIST_STACK, VISIBLE_LIST);
    STRING_STACK_PKG.PUSH(PACKAGE_LIST_STACK, PACKAGE_LIST);
    STRING_STACK_PKG.PUSH(USE_LIST_STACK, STRING_LISTS.COPY(USE_LIST));

    VISIBLE_LIST := NAME_LISTS.CREATE;
    PACKAGE_LIST := STRING_LISTS.CREATE;
    REC_FIELD_LIST := RECORD_LISTS.CREATE;
    CURRENT_RECORD_FIELD.CHOICE_TEXT := STRING_LISTS.CREATE;
    CURRENT_RECORD_FIELD.REC_FIELD := STRING_LISTS.CREATE;
    DISCRIM_LIST := STRING_LISTS.CREATE;

    if not NAME_LISTS.ISEMPTY(PARAM_LIST) then
      SDGU.GENERATE_DUMMY_LOCALS(PARAM_LIST);
      NAME_LISTS.ATTACH(VISIBLE_LIST, NAME_LISTS.COPY(PARAM_LIST));
      NAME_LISTS.DESTROY(PARAM_LIST);
    end if;

    SDGU.GENERATE_FINDVAR_SPEC;

    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY then
      SDBF.COPY_PACKAGE_FILES(PRIVATE_SPEC,
                              VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                              SID.INSTRUMENTED_FILE);
    end if;
    SDBF.START_NEW_SECTION;
  end START_DECLARATIVE_PART;

  ----------------------------------------------------------------

  procedure END_DECLARATIVE_PART is

  --|Effects
  --|
  --|If this is the declarative part of a compilation unit that is a procedure
  --|then define the unique call_unit_information to be a subunit.
  --|1) if it is a package body, then retieve
  --|the instrumenting information file for the private part of the
  --|corresponding package spec. 2) Finish generating the tracing procedures.
  --|3) Copy the procedure bodies from the buffer file that were saved
  --|until the end of the later declarative part.

    ITER        : STRING_LISTS.LISTITER;
    NEXT_OBJECT : STRING_TYPE;
  begin

    -- Finish the type tracing for this declarative part; the
    -- "begin ... end" part follows next.
    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY then
      SDBF.COPY_PACKAGE_FILES(PRIVATE_BODY,
                              VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                              SID.INSTRUMENTED_FILE);
    end if;

    ITER := STRING_LISTS.MAKELISTITER(PACKAGE_LIST);
    while STRING_LISTS.MORE(ITER) loop
      STRING_LISTS.NEXT(ITER, NEXT_OBJECT);
      SDBF.COPY_PACKAGE_FILES(PUBLIC_BODY,
                              VALUE(CURRENT_SCOPE.QUALIFIED_NAME &
                                    "." & NEXT_OBJECT),
                              SID.INSTRUMENTED_FILE);
    end loop;

    SDGU.GENERATE_FINDVAR_BODY(VISIBLE_LIST, PACKAGE_LIST, WITH_LIST, USE_LIST);
    SDBF.SAVE_BUFFER_FILE(SID.INSTRUMENTED_FILE);
    SDBF.RELEASE_SECTION;

    if CURRENT_SCOPE.TYPE_OF_SCOPE /= PACKAGE_BODY then
      if CURRENT_SCOPE.TYPE_OF_SCOPE /= A_BLOCK then
        NUMBER_OF_PROGRAM_UNITS := NUMBER_OF_PROGRAM_UNITS+ 1;
        CURRENT_SCOPE.SCOPE_NUMBER := NUMBER_OF_PROGRAM_UNITS;
      end if;
      SDGU.GENERATE_LOCAL_BREAK(CURRENT_SCOPE.SCOPE_NUMBER,
                                CURRENT_SCOPE.TYPE_OF_SCOPE = TASK_BODY);
    end if;

    STRING_LISTS.DESTROY(PACKAGE_LIST);
    STRING_LISTS.DESTROY(USE_LIST);
    DISCARD_LIST(VISIBLE_LIST);

    LIST_STACK_PKG.POP(VISIBLE_LIST_STACK, VISIBLE_LIST);
    STRING_STACK_PKG.POP(PACKAGE_LIST_STACK, PACKAGE_LIST);
    STRING_STACK_PKG.POP(USE_LIST_STACK, USE_LIST);
  end END_DECLARATIVE_PART;

  -----------------------------------------------------------------
  procedure ADD_IDENTIFIER_TO_LIST is

  --| Effects
  --|
  --| Add the current identifier to "current_list".
  --| The current identifier's name is in Saved_Token.

    CURRENT_NAME : NAME_RECORD;

  begin
    CURRENT_NAME.OBJECT_NAME :=
      MAKE_PERSISTENT(UPPER(SAVED_TOKEN.LEXED_TOKEN.TEXT.all));
    NAME_LISTS.ATTACH(CURRENT_LIST, CURRENT_NAME);
  end ADD_IDENTIFIER_TO_LIST;

  -----------------------------------------------------------------

  procedure SET_IDENTIFIER_MODE(MODE : in IDENTIFIER_MODE) is

  --| Effects
  --|
  --| Save the mode of the current identifier list.

  begin
    CURRENT_MODE := MODE;
    if CURRENT_MODE = WRITE_ONLY then
       -- prepare to save the type_mark which will follow
       FLUSH(EXPANDED_NAME);
       SAVE_EXPANDED_NAME := TRUE;
    end if;
  end SET_IDENTIFIER_MODE;

  -----------------------------------------------------------------

  procedure PROCESS_IDENTIFIER_LIST(LIST_TYPE : in IDENTIFIER_LIST_TYPE) is

  --| Effects
  --|
  --| This is called at the end of the current identifier list.
  --| Update the mode and type for all identifiers in the list,
  --| and save the list for later processing, depending on the
  --| type of list this is.

    ITER        : NAME_LISTS.LISTITER;
    NEXT_OBJECT : NAME_RECORD;

  begin

    case LIST_TYPE is
      when OBJECT_LIST | PARAMETER_LIST | DISCRIMINANT_LIST |
           RECORD_FIELD_LIST =>

        ITER := NAME_LISTS.MAKELISTITER(CURRENT_LIST);
        while NAME_LISTS.MORE(ITER) loop
          NAME_LISTS.NEXT(ITER, NEXT_OBJECT);
          case LIST_TYPE is

            when OBJECT_LIST =>
              NEXT_OBJECT.OBJECT_MODE := CURRENT_MODE;
              NEXT_OBJECT.OBJECT_TYPE := MAKE_PERSISTENT(EXPANDED_NAME);
              NAME_LISTS.ATTACH(VISIBLE_LIST, NEXT_OBJECT);
              if not STRING_LISTS.ISEMPTY(ANON_ARRAY_TEXT) then
                TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
                SDGU.GENERATE_ANON_TYPE(ANON_ARRAY_TEXT);
                CURRENT_TYPE_CLASS := ARRAY_TYPE;
                NOT_INCOMPLETE_TYPE := TRUE;
                END_TYPE_DECLARATION;
                DISCARD_LIST(ANON_ARRAY_TEXT);
              end if;


            when PARAMETER_LIST =>
              NEXT_OBJECT.OBJECT_MODE := CURRENT_MODE;
              NEXT_OBJECT.OBJECT_TYPE := MAKE_PERSISTENT(EXPANDED_NAME);
              NAME_LISTS.ATTACH(PARAM_LIST, NEXT_OBJECT);

            when DISCRIMINANT_LIST =>
              STRING_LISTS.ATTACH(DISCRIM_LIST, NEXT_OBJECT.OBJECT_NAME);

            when RECORD_FIELD_LIST =>
              STRING_LISTS.ATTACH(CURRENT_RECORD_FIELD.REC_FIELD,
                NEXT_OBJECT.OBJECT_NAME);

            when others =>
              null;
          end case;
        end loop;

      when others =>
        null;
    end case;


    FLUSH(EXPANDED_NAME);
    NAME_LISTS.DESTROY(CURRENT_LIST);
    CURRENT_MODE := NONE;
  end PROCESS_IDENTIFIER_LIST;

  -----------------------------------------------------------------

  procedure SAVE_TYPE_IDENTIFIER is

  --| Effects
  --|
  --| The current saved_token is a type identifier.
  --| Save the type identifier for use in generating the
  --| "tracevar" procedures.

  begin
    FLUSH(CURRENT_TYPE_IDENTIFIER);
    CURRENT_TYPE_IDENTIFIER := UPPER(SAVED_TOKEN.LEXED_TOKEN.TEXT.all);
  end SAVE_TYPE_IDENTIFIER;

  -----------------------------------------------------------------

  procedure END_GENERIC_TYPE is
  begin
    GENERIC_TYPE_LIST :=
      STRING_LISTS.ATTACH(MAKE_PERSISTENT(CURRENT_TYPE_IDENTIFIER),
                          GENERIC_TYPE_LIST);
  end END_GENERIC_TYPE;

  -----------------------------------------------------------------

  procedure SAVE_TYPE_CLASS(TYPE_KIND : in TYPE_CLASS) is

  --| Effects
  --|

  begin
    NOT_INCOMPLETE_TYPE := TRUE;
    CURRENT_TYPE_CLASS := TYPE_KIND;

    if TYPE_KIND = TASK_TYPE then
      CURRENT_TYPE_IDENTIFIER := UPPER(SAVED_TOKEN.LEXED_TOKEN.TEXT.all);
    end if;

  end SAVE_TYPE_CLASS;

  -----------------------------------------------------------------

  procedure END_TYPE_DECLARATION is

  --| Effects
  --|

    GENERATE_SPEC : BOOLEAN := TRUE;
    TYPE_NAME     : STRING_TYPE;
  begin

    if NOT_INCOMPLETE_TYPE then
      STRING_PKG.MARK;
      TYPE_NAME := "STANDARD." & CURRENT_SCOPE.QUALIFIED_NAME & "." &
                   CURRENT_TYPE_IDENTIFIER;

      case CURRENT_TYPE_CLASS is

        when ENUMERATION_TYPE | INTEGER_TYPE | FLOAT_TYPE | FIXED_TYPE
             | PRIVATE_TYPE | LIMITED_PRIVATE_TYPE | TASK_TYPE =>
           SDGU.GENERATE_TRACING_INSTANTIATION(VALUE(TYPE_NAME),
                                               CURRENT_TYPE_CLASS);
           GENERATE_SPEC := FALSE;

        when DERIVED_TYPE =>
          -- expanded name is the parent type name --
          SDGU.GENERATE_DERIVED_TRACE(VALUE(TYPE_NAME), VALUE(EXPANDED_NAME));
          FLUSH(EXPANDED_NAME);

        when ARRAY_TYPE =>
          if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION and
             not STRING_LISTS.ISEMPTY(ANON_ARRAY_TEXT) then
            TYPE_NAME := "STANDARD." & EXPANDED_NAME;
          end if;
          SDGU.GENERATE_ARRAY_TRACE(VALUE(TYPE_NAME), NUMBER_OF_DIMENSIONS);

        when RECORD_TYPE =>
          if not STRING_LISTS.ISEMPTY(CURRENT_RECORD_FIELD.REC_FIELD) then
            RECORD_LISTS.ATTACH(REC_FIELD_LIST, CURRENT_RECORD_FIELD);
          end if;
          SDGU.GENERATE_RECORD_TRACE
            (VALUE(TYPE_NAME), REC_FIELD_LIST, DISCRIM_LIST, CASE_DISCRIMINANT);
          FLUSH(CASE_DISCRIMINANT);
          DISCARD_LIST(REC_FIELD_LIST);
          CURRENT_RECORD_FIELD.CHOICE_TEXT := STRING_LISTS.CREATE;
          CURRENT_RECORD_FIELD.REC_FIELD := STRING_LISTS.CREATE;
          REC_FIELD_LIST := RECORD_LISTS.CREATE;

        when ACCESS_TYPE =>
          SDGU.GENERATE_ACCESS_TRACE(VALUE(TYPE_NAME));
      end case;

      if GENERATE_SPEC then
        SDGU.GENERATE_TRACING_SPECS(VALUE(TYPE_NAME));
      end if;
      STRING_PKG.RELEASE;
    end if;

    NOT_INCOMPLETE_TYPE := FALSE;
    FLUSH(CURRENT_TYPE_IDENTIFIER);
    DISCARD_LIST(DISCRIM_LIST);
    DISCRIM_LIST := STRING_LISTS.CREATE;
  end END_TYPE_DECLARATION;

  -----------------------------------------------------------------

  procedure START_ANONYMOUS_ARRAY_DEFINITION is

  --| Effects
  --|

  begin
    SAVE_ANON_ARRAY_TEXT := TRUE;
    CURRENT_TYPE_IDENTIFIER := MAKE_ANON_TYPE_NAME;
    STRING_LISTS.ATTACH(ANON_ARRAY_TEXT,
      "type " & CURRENT_TYPE_IDENTIFIER & " is");
    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
      if not IS_EMPTY(CURRENT_OUTER_SCOPE.QUALIFIED_NAME) then
        EXPANDED_NAME := CURRENT_OUTER_SCOPE.QUALIFIED_NAME & "." &
                         SD_PREFIX & CURRENT_SCOPE.SCOPE_NAME &
                         "." & CURRENT_TYPE_IDENTIFIER;
      else
        EXPANDED_NAME := SD_PREFIX & CURRENT_SCOPE.SCOPE_NAME &
                         "." & CURRENT_TYPE_IDENTIFIER;
      end if;
    else
      EXPANDED_NAME := CURRENT_SCOPE.QUALIFIED_NAME & "." &
                       CURRENT_TYPE_IDENTIFIER;
    end if;
  end START_ANONYMOUS_ARRAY_DEFINITION;

  -----------------------------------------------------------------

  procedure END_ANONYMOUS_ARRAY_DEFINITION is
  begin
    STRING_LISTS.ATTACH(ANON_ARRAY_TEXT, CREATE(";"));
    SAVE_ANON_ARRAY_TEXT := FALSE;
  end END_ANONYMOUS_ARRAY_DEFINITION;

  -----------------------------------------------------------------

  procedure END_TYPEMARK is

  --| Effects
  --|
  --| The current expanded name is a typemark name, before any
  --| constraints which may follow.  Not all typemarks are saved
  --| but in all cases turn off the "SAVE_EXPANDED_NAME" flag.

  begin
    SAVE_EXPANDED_NAME := FALSE;
  end END_TYPEMARK;

  -----------------------------------------------------------------

  procedure START_PRIVATE_PART is

  --| Effects
  --|
  --| This procedure is called at the start of the private part
  --| of a package specification.  Stack
  --| the visible variables list from the public part and set the
  --| "In_Private_Part" field of the current scope record so that
  --| tracing information will be written to the private tracing
  --| files.

  begin
    LIST_STACK_PKG.PUSH(VISIBLE_LIST_STACK, VISIBLE_LIST);
    VISIBLE_LIST := NAME_LISTS.CREATE;
    STRING_STACK_PKG.PUSH(PACKAGE_LIST_STACK, PACKAGE_LIST);
    PACKAGE_LIST := STRING_LISTS.CREATE;
    STRING_STACK_PKG.PUSH(USE_LIST_STACK, STRING_LISTS.COPY(USE_LIST));

    CURRENT_SCOPE.IN_PRIVATE_PART := TRUE;
    SDBF.CREATE_PACKAGE_FILES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                              PRIVATE_FILES);
    SDGU.GENERATE_FINDVAR_SPEC;
  end START_PRIVATE_PART;

  -----------------------------------------------------------------
  procedure SAVE_CASE_IDENTIFIER is
  begin
    SAVE_CASE_DISCRIMINANT := TRUE;
  end SAVE_CASE_IDENTIFIER;

  -----------------------------------------------------------------
  procedure START_RECORD_VARIANT is
  begin
    if not STRING_LISTS.ISEMPTY(CURRENT_RECORD_FIELD.REC_FIELD) then
      RECORD_LISTS.ATTACH(REC_FIELD_LIST, CURRENT_RECORD_FIELD);
      CURRENT_RECORD_FIELD.CHOICE_TEXT := STRING_LISTS.CREATE;
      CURRENT_RECORD_FIELD.REC_FIELD := STRING_LISTS.CREATE;
    end if;
    SAVE_RECORD_VARIANT := TRUE;
  end START_RECORD_VARIANT;

  -----------------------------------------------------------------

  procedure END_RECORD_VARIANT is
  begin
    SAVE_RECORD_VARIANT := FALSE;
  end END_RECORD_VARIANT;

  -----------------------------------------------------------------
  procedure NULL_RECORD_FIELD is
  begin
    STRING_LISTS.ATTACH(
      CURRENT_RECORD_FIELD.REC_FIELD, MAKE_PERSISTENT("NULL"));
  end NULL_RECORD_FIELD;

  -----------------------------------------------------------------
  procedure START_GENERIC_SPECIFICATION is
  begin
    if CURRENT_NESTING_LEVEL = 0 then
      GENERIC_STARTED := TRUE;
      PRINT_BUFFERED_TOKENS;
    end if;
    GENERIC_TYPE_LIST := STRING_LISTS.CREATE;
  end START_GENERIC_SPECIFICATION;

  -----------------------------------------------------------------
  procedure END_GENERIC_SPECIFICATION is
    LIST_ITERATOR : STRING_LISTS.LISTITER;
    CURRENT_TYPE  : STRING_TYPE;
    FIRST_ONE     : BOOLEAN := TRUE;
  begin
    LIST_ITERATOR := STRING_LISTS.MAKELISTITER(GENERIC_TYPE_LIST);
    while STRING_LISTS.MORE(LIST_ITERATOR) loop
      STRING_LISTS.NEXT(LIST_ITERATOR, CURRENT_TYPE);
      if OUTPUT_SOURCE then
        if FIRST_ONE then
          TEXT_IO.NEW_LINE(SID.INSTRUMENTED_FILE);
          FIRST_ONE := FALSE;
        end if;
        SDSB.WRITE_LINE_INST_SOURCE("with procedure " & sd_prefix &
          "D(NAME: STRING; VAR: " & VALUE(CURRENT_TYPE) &
          ") IS <>;");
        SDSB.WRITE_LINE_INST_SOURCE("with procedure " & SD_PREFIX &
          "S(VAR: in out " & VALUE(CURRENT_TYPE) &
          ") IS <>;");
        SDSB.WRITE_LINE_INST_SOURCE("with function " & SD_PREFIX &
          "M(VAR: " & VALUE(CURRENT_TYPE) &
          ") return STRING is <>;");
      end if;
      FLUSH(CURRENT_TYPE);
    end loop;
  end END_GENERIC_SPECIFICATION;

  -----------------------------------------------------------------
  procedure INCREMENT_ARRAY_INDEX is
  begin
    if PARSING_ARRAY_INDEX then
      NUMBER_OF_DIMENSIONS := NUMBER_OF_DIMENSIONS + 1;
    end if;
  end INCREMENT_ARRAY_INDEX;

  -----------------------------------------------------------------
  procedure START_ARRAY_INDEX is
  begin
    PARSING_ARRAY_INDEX := TRUE;
    NUMBER_OF_DIMENSIONS := 0;
  end START_ARRAY_INDEX;

  -----------------------------------------------------------------
  procedure END_ARRAY_INDEX is
  begin
    PARSING_ARRAY_INDEX := FALSE;
  end END_ARRAY_INDEX;


  --------------------------------------------------------------
  --     Local Subprogram Bodies
  --------------------------------------------------------------

  procedure PRINT_BUFFERED_TOKENS is

  --|Effects
  --|
  --|If there were any tokens that were buffered then print them out now.
  --|The last token that was buffered must first be added to the list
  --|of buffered tokens from the place holder.

    ITERATOR      : TOKEN_LISTS.LISTITER;
    CURRENT_TOKEN : TOKEN_DESCRIPTOR;
  begin
    if CURRENT_BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL /= PT.COMMENT_TOKENVALUE then
      REQUESTS.CHANGES := REQUESTS.CHANGES +
                          CURRENT_BUFFERED_TOKEN.REQUESTS.CHANGES;
      CURRENT_BUFFERED_TOKEN.REQUESTS := REQUESTS;
      REQUESTS := (0, 0, 0, 0, 0);
      TOKEN_LISTS.ATTACH(BUFFERED_TOKENS, CURRENT_BUFFERED_TOKEN);
      CURRENT_BUFFERED_TOKEN := INITIALIZED_DESCRIPTOR;
    end if;
    ITERATOR := TOKEN_LISTS.MAKELISTITER(BUFFERED_TOKENS);
    while TOKEN_LISTS.MORE(ITERATOR) loop
      TOKEN_LISTS.NEXT(ITERATOR, CURRENT_TOKEN);
      PRINT_COMMENTS(CURRENT_TOKEN.COMMENTS);
      PRINT_TOKEN(CURRENT_TOKEN.TOKEN);
      REQUESTS := CURRENT_TOKEN.REQUESTS;
      if CURRENT_TOKEN.TOKEN.GRAM_SYM_VAL = PT.LEFTPAREN_TOKENVALUE then
        if CURRENT_COLUMN in SP.INDENTATION_RANGE then
           CURRENT_CHANGE_COLUMN := CURRENT_COLUMN;
        else
          -- CURRENT_INDENT is 0 at the outermost level
          CURRENT_CHANGE_COLUMN := SP.INDENTATION_LEVEL + 2;
        end if;
      end if;
    end loop;
    CURRENT_CHANGE_COLUMN := 0;
    TOKEN_LISTS.DESTROY(BUFFERED_TOKENS);
    BUFFERING_TOKENS := FALSE;
  end PRINT_BUFFERED_TOKENS;

  -----------------------------------------------------------------

  function MAKE_ANON_TYPE_NAME return STRING_TYPE is
  begin
    ANON_NUMBER := ANON_NUMBER + 1;
    RETURN CREATE(SD_PREFIX & "ANON" &
      INTEGER'IMAGE(ANON_NUMBER)(2..INTEGER'IMAGE(ANON_NUMBER)'LAST));
  end MAKE_ANON_TYPE_NAME;

  -----------------------------------------------------------------

  procedure RETRIEVE_SPEC_WITH_LIST is

  --| Effects
  --|
  --| Get the with list that was saved for the package spec.
  --| If it named any units that are not in the with list
  --| for the body, then add those names to the current
  --| with list.

    TEMP_LIST           : STRING_LISTS.LIST;
    TEMP_LIST_ITERATOR  : STRING_LISTS.LISTITER;
    TEMP_LIST_OBJECT    : STRING_TYPE;

    SAVED_LIST          : STRING_LISTS.LIST;
    SAVED_LIST_ITERATOR : STRING_LISTS.LISTITER;
    SAVED_LIST_OBJECT   : STRING_TYPE;
    MATCHED             : BOOLEAN;
  begin

    SAVED_LIST := SDBF.GET_SPEC_WITH_LIST(VALUE(CURRENT_SCOPE.SCOPE_NAME));

    if not STRING_LISTS.ISEMPTY(SAVED_LIST) then
      TEMP_LIST := STRING_LISTS.COPY(WITH_LIST);
      SAVED_LIST_ITERATOR := STRING_LISTS.MAKELISTITER(SAVED_LIST);
      while STRING_LISTS.MORE(SAVED_LIST_ITERATOR) loop
        STRING_LISTS.NEXT(SAVED_LIST_ITERATOR, SAVED_LIST_OBJECT);
        MATCHED := FALSE;

        TEMP_LIST_ITERATOR := STRING_LISTS.MAKELISTITER(TEMP_LIST);
        while STRING_LISTS.MORE(TEMP_LIST_ITERATOR) and not MATCHED loop
          STRING_LISTS.NEXT(TEMP_LIST_ITERATOR, TEMP_LIST_OBJECT);
          MATCHED := EQUAL(UPPER(TEMP_LIST_OBJECT), UPPER(SAVED_LIST_OBJECT));
        end loop;
        if not MATCHED then
          STRING_LISTS.ATTACH(WITH_LIST, SAVED_LIST_OBJECT);
        else
          STRING_LISTS.DELETEITEM(TEMP_LIST, TEMP_LIST_OBJECT);
        end if; -- not matched
      end loop; -- while more (saved_list)
    end if; -- not empty (saved_list)
  end RETRIEVE_SPEC_WITH_LIST;

  ----------------------------------------------------------------------

  procedure DISPLAY_MESSAGE is
  begin
    TEXT_IO.PUT_LINE(
     "If your package specification includes a generic declaration and " &
     "you want");
    TEXT_IO.PUT_LINE(
      "to instrument the generic body, then you must answer YES to this " &
      "question.");
    TEXT_IO.PUT_LINE("");
    TEXT_IO.PUT_LINE(
      "Otherwise, instrumenting will not alter your package specification and");
    TEXT_IO.PUT_LINE(
      "recompiling your package specification may not be required.");
    TEXT_IO.PUT_LINE("");
    TEXT_IO.PUT_LINE(
      "The source instrumenter will create a package which has the procedures");
    TEXT_IO.PUT_LINE(
      "necessary to trace any types and variables declared in your package");
    TEXT_IO.PUT_LINE(
      "specification.  The source instrumenter's package will WITH and USE");
    TEXT_IO.PUT_LINE(
      "your package.  Therefore, your package specification must be compiled");
    TEXT_IO.PUT_LINE(
      "prior to compiling the source instrumenter's package.");
    TEXT_IO.PUT_LINE("");
    TEXT_IO.PUT_LINE(
      "If you need to compile or recompile your package spcecification, you");
    TEXT_IO.PUT_LINE(
      "may have it included in the same file as the source instrumenter's");
    TEXT_IO.PUT_LINE(
      "package.  Then when you compile the instrumented source file, both");
    TEXT_IO.PUT_LINE(
      "packages will be compiled.  You will have to recompile your package");
    TEXT_IO.PUT_LINE(
      "body and all dependent units as usual.");
    TEXT_IO.PUT_LINE("");
    TEXT_IO.PUT_LINE(
      "If you do not want to recompile your package specification, answer NO");
    TEXT_IO.PUT_LINE(
      "to the question.  You will still need to compile the instrumented");
    TEXT_IO.PUT_LINE(
      "source file, but your package will not be affected.");
    TEXT_IO.PUT_LINE("");
  end DISPLAY_MESSAGE;

  ----------------------------------------------------------------------

  function ASK_USER_ABOUT_PACKAGE return BOOLEAN is

  --| Effects
  --|
  --| Before instrumenting a package specification which is a
  --| library unit, ask the user if the text of the package
  --| spec should be included in the instrumented source which
  --| will be compiled.

    ANSWER : STRING(1..80);
    INDEX  : INTEGER := 80;

  begin
    TEXT_IO.NEW_LINE(2);
    TEXT_IO.PUT_LINE(ASCII.BEL & ASCII.BEL &
      "Instrumenting the package specification for ");
    TEXT_IO.PUT_LINE(VALUE(CURRENT_SCOPE_SIMPLE_NAME));
    loop
      TEXT_IO.PUT_LINE("Do you want this package specification included " &
                       "in the instrumented source?");

      TEXT_IO.PUT("Y/N/H or ? for Help ");

      ANSWER(1..INDEX) := (others => ' ');
      TEXT_IO.GET_LINE(TEXT_IO.STANDARD_INPUT, ANSWER, INDEX);
      TEXT_IO.PUT_LINE("");
      case ANSWER(1) is
        when 'Y' | 'y' =>
          return TRUE;
        when 'N' | 'n' =>
          return FALSE;
        when '?' | 'H' | 'h' =>
          DISPLAY_MESSAGE;
        when others =>
          null;
      end case;
    end loop;
  end ASK_USER_ABOUT_PACKAGE;

  ---------------------------------------------------------------

  procedure DISCARD_LIST(WHICH_LIST : in out NAME_LISTS.LIST) is

  --| Effects
  --|
  --| Before destroying a name_list, the string_type fields
  --| needs to be flushed.

    ITER        : NAME_LISTS.LISTITER;
    NEXT_OBJECT : NAME_RECORD;
  begin
    if not NAME_LISTS.ISEMPTY(WHICH_LIST) then
      ITER := NAME_LISTS.MAKELISTITER(WHICH_LIST);
      while NAME_LISTS.MORE(ITER) loop
        NAME_LISTS.NEXT(ITER, NEXT_OBJECT);
        FLUSH(NEXT_OBJECT.OBJECT_NAME);
        FLUSH(NEXT_OBJECT.OBJECT_TYPE);
      end loop;
      NAME_LISTS.DESTROY(WHICH_LIST);
    end if;
  end DISCARD_LIST;

  ---------------------------------------------------------------

  procedure DISCARD_LIST(WHICH_LIST : in out STRING_LISTS.LIST) is

  --| Effects
  --|
  --| Before destroying a string_list, the string_type fields
  --| needs to be flushed.

    ITER          : STRING_LISTS.LISTITER;
    STRING_OBJECT : STRING_TYPE;
  begin
    if not STRING_LISTS.ISEMPTY(WHICH_LIST) then
      ITER := STRING_LISTS.MAKELISTITER(WHICH_LIST);
      while STRING_LISTS.MORE(ITER) loop
        STRING_LISTS.NEXT(ITER, STRING_OBJECT);
        FLUSH(STRING_OBJECT);
      end loop;
      STRING_LISTS.DESTROY(WHICH_LIST);
    end if;
  end DISCARD_LIST;

  ---------------------------------------------------------------

  procedure DISCARD_LIST(WHICH_LIST : in out RECORD_LISTS.LIST) is

  --| Effects
  --|
  --| Before destroying a record_list, the string_type fields
  --| needs to be flushed.

    ITER        : RECORD_LISTS.LISTITER;
    NEXT_OBJECT : REC_FIELD_RECORD;
  begin
    if not RECORD_LISTS.ISEMPTY(WHICH_LIST) then
      ITER := RECORD_LISTS.MAKELISTITER(WHICH_LIST);
      while RECORD_LISTS.MORE(ITER) loop
        RECORD_LISTS.NEXT(ITER, NEXT_OBJECT);
        DISCARD_LIST(NEXT_OBJECT.CHOICE_TEXT);
        DISCARD_LIST(NEXT_OBJECT.REC_FIELD);
      end loop;
      RECORD_LISTS.DESTROY(WHICH_LIST);
    end if;
  end DISCARD_LIST;

  --------------------------------------------------------------------

  procedure ADD_WITHS_TO_BODY is

  --| Effects
  --|
  --| This is called from Increment_Scope when the current
  --| nesting level is 0, and the type of unit is either
  --| a subprogram body or a package body.  Add the with
  --| and use clauses that will be needed by the instrumented
  --| source and retrieve any with clauses that were given for
  --| the specification.

    ITERATOR    : STRING_LISTS.LISTITER;
    NEXT_OBJECT : STRING_TYPE;

  begin
    if not SEPARATE_UNIT then
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with SD_Run_Time_Monitor; use SD_Run_Time_Monitor;");
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with SD_Type_Definitions; use SD_Type_Definitions;");
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with SD_User_Interface; use SD_User_Interface;");
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with SD_Runtime_Declarations; use SD_Runtime_Declarations;");
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with SD_Runtime_Utilities; use SD_Runtime_Utilities;");
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with SD_Trace_Predefined_Types; use SD_Trace_Predefined_Types;");
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with SD_Generic_Templates; use SD_Generic_Templates;");
      TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE, "with String_Pkg;");
      RETRIEVE_SPEC_WITH_LIST;
    end if; -- not separate

    -- if the current unit is a package body and its spec was instrumented
    -- then with and use its public trace package
    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY and then
       SDBF.PACKAGE_FILES_EXIST(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                                PUBLIC_FILES) then
      SDSB.WRITE_LINE_INST_SOURCE(
        "with " & SD_PREFIX & VALUE(CURRENT_SCOPE_SIMPLE_NAME) & "; " &
        "use " & SD_PREFIX & VALUE(CURRENT_SCOPE_SIMPLE_NAME) & ";");
    end if; -- package_body and type_tracing

    -- now add with and use for anything in the with list that
    -- has been instrumented.  Note that the with list won't have
    -- anything in it if type_tracing is turned off.

    ITERATOR := STRING_LISTS.MAKELISTITER(WITH_LIST);
    while STRING_LISTS.MORE(ITERATOR) loop
      STRING_LISTS.NEXT(ITERATOR, NEXT_OBJECT);
      SDSB.WRITE_LINE_INST_SOURCE(
        "with " & SD_PREFIX & VALUE(NEXT_OBJECT) & "; " &
        "use " & SD_PREFIX & VALUE(NEXT_OBJECT) & ";");
    end loop;

  end ADD_WITHS_TO_BODY;

  ------------------------------------------------------------------

  procedure ADD_WITHS_TO_TRACE_PACKAGES is

  --| Effects
  --|
  --| This is called by Initialize_Trace_Packages when the current
  --| nesting level is 0. The tracing packages have to have visibility
  --| of the package specification being traced, the public tracing
  --| packages of any instrumented units in the context clause, and
  --| other assorted utility packages.

    ITERATOR    : STRING_LISTS.LISTITER;
    NEXT_OBJECT : STRING_TYPE;

    -----------------------------------------------------------------
    -- See if the name in the with clause is also in the use list.
    -- We can't use LIST_PACKAGE.ISINLIST because it checks to
    -- see if the pointers are equal, rather than what they point to.

    function IS_USED(NAME: STRING_TYPE) return BOOLEAN is
      USE_ITERATOR : STRING_LISTS.LISTITER;
      NEXT_NAME    : STRING_TYPE;
    begin
      USE_ITERATOR := STRING_LISTS.MAKELISTITER(USE_LIST);
      while STRING_LISTS.MORE(USE_ITERATOR) loop
        STRING_LISTS.NEXT(USE_ITERATOR, NEXT_NAME);
        if STRING_PKG.EQUAL(NAME, NEXT_NAME) then
          return TRUE;
        end if;
      end loop;
      return FALSE;
    end IS_USED;
    -----------------------------------------------------------------

  begin

    -- with and use the package being traced
    SDSB.WRITE_SPEC_BUFFER("with " & VALUE(CURRENT_SCOPE_SIMPLE_NAME) & "; ");

    if not GENERIC_STARTED then
      SDSB.WRITE_LINE_SPEC_BUFFER(
        "use " & VALUE(CURRENT_SCOPE_SIMPLE_NAME) & ";");
    else
      SDSB.WRITE_LINE_SPEC_BUFFER("");
    end if;

    -- with and use the support packages
    SDSB.WRITE_LINE_SPEC_BUFFER(
      "with SD_Runtime_Declarations; use SD_Runtime_Declarations;");
    SDSB.WRITE_LINE_SPEC_BUFFER(
      "with SD_Runtime_Utilities; use SD_Runtime_Utilities;");
    SDSB.WRITE_LINE_SPEC_BUFFER(
      "with SD_Trace_Predefined_Types; use SD_Trace_Predefined_Types;");
    SDSB.WRITE_LINE_SPEC_BUFFER(
      "with SD_Generic_Templates; use SD_Generic_Templates;");
    SDSB.WRITE_LINE_SPEC_BUFFER(
      "with STRING_PKG;");

    -- with and use the packages and public trace packages of anything
    -- in the with list that was instrumented.
    ITERATOR := STRING_LISTS.MAKELISTITER(WITH_LIST);
    while STRING_LISTS.MORE(ITERATOR) loop
      STRING_LISTS.NEXT(ITERATOR, NEXT_OBJECT);
      SDSB.WRITE_SPEC_BUFFER("with " & VALUE(NEXT_OBJECT) & "; ");
      if IS_USED(NEXT_OBJECT) then
        SDSB.WRITE_LINE_SPEC_BUFFER("use " & VALUE(NEXT_OBJECT) & ";");
      else
        SDSB.WRITE_LINE_SPEC_BUFFER("");
      end if;

      SDSB.WRITE_LINE_SPEC_BUFFER(
        "with " & SD_PREFIX & VALUE(NEXT_OBJECT) & "; " &
        "use " & SD_PREFIX & VALUE(NEXT_OBJECT) & ";");
    end loop;

  end ADD_WITHS_TO_TRACE_PACKAGES;

  -----------------------------------------------------------------

  procedure INITIALIZE_TRACE_PACKAGES is

  --| Effects
  --|
  --| This procedure is called by Increment_Scope when the
  --| current scope is a package specification.

  begin
    if CURRENT_OUTER_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
      if CURRENT_OUTER_SCOPE.IN_PRIVATE_PART then
        SDBF.CLOSE_PACKAGE_FILES(ALL_FILES);
        SDBF.CREATE_PACKAGE_FILES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                                  PUBLIC_FILES);
      end if;
    else
      SDBF.CREATE_PACKAGE_FILES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                                PUBLIC_FILES);

      if CURRENT_NESTING_LEVEL = 1 then
        if not STRING_LISTS.ISEMPTY(WITH_LIST) then
          SDBF.SAVE_SPEC_WITH_LIST(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                                   WITH_LIST);
        end if;
        ADD_WITHS_TO_TRACE_PACKAGES;
      end if; -- Current_Nesting_Level = 1

      -- Start the public trace packages
      SDSB.WRITE_LINE_SPEC_BUFFER(
        "package " & SD_PREFIX & VALUE(CURRENT_SCOPE.SCOPE_NAME) & " is");
      SDSB.WRITE_LINE_BODY_BUFFER(
        "package body " & SD_PREFIX & VALUE(CURRENT_SCOPE.SCOPE_NAME) & " is");
    end if;

    SDGU.GENERATE_FINDVAR_SPEC;

    -- start new visible variable and local package lists
    LIST_STACK_PKG.PUSH(VISIBLE_LIST_STACK, VISIBLE_LIST);
    VISIBLE_LIST := NAME_LISTS.CREATE;
    STRING_STACK_PKG.PUSH(PACKAGE_LIST_STACK, PACKAGE_LIST);
    PACKAGE_LIST := STRING_LISTS.CREATE;
    STRING_STACK_PKG.PUSH(USE_LIST_STACK, STRING_LISTS.COPY(USE_LIST));
  end INITIALIZE_TRACE_PACKAGES;

  -----------------------------------------------------------------

  procedure CLOSE_TRACE_PACKAGES is

  --| Effects
  --|
  --| This procedure is called by Decrement_Scope when the current unit
  --| is a package specification.  Finish the tracing information packages.

  begin

    -- Finish the private tracing packages
    if CURRENT_SCOPE.IN_PRIVATE_PART then
      SDGU.GENERATE_PACKAGE_FINDVAR(VISIBLE_LIST, PACKAGE_LIST, USE_LIST);
      LIST_STACK_PKG.POP(VISIBLE_LIST_STACK, VISIBLE_LIST);
      STRING_STACK_PKG.POP(PACKAGE_LIST_STACK, PACKAGE_LIST);
      STRING_STACK_PKG.POP(USE_LIST_STACK, USE_LIST);
      CURRENT_SCOPE.IN_PRIVATE_PART := FALSE;
      SDBF.CLOSE_PACKAGE_FILES(PRIVATE_FILES);
    end if;

    SDGU.GENERATE_PACKAGE_FINDVAR(VISIBLE_LIST, PACKAGE_LIST, USE_LIST);

    LIST_STACK_PKG.POP(VISIBLE_LIST_STACK, VISIBLE_LIST);
    STRING_STACK_PKG.POP(PACKAGE_LIST_STACK, PACKAGE_LIST);
    STRING_STACK_PKG.POP(USE_LIST_STACK, USE_LIST);

    if CURRENT_OUTER_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
      if CURRENT_OUTER_SCOPE.IN_PRIVATE_PART then
        SDBF.REOPEN_FILES(VALUE(CURRENT_OUTER_SCOPE.QUALIFIED_NAME),
                          PRIVATE_FILES);
        SDBF.COPY_AND_DELETE(PUBLIC_SPEC_FILE, PRIVATE_SPEC_FILE);
        SDBF.COPY_AND_DELETE(PUBLIC_BODY_FILE, PRIVATE_BODY_FILE);
        SDBF.REOPEN_FILES(VALUE(CURRENT_OUTER_SCOPE.QUALIFIED_NAME),
                          PUBLIC_FILES);
      end if;
      STRING_LISTS.ATTACH(PACKAGE_LIST,
                          MAKE_PERSISTENT(CURRENT_SCOPE.SCOPE_NAME));
    else
      -- End the public trace packages
      SDSB.WRITE_LINE_SPEC_BUFFER(
        "end " & SD_PREFIX & VALUE(CURRENT_SCOPE.SCOPE_NAME) & ";");
      SDSB.WRITE_LINE_BODY_BUFFER(
        "end " & SD_PREFIX & VALUE(CURRENT_SCOPE.SCOPE_NAME) & ";");

      SDBF.CLOSE_PACKAGE_FILES(PUBLIC_FILES);

      SDBF.COPY_PACKAGE_FILES(PUBLIC_SPEC,
                              VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                              SID.INSTRUMENTED_FILE);

      if CURRENT_NESTING_LEVEL = 1 then
        SDBF.COPY_PACKAGE_FILES(PUBLIC_BODY,
                                VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                                SID.INSTRUMENTED_FILE);
      else
        TEXT_IO.PUT_LINE(SID.INSTRUMENTED_FILE,
          "use " & SD_PREFIX & VALUE(CURRENT_SCOPE.SCOPE_NAME) & ";");
        STRING_LISTS.ATTACH(PACKAGE_LIST,
                            MAKE_PERSISTENT(CURRENT_SCOPE.SCOPE_NAME));
      end if; -- if current nesting level = 1
    end if;
  end CLOSE_TRACE_PACKAGES;

  -----------------------------------------------------------------
end SOURCE_INSTRUMENTER_UTILITIES;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--PARSE.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with Lex;                       -- the lexical analyzer
with ParseStack;                -- elements awaiting parsing
with StateStack;                -- stack of parse states
with ParseTables;               -- state tables generated by parser
                                -- generator
use ParseTables;

with Grammar_Constants;         -- constants generated by parser generator
use Grammar_Constants;

with Source_Instrumenter_Utilities;--

package body Parser is

    ------------------------------------------------------------------

    procedure Apply_Actions(
        Rule_Number : in PT.LeftHandSideRange) is separate;

    ------------------------------------------------------------------

    function Parse return PD.ParseStackElement is

    --| Overview
    --|
    --| The appropriate reference is:
    --|
    --| Using the NYU LALR Parser Generator. Philippe Charles and
    --| Gerald Fisher. Courant Institute, New York University, 251 Mercer
    --| Street, New York, N.Y.  10012. Unpublished paper. 1981.
    --|

    --|
    --| Notes
    --|
    --| Abbreviations Used:
    --|
    --| Cur : Current - used as prefix
    --| LH  : LeftHand
    --| RH  : RightHand
    --|

    ------------------------------------------------------------------
    -- Reduce Action Work Variables
    ------------------------------------------------------------------

    Reduce_Action_Number   : PT.LeftHandSideRange;
        --| reduction to perform

    Reduce_Action_LH_Value : GrammarSymbolRange;
        --| grammar symbol number of left hand side of reduction

    Reduce_Action_RH_Size  : PD.StateParseStacksIndex;
        --| number of elements in right hand side of reduction

    ------------------------------------------------------------------
    -- Other Objects
    ------------------------------------------------------------------

    Current_Action      : ActionRange;
        --| return from PT.GetAction.

    Start_State         : constant := 1;
        --| Start state for parser.

    Last_Element_Popped : PD.ParseStackElement;
        --| Last element popped from parse stack

    ------------------------------------------------------------------

    begin

    --|
    --| Algorithm
    --|
    --| Function PT.GetAction returns an action value,
    --| which indicate one of four possible actions:
    --|
    --| Error:  action value = 0.
    --| Shift:  0 < action value < StateCountPlusOne.
    --| Accept: action value = StateCountPlusOne.
    --| Reduce: action value > StateCountPlusOne.
    --|
    --| The action is processed (as described below).
    --| This is repeated until no more tokens are obtained.
    --|
    --| The basic action processing is:
    --|
    --| SHIFT ACTION: the next token is placed on the ParseStack.
    --|
    --| REDUCE ACTION: the handle (a grammar rule's right hand side)
    --| found on the ParseStack is replaced with a
    --| non-terminal (grammar rule's left hand side) to which
    --| it has been reduced, and a new state.
    --|
    --| ACCEPT ACTION: the ParseStack contains the root
    --| of the parse tree, and processing is finished for
    --| If another compilation unit is present, parsing continues.
    --|
    --| ERROR ACTION: the exception Parser_Error is raised.

    ------------------------------------------------------------------

        -- Initialize Lexical Analyzer
        Lex.Initialization;

        PD.CurToken := Lex.GetNextNonCommentToken;

        StateStack.Push(Start_State);

        Do_Parse: loop

            Current_Action := PT.GetAction(
                StateStack.CopyTop,
                PD.CurToken.gram_sym_val);

            -- Accept action
            exit when (Current_Action in PD.Accept_Action_Range);

            if Current_Action in PD.Shift_Action_Range then

                -- Pretty Printer Utility call
                Source_Instrumenter_Utilities.Put(PD.CurToken);

                -- Shift token from CurToken to ParseStack.
                ParseStack.Push(PD.CurToken);

                -- Add new state to top of StateStack
                StateStack.Push(Current_Action);

                -- Get next token.
                PD.CurToken := Lex.GetNextNonCommentToken;

            elsif Current_Action in PD.Reduce_Action_Range then

                Reduce_Action_Number := Current_Action -
                    StateCountPlusOne;

                Reduce_Action_LH_Value  :=
                    PT.Get_LeftHandSide(Reduce_Action_Number);

                Reduce_Action_RH_Size :=
                    PT.Get_RightHandSide(Reduce_Action_Number);

                -- Reduce Parse Stack
                ParseStack.Reduce(Reduce_Action_RH_Size);

                ParseStack.Push((
                    gram_sym_val => Reduce_Action_LH_Value,
                    lexed_token => (
                        text => PD.Null_Source_Text,
                        srcpos_line => 0,
                        srcpos_column => 0)));

                -- Reduce State Stack
                StateStack.Reduce(Reduce_Action_RH_Size);

                StateStack.Push(PT.GetAction(
                    StateStack.CopyTop,
                    Reduce_Action_LH_Value));

                Apply_Actions(Reduce_Action_Number);

                else -- Current_Action is in PD.Error_Action_Range
                    raise PD.Parser_Error;
            end if;
        end loop Do_Parse;
        return ParseStack.Pop;

    exception
        when PD.MemoryOverflow =>
            -- raised if Parse runs out of newable memory.
            raise PD.MemoryOverflow;

    end Parse;

    ------------------------------------------------------------------

end Parser;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--GETNEXT.SUB
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SOURCE_INSTRUMENTER_DECLARATIONS;
with Source_Instrumenter_Utilities;
separate (Lex)
function GetNextNonCommentToken return PD.ParseStackElement is

    package SIU renames Source_Instrumenter_Utilities;
    package SID renames SOURCE_INSTRUMENTER_DECLARATIONS;

begin
    SIU.Comment_Buffer := SID.Comment_Lists.Create;
    loop
        CST := GetNextSourceToken;
        exit when (CST.gram_sym_val = PT.EOF_TokenValue) or
            (CST.gram_sym_val /= PT.Comment_TokenValue);
        SID.Comment_Lists.Attach(SIU.Comment_Buffer, CST);
    end loop;
    return CST;    -- return the token that is not a comment
end GetNextNonCommentToken;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--APPLYACT.SUB
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

 with Source_Instrumenter_Declarations;

 separate (Parser)
 procedure Apply_Actions(Rule_Number : in PT.LeftHandSideRange) is

    -- all procedure calls in this unit are procedures in package
    -- Source_Instrumenter_Utilities

     use Source_Instrumenter_Declarations;
     use Source_Instrumenter_Utilities;

 begin

     case Rule_Number is


 -------------------------------------------------------------------
 -- pragma ::= PRAGMA identifier ( general_component_associations ) ;

  when 1

 -------------------------------------------------------------------
 -- pragma ::= PRAGMA identifier ;

  | 2 =>

         New_Line;

 -------------------------------------------------------------------
 -- basic_declaration ::= type_declaration

  when 3 =>

         End_Type_Declaration;

 -------------------------------------------------------------------
 -- basic_colon_declaration ::= object_declaration

  when 11

 -------------------------------------------------------------------
 -- basic_colon_declaration ::= number_declaration

  | 12

 -------------------------------------------------------------------
 -- basic_colon_declaration ::= exception_declaration

  | 13

 -------------------------------------------------------------------
 -- basic_colon_declaration ::= renaming_colon_declaration

  | 14 =>

         New_Line;

 -------------------------------------------------------------------
 -- object_declaration ::= identifier_list : subtype_indication [:=expression] ;

  when 15 =>

         Set_Identifier_Mode (Read_Write);
         Process_Identifier_List (Object_List);

 -------------------------------------------------------------------
 -- object_declaration ::= identifier_list : CONSTANT subtype_indication ;

  when 16 =>

         Set_Identifier_Mode (Read_Only);
         Process_Identifier_List (Object_List);

 -------------------------------------------------------------------
 -- object_declaration ::= identifier_list : start_cad
 --     constrained_array_definition

  when 17 =>

         Set_Identifier_Mode (Read_Write);
         Process_Identifier_List (Object_List);

 -------------------------------------------------------------------
 -- object_declaration ::= identifier_list : CONSTANT start_cad end_cad ;

  when 18 =>

         Set_Identifier_Mode (Read_Only);
         Process_Identifier_List (Object_List);

 -------------------------------------------------------------------
 -- start_cad ::= empty

  when 19 =>

         Start_Anonymous_Array_Definition;

 -------------------------------------------------------------------
 -- end_cad ::= empty

  when 20 =>

         End_Anonymous_Array_Definition;

 -------------------------------------------------------------------
 -- number_declaration ::= identifier_list : CONSTANT := expression ;

  when 21 =>

         Set_Identifier_Mode (Const);
         Process_Identifier_List (Object_List);

 -------------------------------------------------------------------
 -- save_identifier ::= identifier

  when 23 =>

         Add_Identifier_To_List;

 -------------------------------------------------------------------
 -- type_identifier ::= identifier

  when 29 =>

          Save_Type_Identifier;

 -------------------------------------------------------------------
 -- type_definition ::= array_type_definition ;

  when 33 =>

         Save_Type_Class (Array_Type);

 -------------------------------------------------------------------
 -- type_definition ::= record_type_definition ;

  when 34 =>

         Decrease_Indent;
         Save_Type_Class (Record_Type);

 -------------------------------------------------------------------
 -- type_definition ::= access_type_definition ;

  when 35 =>

         Save_Type_Class (Access_Type);

 -------------------------------------------------------------------
 -- type_mark ::= type_name|subtype_name

  when 40 =>

         End_Typemark;

 -------------------------------------------------------------------
 -- derived_type_definition ::= NEW start_expanded_name subtype_indication

  when 45 =>

         Save_Type_Class (Derived_Type);

 -------------------------------------------------------------------
 -- enumeration_type_definition ::= ( enumeration_literal_specification )

  when 48 =>

         Save_Type_Class (Enumeration_Type);

 -------------------------------------------------------------------
 -- integer_type_definition ::= range_constraint

  when 52 =>

         Save_Type_Class (Integer_Type);

 -------------------------------------------------------------------
 -- real_type_definition ::= floating_point_constraint

  when 53 =>

         Save_Type_Class (Float_Type);

 -------------------------------------------------------------------
 -- real_type_definition ::= fixed_point_constraint

  when 54 =>

         Save_Type_Class (Fixed_Type);

 -------------------------------------------------------------------
 -- index_subtype_definition ::= name RANGE <>

  when 63 =>

         Increment_Array_Index;

 -------------------------------------------------------------------
 -- index_left_paren ::= (

  when 65 =>

          Start_Array_Index;

 -------------------------------------------------------------------
 -- index_right_paren ::= )

  when 66 =>

          End_Array_Index;

 -------------------------------------------------------------------
 -- discrete_range ::= name range_constraint

  when 67

 -------------------------------------------------------------------
 -- discrete_range ::= range

  | 68 =>

         Increment_Array_Index;

 -------------------------------------------------------------------
 -- component_list ::= {pragma_decl} {component_declaration}
 --     component_declaration

  when 72

 -------------------------------------------------------------------
 -- component_list ::= {pragma_decl} {component_declaration}' variant_part

  | 73 =>

          Decrease_Indent;

 -------------------------------------------------------------------
 -- component_list ::= null_statement {pragma_decl}

  when 74 =>

         Decrease_Indent;
         Null_Record_Field;

 -------------------------------------------------------------------
 -- component_declaration ::= identifier_list : subtype_indication
 --     [:=expression] ;

  when 75 =>

         New_Line;
         Process_Identifier_List (Record_Field_List);

 -------------------------------------------------------------------
 -- discriminant_specification ::= identifier_list : type_mark [:=expression]

  when 76 =>

         Process_Identifier_List (Discriminant_List);

 -------------------------------------------------------------------
 -- variant_part ::= CASE__identifier__IS {pragma_variant}__variant__{variant}
 --     END

  when 77 =>

         New_Line;

 -------------------------------------------------------------------
 -- start_record_variant ::= empty

  when 80 =>

         Start_Record_Variant;

 -------------------------------------------------------------------
 -- declarative_part ::= start_bdi {basic_declarative_item}

  when 87

 -------------------------------------------------------------------
 -- declarative_part ::= start_bdi {basic_declarative_item} body

  | 88 =>

         Decrease_Indent;
         End_Declarative_Part;

 -------------------------------------------------------------------
 -- start_bdi ::= empty

  when 89 =>

         Start_Declarative_Part;

 -------------------------------------------------------------------
 -- basic_declarative_item ::= basic_declaration

  when 90

 -------------------------------------------------------------------
 -- basic_declarative_item ::= representation_clause

  | 91

 -------------------------------------------------------------------
 -- basic_declarative_item ::= use_clause

  | 92

 -------------------------------------------------------------------
 -- later_declarative_item ::= subprogram_declaration

  | 94

 -------------------------------------------------------------------
 -- later_declarative_item ::= package_declaration

  | 95

 -------------------------------------------------------------------
 -- later_declarative_item ::= task_specification

  | 96

 -------------------------------------------------------------------
 -- later_declarative_item ::= generic_specification

  | 97

 -------------------------------------------------------------------
 -- later_declarative_item ::= use_clause

  | 98

 -------------------------------------------------------------------
 -- later_declarative_item ::= generic_instantiation

  | 99

 -------------------------------------------------------------------
 -- body ::= proper_body

  | 100

 -------------------------------------------------------------------
 -- body ::= body_stub

  | 101 =>

         New_Line;

 -------------------------------------------------------------------
 -- binary_adding_operator ::= +

  when 158

 -------------------------------------------------------------------
 -- binary_adding_operator ::= -

  | 159 =>

         Put_Space;

 -------------------------------------------------------------------
 -- sequence_of_statements ::= {pragma_stm} statement {statement}

  when 176 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- simple_statement ::= break_point assignment_statement

  when 182

 -------------------------------------------------------------------
 -- simple_statement ::= break_point exit_statement

  | 183

 -------------------------------------------------------------------
 -- simple_statement ::= break_return return_statement

  | 184

 -------------------------------------------------------------------
 -- simple_statement ::= break_point goto_statement

  | 185

 -------------------------------------------------------------------
 -- simple_statement ::= break_point abort_statement

  | 187

 -------------------------------------------------------------------
 -- simple_statement ::= break_point raise_statement

  | 188

 -------------------------------------------------------------------
 -- simple_statement ::= break_point code_statement

  | 189

 -------------------------------------------------------------------
 -- compound_statement ::= break_point if_statement

  | 191

 -------------------------------------------------------------------
 -- compound_statement ::= break_point case_statement

  | 192

 -------------------------------------------------------------------
 -- compound_statement ::= break_point loop_statement

  | 193

 -------------------------------------------------------------------
 -- compound_statement ::= break_point block_statement

  | 194

 -------------------------------------------------------------------
 -- compound_statement ::= break_point select_statement

  | 196 =>

         New_Line;

 -------------------------------------------------------------------
 -- break_point ::= empty

  when 197 =>

         Add_Breakpoint;

 -------------------------------------------------------------------
 -- break_return ::= empty

  when 198 =>

         Start_Return_Statement;

 -------------------------------------------------------------------
 -- null_statement ::= NULL ;

  when 200 =>

         New_Line;

 -------------------------------------------------------------------
 -- loop_statement ::= [loop_identifier:] FOR loop_parameter IN discrete_range

  when 208

 -------------------------------------------------------------------
 -- loop_statement ::= [loop_identifier:] FOR loop_parameter IN REVERSE END LOOP

  | 209 =>

         End_For_Loop;

 -------------------------------------------------------------------
 -- loop_parameter ::= identifier

  when 211 =>

          Save_Loop_Parameter;

 -------------------------------------------------------------------
 -- sequence_of_statements__end_block_statements ::= sequence_of_statements

  when 214 =>

         End_Block_Sequence_of_Statements;

 -------------------------------------------------------------------
 -- block_statement ::= [block_identifier:] declare_terminal [identifier] ;

  when 215

 -------------------------------------------------------------------
 -- block_statement ::= [block_identifier:] begin_end_block [identifier] ;

  | 216 =>

         End_Block_Statement;

 -------------------------------------------------------------------
 -- subprogram_declaration ::= subprogram_specification ;

  when 224 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- subprogram_specification ::= PROCEDURE start_identifier

  when 225

 -------------------------------------------------------------------
 -- subprogram_specification ::= PROCEDURE start_identifier left_paren

  | 226 =>

         Subprogram_Type ("procedure");

 -------------------------------------------------------------------
 -- subprogram_specification ::= FUNCTION designator RETURN type_mark

  when 227

 -------------------------------------------------------------------
 -- subprogram_specification ::= FUNCTION designator left_paren right_paren

  | 228 =>

         Subprogram_Type ("function");

 -------------------------------------------------------------------
 -- designator ::= identifier

  when 229

 -------------------------------------------------------------------
 -- designator ::= string_literal

  | 230 =>

         Push_Identifier;

 -------------------------------------------------------------------
 -- parameter_specification ::= identifier_list mode type_mark [:=expression]

  when 231 =>

         Process_Identifier_List (Parameter_List);

 -------------------------------------------------------------------
 -- mode ::= : OUT

  when 233 =>

         Set_Identifier_Mode (Write_Only);

 -------------------------------------------------------------------
 -- generic_parameter_mode ::= :

  when 234 =>

         Set_Identifier_Mode (Read_Only);

 -------------------------------------------------------------------
 -- generic_parameter_mode ::= : IN

  when 235 =>

         Set_Identifier_Mode (Read_Only);

 -------------------------------------------------------------------
 -- generic_parameter_mode ::= : IN OUT

  when 236 =>

         Set_Identifier_Mode (Read_Write);

 -------------------------------------------------------------------
 -- subprogram_body ::= subprogram_specification__IS [end_designator] ;

  when 237 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- call_statement ::= name ;

  when 238 =>

         New_Line;

 -------------------------------------------------------------------
 -- package_declaration ::= package_specification ;

  when 239 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- package_body ::= PACKAGE__BODY__start_identifier__IS
 --     declarative_part__no_begin

  when 242

 -------------------------------------------------------------------
 -- package_body ::= PACKAGE__BODY__start_identifier__IS [identifier] ;

  | 243 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- declarative_part__no_begin ::= declarative_part

  when 244 =>

         Add_Package_Body_Begin;

 -------------------------------------------------------------------
 -- private_type_declaration ::= TYPE type_identifier IS LIMITED PRIVATE ;

  when 245 =>

         Save_Type_Class (Limited_Private_Type);

 -------------------------------------------------------------------
 -- private_type_declaration ::= TYPE type_identifier left_paren right_paren IS

  when 246 =>

         Save_Type_Class (Limited_Private_Type);

 -------------------------------------------------------------------
 -- private_type_declaration ::= TYPE type_identifier IS PRIVATE ;

  when 247 =>

         Save_Type_Class (Private_Type);

 -------------------------------------------------------------------
 -- private_type_declaration ::= TYPE type_identifier left_paren right_paren IS

  when 248 =>

         Save_Type_Class (Private_Type);

 -------------------------------------------------------------------
 -- package_name ::= start_expanded_name expanded_name

  when 250 =>

         Use_Package_Name;

 -------------------------------------------------------------------
 -- renaming_colon_declaration ::= identifier_list : type_mark RENAMES name ;

  when 251

 -------------------------------------------------------------------
 -- renaming_colon_declaration ::= identifier_list : EXCEPTION RENAMES ;

  | 252 =>

         Process_Identifier_List (Renaming_List);

 -------------------------------------------------------------------
 -- renaming_declaration ::= PACKAGE start_identifier RENAMES expanded_name ;

  when 253

 -------------------------------------------------------------------
 -- renaming_declaration ::= subprogram_specification RENAMES name ;

  | 254

 -------------------------------------------------------------------
 -- task_specification ::= TASK start_identifier ;

  | 255 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- task_specification ::= TASK TYPE start_identifier ;

  when 256 =>

         Pop_Identifier;
         Save_Type_Class (Task_Type);
         End_Type_Declaration;

 -------------------------------------------------------------------
 -- task_specification ::= TASK__TYPE__start_identifier__IS END [identifier] ;

  when 258 =>

         End_Type_Declaration;

 -------------------------------------------------------------------
 -- task_body ::= TASK__BODY__start_identifier__IS [identifier] ;

  when 259 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- entry_declaration ::= ENTRY identifier [(discrete_range)][formal_part] ;

  when 260 =>

         New_Line;

 -------------------------------------------------------------------
 -- accept_statement ::= ACCEPT start_identifier [(expression)][formal_part] ;

  when 261 =>

         Pop_Identifier;
         New_Line;

 -------------------------------------------------------------------
 -- accept_statement ::=
 --     ACCEPT__start_identifier__[(expression)][formal_part]__DO

  when 262 =>

         New_Line;

 -------------------------------------------------------------------
 -- do_sequence_of_statements ::= sequence_of_statements

  when 263 =>

         End_Do_Sequence_Of_Statements;

 -------------------------------------------------------------------
 -- delay_statement ::= DELAY simple_expression ;

  when 264 =>

         New_Line;

 -------------------------------------------------------------------
 -- select_alternative ::= {pragma_stm}

  when 269

 -------------------------------------------------------------------
 -- select_alternative ::= {pragma_stm} selective_wait_alternative

  | 270 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- TERMINATE__; ::= TERMINATE ;

  when 277 =>

         New_Line;

 -------------------------------------------------------------------
 -- accept_statement__decision_point ::= accept_statement

  when 280

 -------------------------------------------------------------------
 -- delay_statement__decision_point ::= delay_statement

  | 281

 -------------------------------------------------------------------
 -- call_statement__decision_point ::= call_statement

  | 282 =>

         Add_Breakpoint;

 -------------------------------------------------------------------
 -- compilation_unit ::= pragma_header ( general_component_associations ) ;

  when 286

 -------------------------------------------------------------------
 -- compilation_unit ::= pragma_header ;

  | 287 =>

         New_Line;

 -------------------------------------------------------------------
 -- compilation_unit ::= context_clause library_or_secondary_unit

  when 288 =>

         End_Compilation_Unit;

 -------------------------------------------------------------------
 -- library_unit_name ::= identifier

  when 298 =>

         With_Library_Unit;

 -------------------------------------------------------------------
 -- body_stub ::= subprogram_specification IS SEPARATE ;

  when 299

 -------------------------------------------------------------------
 -- body_stub ::= PACKAGE BODY start_identifier IS SEPARATE ;

  | 300

 -------------------------------------------------------------------
 -- body_stub ::= TASK BODY start_identifier IS SEPARATE ;

  | 301 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- exception_declaration ::= identifier_list : EXCEPTION ;

  when 303 =>

         Process_Identifier_List (Exception_List);

 -------------------------------------------------------------------
 -- non_others_handler ::= WHEN__exception_choice__{|exception_choice}__=>

  when 306

 -------------------------------------------------------------------
 -- others_handler ::= WHEN__exception_OTHERS__=> sequence_of_statements

  | 307 =>

         End_Exception_Sequence_of_Statements;

 -------------------------------------------------------------------
 -- generic_specification ::= generic_formal_part subprogram_specification ;

  when 311 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- generic_specification ::= generic_formal_part package_specification ;

  when 312 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- generic_formal_part ::= generic_terminal {generic_parameter_declaration}

  when 313 =>

         Decrease_Indent;
         End_Generic_Specification;

 -------------------------------------------------------------------
 -- generic_parameter_declaration ::= identifier_list generic_parameter_mode ;

  when 314 =>

         New_Line;
         Process_Identifier_List (Generic_Object_List);

 -------------------------------------------------------------------
 -- generic_parameter_declaration ::= TYPE generic_type_identifier IS ;

  when 315

 -------------------------------------------------------------------
 -- generic_parameter_declaration ::= TYPE generic_type_identifier left_paren IS

  | 316 =>

         New_Line;
         End_Generic_Type;

 -------------------------------------------------------------------
 -- generic_parameter_declaration ::= WITH subprogram_specification ;

  when 317 =>

         New_Line;
         Pop_Identifier;

 -------------------------------------------------------------------
 -- generic_type_identifier ::= identifier

  when 318 =>

       Save_Type_Identifier;

 -------------------------------------------------------------------
 -- generic_instantiation ::= PACKAGE start_identifier IS__NEW__expanded_name ;

  when 327

 -------------------------------------------------------------------
 -- generic_instantiation ::= PACKAGE start_identifier IS__NEW__expanded_name (
 --     )

  | 328

 -------------------------------------------------------------------
 -- generic_instantiation ::= FUNCTION designator IS__NEW__expanded_name ;

  | 329

 -------------------------------------------------------------------
 -- generic_instantiation ::= FUNCTION designator IS__NEW__expanded_name ( ) ;

  | 330

 -------------------------------------------------------------------
 -- generic_instantiation ::= subprogram_specification IS__NEW__expanded_name ;

  | 331

 -------------------------------------------------------------------
 -- generic_instantiation ::= subprogram_specification IS__NEW__expanded_name (
 --     )

  | 332 =>

         Decrease_Indent;
         Pop_Identifier;

 -------------------------------------------------------------------
 -- IS__NEW__expanded_name ::= generic_instantiation_IS NEW start_expanded_name

  when 333 =>

         Save_Generic_Name;

 -------------------------------------------------------------------
 -- generic_instantiation_IS ::= IS

  when 334 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- representation_clause ::= record_representation_clause

  when 342 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- component_clause ::= name AT simple_expression range_constraint ;

  when 347 =>

         New_Line;

 -------------------------------------------------------------------
 -- alignment_clause ::= AT MOD simple_expression ;

  when 348 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- [loop_identifier:] ::= empty

  when 437 =>

         Push_Empty_Token;

 -------------------------------------------------------------------
 -- [loop_identifier:] ::= identifier :

  when 438 =>

         Push_Identifier;

 -------------------------------------------------------------------
 -- [identifier] ::= empty

  when 439 =>

         Pop_Identifier(To_Output);

 -------------------------------------------------------------------
 -- [identifier] ::= identifier

  when 440 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- [block_identifier:] ::= empty

  when 441 =>

         Start_Block (False);

 -------------------------------------------------------------------
 -- [block_identifier:] ::= identifier :

  when 442 =>

         Push_Identifier;
         Start_Block (True);

 -------------------------------------------------------------------
 -- [exception_handler_part] ::= empty

  when 443 =>

         Add_Exception_Handler;

 -------------------------------------------------------------------
 -- {pragma_alt}__exception_handler ::= {pragma_alt} exception_handler

  when 445 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- [others_handler] ::= empty

  when 448 =>

         Add_Others_Handler;

 -------------------------------------------------------------------
 -- [end_designator] ::= empty

  when 452 =>

         Pop_Identifier(To_Output);

 -------------------------------------------------------------------
 -- [end_designator] ::= identifier

  when 453

 -------------------------------------------------------------------
 -- [end_designator] ::= string_literal

  | 454 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- {with_clause{use_clause}} ::= {with_clause{use_clause}} with_clause

  when 478 =>

         New_Line;

 -------------------------------------------------------------------
 -- record_terminal ::= RECORD

  when 496 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- start_of_record_type ::= EMPTY

  when 499

 -------------------------------------------------------------------
 -- repspec_record_terminal ::= RECORD

  | 500

 -------------------------------------------------------------------
 -- CASE__identifier__IS ::= CASE__identifier IS

  | 501

 -------------------------------------------------------------------
 -- WHEN__choice__{|choice}__=> ::= WHEN choice {|choice} =>

  | 502

 -------------------------------------------------------------------
 -- WHEN__OTHERS__=> ::= WHEN OTHERS =>

  | 503

 -------------------------------------------------------------------
 -- CASE__expression__IS ::= CASE expression IS

  | 504 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- generic_terminal ::= GENERIC

  when 505 =>

         Start_Generic_Specification;
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- CASE__identifier ::= CASE identifier

  when 506 =>

         Save_Case_Identifier;

 -------------------------------------------------------------------
 -- WHEN__variant_choice__{|variant_choice}__=> ::= WHEN__choice__{|choice}__=>

  when 507

 -------------------------------------------------------------------
 -- WHEN__variant_OTHERS__=> ::= WHEN__OTHERS__=>

  | 508 =>

         End_Record_Variant;

 -------------------------------------------------------------------
 -- WHEN__case_choice__{|choice}__=> ::= WHEN__choice__{|choice}__=>

  when 509

 -------------------------------------------------------------------
 -- WHEN__case_OTHERS__=> ::= WHEN__OTHERS__=>

  | 510 =>

         Add_Breakpoint;

 -------------------------------------------------------------------
 -- {pragma_alt}__case_statement_alternative__{case_statement_alternative} ::=

  when 511 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- loop_terminal ::= LOOP

  when 512 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- begin_terminal ::= BEGIN

  when 513 =>

         New_Line;
         Increase_Indent;
         Start_Begin_End_Block;

 -------------------------------------------------------------------
 -- {pragma_variant}__variant__{variant} ::= {pragma_variant} variant {variant}

  when 514 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- declare_terminal ::= DECLARE

  when 515 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- PACKAGE__start_identifier__IS ::= PACKAGE start_identifier IS

  when 516 =>

         Increment_Scope (Package_Specification);
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- start_identifier ::= identifier

  when 517 =>

         Push_Identifier;

 -------------------------------------------------------------------
 -- {basic_declarative_item}' ::= {basic_declarative_item}

  when 518

 -------------------------------------------------------------------
 -- {entry_declaration}__{representation_clause} ::= {entry_declaration}

  | 519 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- private_terminal ::= PRIVATE

  when 520 =>

         New_Line;
         Increase_Indent;
         Start_Private_Part;

 -------------------------------------------------------------------
 -- PACKAGE__BODY__start_identifier__IS ::= PACKAGE BODY start_identifier IS

  when 521 =>

         Increment_Scope (Package_Body);
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- TASK__start_identifier__IS ::= TASK start_identifier IS

  when 522 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- TASK__TYPE__start_identifier__IS ::= TASK TYPE start_identifier IS

  when 523 =>

         New_Line;
         Increase_Indent;
         Save_Type_Class (Task_Type);

 -------------------------------------------------------------------
 -- TASK__BODY__start_identifier__IS ::= TASK BODY start_identifier IS

  when 524 =>

         Increment_Scope (Task_Body);
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- ACCEPT__start_identifier__[(expression)][formal_part]__DO ::= ACCEPT DO

  when 525 =>

         New_Line;
         Increase_Indent;
         Start_Do_Sequence_Of_Statements;

 -------------------------------------------------------------------
 -- select_terminal ::= SELECT

  when 526 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- call_statement__[sequence_of_statements] ::= call_statement__decision_point

  when 527 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- delay_alternative_in_timed_entry ::= delay_alternative

  when 529

 -------------------------------------------------------------------
 -- WHEN__condition__=>__selective_wait_alternative ::= WHEN__condition__=>

  | 530 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- WHEN__condition__=> ::= WHEN condition =>

  when 531

 -------------------------------------------------------------------
 -- exception_terminal ::= EXCEPTION

  | 532 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- WHEN__exception_choice__{|exception_choice}__=> ::= WHEN exception_choice =>

  when 533

 -------------------------------------------------------------------
 -- WHEN__exception_OTHERS__=> ::= WHEN OTHERS =>

  | 534 =>

         New_Line;
         Increase_Indent;
         Start_Exception_Branch;

 -------------------------------------------------------------------
 -- subprogram_specification__IS ::= subprogram_specification IS

  when 535 =>

         Increment_Scope (Subprogram_Body);
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- {component_clause}' ::= {component_clause}

  when 536 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- SEPARATE__(__expanded_name__) ::= SEPARATE__(__expanded_name )

  when 537 =>

         New_Line;

 -------------------------------------------------------------------
 -- SEPARATE__(__expanded_name ::= SEPARATE ( start_expanded_name expanded_name

  when 538 =>

         Save_Separate_Name;

 -------------------------------------------------------------------
 -- start_expanded_name ::= empty

  when 539 =>

         Start_Saving_Expanded_Name;

 -------------------------------------------------------------------
 -- condition__THEN ::= condition THEN

  when 546

 -------------------------------------------------------------------
 -- ELSIF__condition__THEN ::= ELSIF condition THEN

  | 547

 -------------------------------------------------------------------
 -- else_terminal ::= ELSE

  | 548 =>

         New_Line;
         Increase_Indent;
         Add_Breakpoint;

 -------------------------------------------------------------------
 -- or_terminal ::= OR

  when 549 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- discriminant__; ::= ;

  when 550

 -------------------------------------------------------------------
 -- parameter__; ::= ;

  | 551 =>

         New_Line;

 -------------------------------------------------------------------
 -- left_paren ::= (

  when 552 =>

         Change_Indent;

 -------------------------------------------------------------------
 -- right_paren ::= )

  when 553 =>

         Resume_Normal_Indentation;

     when others =>
         null;
     end case;
 end Apply_Actions;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--SI.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG;
with Source_Instrumenter_Declarations;   -- Parameters of pretty printer
with Source_Instrumenter_Utilities;
with ParserDeclarations;            -- declarations for parser
with Parser;                        -- contains parse and Apply_Actions
with TEXT_IO;
with STRING_IO;

procedure Source_Instrument(
    Source_File : in String;
    Listing_File : in String := "";
    Instrumented_File : in String := "") is

    package SID renames Source_Instrumenter_Declarations;
    package SIU renames Source_Instrumenter_Utilities;
    package PD  renames ParserDeclarations;

                         -- Objects --

    Return_Value : PD.ParseStackElement;
    Input_File   : TEXT_IO.FILE_TYPE;

    procedure CLOSE_FILES is
    begin
      if TEXT_IO.IS_OPEN(SID.LISTING_FILE) then
         TEXT_IO.CLOSE(SID.LISTING_FILE);
      end if;
      if TEXT_IO.IS_OPEN(SID.INSTRUMENTED_FILE) then
         TEXT_IO.CLOSE(SID.INSTRUMENTED_FILE);
      end if;
      if TEXT_IO.IS_OPEN(INPUT_FILE) then
         TEXT_IO.CLOSE(INPUT_FILE);
      end if;
      TEXT_IO.SET_INPUT(TEXT_IO.STANDARD_INPUT);
      begin
        STRING_PKG.RELEASE;
      exception
        when others => null;
      end;
    end CLOSE_FILES;

begin
    STRING_PKG.MARK;

    TEXT_IO.OPEN(FILE => Input_File,
                 MODE => TEXT_IO.IN_FILE,
                 NAME => Source_File);

    TEXT_IO.CREATE(FILE => SID.LISTING_FILE,
                   MODE => TEXT_IO.OUT_FILE,
                   NAME => LISTING_FILE);

    TEXT_IO.CREATE(FILE => SID.INSTRUMENTED_FILE,
                   MODE => TEXT_IO.OUT_FILE,
                   NAME => INSTRUMENTED_FILE);

    SIU.Initialize;

    TEXT_IO.SET_INPUT(Input_File);
    Return_Value := Parser.Parse;

    -- print any comments following the last token in the file.
    SIU.Print_Comments(SIU.Comment_Buffer);
    CLOSE_FILES;

exception
    when TEXT_IO.NAME_ERROR =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE("ERROR:  Invalid compilation unit name.");
        CLOSE_FILES;

    when PD.Parser_Error =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE(ITEM => "Syntax Error in Source: Line: " &
            NATURAL'image(PD.CurToken.lexed_token.srcpos_line) &
            " Column: " & NATURAL'image(
            PD.CurToken.lexed_token.srcpos_column));
        CLOSE_FILES;

    -- Handle others in driver.
    when others =>
        CLOSE_FILES;
        raise;
end Source_Instrument;

---------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--WIS_DEBUG.ADA
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SYSTEM_PARAMETERS; use SYSTEM_PARAMETERS;
with SOURCE_INSTRUMENT;
with TEXT_IO; use TEXT_IO;
with SD_TYPE_DEFINITIONS; use SD_TYPE_DEFINITIONS;
with STRING_PKG; use STRING_PKG;
with STRING_UTILITIES; use STRING_UTILITIES;
with SD_BUFFER_FILES;
with CATALOG_PKG;
with WD_HELP;
with SYSDEP;

procedure WIS_DEBUG is
--| overview
--| Test_tools is a shell to incorporate all of the tools together and
--| interface with the user.  The user may enter parameters on the command
--| line or he will be prompted for them.


  type COMMAND_TYPE is (SOURCE_INSTRUMENT, SET_LIBRARY, COMPILE, LINK, RUN,
    SYSTEM_COMMAND, DELETE, UNKNOWN, HELP, QUIT);
   --| acceptable options
  COMMAND             : COMMAND_TYPE := UNKNOWN;  --| user entered option
  MAXLINE             : INTEGER := MAX_SOURCE_LINE_LENGTH;
         --| maximum length of input string
  BLANKS              : STRING(1 .. MAXLINE) := (others => ' ');
  COMMAND_LINE        : STRING(1 .. MAXLINE); --| user input string
  COMMAND_INDEX       : NATURAL; --| position in input string
  END_INDEX           : NATURAL; --| last position in input string
  LINE_LENGTH         : INTEGER := 80; --| length of input string
  SOURCE_FILE         : FILENAME; --| user specified parameter
  SOURCE_LISTING      : FILENAME; --| user specified parameter
  INSTRUMENTED_SOURCE : FILENAME; --| user specified parameter
  COMPILATION_UNIT    : FILENAME; --| user specified parameter
  COMMAND_TO_EXECUTE  : STRING_TYPE; --| user specified command
  PARAMETER_FOUND     : BOOLEAN := FALSE;
  TEMPFILE            : TEXT_IO.FILE_TYPE; --| for deleting source_listing

  procedure GET_COMMAND( --| Extract command from a string
                        COMMAND_LINE : in STRING;  --| input string
                        COMMAND      : out COMMAND_TYPE;  --| returned command
                        ARG_INDEX    : out INTEGER) --| end position of command
  is
    I : INTEGER;
  begin
    I := COMMAND_LINE'FIRST - 1;
    loop
      I := I + 1;
      if I > COMMAND_LINE'LAST then
        COMMAND := UNKNOWN;
        return;
      end if;
      if COMMAND_LINE(I) /= ' ' then

        -- clear blanks
        if COMMAND_LINE(I) = '?' then
          COMMAND := HELP;
        elsif COMMAND_LINE(I) = 'H' then
          COMMAND := HELP;
        elsif COMMAND_LINE(I) = 'D' then
          COMMAND := DELETE;
        elsif COMMAND_LINE(I) = 'C' then
          COMMAND := COMPILE;
        elsif COMMAND_LINE(I) = 'R' then
          COMMAND := RUN;
        elsif COMMAND_LINE(I .. I + 1) = "QU" then
          COMMAND := QUIT;
        elsif COMMAND_LINE(I .. I + 1) = "EX" then
          COMMAND := QUIT;
        elsif COMMAND_LINE(I .. I + 1) = "SO" then
          COMMAND := SOURCE_INSTRUMENT;
        elsif COMMAND_LINE(I .. I + 1) = "SI" then
          COMMAND := SOURCE_INSTRUMENT;
        elsif COMMAND_LINE(I .. I + 1) = "SE" then
          COMMAND := SET_LIBRARY;
        elsif COMMAND_LINE(I .. I + 1) = "SY" then
          COMMAND := SYSTEM_COMMAND;
        elsif COMMAND_LINE(I .. I + 2) = "LIB" then
          COMMAND := SET_LIBRARY;
        elsif COMMAND_LINE(I .. I + 2) = "LIN" then
          COMMAND := LINK;
        else
          COMMAND := UNKNOWN;
          PUT("unrecognized command");
        end if;
        exit;
      end if;
    end loop;
    while (COMMAND_LINE(I) /= '(' and I /= LINE_LENGTH) loop
      -- strip off the rest of the command
      I := I + 1;
    end loop;
    if COMMAND_LINE(I) = '(' and I = COMMAND_LINE'LAST then
      -- if the last character is '(', ignore it
      I := I + 1;
    end if;
    ARG_INDEX := I;
  exception
    when CONSTRAINT_ERROR =>
      PUT("unrecognized command");
      COMMAND := UNKNOWN;
  end GET_COMMAND;

  function FILE_EXISTS(FILE_NAME : in STRING) return BOOLEAN is
  begin
    OPEN(TEMPFILE, IN_FILE, FILE_NAME);
    CLOSE(TEMPFILE);
    return TRUE;
  exception
    when others =>
      return FALSE;
  end;


  procedure GET_NAMED_PARAMETER( --| find Parameter_Name in String_To_search
                                STRING_TO_SEARCH : in STRING;
                                PARAMETER_NAME   : in STRING;
                                PARAMETER_FOUND  : out FILENAME;
                                FOUND            : in out BOOLEAN)
  -- Get_Named_Parameters will search String_To_Search for Parameter_Found,
  -- if found, Parameter_Found is set to the string following => and
  -- terminated by a comma or ).  All blanks are removed and letters are
  -- capitalized.  Found is true if Parameter_Name is found.

  is
    ASSIGNMENT_POSITION : INTEGER;
    BEGINING_OF_STRING  : INTEGER := STRING_TO_SEARCH'FIRST;
    END_OF_STRING       : INTEGER;
  begin
    FOUND := FALSE;
    ASSIGNMENT_POSITION := POSITION_OF("=>", STRING_TO_SEARCH);
    while not FOUND and ASSIGNMENT_POSITION /= 0 loop
      END_OF_STRING := POSITION_OF(',', STRING_TO_SEARCH(
        ASSIGNMENT_POSITION + 2 .. STRING_TO_SEARCH'LAST));
      if END_OF_STRING = 0 then
        -- no comma found so this must be the last parameter
        END_OF_STRING := POSITION_OF_REVERSE(')', STRING_TO_SEARCH);
        if END_OF_STRING = 0 then
          -- no ) found so take the remainder of the string as input
          END_OF_STRING := STRING_TO_SEARCH'LAST;
        else
          -- don't include the ) in the name
          END_OF_STRING := END_OF_STRING - 1;
        end if;
      else
        -- don't include the comma in the name
        END_OF_STRING := END_OF_STRING - 1;
      end if;
      if STRIP_BLANKS(STRING_TO_SEARCH(BEGINING_OF_STRING ..
        ASSIGNMENT_POSITION - 1))'LENGTH = PARAMETER_NAME'LENGTH and then
        STRIP_BLANKS(STRING_TO_SEARCH(
        BEGINING_OF_STRING .. ASSIGNMENT_POSITION - 1)) =
        PARAMETER_NAME then
        -- Parameter name matches
        FOUND := TRUE;
        PARAMETER_FOUND := CREATE(STRIP_BLANKS(STRING_TO_SEARCH(
          ASSIGNMENT_POSITION + 2 .. END_OF_STRING)));
      else
        -- check next parameter
        ASSIGNMENT_POSITION := POSITION_OF("=>", STRING_TO_SEARCH(
          ASSIGNMENT_POSITION + 2 .. STRING_TO_SEARCH'LAST));
        if END_OF_STRING < STRING_TO_SEARCH'LAST and then STRING_TO_SEARCH(
          END_OF_STRING + 1) /= ')' then
          -- there is another parameter
          BEGINING_OF_STRING := END_OF_STRING + 2;
        else
          ASSIGNMENT_POSITION := 0;
        end if;
      end if;
    end loop;
  end GET_NAMED_PARAMETER;

  function VALID_FILE(FILE_NAME : in STRING) return BOOLEAN is
  -- return true if file_name is a valid filename
  begin
    CREATE(TEMPFILE, OUT_FILE, FILE_NAME);
    DELETE(TEMPFILE);
    return TRUE;
  exception
    when others =>
      return FALSE;
  end;

  procedure GET_SOURCE_FILE( --| get source file from user
                            SOURCE_FILE : out FILENAME) --| source file name
  is
  --| source file is a required parameter for the source instrumenter and the
  --| compiler.
  --| The user will be prompted until a file name is entered.
    INPUT_STRING : STRING(1 .. MAXLINE) := BLANKS;
     --| string retreived from terminal
    LINE_LENGTH  : INTEGER := MAXLINE;  --| length of input_String
  begin
    loop
      while INPUT_STRING(1 .. LINE_LENGTH) = BLANKS(1 .. LINE_LENGTH) loop
        PUT("Enter Source_File => ");
        GET_LINE(INPUT_STRING, LINE_LENGTH);
      end loop;
      if FILE_EXISTS(STRIP_BLANKS(INPUT_STRING(1 .. LINE_LENGTH))) then
        SOURCE_FILE := CREATE(STRIP_BLANKS(INPUT_STRING(1 .. LINE_LENGTH)));
        exit;
      end if;
      NEW_LINE;
      PUT_LINE("ERROR:  Source file has invalid name or does not exist.");
      NEW_LINE;
      INPUT_STRING := BLANKS;
    end loop;
  end GET_SOURCE_FILE;

  procedure GET_COMPILATION_UNIT( --| get compilation unit name from user
                                 COMPILATION_UNIT : out FILENAME)
  is
  --| compilation unit is required for link and execution of instrumented code.
  --| The user will be prompted until a compilation unit is entered.

    INPUT_STRING : STRING(1 .. MAXLINE) := BLANKS;
     --| string retreived from terminal
    LINE_LENGTH  : INTEGER := MAXLINE;  --| length of input_String
  begin
    while INPUT_STRING(1 .. LINE_LENGTH) = BLANKS(1 .. LINE_LENGTH) loop
      PUT("Enter Compilation_Unit => ");
      GET_LINE(INPUT_STRING, LINE_LENGTH);
    end loop;
    COMPILATION_UNIT := CREATE(STRIP_BLANKS(INPUT_STRING(1 .. LINE_LENGTH)));
    INPUT_STRING := BLANKS;
  end GET_COMPILATION_UNIT;

  procedure GET_ARGUMENTS --| get necessary file names for tool
  is
    FOUND              : BOOLEAN;
    PRINT_BUFFER       : STRING(1 .. 80);
    BEGINING_OF_STRING : INTEGER;
    END_OF_STRING      : INTEGER;
    STRING_INDEX       : INTEGER;



    procedure GET_SOURCE_LISTING( --| get listing file name from user
                              SOURCE_FILE    : in FILENAME;
                                      --| source name for default
                              SOURCE_LISTING : out FILENAME)
                                      --| source listing file name
    is
      -- Source_Listing is an optional parameter.  The user will be prompted
      -- for the file name.  If nothing is entered, a temporary file will be
      -- created and deleted after instrumentation.

      INPUT_STRING  : STRING(1 .. MAXLINE) := BLANKS;
       --| string retreived from terminal
      LINE_LENGTH   : INTEGER := MAXLINE;  --| length of input_string
    begin
      loop
        PUT("Enter Source_Listing_File => ");
        GET_LINE(INPUT_STRING, LINE_LENGTH);
        if INPUT_STRING(1 .. LINE_LENGTH) = BLANKS(1 .. LINE_LENGTH) then
          -- no report file specified, use default
          SOURCE_LISTING := CREATE("");
          exit;
        else
          if VALID_FILE(STRIP_BLANKS(INPUT_STRING(1..LINE_LENGTH))) then
            SOURCE_LISTING := CREATE(STRIP_BLANKS(INPUT_STRING(1 .. LINE_LENGTH)));
            exit;
          else
            NEW_LINE;
            PUT_LINE("ERROR : Invalid listing file name.");
            NEW_LINE;
          end if;
        end if;
      end loop;
    end GET_SOURCE_LISTING;

    procedure GET_INSTRUMENTED_SOURCE(
                                     --| get instrumented source file from user
                                      SOURCE_FILE         : in FILENAME;
                                         --| source name for default
                                      INSTRUMENTED_SOURCE : out FILENAME)
                                                  --| instrumented file name
    is
      -- Istrumented_Source is an optional parameter.  The user will be prompted
      -- for the file name.  If nothing is entered, the file name will be
      -- created by appending .INS to the base Source_File.

      INPUT_STRING  : STRING(1 .. MAXLINE);  --| string retreived from terminal
      LINE_LENGTH   : INTEGER := MAXLINE;  --| length of input_String
      N             : INTEGER;  --| length of name
      END_OF_STRING : INTEGER;  --| last character in input string
    begin
      loop
        INPUT_STRING := BLANKS;
        PUT("Enter Instrumented_Source_File => ");
        GET_LINE(INPUT_STRING, LINE_LENGTH);
        if INPUT_STRING(1 .. LINE_LENGTH) = BLANKS(1 .. LINE_LENGTH) then
          -- instrumented source not specified, create default
          INPUT_STRING(1 .. LENGTH(SOURCE_FILE)) := VALUE(SOURCE_FILE);
          N := SKIP_BLANKS_REVERSE(INPUT_STRING(1..LENGTH(SOURCE_FILE)));
          END_OF_STRING := N;
          while INPUT_STRING(N) /= '.' and INPUT_STRING(N) /= ']' and N > 1 loop
            N := N - 1;
          end loop;
          if INPUT_STRING(N) /= '.' then
            N := END_OF_STRING + 1;
            INPUT_STRING(N) := '.';
          end if;
          INPUT_STRING(N + 1 .. N + DEFAULT_INST_FILE_EXT'LENGTH)
               := DEFAULT_INST_FILE_EXT;
          INSTRUMENTED_SOURCE :=
             CREATE(INPUT_STRING(1 ..  N + DEFAULT_INST_FILE_EXT'LENGTH));
          exit;
        else
          -- instrumented source is specified
          if VALID_FILE(STRIP_BLANKS(INPUT_STRING(1..LINE_LENGTH))) then
            INSTRUMENTED_SOURCE := CREATE(STRIP_BLANKS(INPUT_STRING(
              1 .. LINE_LENGTH)));
            exit;
          else
            NEW_LINE;
            PUT_LINE("ERROR : Invalid instrumented source file name.");
            NEW_LINE;
          end if;
        end if;
      end loop;
    end GET_INSTRUMENTED_SOURCE;

  begin
    if COMMAND_LINE(COMMAND_INDEX) /= '(' then
      GET_SOURCE_FILE(SOURCE_FILE);
      GET_SOURCE_LISTING(SOURCE_FILE, SOURCE_LISTING);
      GET_INSTRUMENTED_SOURCE(SOURCE_FILE, INSTRUMENTED_SOURCE);
    else
      BEGINING_OF_STRING := COMMAND_INDEX + 1;
      STRING_INDEX := POSITION_OF("=>", COMMAND_LINE(BEGINING_OF_STRING ..
        LINE_LENGTH));
      END_OF_STRING := POSITION_OF(',', COMMAND_LINE(BEGINING_OF_STRING ..
        LINE_LENGTH));
      if STRING_INDEX = 0 then
        -- only positional parameters supplied
        if END_OF_STRING = 0 then
          -- no comma, only Source_File is supplied
          END_OF_STRING := POSITION_OF_REVERSE(')', COMMAND_LINE(
            BEGINING_OF_STRING .. LINE_LENGTH));
          if END_OF_STRING = 0 then
            -- no ) found so accept the rest of the string as Source_File
            END_OF_STRING := LINE_LENGTH;
          else
            -- don't include the ) in the name
            END_OF_STRING := END_OF_STRING - 1;
          end if;
          SOURCE_FILE := CREATE(STRIP_BLANKS(COMMAND_LINE(BEGINING_OF_STRING
            .. END_OF_STRING)));
          if not FILE_EXISTS(VALUE(SOURCE_FILE)) then
             NEW_LINE;
             PUT_LINE("ERROR: Source file has invalid name or does not exist.");
             NEW_LINE;
             GET_SOURCE_FILE(SOURCE_FILE);
          end if;
          GET_SOURCE_LISTING(SOURCE_FILE, SOURCE_LISTING);
          GET_INSTRUMENTED_SOURCE(SOURCE_FILE, INSTRUMENTED_SOURCE);
        else
          -- a comma was found so at least two parameters are supplied
          SOURCE_FILE := CREATE(STRIP_BLANKS(COMMAND_LINE(BEGINING_OF_STRING
            .. END_OF_STRING - 1)));
          if not FILE_EXISTS(VALUE(SOURCE_FILE)) then
             NEW_LINE;
             PUT_LINE("ERROR: Source file has invalid name or does not exist.");
             NEW_LINE;
             GET_SOURCE_FILE(SOURCE_FILE);
          end if;
          BEGINING_OF_STRING := END_OF_STRING + 1;
          END_OF_STRING := POSITION_OF(',', COMMAND_LINE(BEGINING_OF_STRING
            .. LINE_LENGTH));
          if END_OF_STRING = 0 then
            -- this is the last parameter
            END_OF_STRING := POSITION_OF_REVERSE(')', COMMAND_LINE(
              BEGINING_OF_STRING .. LINE_LENGTH));
            if END_OF_STRING = 0 then
              -- no ) found so accept the rest of the string as the name
              END_OF_STRING := LINE_LENGTH;
            else
              -- don't include the ) in the name
              END_OF_STRING := END_OF_STRING - 1;
            end if;
            SOURCE_LISTING := CREATE(STRIP_BLANKS(COMMAND_LINE(
              BEGINING_OF_STRING .. END_OF_STRING)));
            GET_INSTRUMENTED_SOURCE(SOURCE_FILE, INSTRUMENTED_SOURCE);
          else
            -- all three parameters were found
            SOURCE_LISTING := CREATE(STRIP_BLANKS(COMMAND_LINE(
              BEGINING_OF_STRING .. END_OF_STRING - 1)));
            BEGINING_OF_STRING := END_OF_STRING + 1;
             END_OF_STRING := POSITION_OF(',', COMMAND_LINE(BEGINING_OF_STRING
              .. LINE_LENGTH));
            if END_OF_STRING = 0 then
              END_OF_STRING := POSITION_OF_REVERSE(')', COMMAND_LINE(
                BEGINING_OF_STRING .. LINE_LENGTH));
              if END_OF_STRING = 0 then
                -- no ) so accept the rest of the string as the name
                END_OF_STRING := LINE_LENGTH;
              else
                -- don't include the ) in the name
                END_OF_STRING := END_OF_STRING - 1;
              end if;
            else
              -- don't include the , in the name
              END_OF_STRING := END_OF_STRING - 1;
            end if;
            INSTRUMENTED_SOURCE := CREATE(STRIP_BLANKS(COMMAND_LINE(
              BEGINING_OF_STRING .. END_OF_STRING)));
          end if;
        end if;
      else
        -- named parameters were found
        if END_OF_STRING /= 0 and END_OF_STRING < STRING_INDEX then
          -- the comma is before the => so the first parameter is positional
          SOURCE_FILE := CREATE(STRIP_BLANKS(COMMAND_LINE(BEGINING_OF_STRING
            .. END_OF_STRING - 1)));
          if not FILE_EXISTS(VALUE(SOURCE_FILE)) then
             NEW_LINE;
             PUT_LINE("ERROR: Source file has invalid name or does not exist.");
             NEW_LINE;
             GET_SOURCE_FILE(SOURCE_FILE);
          end if;
          BEGINING_OF_STRING := END_OF_STRING + 1;
          END_OF_STRING := POSITION_OF(',', COMMAND_LINE(BEGINING_OF_STRING
            .. LINE_LENGTH));
          if END_OF_STRING /= 0 and END_OF_STRING < STRING_INDEX then
            -- the comma is before the => so te second parameter is positional
            SOURCE_LISTING := CREATE(STRIP_BLANKS(COMMAND_LINE(
              BEGINING_OF_STRING .. END_OF_STRING - 1)));
            BEGINING_OF_STRING := END_OF_STRING + 1;
            END_OF_STRING := POSITION_OF(',', COMMAND_LINE(
              BEGINING_OF_STRING .. LINE_LENGTH));
            if END_OF_STRING /= 0 and END_OF_STRING < STRING_INDEX then
              -- another positional parameter was found so use it and ignore
              -- the rest of the string
              INSTRUMENTED_SOURCE := CREATE(STRIP_BLANKS(COMMAND_LINE(
                BEGINING_OF_STRING .. END_OF_STRING - 1)));
            else
              GET_NAMED_PARAMETER(COMMAND_LINE(BEGINING_OF_STRING ..
                LINE_LENGTH), "INSTRUMENTED_SOURCE_FILE", INSTRUMENTED_SOURCE,
                FOUND);
              if not FOUND then
                GET_INSTRUMENTED_SOURCE(SOURCE_FILE, INSTRUMENTED_SOURCE);
              end if;
            end if;
          else
            GET_NAMED_PARAMETER(COMMAND_LINE(BEGINING_OF_STRING ..
              LINE_LENGTH), "SOURCE_LISTING_FILE", SOURCE_LISTING, FOUND);
            if not FOUND then
              GET_SOURCE_LISTING(SOURCE_FILE, SOURCE_LISTING);
            end if;
            GET_NAMED_PARAMETER(COMMAND_LINE(BEGINING_OF_STRING ..
              LINE_LENGTH), "INSTRUMENTED_SOURCE_FILE", INSTRUMENTED_SOURCE,
              FOUND);
            if not FOUND then
              GET_INSTRUMENTED_SOURCE(SOURCE_FILE, INSTRUMENTED_SOURCE);
            end if;
          end if;
        else
          GET_NAMED_PARAMETER(COMMAND_LINE(BEGINING_OF_STRING ..
            LINE_LENGTH), "SOURCE_FILE", SOURCE_FILE, FOUND);
          if not FOUND then
            GET_SOURCE_FILE(SOURCE_FILE);
          elsif not FILE_EXISTS(VALUE(SOURCE_FILE)) then
             NEW_LINE;
             PUT_LINE("ERROR: Source file has invalid name or does not exist.");
             NEW_LINE;
             GET_SOURCE_FILE(SOURCE_FILE);
          end if;
          GET_NAMED_PARAMETER(COMMAND_LINE(BEGINING_OF_STRING ..
            LINE_LENGTH), "SOURCE_LISTING_FILE", SOURCE_LISTING, FOUND);
          if not FOUND then
            GET_SOURCE_LISTING(SOURCE_FILE, SOURCE_LISTING);
          end if;
          GET_NAMED_PARAMETER(COMMAND_LINE(BEGINING_OF_STRING ..
            LINE_LENGTH), "INSTRUMENTED_SOURCE_FILE", INSTRUMENTED_SOURCE,
            FOUND);
          if not FOUND then
            GET_INSTRUMENTED_SOURCE(SOURCE_FILE, INSTRUMENTED_SOURCE);
          end if;
        end if;
      end if;
    end if;
    if not VALID_FILE(VALUE(SOURCE_LISTING)) then
      NEW_LINE;
      PUT_LINE("ERROR : Invalid listing file name.");
      NEW_LINE;
      GET_SOURCE_LISTING(SOURCE_FILE, SOURCE_LISTING);
    end if;
    if not VALID_FILE(VALUE(INSTRUMENTED_SOURCE)) then
      NEW_LINE;
      PUT_LINE("ERROR : Invalid instrumented source file name.");
      NEW_LINE;
      GET_INSTRUMENTED_SOURCE(SOURCE_FILE, INSTRUMENTED_SOURCE);
    end if;
    NEW_LINE;
    NEW_LINE;
    PRINT_BUFFER := BLANKS;
    PRINT_BUFFER(1 .. 14) := "source_file = ";
    PRINT_BUFFER(15 .. VALUE(SOURCE_FILE)'LENGTH + 14) := VALUE(SOURCE_FILE);
    PUT_LINE(PRINT_BUFFER);
    PRINT_BUFFER := BLANKS;
    PRINT_BUFFER(1 .. 17) := "source_listing = ";
    if not IS_EMPTY(SOURCE_LISTING) then
      PRINT_BUFFER(18 .. VALUE(SOURCE_LISTING)'LENGTH + 17) := VALUE(
        SOURCE_LISTING);
    end if;
    PUT_LINE(PRINT_BUFFER);
    PRINT_BUFFER := BLANKS;
    PRINT_BUFFER(1 .. 22) := "instrumented_source = ";
    PRINT_BUFFER(23 .. VALUE(INSTRUMENTED_SOURCE)'LENGTH + 22) := VALUE(
      INSTRUMENTED_SOURCE);
    PUT_LINE(PRINT_BUFFER);

  end GET_ARGUMENTS;


begin
  NEW_LINE;
  COMMAND_LINE := BLANKS;
  PUT_LINE("SYMBOLIC DEBUGGER - VERSION 1.0");
  PUT_LINE("SOURCE INSTRUMENTER AND PROGRAM LIBRARY MANAGEMENT");
  NEW_LINE;
  PUT_LINE("Enter a new program library name or RETURN to continue");
  PUT("[Current Directory] >> ");
  GET_LINE(COMMAND_LINE, LINE_LENGTH);
  if LINE_LENGTH /= COMMAND_LINE'FIRST - 1 then
    CURRENT_PROGRAM_LIBRARY := CREATE(COMMAND_LINE(COMMAND_LINE'FIRST ..
      LINE_LENGTH));
    PUT_LINE("lib = " & VALUE(CURRENT_PROGRAM_LIBRARY));
  end if;
  NEW_LINE;
  PUT_LINE("please enter desired option");
  PUT_LINE("enter ? for a list of options available");
  GET_LINE(COMMAND_LINE, LINE_LENGTH);
  COMMAND_LINE(1 .. LINE_LENGTH) := STRING_UTILITIES.UPPER_CASE(COMMAND_LINE(
    1 .. LINE_LENGTH));
  NEW_LINE;
  GET_COMMAND(COMMAND_LINE(COMMAND_LINE'FIRST .. LINE_LENGTH), COMMAND,
    COMMAND_INDEX);
  while COMMAND /= QUIT loop
    case COMMAND is
      when SOURCE_INSTRUMENT =>
        GET_ARGUMENTS;
        SOURCE_INSTRUMENT(VALUE(SOURCE_FILE), VALUE(SOURCE_LISTING),
        VALUE(INSTRUMENTED_SOURCE));
        NEW_LINE;
        PUT("Do you wish to compile the instrumented source (Y/N)?  ");
        GET_LINE(COMMAND_LINE, LINE_LENGTH);
        NEW_LINE;
        if COMMAND_LINE(1) = 'Y' or COMMAND_LINE(1) = 'y' then
          SYSDEP.SD_COMPILE(VALUE(INSTRUMENTED_SOURCE));
        end if;
      when SET_LIBRARY =>
        if COMMAND_LINE(COMMAND_INDEX) = '(' then
          GET_NAMED_PARAMETER(COMMAND_LINE(COMMAND_INDEX + 1 .. LINE_LENGTH),
            "CURRENT_PROGRAM_LIBRARY", CURRENT_PROGRAM_LIBRARY,
            PARAMETER_FOUND);
          if not PARAMETER_FOUND then
            END_INDEX := POSITION_OF_REVERSE(')', COMMAND_LINE(
              COMMAND_INDEX .. LINE_LENGTH));
            if END_INDEX = 0 then
              END_INDEX := LINE_LENGTH;
            else
              END_INDEX := END_INDEX - 1;
            end if;
            CURRENT_PROGRAM_LIBRARY := CREATE(STRIP_BLANKS(COMMAND_LINE(
              COMMAND_INDEX + 1 .. END_INDEX)));
            begin
              OPEN(TEMPFILE, IN_FILE, TEMP_CPLFILE);
              DELETE(TEMPFILE);
            exception
              when others =>
                null;
            end;
            CREATE(TEMPFILE, OUT_FILE, TEMP_CPLFILE);
            PUT_LINE(TEMPFILE, VALUE(CURRENT_PROGRAM_LIBRARY));
            CLOSE(TEMPFILE);
          end if;
          put_line("lib = " & value(current_program_library));
        else
          PUT_LINE("SET_LIBRARY requires a parameter, CURRENT_PROGRAM_LIBRARY");
        end if;
      when DELETE =>
        if COMMAND_LINE(COMMAND_INDEX) = '(' then
          GET_NAMED_PARAMETER(COMMAND_LINE(COMMAND_INDEX + 1 .. LINE_LENGTH),
            "UNIT_NAME", SOURCE_FILE, PARAMETER_FOUND);
          if not PARAMETER_FOUND then
            END_INDEX := POSITION_OF_REVERSE(')', COMMAND_LINE(
              COMMAND_INDEX .. LINE_LENGTH));
            if END_INDEX = 0 then
              END_INDEX := LINE_LENGTH;
            else
              END_INDEX := END_INDEX - 1;
            end if;
            SD_BUFFER_FILES.PURGE_PACKAGE_FILES(STRIP_BLANKS(COMMAND_LINE(
              COMMAND_INDEX + 1 .. END_INDEX)));
            CATALOG_PKG.REMOVE_CATALOG_FILE(STRIP_BLANKS(COMMAND_LINE(
              COMMAND_INDEX + 1 .. END_INDEX)));
          else
            SD_BUFFER_FILES.PURGE_PACKAGE_FILES(VALUE(SOURCE_FILE));
            CATALOG_PKG.REMOVE_CATALOG_FILE(VALUE(SOURCE_FILE));
          end if;
        else
          PUT_LINE("DELETE requires a parameter, UNIT_NAME");
        end if;
      when COMPILE =>
        if COMMAND_LINE(COMMAND_INDEX) = '(' then
          GET_NAMED_PARAMETER(COMMAND_LINE(COMMAND_INDEX + 1 .. LINE_LENGTH),
            "SOURCE_FILE", SOURCE_FILE, PARAMETER_FOUND);
          if not PARAMETER_FOUND then
            END_INDEX := POSITION_OF_REVERSE(')', COMMAND_LINE(
              COMMAND_INDEX .. LINE_LENGTH));
            if END_INDEX = 0 then
              END_INDEX := LINE_LENGTH;
            else
              END_INDEX := END_INDEX - 1;
            end if;
            SOURCE_FILE := CREATE(STRIP_BLANKS(COMMAND_LINE(
              COMMAND_INDEX + 1 .. END_INDEX)));
          end if;
        else GET_SOURCE_FILE(SOURCE_FILE);
        end if;
        SYSDEP.SD_COMPILE(VALUE(SOURCE_FILE));
      when LINK =>
        if COMMAND_LINE(COMMAND_INDEX) = '(' then
          GET_NAMED_PARAMETER(COMMAND_LINE(COMMAND_INDEX + 1 .. LINE_LENGTH),
            "COMPILATION_UNIT", COMPILATION_UNIT, PARAMETER_FOUND);
          if not PARAMETER_FOUND then
            END_INDEX := POSITION_OF_REVERSE(')', COMMAND_LINE(
              COMMAND_INDEX .. LINE_LENGTH));
            if END_INDEX = 0 then
              END_INDEX := LINE_LENGTH;
            else
              END_INDEX := END_INDEX - 1;
            end if;
            COMPILATION_UNIT := CREATE(STRIP_BLANKS(COMMAND_LINE(
              COMMAND_INDEX + 1 .. END_INDEX)));
          end if;
        else GET_COMPILATION_UNIT(COMPILATION_UNIT);
        end if;
        SYSDEP.SD_LINK(VALUE(COMPILATION_UNIT));
      when RUN =>
        if COMMAND_LINE(COMMAND_INDEX) = '(' then
          GET_NAMED_PARAMETER(COMMAND_LINE(COMMAND_INDEX + 1 .. LINE_LENGTH),
            "COMPILATION_UNIT", COMPILATION_UNIT, PARAMETER_FOUND);
          if not PARAMETER_FOUND then
            END_INDEX := POSITION_OF_REVERSE(')', COMMAND_LINE(
              COMMAND_INDEX .. LINE_LENGTH));
            if END_INDEX = 0 then
              END_INDEX := LINE_LENGTH;
            else
              END_INDEX := END_INDEX - 1;
            end if;
            COMPILATION_UNIT := CREATE(STRIP_BLANKS(COMMAND_LINE(
              COMMAND_INDEX + 1 .. END_INDEX)));
          end if;
        else GET_COMPILATION_UNIT(COMPILATION_UNIT);
        end if;
        SYSDEP.SD_RUN(VALUE(COMPILATION_UNIT));
      when SYSTEM_COMMAND =>
        if COMMAND_LINE(COMMAND_INDEX) = '(' then
          GET_NAMED_PARAMETER(COMMAND_LINE(COMMAND_INDEX + 1 .. LINE_LENGTH),
            "COMMAND", COMMAND_TO_EXECUTE, PARAMETER_FOUND);
          if not PARAMETER_FOUND then
            END_INDEX := POSITION_OF_REVERSE(')', COMMAND_LINE(
              COMMAND_INDEX + 1 .. LINE_LENGTH));
            if END_INDEX = 0 then
              END_INDEX := LINE_LENGTH;
            else
              END_INDEX := END_INDEX - 1;
            end if;
            SYSDEP.SD_SYS(COMMAND_LINE(COMMAND_INDEX + 1 .. END_INDEX));
          else
            SYSDEP.SD_SYS(VALUE(COMMAND_TO_EXECUTE));
          end if;
        else
          PUT_LINE("SYSTEM_COMMAND requires a parameter, COMMAND");
        end if;
      when HELP =>
        WD_HELP.HELP(VALUE(BASE_PROGRAM_LIBRARY) & "WISDEBUG.HLP",
          COMMAND_LINE(1 .. LINE_LENGTH));
      when OTHERS =>
        null;
    end case;
    NEW_LINE;
    COMMAND := UNKNOWN;
    COMMAND_LINE := BLANKS;
    PUT_LINE("please enter desired option");
    GET_LINE(COMMAND_LINE, LINE_LENGTH);
    COMMAND_LINE(1 .. LINE_LENGTH) := STRING_UTILITIES.UPPER_CASE(COMMAND_LINE(
      1 .. LINE_LENGTH));
    NEW_LINE;
    GET_COMMAND(COMMAND_LINE(COMMAND_LINE'FIRST .. LINE_LENGTH), COMMAND,
      COMMAND_INDEX);
  end loop;
  OPEN(TEMPFILE, IN_FILE, TEMP_CPLFILE);
  DELETE(TEMPFILE);
exception
  when NAME_ERROR =>
    null;
end WIS_DEBUG;