Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/metric/sinstool.src

Text File | 1988-05-03 | 1.1 MB | 32,068 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);
  begin
    if S = "" then
      return null;
    else
      return new CONSTR_STR'(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);
      FLUSH(S);

    -- 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;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--scanner.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG; use STRING_PKG;

package STRING_SCANNER is

--| Functions for scanning tokens from strings.
  pragma PAGE;
  --| Overview
  --| This package provides a set of functions used to scan tokens from
  --| strings.  After the function make_Scanner is called to convert a string
  --| into a string Scanner, the following functions may be called to scan
  --| various tokens from the string:
  --|-
  --| Make_Scanner    Given a string returns a Scanner
  --| Destroy_Scanner    Free storage used by Scanner
  --| More        Return TRUE iff unscanned characters remain
  --| Forward             Bump the Scanner
  --| Backward        Bump back the Scanner
  --| Get            Return character
  --| Next        Return character and bump the Scanner
  --| Get_String        Return String_Type in Scanner
  --| Get_Remainder    Return String_Type in Scanner from current Index
  --| Mark        Mark the current Index for Restore
  --| Restore        Restore the previously marked Index
  --| Position        Return the current position of the Scanner
  --| Is_Word        Return TRUE iff Scanner is at a non-blank character
  --| Scan_Word        Return sequence of non blank characters
  --| Is_Number        Return TRUE iff Scanner is at a digit
  --| Scan_Number (2)    Return sequence of decimal digits
  --| Is_Signed_Number    Return TRUE iff Scanner is at a digit or sign
  --| Scan_Signed_Number (2)
  --|            sequence of decimal digits with optional sign (+/-)
  --| Is_Space        Return TRUE iff Scanner is at a space or tab
  --| Scan_Space        Return sequence of spaces or tabs
  --| Skip_Space        Advance Scanner past white space
  --| Is_Ada_Id        Return TRUE iff Scanner is at first character of ada id
  --| Scan_Ada_Id        Scan an Ada identifier
  --| Is_Quoted        Return TRUE iff Scanner is at a double quote
  --| Scan_Quoted        Scan quoted string, embedded quotes doubled
  --| Is_Enclosed        Return TRUE iff Scanner is at an enclosing character
  --| Scan_Enclosed    Scan enclosed string, embedded enclosing character doubled
  --| Is_Sequence        Return TRUE iff Scanner is at some character in sequence
  --| Scan_Sequence    Scan user specified sequence of chars
--| Is_Not_Sequence    Return TRUE iff Scanner is not at the characters in sequence
--| Scan_Not_Sequence    Scan string up to but not including a given sequence of chars
  --| Is_Literal            Return TRUE iff Scanner is at literal
  --| Scan_Literal    Scan user specified literal
  --| Is_Not_Literal    Return TRUE iff Scanner is not a given literal
  --| Scan_Not_Literal    Scan string up to but not including a given literal
  --|+

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

  OUT_OF_BOUNDS          : exception;
                                --| Raised when a operation is attempted on a
  --| Scanner that has passed the end
  SCANNER_ALREADY_MARKED : exception;
  --| Raised when a Mark is attemped on a Scanner
  --| that has already been marked

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

  type SCANNER is private;  --| Scanner type

  ----------------------------------------------------------------
  pragma PAGE;
  function MAKE_SCANNER( --| Construct a Scanner from S.
                        S : in STRING_TYPE --| String to be scanned.
                        ) return SCANNER;

  --| Effects: Construct a Scanner from S.
  --| N/A: Raises, Modifies, Errors

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

  procedure DESTROY_SCANNER( --| Free Scanner storage
                            T : in out SCANNER --| Scanner to be freed
                            );

  --| Effects: Free space occupied by the Scanner.
  --| N/A: Raises, Modifies, Errors

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

  function MORE( --| Check if Scanner is exhausted
                T : in SCANNER --| Scanner to check
                ) return BOOLEAN;

  --| Effects: Return TRUE iff additional characters remain to be scanned.
  --| N/A: Raises, Modifies, Errors

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

  procedure FORWARD( --| Bump scanner
                    T : in SCANNER --| Scanner
                    );

  --| Effects: Update the scanner position.
  --| N/A: Raises, Modifies, Errors

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

  procedure BACKWARD( --| Bump back scanner
                     T : in SCANNER --| Scanner
                     );

  --| Effects: Update the scanner position.
  --| N/A: Raises, Modifies, Errors

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

  function GET( --| Return character
               T : in SCANNER --| Scanner to check
               ) return CHARACTER;

  --| Raises: Out_Of_Bounds
  --| Effects: Return character at the current Scanner position.
  --| The scanner position remains unchanged.
  --| N/A: Modifies, Errors

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

  procedure NEXT( --| Return character and bump scanner
                 T : in SCANNER;  --| Scanner to check
                 C : out CHARACTER --| Character to be returned
                 );

  --| Raises: Out_Of_Bounds
  --| Effects: Return character at the current Scanner position and update
  --| the position.
  --| N/A: Modifies, Errors

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

  function POSITION( --| Return current Scanner position
                    T : in SCANNER --| Scanner to check
                    ) return POSITIVE;

  --| Raises: Out_Of_Bounds
--| Effects: Return a positive integer indicating the current Scanner position,
  --| N/A: Modifies, Errors

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

  function GET_STRING( --| Return contents of Scanner
                      T : in SCANNER --| Scanner
                      ) return STRING_TYPE;

--| Effects: Return a String_Type corresponding to the contents of the Scanner
  --| N/A: Raises, Modifies, Errors

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

  function GET_REMAINDER( --| Return contents of Scanner from index
                         T : in SCANNER) return STRING_TYPE;

--| Effects: Return a String_Type starting at the current index of the Scanner
  --| N/A: Raises, Modifies, Errors

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

  procedure MARK(T : in SCANNER);

  --| Raises: Scanner_Already_Marked
  --| Effects: Mark the current index for possible future use
  --| N/A: Modifies, Errors

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

  procedure RESTORE(T : in SCANNER);

  --| Effects: Restore the index to the previously marked value
  --| N/A: Raises, Modifies, Errors

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

  pragma PAGE;
  function IS_WORD( --| Check if Scanner is at the start of a word.
                   T : in SCANNER --| Scanner to check
                   ) return BOOLEAN;

  --| Effects: Return TRUE iff Scanner is at the start of a word.
  --| N/A: Raises, Modifies, Errors

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

  procedure SCAN_WORD( --| Scan sequence of non blank characters
                      T      : in SCANNER;  --| String to be scanned
                      FOUND  : out BOOLEAN;  --| TRUE iff a word found
                      RESULT : out STRING_TYPE;  --| Word scanned from string
                      SKIP   : in BOOLEAN := FALSE
                      --| Skip white spaces before scan
                      );

  --| Effects: Scan T for a sequence of non blank
  --| characters.  If at least one is found, return Found => TRUE,
  --| Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| N/A: Raises, Modifies, Errors
  pragma PAGE;
  function IS_NUMBER( --| Return TRUE iff Scanner is at a decimal digit
                     T : in SCANNER --| The string being scanned
                     ) return BOOLEAN;

  --| Effects: Return TRUE iff Scan_Number would return a non-null string.
  --| N/A: Raises, Modifies, Errors

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

  procedure SCAN_NUMBER( --| Scan sequence of digits
                        T      : in SCANNER;  --| String to be scanned
                        FOUND  : out BOOLEAN;
                                --| TRUE iff one or more digits found
                        RESULT : out STRING_TYPE;
                                --| Number scanned from string
                        SKIP   : in BOOLEAN := FALSE
                        --| Skip white spaces before scan
                        );

  --| Effects: Scan T for a sequence of digits.
  --| If at least one is found, return Found => TRUE, Result => <the digits>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_NUMBER( --| Scan sequence of digits
                        T      : in SCANNER;  --| String to be scanned
                        FOUND  : out BOOLEAN;
                                --| TRUE iff one or more digits found
                        RESULT : out INTEGER;  --| Number scanned from string
                        SKIP   : in BOOLEAN := FALSE
                        --| Skip white spaces before scan
                        );

  --| Effects: Scan T for a sequence of digits.
  --| If at least one is found, return Found => TRUE, Result => <the digits>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
  function IS_SIGNED_NUMBER( --| Check if Scanner is at a decimal digit or
  --| sign (+/-)
                            T : in SCANNER --| The string being scanned
                            ) return BOOLEAN;

  --| Effects: Return TRUE iff Scan_Signed_Number would return a non-null
  --| string.

  --| N/A: Raises, Modifies, Errors

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

  procedure SCAN_SIGNED_NUMBER( --| Scan signed sequence of digits
                               T      : in SCANNER;  --| String to be scanned
                               FOUND  : out BOOLEAN;
                                --| TRUE iff one or more digits found
                               RESULT : out STRING_TYPE;
                                --| Number scanned from string
                               SKIP   : in BOOLEAN := FALSE
                               --| Skip white spaces before scan
                               );

  --| Effects: Scan T for a sequence of digits preceeded with optional sign.
  --| If at least one digit is found, return Found => TRUE,
  --| Result => <the digits>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_SIGNED_NUMBER( --| Scan signed sequence of digits
                               T      : in SCANNER;  --| String to be scanned
                               FOUND  : out BOOLEAN;
                                --| TRUE iff one or more digits found
                               RESULT : out INTEGER;
                                --| Number scanned from string
                               SKIP   : in BOOLEAN := FALSE
                               --| Skip white spaces before scan
                               );

  --| Effects: Scan T for a sequence of digits preceeded with optional sign.
  --| If at least one digit is found, return Found => TRUE,
  --| Result => <the digits>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
  function IS_SPACE( --| Check if T is at a space or tab
                    T : in SCANNER --| The string being scanned
                    ) return BOOLEAN;

  --| Effects: Return TRUE iff Scan_Space would return a non-null string.
  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_SPACE( --| Scan sequence of white space characters
                       T      : in SCANNER;  --| String to be scanned
                       FOUND  : out BOOLEAN;  --| TRUE iff space found
                       RESULT : out STRING_TYPE --| Spaces scanned from string
                       );

  --| Effects: Scan T past all white space (spaces
  --| and tabs.  If at least one is found, return Found => TRUE,
  --| Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors

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

  procedure SKIP_SPACE( --| Skip white space
                       T : in SCANNER --| String to be scanned
                       );

  --| Effects: Scan T past all white space (spaces and tabs).
  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
  function IS_ADA_ID( --| Check if T is at an Ada identifier
                     T : in SCANNER --| The string being scanned
                     ) return BOOLEAN;

  --| Effects: Return TRUE iff Scan_Ada_Id would return a non-null string.
  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_ADA_ID( --| Scan Ada identifier
                        T      : in SCANNER;  --| String to be scanned
                        FOUND  : out BOOLEAN;
                                --| TRUE iff an Ada identifier found
                        RESULT : out STRING_TYPE;
                                --| Identifier scanned from string
                        SKIP   : in BOOLEAN := FALSE
                        --| Skip white spaces before scan
                        );

  --| Effects: Scan T for a valid Ada identifier.
  --| If one is found, return Found => TRUE, Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
  function IS_QUOTED( --| Check if T is at a double quote
                     T : in SCANNER --| The string being scanned
                     ) return BOOLEAN;

  --| Effects: Return TRUE iff T is at a quoted string (eg. ... "Hello" ...).
  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_QUOTED( --| Scan a quoted string
                        T      : in SCANNER;  --| String to be scanned
                        FOUND  : out BOOLEAN;
                                --| TRUE iff a quoted string found
                        RESULT : out STRING_TYPE;
                                --| Quoted string scanned from string
                        SKIP   : in BOOLEAN := FALSE
                        --| Skip white spaces before scan
                        );

  --| Effects: Scan at T for an opening quote
  --| followed by a sequence of characters and ending with a closing
  --| quote.  If successful, return Found => TRUE, Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.
  --| A pair of quotes within the quoted string is converted to a single quote.
  --| The outer quotes are stripped.

  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
  function IS_ENCLOSED( --| Check if T is at an enclosing character
                       B : in CHARACTER;  --| Enclosing open character
                       E : in CHARACTER;  --| Enclosing close character
                       T : in SCANNER --| The string being scanned
                       ) return BOOLEAN;

  --| Effects: Return TRUE iff T as encosed by B and E (eg. ... [ABC] ...).
  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_ENCLOSED( --| Scan an enclosed string
                          B      : in CHARACTER;  --| Enclosing open character
                          E      : in CHARACTER;  --| Enclosing close character
                          T      : in SCANNER;  --| String to be scanned
                          FOUND  : out BOOLEAN;
                                --| TRUE iff a quoted string found
                          RESULT : out STRING_TYPE;
                                --| Quoted string scanned from string
                          SKIP   : in BOOLEAN := FALSE
                          --| Skip white spaces before scan
                          );

  --| Effects: Scan at T for an enclosing character
--| followed by a sequence of characters and ending with an enclosing character.
  --| If successful, return Found => TRUE, Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.
  --| The enclosing characters are stripped.

  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
  function IS_SEQUENCE( --| Check if T is at some sequence characters
                       CHARS : in STRING_TYPE;  --| Characters to be scanned
                       T     : in SCANNER --| The string being scanned
                       ) return BOOLEAN;

  --| Effects: Return TRUE iff T is at some character of Chars.
  --| Modifies: Raises, Modifies, Errors

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

  function IS_SEQUENCE( --| Check if T is at some sequence characters
                       CHARS : in STRING;  --| Characters to be scanned
                       T     : in SCANNER --| The string being scanned
                       ) return BOOLEAN;

  --| Effects: Return TRUE iff T is at some character of Chars.
  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_SEQUENCE( --| Scan arbitrary sequence of characters
                          CHARS  : in STRING_TYPE;
                                --| Characters that should be scanned
                          T      : in SCANNER;  --| String to be scanned
                          FOUND  : out BOOLEAN;  --| TRUE iff a sequence found
                          RESULT : out STRING_TYPE;
                                --| Sequence scanned from string
                          SKIP   : in BOOLEAN := FALSE
                          --| Skip white spaces before scan
                          );

  --| Effects: Scan T for a sequence of characters C such that C appears in
  --| Char.  If at least one is found, return Found => TRUE,
  --| Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors

  --| Notes:
  --| Scan_Sequence("0123456789", S, Index, Found, Result)
  --| is equivalent to Scan_Number(S, Index, Found, Result)
  --| but is less efficient.

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

  procedure SCAN_SEQUENCE( --| Scan arbitrary sequence of characters
                          CHARS  : in STRING;
                                --| Characters that should be scanned
                          T      : in SCANNER;  --| String to be scanned
                          FOUND  : out BOOLEAN;  --| TRUE iff a sequence found
                          RESULT : out STRING_TYPE;
                                --| Sequence scanned from string
                          SKIP   : in BOOLEAN := FALSE
                          --| Skip white spaces before scan
                          );

  --| Effects: Scan T for a sequence of characters C such that C appears in
  --| Char.  If at least one is found, return Found => TRUE,
  --| Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors

  --| Notes:
  --| Scan_Sequence("0123456789", S, Index, Found, Result)
  --| is equivalent to Scan_Number(S, Index, Found, Result)
  --| but is less efficient.
  pragma PAGE;
  function IS_NOT_SEQUENCE( --| Check if T is not at some seuqnce of character
                           CHARS : in STRING_TYPE;  --| Characters to be scanned
                           T     : in SCANNER --| The string being scanned
                           ) return BOOLEAN;

  --| Effects: Return TRUE iff T is not at some character of Chars.
  --| Modifies: Raises, Modifies, Errors

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

  function IS_NOT_SEQUENCE( --| Check if T is at some sequence of characters
                           CHARS : in STRING;  --| Characters to be scanned
                           T     : in SCANNER --| The string being scanned
                           ) return BOOLEAN;

  --| Effects: Return TRUE iff T is not at some character of Chars.
  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_NOT_SEQUENCE( --| Scan arbitrary sequence of characters
                              CHARS  : in STRING_TYPE;
                                --| Characters that should be scanned
                              T      : in SCANNER;  --| String to be scanned
                              FOUND  : out BOOLEAN;
                                --| TRUE iff a sequence found
                              RESULT : out STRING_TYPE;
                                --| Sequence scanned from string
                              SKIP   : in BOOLEAN := FALSE
                              --| Skip white spaces before scan
                              );

--| Effects: Scan T for a sequence of characters C such that C does not appear
  --| in Chars.  If at least one such C is found, return Found => TRUE,
  --| Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_NOT_SEQUENCE( --| Scan arbitrary sequence of characters
                              CHARS  : in STRING;
                                --| Characters that should be scanned
                              T      : in SCANNER;  --| String to be scanned
                              FOUND  : out BOOLEAN;
                                --| TRUE iff a sequence found
                              RESULT : out STRING_TYPE;
                                --| Sequence scanned from string
                              SKIP   : in BOOLEAN := FALSE
                              --| Skip white spaces before scan
                              );

--| Effects: Scan T for a sequence of characters C such that C does not appear
  --| in Chars.  If at least one such C is found, return Found => TRUE,
  --| Result => <the characters>.
  --| Otherwise return Found => FALSE and Result is unpredictable.

  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
  function IS_LITERAL( --| Check if T is at literal Chars
                      CHARS : in STRING_TYPE;  --| Characters to be scanned
                      T     : in SCANNER --| The string being scanned
                      ) return BOOLEAN;

  --| Effects: Return TRUE iff T is at literal Chars.
  --| Modifies: Raises, Modifies, Errors

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

  function IS_LITERAL( --| Check if T is at literal Chars
                      CHARS : in STRING;  --| Characters to be scanned
                      T     : in SCANNER --| The string being scanned
                      ) return BOOLEAN;

  --| Effects: Return TRUE iff T is at literal Chars.
  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_LITERAL( --| Scan arbitrary literal
                         CHARS : in STRING_TYPE;
                                --| Literal that should be scanned
                         T     : in SCANNER;  --| String to be scanned
                         FOUND : out BOOLEAN;  --| TRUE iff a sequence found
                         SKIP  : in BOOLEAN := FALSE
                         --| Skip white spaces before scan
                         );

  --| Effects: Scan T for a litral Chars such that Char matches the sequence
  --| of characters in T.  If found, return Found => TRUE,
  --| Otherwise return Found => FALSE

  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_LITERAL( --| Scan arbitrary literal
                         CHARS : in STRING;  --| Literal that should be scanned
                         T     : in SCANNER;  --| String to be scanned
                         FOUND : out BOOLEAN;  --| TRUE iff a sequence found
                         SKIP  : in BOOLEAN := FALSE
                         --| Skip white spaces before scan
                         );

  --| Effects: Scan T for a litral Chars such that Char matches the sequence
  --| of characters in T.  If found, return Found => TRUE,
  --| Otherwise return Found => FALSE

  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
  function IS_NOT_LITERAL( --| Check if T is not at literal Chars
                          CHARS : in STRING;  --| Characters to be scanned
                          T     : in SCANNER --| The string being scanned
                          ) return BOOLEAN;

  --| Effects: Return TRUE iff T is not at literal Chars
  --| Modifies: Raises, Modifies, Errors

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

  function IS_NOT_LITERAL( --| Check if T is not at literal Chars
                          CHARS : in STRING_TYPE;  --| Characters to be scanned
                          T     : in SCANNER --| The string being scanned
                          ) return BOOLEAN;

  --| Effects: Return TRUE iff T is not at literal Chars
  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_NOT_LITERAL( --| Scan arbitrary literal
                             CHARS  : in STRING;
                                --| Literal that should be scanned
                             T      : in SCANNER;  --| String to be scanned
                             FOUND  : out BOOLEAN;
                                --| TRUE iff a sequence found
                             RESULT : out STRING_TYPE;  --| String up to literal
                             SKIP   : in BOOLEAN := FALSE
                             --| Skip white spaces before scan
                             );

  --| Effects: Scan T for a litral Chars such that Char does not match the
  --| sequence of characters in T.  If found, return Found => TRUE,
  --| Otherwise return Found => FALSE

  --| Modifies: Raises, Modifies, Errors

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

  procedure SCAN_NOT_LITERAL( --| Scan arbitrary literal
                             CHARS  : in STRING_TYPE;
                                --| Literal that should be scanned
                             T      : in SCANNER;  --| String to be scanned
                             FOUND  : out BOOLEAN;
                                --| TRUE iff a sequence found
                             RESULT : out STRING_TYPE;  --| String up to literal
                             SKIP   : in BOOLEAN := FALSE
                             --| Skip white spaces before scan
                             );

  --| Effects: Scan T for a litral Chars such that Char does not match the
  --| sequence of characters in T.  If found, return Found => TRUE,
  --| Otherwise return Found => FALSE

  --| Modifies: Raises, Modifies, Errors
  pragma PAGE;
private
  pragma LIST(OFF);
  type SCAN_RECORD is
    record
      TEXT  : STRING_TYPE;  --| Copy of string being scanned
      INDEX : POSITIVE := 1;  --| Current position of Scanner
      MARK  : NATURAL := 0;  --| Mark
    end record;

  type SCANNER is access SCAN_RECORD;
  pragma LIST(ON);
end STRING_SCANNER;
pragma PAGE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--scanner.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG; use STRING_PKG;
with UNCHECKED_DEALLOCATION;

package body STRING_SCANNER is


  WHITE_SPACE : constant STRING := " " & ASCII.HT;
  NUMBER_1    : constant STRING := "0123456789";
  NUMBER      : constant STRING := NUMBER_1 & "_";
  QUOTE       : constant STRING := """";
  ADA_ID_1    : constant STRING :=
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
  ADA_ID      : constant STRING := ADA_ID_1 & NUMBER;

  procedure FREE_SCANNER is
    new UNCHECKED_DEALLOCATION(SCAN_RECORD, SCANNER);
  pragma PAGE;
  function IS_VALID(T : in SCANNER) return BOOLEAN is

  begin

    return T /= null;

  end IS_VALID;

  function MAKE_SCANNER(S : in STRING_TYPE) return SCANNER is

    T : SCANNER := new SCAN_RECORD;

  begin

    T.TEXT := STRING_PKG.MAKE_PERSISTENT(S);
    return T;

  end MAKE_SCANNER;

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

  procedure DESTROY_SCANNER(T : in out SCANNER) is

  begin

    if IS_VALID(T) then
      STRING_PKG.FLUSH(T.TEXT);
      FREE_SCANNER(T);
    end if;

  end DESTROY_SCANNER;

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

  function MORE(T : in SCANNER) return BOOLEAN is

  begin

    if IS_VALID(T) then
      if T.INDEX > STRING_PKG.LENGTH(T.TEXT) then
        return FALSE;
      else
        return TRUE;
      end if;
    else
      return FALSE;
    end if;

  end MORE;

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

  function GET(T : in SCANNER) return CHARACTER is

  begin

    if not MORE(T) then
      raise OUT_OF_BOUNDS;
    end if;
    return STRING_PKG.FETCH(T.TEXT, T.INDEX);

  end GET;

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

  procedure FORWARD(T : in SCANNER) is

  begin

    if IS_VALID(T) then
      if STRING_PKG.LENGTH(T.TEXT) >= T.INDEX then
        T.INDEX := T.INDEX + 1;
      end if;
    end if;

  end FORWARD;

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

  procedure BACKWARD(T : in SCANNER) is

  begin

    if IS_VALID(T) then
      if T.INDEX > 1 then
        T.INDEX := T.INDEX - 1;
      end if;
    end if;

  end BACKWARD;

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

  procedure NEXT(T : in SCANNER;
                 C : out CHARACTER) is

  begin

    C := GET(T);
    FORWARD(T);

  end NEXT;

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

  function POSITION(T : in SCANNER) return POSITIVE is

  begin

    if not MORE(T) then
      raise OUT_OF_BOUNDS;
    end if;
    return T.INDEX;

  end POSITION;

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

  function GET_STRING(T : in SCANNER) return STRING_TYPE is

  begin

    if IS_VALID(T) then
      return STRING_PKG.MAKE_PERSISTENT(T.TEXT);
    else
      return STRING_PKG.MAKE_PERSISTENT("");
    end if;

  end GET_STRING;

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

  function GET_REMAINDER(T : in SCANNER) return STRING_TYPE is

    S_STR : STRING_TYPE;

  begin

    if MORE(T) then
      STRING_PKG.MARK;
      S_STR := STRING_PKG.MAKE_PERSISTENT(STRING_PKG.SUBSTR(T.TEXT, T.INDEX,
        STRING_PKG.LENGTH(T.TEXT) - T.INDEX + 1));
      STRING_PKG.RELEASE;
    else
      S_STR := STRING_PKG.MAKE_PERSISTENT("");
    end if;
    return S_STR;

  end GET_REMAINDER;

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

  procedure MARK(T : in SCANNER) is

  begin

    if IS_VALID(T) then
      if T.MARK /= 0 then
        raise SCANNER_ALREADY_MARKED;
      else
        T.MARK := T.INDEX;
      end if;
    end if;

  end MARK;

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

  procedure RESTORE(T : in SCANNER) is

  begin

    if IS_VALID(T) then
      if T.MARK /= 0 then
        T.INDEX := T.MARK;
        T.MARK := 0;
      end if;
    end if;

  end RESTORE;
  pragma PAGE;
  function IS_ANY(T : in SCANNER;
                  Q : in STRING) return BOOLEAN is

    N : NATURAL;

  begin

    if not MORE(T) then
      return FALSE;
    end if;
    STRING_PKG.MARK;
    N := STRING_PKG.MATCH_ANY(T.TEXT, Q, T.INDEX);
    if N /= T.INDEX then
      N := 0;
    end if;
    STRING_PKG.RELEASE;
    return N /= 0;

  end IS_ANY;
  pragma PAGE;
  procedure SCAN_ANY(T      : in SCANNER;
                     Q      : in STRING;
                     FOUND  : out BOOLEAN;
                     RESULT : in out STRING_TYPE) is

    S_STR : STRING_TYPE;
    N     : NATURAL;

  begin

    if IS_ANY(T, Q) then
      N := STRING_PKG.MATCH_NONE(T.TEXT, Q, T.INDEX);
      if N = 0 then
        N := STRING_PKG.LENGTH(T.TEXT) + 1;
      end if;
      RESULT := RESULT & STRING_PKG.SUBSTR(T.TEXT, T.INDEX, N - T.INDEX);
      T.INDEX := N;
      FOUND := TRUE;
    else
      FOUND := FALSE;
    end if;

  end SCAN_ANY;
  pragma PAGE;
  function QUOTED_STRING(T : in SCANNER) return INTEGER is

    COUNT : INTEGER := 0;
    I     : POSITIVE;
    N     : NATURAL;

  begin

    if not IS_VALID(T) then
      return COUNT;
    end if;
    I := T.INDEX;
    while IS_ANY(T, """") loop
      T.INDEX := T.INDEX + 1;
      if not MORE(T) then
        T.INDEX := I;
        return 0;
      end if;
      STRING_PKG.MARK;
      N := STRING_PKG.MATCH_ANY(T.TEXT, """", T.INDEX);
      STRING_PKG.RELEASE;
      if N = 0 then
        T.INDEX := I;
        return 0;
      end if;
      T.INDEX := N + 1;
    end loop;
    COUNT := T.INDEX - I;
    T.INDEX := I;
    return COUNT;

  end QUOTED_STRING;
  pragma PAGE;
  function ENCLOSED_STRING(B : in CHARACTER;
                           E : in CHARACTER;
                           T : in SCANNER) return NATURAL is

    COUNT : NATURAL := 1;
    I     : POSITIVE;
    INX_B : NATURAL;
    INX_E : NATURAL;
    DEPTH : NATURAL := 1;

  begin

    if not IS_ANY(T, B & "") then
      return 0;
    end if;
    I := T.INDEX;
    FORWARD(T);
    while DEPTH /= 0 loop
      if not MORE(T) then
        T.INDEX := I;
        return 0;
      end if;
      STRING_PKG.MARK;
      INX_B := STRING_PKG.MATCH_ANY(T.TEXT, B & "", T.INDEX);
      INX_E := STRING_PKG.MATCH_ANY(T.TEXT, E & "", T.INDEX);
      STRING_PKG.RELEASE;
      if INX_E = 0 then
        T.INDEX := I;
        return 0;
      end if;
      if INX_B /= 0 and then INX_B < INX_E then
        DEPTH := DEPTH + 1;
      else
        INX_B := INX_E;
        DEPTH := DEPTH - 1;
      end if;
      T.INDEX := INX_B + 1;
    end loop;
    COUNT := T.INDEX - I;
    T.INDEX := I;
    return COUNT;

  end ENCLOSED_STRING;
  pragma PAGE;
  function IS_WORD(T : in SCANNER) return BOOLEAN is

  begin

    if not MORE(T) then
      return FALSE;
    else
      return not IS_ANY(T, WHITE_SPACE);
    end if;

  end IS_WORD;

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

  procedure SCAN_WORD(T      : in SCANNER;
                      FOUND  : out BOOLEAN;
                      RESULT : out STRING_TYPE;
                      SKIP   : in BOOLEAN := FALSE) is

    S_STR : STRING_TYPE;
    N     : NATURAL;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    if IS_WORD(T) then
      STRING_PKG.MARK;
      N := STRING_PKG.MATCH_ANY(T.TEXT, WHITE_SPACE, T.INDEX);
      if N = 0 then
        N := STRING_PKG.LENGTH(T.TEXT) + 1;
      end if;
      RESULT := STRING_PKG.MAKE_PERSISTENT(STRING_PKG.SUBSTR(T.TEXT, T.INDEX, N
        - T.INDEX));
      T.INDEX := N;
      FOUND := TRUE;
      STRING_PKG.RELEASE;
    else
      FOUND := FALSE;
    end if;
    return;

  end SCAN_WORD;
  pragma PAGE;
  function IS_NUMBER(T : in SCANNER) return BOOLEAN is

  begin

    return IS_ANY(T, NUMBER_1);

  end IS_NUMBER;

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

  procedure SCAN_NUMBER(T      : in SCANNER;
                        FOUND  : out BOOLEAN;
                        RESULT : out STRING_TYPE;
                        SKIP   : in BOOLEAN := FALSE) is

    C     : CHARACTER;
    S_STR : STRING_TYPE;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    if not IS_NUMBER(T) then
      FOUND := FALSE;
      return;
    end if;
    STRING_PKG.MARK;
    while IS_NUMBER(T) loop
      SCAN_ANY(T, NUMBER_1, FOUND, S_STR);
      if MORE(T) then
        C := GET(T);
        if C = '_' then
          FORWARD(T);
          if IS_NUMBER(T) then
            S_STR := S_STR & "_";
          else
            BACKWARD(T);
          end if;
        end if;
      end if;
    end loop;
    RESULT := STRING_PKG.MAKE_PERSISTENT(S_STR);
    STRING_PKG.RELEASE;

  end SCAN_NUMBER;

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

  procedure SCAN_NUMBER(T      : in SCANNER;
                        FOUND  : out BOOLEAN;
                        RESULT : out INTEGER;
                        SKIP   : in BOOLEAN := FALSE) is

    F     : BOOLEAN;
    S_STR : STRING_TYPE;

  begin

    SCAN_NUMBER(T, F, S_STR, SKIP);
    if F then
      RESULT := INTEGER'VALUE(STRING_PKG.VALUE(S_STR));
    end if;
    FOUND := F;

  end SCAN_NUMBER;
  pragma PAGE;
  function IS_SIGNED_NUMBER(T : in SCANNER) return BOOLEAN is

    I : POSITIVE;
    C : CHARACTER;
    F : BOOLEAN;

  begin

    if MORE(T) then
      I := T.INDEX;
      C := GET(T);
      if C = '+' or C = '-' then
        T.INDEX := T.INDEX + 1;
      end if;
      F := IS_ANY(T, NUMBER_1);
      T.INDEX := I;
      return F;
    else
      return FALSE;
    end if;

  end IS_SIGNED_NUMBER;

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

  procedure SCAN_SIGNED_NUMBER(T      : in SCANNER;
                               FOUND  : out BOOLEAN;
                               RESULT : out STRING_TYPE;
                               SKIP   : in BOOLEAN := FALSE) is

    C     : CHARACTER;
    S_STR : STRING_TYPE;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    if IS_SIGNED_NUMBER(T) then
      C := GET(T);
      if C = '+' or C = '-' then
        FORWARD(T);
      end if;
      SCAN_NUMBER(T, FOUND, S_STR);
      STRING_PKG.MARK;
      if C = '+' or C = '-' then
        RESULT := STRING_PKG.MAKE_PERSISTENT(("" & C) & S_STR);
      else
        RESULT := STRING_PKG.MAKE_PERSISTENT(S_STR);
      end if;
      STRING_PKG.RELEASE;
      STRING_PKG.FLUSH(S_STR);
    else
      FOUND := FALSE;
    end if;

  end SCAN_SIGNED_NUMBER;

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

  procedure SCAN_SIGNED_NUMBER(T      : in SCANNER;
                               FOUND  : out BOOLEAN;
                               RESULT : out INTEGER;
                               SKIP   : in BOOLEAN := FALSE) is

    F     : BOOLEAN;
    S_STR : STRING_TYPE;

  begin

    SCAN_SIGNED_NUMBER(T, F, S_STR, SKIP);
    if F then
      RESULT := INTEGER'VALUE(STRING_PKG.VALUE(S_STR));
    end if;
    FOUND := F;

  end SCAN_SIGNED_NUMBER;
  pragma PAGE;
  function IS_SPACE(T : in SCANNER) return BOOLEAN is

  begin

    return IS_ANY(T, WHITE_SPACE);

  end IS_SPACE;

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

  procedure SCAN_SPACE(T      : in SCANNER;
                       FOUND  : out BOOLEAN;
                       RESULT : out STRING_TYPE) is

    S_STR : STRING_TYPE;

  begin

    STRING_PKG.MARK;
    SCAN_ANY(T, WHITE_SPACE, FOUND, S_STR);
    RESULT := STRING_PKG.MAKE_PERSISTENT(S_STR);
    STRING_PKG.RELEASE;

  end SCAN_SPACE;

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

  procedure SKIP_SPACE(T : in SCANNER) is

    S_STR : STRING_TYPE;
    FOUND : BOOLEAN;

  begin

    STRING_PKG.MARK;
    SCAN_ANY(T, WHITE_SPACE, FOUND, S_STR);
    STRING_PKG.RELEASE;

  end SKIP_SPACE;
  pragma PAGE;
  function IS_ADA_ID(T : in SCANNER) return BOOLEAN is

  begin

    return IS_ANY(T, ADA_ID_1);

  end IS_ADA_ID;

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

  procedure SCAN_ADA_ID(T      : in SCANNER;
                        FOUND  : out BOOLEAN;
                        RESULT : out STRING_TYPE;
                        SKIP   : in BOOLEAN := FALSE) is

    C     : CHARACTER;
    F     : BOOLEAN;
    S_STR : STRING_TYPE;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    if IS_ADA_ID(T) then
      STRING_PKG.MARK;
      NEXT(T, C);
      SCAN_ANY(T, ADA_ID, F, S_STR);
      RESULT := STRING_PKG.MAKE_PERSISTENT(("" & C) & S_STR);
      FOUND := TRUE;
      STRING_PKG.RELEASE;
    else
      FOUND := FALSE;
    end if;

  end SCAN_ADA_ID;
  pragma PAGE;
  function IS_QUOTED(T : in SCANNER) return BOOLEAN is

  begin

    if QUOTED_STRING(T) = 0 then
      return FALSE;
    else
      return TRUE;
    end if;

  end IS_QUOTED;

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

  procedure SCAN_QUOTED(T      : in SCANNER;
                        FOUND  : out BOOLEAN;
                        RESULT : out STRING_TYPE;
                        SKIP   : in BOOLEAN := FALSE) is

    COUNT : INTEGER;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    COUNT := QUOTED_STRING(T);
    if COUNT /= 0 then
      COUNT := COUNT - 2;
      T.INDEX := T.INDEX + 1;
      if COUNT /= 0 then
        STRING_PKG.MARK;
        RESULT := STRING_PKG.MAKE_PERSISTENT(STRING_PKG.SUBSTR(T.TEXT, T.INDEX,
          POSITIVE(COUNT)));
        STRING_PKG.RELEASE;
      else
        RESULT := STRING_PKG.MAKE_PERSISTENT("");
      end if;
      T.INDEX := T.INDEX + COUNT + 1;
      FOUND := TRUE;
    else
      FOUND := FALSE;
    end if;

  end SCAN_QUOTED;
  pragma PAGE;
  function IS_ENCLOSED(B : in CHARACTER;
                       E : in CHARACTER;
                       T : in SCANNER) return BOOLEAN is

  begin

    if ENCLOSED_STRING(B, E, T) = 0 then
      return FALSE;
    else
      return TRUE;
    end if;

  end IS_ENCLOSED;

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

  procedure SCAN_ENCLOSED(B      : in CHARACTER;
                          E      : in CHARACTER;
                          T      : in SCANNER;
                          FOUND  : out BOOLEAN;
                          RESULT : out STRING_TYPE;
                          SKIP   : in BOOLEAN := FALSE) is

    COUNT : NATURAL;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    COUNT := ENCLOSED_STRING(B, E, T);
    if COUNT /= 0 then
      COUNT := COUNT - 2;
      T.INDEX := T.INDEX + 1;
      if COUNT /= 0 then
        STRING_PKG.MARK;
        RESULT := STRING_PKG.MAKE_PERSISTENT(STRING_PKG.SUBSTR(T.TEXT, T.INDEX,
          POSITIVE(COUNT)));
        STRING_PKG.RELEASE;
      else
        RESULT := STRING_PKG.MAKE_PERSISTENT("");
      end if;
      T.INDEX := T.INDEX + COUNT + 1;
      FOUND := TRUE;
    else
      FOUND := FALSE;
    end if;

  end SCAN_ENCLOSED;
  pragma PAGE;
  function IS_SEQUENCE(CHARS : in STRING_TYPE;
                       T     : in SCANNER) return BOOLEAN is

  begin

    return IS_ANY(T, STRING_PKG.VALUE(CHARS));

  end IS_SEQUENCE;

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

  function IS_SEQUENCE(CHARS : in STRING;
                       T     : in SCANNER) return BOOLEAN is

  begin

    return IS_ANY(T, CHARS);

  end IS_SEQUENCE;

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

  procedure SCAN_SEQUENCE(CHARS  : in STRING_TYPE;
                          T      : in SCANNER;
                          FOUND  : out BOOLEAN;
                          RESULT : out STRING_TYPE;
                          SKIP   : in BOOLEAN := FALSE) is

    I     : POSITIVE;
    COUNT : INTEGER := 0;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    if not IS_VALID(T) then
      FOUND := FALSE;
      return;
    end if;
    I := T.INDEX;
    while IS_ANY(T, VALUE(CHARS)) loop
      FORWARD(T);
      COUNT := COUNT + 1;
    end loop;
    if COUNT /= 0 then
      STRING_PKG.MARK;
      RESULT := STRING_PKG.MAKE_PERSISTENT(STRING_PKG.SUBSTR(T.TEXT, I, POSITIVE
        (COUNT)));
      FOUND := TRUE;
      STRING_PKG.RELEASE;
    else
      FOUND := FALSE;
    end if;

  end SCAN_SEQUENCE;

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

  procedure SCAN_SEQUENCE(CHARS  : in STRING;
                          T      : in SCANNER;
                          FOUND  : out BOOLEAN;
                          RESULT : out STRING_TYPE;
                          SKIP   : in BOOLEAN := FALSE) is

  begin

    STRING_PKG.MARK;
    SCAN_SEQUENCE(STRING_PKG.CREATE(CHARS), T, FOUND, RESULT, SKIP);
    STRING_PKG.RELEASE;

  end SCAN_SEQUENCE;
  pragma PAGE;
  function IS_NOT_SEQUENCE(CHARS : in STRING_TYPE;
                           T     : in SCANNER) return BOOLEAN is

    N : NATURAL;

  begin

    if not IS_VALID(T) then
      return FALSE;
    end if;
    STRING_PKG.MARK;
    N := STRING_PKG.MATCH_ANY(T.TEXT, CHARS, T.INDEX);
    if N = T.INDEX then
      N := 0;
    end if;
    STRING_PKG.RELEASE;
    return N /= 0;

  end IS_NOT_SEQUENCE;

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

  function IS_NOT_SEQUENCE(CHARS : in STRING;
                           T     : in SCANNER) return BOOLEAN is

  begin

    return IS_NOT_SEQUENCE(STRING_PKG.CREATE(CHARS), T);

  end IS_NOT_SEQUENCE;

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

  procedure SCAN_NOT_SEQUENCE(CHARS  : in STRING;
                              T      : in SCANNER;
                              FOUND  : out BOOLEAN;
                              RESULT : out STRING_TYPE;
                              SKIP   : in BOOLEAN := FALSE) is

    N : NATURAL;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    if IS_NOT_SEQUENCE(CHARS, T) then
      STRING_PKG.MARK;
      N := STRING_PKG.MATCH_ANY(T.TEXT, CHARS, T.INDEX);
      RESULT := STRING_PKG.MAKE_PERSISTENT(STRING_PKG.SUBSTR(T.TEXT, T.INDEX, N
        - T.INDEX));
      T.INDEX := N;
      FOUND := TRUE;
      STRING_PKG.RELEASE;
    else
      FOUND := FALSE;
    end if;

  end SCAN_NOT_SEQUENCE;

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

  procedure SCAN_NOT_SEQUENCE(CHARS  : in STRING_TYPE;
                              T      : in SCANNER;
                              FOUND  : out BOOLEAN;
                              RESULT : out STRING_TYPE;
                              SKIP   : in BOOLEAN := FALSE) is

  begin

    SCAN_NOT_SEQUENCE(STRING_PKG.VALUE(CHARS), T, FOUND, RESULT, SKIP);

  end SCAN_NOT_SEQUENCE;
  pragma PAGE;
  function IS_LITERAL(CHARS : in STRING_TYPE;
                      T     : in SCANNER) return BOOLEAN is

    N : NATURAL;

  begin

    if not IS_VALID(T) then
      return FALSE;
    end if;
    STRING_PKG.MARK;
    N := STRING_PKG.MATCH_S(T.TEXT, CHARS, T.INDEX);
    if N /= T.INDEX then
      N := 0;
    end if;
    STRING_PKG.RELEASE;
    return N /= 0;

  end IS_LITERAL;

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

  function IS_LITERAL(CHARS : in STRING;
                      T     : in SCANNER) return BOOLEAN is

    FOUND : BOOLEAN;

  begin

    STRING_PKG.MARK;
    FOUND := IS_LITERAL(STRING_PKG.CREATE(CHARS), T);
    STRING_PKG.RELEASE;
    return FOUND;

  end IS_LITERAL;

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

  procedure SCAN_LITERAL(CHARS : in STRING_TYPE;
                         T     : in SCANNER;
                         FOUND : out BOOLEAN;
                         SKIP  : in BOOLEAN := FALSE) is

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    if IS_LITERAL(CHARS, T) then
      T.INDEX := T.INDEX + STRING_PKG.LENGTH(CHARS);
      FOUND := TRUE;
    else
      FOUND := FALSE;
    end if;

  end SCAN_LITERAL;

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

  procedure SCAN_LITERAL(CHARS : in STRING;
                         T     : in SCANNER;
                         FOUND : out BOOLEAN;
                         SKIP  : in BOOLEAN := FALSE) is

  begin

    STRING_PKG.MARK;
    SCAN_LITERAL(STRING_PKG.CREATE(CHARS), T, FOUND, SKIP);
    STRING_PKG.RELEASE;

  end SCAN_LITERAL;
  pragma PAGE;
  function IS_NOT_LITERAL(CHARS : in STRING;
                          T     : in SCANNER) return BOOLEAN is

    N : NATURAL;

  begin

    if not IS_VALID(T) then
      return FALSE;
    end if;
    STRING_PKG.MARK;
    N := STRING_PKG.MATCH_S(T.TEXT, CHARS, T.INDEX);
    if N = T.INDEX then
      N := 0;
    end if;
    STRING_PKG.RELEASE;
    return N /= 0;

  end IS_NOT_LITERAL;

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

  function IS_NOT_LITERAL(CHARS : in STRING_TYPE;
                          T     : in SCANNER) return BOOLEAN is

  begin

    if not MORE(T) then
      return FALSE;
    end if;
    return IS_NOT_LITERAL(STRING_PKG.VALUE(CHARS), T);

  end IS_NOT_LITERAL;

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

  procedure SCAN_NOT_LITERAL(CHARS  : in STRING;
                             T      : in SCANNER;
                             FOUND  : out BOOLEAN;
                             RESULT : out STRING_TYPE;
                             SKIP   : in BOOLEAN := FALSE) is

    N : NATURAL;

  begin

    if SKIP then
      SKIP_SPACE(T);
    end if;
    if IS_NOT_LITERAL(CHARS, T) then
      STRING_PKG.MARK;
      N := STRING_PKG.MATCH_S(T.TEXT, CHARS, T.INDEX);
      RESULT := STRING_PKG.MAKE_PERSISTENT(STRING_PKG.SUBSTR(T.TEXT, T.INDEX, N
        - T.INDEX));
      T.INDEX := N;
      FOUND := TRUE;
      STRING_PKG.RELEASE;
    else
      FOUND := FALSE;
      return;
    end if;

  end SCAN_NOT_LITERAL;

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

  procedure SCAN_NOT_LITERAL(CHARS  : in STRING_TYPE;
                             T      : in SCANNER;
                             FOUND  : out BOOLEAN;
                             RESULT : out STRING_TYPE;
                             SKIP   : in BOOLEAN := FALSE) is

  begin

    SCAN_NOT_LITERAL(STRING_PKG.VALUE(CHARS), T, FOUND, RESULT, SKIP);

  end SCAN_NOT_LITERAL;


end STRING_SCANNER;
pragma PAGE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--sort.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

generic
  type ITEM_TYPE is private;
  --| Component type of array to be sorted.

  with function "<="(X, Y : in ITEM_TYPE) return BOOLEAN;
  --| Required to totally order item_type;

  type INDEX_TYPE is (<>);
  --| Index type of array to be sorted.

  type SEQUENCE is array(INDEX_TYPE range <>) of ITEM_TYPE;
  --| Type of array to be sorted.

procedure HEAP_SORT(S : in out SEQUENCE);
--| Overview:
--| Heap sort is an O(n lg n) guaranteed time sorting algorithm.
--| This procedure provides heap sort for arrays of arbitrary index
--| and component type.

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

--| Effects:
--|     Let s1 and s2 denote the value of s before and after an
--| invocation of heap_sort.  Then s1 and s2 have the following
--| properties:
--|   1. For i,j in s'range, i <= j implies that s2(i) <= s2(j).
--|   2. s2(s'first) through s2(s'last) is a permutation of
--|      s1(s'first) through s1(s'last).
--|
--| Requires:
--|     <= must form a total order over item_type.
--|
--| Algorithm:
--|     The algorithm is described in Knuth, vol 3, and Aho et al,
--| The Design and Analysis of Computer Algorithms.
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--sort.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

procedure HEAP_SORT(S : in out SEQUENCE) is

--| Notes:
--| Implementation is taken directly from The Design and Analysis of
--| Computer Algorithms, by Aho, Hopcroft and Ullman.  The only change
--| of any significance is code to map between the index_type subrange
--| defined by the sequence bounds and the subrange, 1..s'length, of
--| the integers.  This mapping is necessary because the algorithm
--| represents binary trees as an array such that the sons of s(i) are
--| located at s(2i) and s(2i + 1).

  subtype INT_RANGE is INTEGER range 1 .. S'LENGTH;

  function INT_RANGE_TO_INDEX(I : in INT_RANGE) return INDEX_TYPE is
  --| Effects:
  --| Map 1 --> s'first, ..., s'length --> s'last.
  begin
    return INDEX_TYPE'VAL(I + INDEX_TYPE'POS(S'FIRST) - 1);
  end INT_RANGE_TO_INDEX;

  function INDEX_TO_INT_RANGE(I : in INDEX_TYPE) return INT_RANGE is
  --| Effects:
  --| Map s'first --> 1, ..., s'last --> s'length.
  begin
    return (INDEX_TYPE'POS(I) - INDEX_TYPE'POS(S'FIRST) + 1);
  end INDEX_TO_INT_RANGE;

  procedure SWAP(I, J : in INDEX_TYPE) is
  --| Effects:
  --| Exchange the values of s(i) and s(j).

    T : ITEM_TYPE := S(I);
  begin
    S(I) := S(J);
    S(J) := T;
  end SWAP;

  procedure HEAPIFY(ROOT, BOUNDARY : in INDEX_TYPE) is
  --| Effects:
  --|     Give s(root..boundary) the heap property:
  --|        s(i) > s(2i) and s(i) > s(2i + 1).
  --| (provided that 2i, 2i + 1 are less than boundary.  Note that
  --| the property is being expressed in terms of the integer range,
  --| 1..s'last.)
  --| Requires:
  --|     s(i + 1, ..., boundary) already has the heap property.

    MAX                : INDEX_TYPE := ROOT;
    BOUNDARY_POSITION  : INT_RANGE := INDEX_TO_INT_RANGE(BOUNDARY);
    LEFT_SON_POSITION  : INTEGER := 2*INDEX_TO_INT_RANGE(ROOT);
    RIGHT_SON_POSITION : INTEGER := 2*INDEX_TO_INT_RANGE(ROOT) + 1;
    LEFT_SON           : INDEX_TYPE;
    RIGHT_SON          : INDEX_TYPE;
  begin

    -- If root is not a leaf, and if a son of root contains a larger
    -- value than the root value, then let max be the son with the
    -- largest value.
    if LEFT_SON_POSITION <= BOUNDARY_POSITION then

      -- has left son?
      LEFT_SON := INT_RANGE_TO_INDEX(LEFT_SON_POSITION);
      if S(ROOT) <= S(LEFT_SON) then
        MAX := LEFT_SON;
      end if;
    else
      return;

    -- no sons, meets heap property trivially.
    end if;

    if RIGHT_SON_POSITION <= BOUNDARY_POSITION then

      -- has right son?
      RIGHT_SON := INT_RANGE_TO_INDEX(RIGHT_SON_POSITION);
      if S(MAX) <= S(RIGHT_SON) then

        -- biggest so far?
        MAX := RIGHT_SON;
      end if;
    end if;

    if MAX /= ROOT then

      -- If a larger son found then
      SWAP(ROOT, MAX);

      -- carry out exchange and
      HEAPIFY(MAX, BOUNDARY);

    -- propagate heap propery to subtree
    end if;
  end HEAPIFY;

  procedure BUILD_HEAP is
  --| Effects:
  --| Give all of s the heap property.

    MID : INDEX_TYPE := INT_RANGE_TO_INDEX(INDEX_TO_INT_RANGE(S'LAST)/2);
  begin
    for I in reverse S'FIRST .. MID loop
      HEAPIFY(I, S'LAST);
    end loop;
  end BUILD_HEAP;

begin

  -- Make s into a heap.  Then, repeat until sorted:
  --   1. exchange the largest element, located at the root, with the
  --      last element that has not yet been ordered, and
  --   2. reheapify the unsorted portion of s.
  BUILD_HEAP;
  for I in reverse INDEX_TYPE'SUCC(S'FIRST) .. S'LAST loop
    SWAP(S'FIRST, I);
    HEAPIFY(S'FIRST, INDEX_TYPE'PRED(I));
  end loop;

exception
  when CONSTRAINT_ERROR =>

    -- On succ(s'first) for array of length <= 1.
    return;

-- Such arrays are trivially sorted.
end HEAP_SORT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--simplepo.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
with STRING_PKG;

package SIMPLE_PAGINATED_OUTPUT is

--| Create paginated text files with user defined heading,
--| footing, and page length.

--| Overview:

--| The Paginated_Output package is used to create paginated
--| output files.  When such a file is created, the page length,
--| and page header length are specified. Several operations are
--| provided for setting the header text which will appear
--| on each output page.  The following escapes can be used in the
--| header text:
--|-
--|     ~f    the current external file name
--|     ~p    the current page number
--|     ~d    the current date (eg. 03/15/85)
--|     ~c    the current calendar date (eg. March 15, 1985)
--|     ~t    the current time (eg. 04:53:32)
--|+
--| Case is not significant after the tilde (~).  If the tilde
--| is followed by any other character, only the second character
--| is printed unless the line ends with a tilde in which case
--| the line will be terminated one character before the tilde.
--|
--| The header is printed just before the first line of a page
--| is output.  Thus, if a paginated file is opened and closed without
--| any calls to print a line in between, the output is a null file.
--|
--| This package knows nothing about (and places no limits on)
--| the length or contents of each line sent to the output file.
--| In particular, if the line contains ASCII control codes
--| for new line, form feed, and/or vertical tab the output file
--| will not be properly paginated.  Normal usage is to call
--| Create_Paginated_File, call Set_Header, call Put and Put_Line
--| repeatedly to output a sequence of lines of text, and finally
--| call Close_Paginated_File to complete the last page and close
--| the file.

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

-- Exceptions --

  FILE_ALREADY_OPEN : exception;  --| Raised if create is attempted
  --| for an already existing file.
  FILE_ERROR        : exception;  --| Raised if unable to open a file
  --| other than File_Already_Open
  FILE_NOT_OPEN     : exception;  --| Raised if close is attempted
  --| for an unopened file.
  INVALID_COUNT     : exception;  --| Raised if a requested count
  --| can not be serviced.
  INVALID_FILE      : exception;  --| Raised if output is attempted
  --| with an invalid file handle.
  OUTPUT_ERROR      : exception;  --| Raised if error is encountered
  --| during an output operation.
  PAGE_LAYOUT_ERROR : exception;  --| Raised if page specification
  --| is invalid.
  PAGE_OVERFLOW     : exception;  --| Raised if specified reserve
  --| value exceeds the page size.
  TEXT_OVERFLOW     : exception;  --| Raised if header text
  --| overflows area.
  TEXT_UNDERFLOW    : exception;  --| Raised if header text
  --| underflows area.

  -- Types --

  subtype HOST_FILE_NAME is STRING;
  --| String of valid characters for
  --| external file name.

  type VARIABLE_STRING_ARRAY is  --| Array of variable length strings
  array(POSITIVE range <>) of STRING_PKG.STRING_TYPE;

  type PAGINATED_FILE_HANDLE is  --| Handle to be passed around in a
  limited private;  --| program that uses paginated output.


  -- Operations --

  procedure CREATE_PAGINATED_FILE( --| Create a paginated output file
  --| and return the file handle.
                                  FILE_NAME   : in HOST_FILE_NAME := "";
                                  --| The name of the file to be created.
                                  FILE_HANDLE : in out PAGINATED_FILE_HANDLE;
                                  --| Handle to be used for subsequent
                                  --| operations
                                  PAGE_SIZE   : in INTEGER := 60;
                                  --| The number of lines per page
                                  HEADER_SIZE : in INTEGER := 6
                                  --| The number of header text lines
                                  );

  --| Raises:
  --| File_Already_Open, File_Error, Page_Layout_Error

  --| Requires:
  --| File_Name is an valid external name of the file to be created (If
  --| it is omitted, the current output file is selected).  Page_Size,
  --| and Header_Size are optional values (if omitted 60, and 6 are
  --| respectively) to be used for the page layout of the file to be
  --| created.  Page_Size specifies the total number of lines per page
  --| (including the areas for the header).
  --| Header_Size specifies the number of lines to be reserved for the
  --| header area.

  --| Effects:
  --| Creates a new paginated file with Page_Size number of lines
  --| per page and Header_Size and number of lines reserved for the header.
  --| Access to the paginated file control structure Paginated_File_Handle
  --| is returned for use in subsequent operations.

  --| Errors:
  --| If any of the page layout values are negative, the exception
  --| Page_Layout_Error is raised.  Also if the total number of lines
  --| in the header plus one exceeds Page_Size, the same
  --| exception is raised.  This guarantees that at least one line of
  --| text can appear on each output page.
  --| If the output file with the specified File_Name is already open
  --| File_Already_Open exception is raised.
  --| If the file cannot be opened for any other reason, the exception
  --| File_Error is raise.

  --| N/A: Modifies

  procedure SET_PAGE_LAYOUT( --| Set the page layout for the
  --| paginated file.
                            FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                            --| The paginated file to be set
                            --| with the given page layout
                            PAGE_SIZE   : in INTEGER;
                                --| The number of lines per page
                            HEADER_SIZE : in INTEGER
                                --| The number of header text lines
                            );

  --| Raises:
  --| Page_Layout_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Page_Size specifies the total
  --| number of lines per page (including the area for header).
  --| Header_Size and specifies the number of lines to be
  --| reserved for the header area.

  --| Effects:
  --| A paginated file is set with Page_Size number of lines per
  --| page and Header_Size number of lines reserved for the
  --| header.A page eject is performed if not at the top of the page before
  --| the new page layout values are set.

  --| Errors:
  --| If any of the page layout values are negative, the exception
  --| Page_Layout_Error is raised.  Also if the total number of lines
  --| in the header plus one exceeds Page_Size, the exception
  --| Page_Layout_Error is raised.

  --| N/A: Modifies

  procedure SET_HEADER( --| Set the header text on a paginated
  --| output file.
                       FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       --| Paginated file to be set
                       --| with the header text
                       HEADER_TEXT : in VARIABLE_STRING_ARRAY
                       --| Sequence of header lines
                       );

  --| Raises:
  --| Invalid_File, Text_Overflow

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Header_Text is the array
  --| of text to be used for the page header.

  --| Effects:
  --| The header text of File_Handle is set to Header_Text.  Note that
  --| the replaced header text will not be printed until the next
  --| page of the output.

  --| Errors:
  --| If File_Handle is not a valid access to a paginated file control
  --| structure exception Invalid_File is raised.
  --| Specification of a header text array which implies a greater
  --| number of lines than reserved for by Create_Paginated_File or
  --| Set_Page_Layout results in Text_Overflow exception to be raised.

  --| N/A: Modifies

  procedure SET_HEADER( --| Replace a line of header text on a
  --| paginated output file.
                       FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       --| Paginated file to be set
                       --| with the header text
                       HEADER_LINE : in INTEGER;
                                --| Line number of header to be replaced
                       HEADER_TEXT : in STRING --| Header line to replace
                       );

  --| Raises:
  --| Invalid_File, Text_Overflow, Text_Underflow

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Header_Text is the text
  --| to replace the existing header line at Header_Line.

  --| Effects:
  --| The header text of File_Handle at Header_Line is set to Header_Text.
  --| Note that the replaced header text will not be printed until
  --| the next page of the output.

  --| Errors:
  --| If File_Handle is not a valid access to a paginated file control
  --| structure exception Invalid_File is raised.
  --| Specification of Header_Line greater than the number of header
  --| lines reserved by Create_Paginated_File or Set_Page_Layout
  --| results in Text_Overflow exception to be raised.
  --| If the specified Header_Line is less than or equal to 0 then
  --| Text_Underflow exception is raised.

  --| N/A: Modifies

  procedure SET_HEADER( --| Replace a line of header text on a
  --| paginated output file.
                       FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       --| Paginated file to be set
                       --| with the header text
                       HEADER_LINE : in INTEGER;
                                --| Line number of header to be replaced
                       HEADER_TEXT : in STRING_PKG.STRING_TYPE
                       --| Header line to replace
                       );

  --| Raises:
  --| Invalid_File, Text_Overflow, Text_Underflow

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Header_Text is the text
  --| to replace the existing header line at Header_Line.

  --| Effects:
  --| The header text of File_Handle at Header_Line is set to Header_Text.
  --| Note that the replaced header text will not be printed until
  --| the next page of the output.

  --| Errors:
  --| If File_Handle is not a valid access to a paginated file control
  --| structure exception Invalid_File is raised.
  --| Specification of Header_Line greater than the number of header
  --| lines reserved by Create_Paginated_File or Set_Page_Layout
  --| results in Text_Overflow exception to be raised.
  --| If the specified Header_Line is less than or equal to 0 then
  --| Text_Underflow exception is raised.

  --| N/A: Modifies

  procedure CLOSE_PAGINATED_FILE( --| Complete the last page and close
  --| the paginated file.
                                 FILE_HANDLE : in out PAGINATED_FILE_HANDLE
                                 --| The paginated file to be closed
                                 );

  --| Raises:
  --| Invalid_File, File_Not_Open

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.

  --| Effects:
  --| Completes the last page of output and closes the output file.

  --| Errors:
  --| If File_Handle is not a valid Paginated_File_Handle, the exception
  --| Invalid_File is raised.  If an error occurs in closing the file,
  --| File_Not_Open is raised.

  --| N/A: Modifies

  procedure PUT( --| Output a line on a paginated file
                FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                --| The paginated file to
                --| output the text
                TEXT        : in VARIABLE_STRING_ARRAY
                --| The text to be output.
                );

  --| Raises:
  --| Invalid_File, Output_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Text is a string of
  --| characters to be written to the paginated output file.

  --| Effects:
  --| Outputs Text of text to File_Handle.  If Text is the first string of the
  --| first line to be printed on a page, the page header is printed before
  --| printing the text.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If an error
  --| occurs during output, Output_Error is raised.

  --| N/A: Modifies

  procedure PUT( --| Output a line on a paginated file
                FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                --| The paginated file to
                --| output the text
                TEXT        : in STRING_PKG.STRING_TYPE
                --| The text to be output.
                );

  --| Raises:
  --| Invalid_File, Output_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Text is a string of
  --| characters to be written to the paginated output file.

  --| Effects:
  --| Outputs Text of text to File_Handle.  If Text is the first string of the
  --| first line to be printed on a page, the page header is printed before
  --| printing the text.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If an error
  --| occurs during output, Output_Error is raised.

  --| N/A: Modifies

  procedure PUT( --| Output a line on a paginated file
                FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                --| The paginated file to
                --| output the text
                TEXT        : in STRING --| The text to be output.
                );

  --| Raises:
  --| Invalid_File, Output_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Text is a string of
  --| characters to be written to the paginated output file.

  --| Effects:
  --| Outputs Text of text to File_Handle.  If Text is the first string of the
  --| first line to be printed on a page, the page header is printed before
  --| printing the string.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If an error
  --| occurs during output, Output_Error is raised.

  --| N/A: Modifies

  procedure PUT( --| Output a line on a paginated file
                FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                --| The paginated file to
                --| output the text
                TEXT        : in CHARACTER --| The text to be output.
                );

  --| Raises:
  --| Invalid_File, Output_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Text is a the characters to be
  --| written to the paginated output file.

  --| Effects:
--| Outputs Text of text to File_Handle.  If Text is the first character of the
  --| first line to be printed on a page, the page header is printed before
  --| printing the string.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If an error
  --| occurs during output, Output_Error is raised.

  --| N/A: Modifies

  procedure SPACE( --| Output a specified number of spaces
                  FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                  --| The paginated file to output the line
                  COUNT       : in INTEGER --| Number of spaces
                  );

  --| Raises:
  --| Invalid_File, Output_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Count is the number of horizontal
  --| spaces to be output.

  --| Effects:
  --| Output Count number of blanks to File_Handle.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If an error
  --| occurs during output, Output_Error is raised.

  --| N/A: Modifies

  procedure PUT_LINE( --| Output a line on a paginated file
                     FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     --| The paginated file to output the line
                     TEXT_LINE   : in VARIABLE_STRING_ARRAY
                     --| The line to be output.
                     );

  --| Raises:
  --| Invalid_File, Output_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Text_Line is a string of
  --| characters to be written to the paginated output file.

  --| Effects:
  --| Outputs Text_Line of text to File_Handle.  If Text_Line is the
  --| first line to be printed on a page, the page header is printed
  --| before the line.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If an error
  --| occurs during output, Output_Error is raised.

  --| N/A: Modifies

  procedure PUT_LINE( --| Output a line on a paginated file
                     FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     --| The paginated file to
                     --| output the line
                     TEXT_LINE   : in STRING_PKG.STRING_TYPE
                     --| The line to be output.
                     );

  --| Raises:
  --| Invalid_File, Output_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Text_Line is a string of
  --| characters to be written to the paginated output file.

  --| Effects:
  --| Outputs Text_Line of text to File_Handle.  If Text_Line is the
  --| first line to be printed on a page, the page header is printed
  --| before the line.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If an error
  --| occurs during output, Output_Error is raised.

  --| N/A: Modifies

  procedure PUT_LINE( --| Output a line on a paginated file
                     FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     --| The paginated file to
                     --| output the line
                     TEXT_LINE   : in STRING --| The line to be output.
                     );

  --| Raises:
  --| Invalid_File, Output_Error

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Text_Line is a string of
  --| characters to be written to the paginated output file.

  --| Effects:
  --| Outputs Text_Line of text to File_Handle.  If Text_Line is the
  --| first line to be printed on a page, the page header is printed
  --| before the line.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If an error
  --| occurs during output, Output_Error is raised.

  --| N/A: Modifies

  procedure SPACE_LINE( --| Output one or more spaces on a
  --| paginated file
                       FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       --| The paginated file to
                       --| output spaces
                       COUNT       : in INTEGER := 1
                       --| The number of spaces.
                       );

  --| Raises:
  --| Invalid_File, Output_Error, Invalid_Count

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Count is the number of
  --| spaces to be output to File_Handle.  If Count is omitted, 1 is
  --| assumed.

  --| Effects:
  --| Count number of line terminators are output to File_Handle.
  --| If Count is greater than the number of lines remaining on
  --| the page, a page terminator, and the page header
  --| are written before the remainder of the spaces are output.
  --| If the specified Count is less than equal to 0, no operation
  --| takes place.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If the requested space
  --| count is greater than a predetermined amount, Invalid_Count
  --| is raised.  If an error occurs during output, Output_Error
  --| is raised.

  --| N/A: Modifies

  procedure SKIP_LINE( --| Output one or more spaces on a
  --| paginated file
                      FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                      --| The paginated file to
                      --| output skips
                      COUNT       : in INTEGER := 1
                      --| The number of spaces.
                      );

  --| Raises:
  --| Invalid_File, Output_Error, Invalid_Count

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Count is the number of
  --| spaces to be output to File_Handle.  If Count is omitted, 1 is
  --| assumed.

  --| Effects:
  --| Count number of line terminators are output to File_Handle.
  --| If Count is greater than the number of lines remaining on
  --| the page, a page terminator is
  --| output and the remainder of the skips are NOT output.
  --| If the specified Count is less than equal to 0, no operation
  --| takes place.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If the requested skip
  --| count is greater than a predetermined amount, Invalid_Count
  --| is raised.  If an error occurs during output, Output_Error
  --| is raised.

  --| N/A: Modifies

  procedure PUT_PAGE( --| Output one or more page ejects
  --| on a paginated file
                     FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     --| The paginated file to
                     --| output page ejects
                     COUNT       : in INTEGER := 1
                     --| The number of pages.
                     );

  --| Raises:
  --| Invalid_File, Output_Error, Invalid_Count

  --| Requires:
  --| File_Handle is the access to the paginated file control structure
  --| returned by Create_Paginated_File.  Count is the number of
  --| pages to be output to File_Handle.  If Count is omitted, 1 is
  --| assumed.

  --| Effects:
  --| Outputs Count number of page ejects. The page header is printed as
--| appropriate.  If the specified Count is less than equal to 0, no operation
  --| takes place.

  --| Errors:
  --| If File_Handle is not a valid, open Paginated_File_Handle,
  --| the exception Invalid_File is raised.  If the requested page
  --| count is greater than a predetermined amount, Invalid_Count
  --| is raised.  If an error occurs during output, Output_Error
  --| is raised.

  --| N/A: Modifies
private

  type VARIABLE_STRING_ARRAY_HANDLE is access VARIABLE_STRING_ARRAY;
  --| Handle to array of variable length
  --| strings

  type PAGINATED_FILE_STRUCTURE;
  --| Data structure to store state of
  --| the output file.

  type PAGINATED_FILE_HANDLE is access PAGINATED_FILE_STRUCTURE;
  --| Handle to be passed around in a
  --| program that uses paginated_output.

  type PAGINATED_FILE_STRUCTURE is
  --| a structure to store state of
    record --| the output file.
      FILE_NAME        : STRING_PKG.STRING_TYPE;
      --| External file name
      FILE_REFERENCE   : TEXT_IO.FILE_TYPE;
      --| External file reference
      PAGE_SIZE        : INTEGER;
      --| The number of lines per page
      MAXIMUM_LINE     : INTEGER;
      --| The maximum number of text lines
      CURRENT_CALENDAR : STRING_PKG.STRING_TYPE;
      --| Creation date (eg. March 15, 1985)
      CURRENT_DATE     : STRING(1 .. 8);
      --| Creation date (eg. 03/15/85)
      CURRENT_TIME     : STRING(1 .. 8);
      --| Creation time (eg. 15:24:07)
      CURRENT_PAGE     : INTEGER := 0;
      --| The number of lines per page
      CURRENT_LINE     : INTEGER := 0;
      --| The number of lines used
      HEADER_SIZE      : INTEGER;
      --| Number of lines of header text
      PAGE_HEADER      : VARIABLE_STRING_ARRAY_HANDLE := null;
      --| Access to page header text
    end record;

end SIMPLE_PAGINATED_OUTPUT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--simplepo.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO; use TEXT_IO;
with CALENDAR; use CALENDAR;
with STRING_PKG; use STRING_PKG;
with UNCHECKED_DEALLOCATION;


package body SIMPLE_PAGINATED_OUTPUT is

  package INT_IO is
    new INTEGER_IO(INTEGER);

  MONTH_NAME : constant VARIABLE_STRING_ARRAY(1 .. 12) := (1 => CREATE("January"
    ), 2 => CREATE("February"), 3 => CREATE("March"), 4 => CREATE("April"), 5
    => CREATE("May"), 6 => CREATE("June"), 7 => CREATE("July"), 8 => CREATE(
    "August"), 9 => CREATE("September"), 10 => CREATE("October"), 11 => CREATE(
    "November"), 12 => CREATE("December"));

  function CONVERT(INPUT_NUMBER : in INTEGER;
                   DIGIT        : in INTEGER := 0) return STRING is

  --|-Algorithm:
  --| If integer value is negative or greater than 99
  --|    then return null text
  --| If input value is less than 10 (ie. single decimal digit)
  --|    then concatenate 0 and character equivalent of the given value
  --|    else convert value to character equivalent
  --| Return converted text
  --|+

    TEMP_TEXT : STRING(1 .. 16);
    INDEX     : INTEGER;

  begin

    if DIGIT > TEMP_TEXT'LAST then
      return "";
    end if;
    INT_IO.PUT(TEMP_TEXT, INPUT_NUMBER);
    if DIGIT <= 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 - DIGIT + 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;
  pragma PAGE;
  procedure SET_DATE_TIME(FILE_HANDLE : in PAGINATED_FILE_HANDLE) is

  --|-Algorithm:
  --| Get the current system date/time
  --| Separate date/time into appropriate components
  --| Calculate in terms of hours, minutes, and seconds
  --| Set current date/time in the file structure
  --| Set the current date in "English" (eg. January 1, 1985)
  --|    in the file structure
  --| Exit
  --|+

    CLOCK_VALUE : CALENDAR.TIME;
    YEAR        : CALENDAR.YEAR_NUMBER;
    MONTH       : CALENDAR.MONTH_NUMBER;
    DAY         : CALENDAR.DAY_NUMBER;
    DURATION    : CALENDAR.DAY_DURATION;

  begin

    CLOCK_VALUE := CALENDAR.CLOCK;
    CALENDAR.SPLIT(CLOCK_VALUE, YEAR, MONTH, DAY, DURATION);
    FILE_HANDLE.CURRENT_DATE := CONVERT(INTEGER(MONTH), 2) & "/" & CONVERT(
      INTEGER(DAY), 2) & "/" & CONVERT(INTEGER(YEAR mod 100), 2);
    FILE_HANDLE.CURRENT_TIME := CONVERT(INTEGER(DURATION)/(60*60), 2) & ":" &
      CONVERT((INTEGER(DURATION) mod (60*60))/60, 2) & ":" & CONVERT(INTEGER(
      DURATION) mod 60, 2);
    STRING_PKG.MARK;
    FILE_HANDLE.CURRENT_CALENDAR := STRING_PKG.MAKE_PERSISTENT(MONTH_NAME(
      INTEGER(MONTH)) & INTEGER'IMAGE(DAY) & "," & INTEGER'IMAGE(YEAR));
    STRING_PKG.RELEASE;

  end SET_DATE_TIME;
  pragma PAGE;
  procedure CHECK_VALID(FILE_HANDLE : in PAGINATED_FILE_HANDLE) is

  --|-Algorithm:
  --| If handle is null or external file name is null
  --|    then raise an error
  --| Exit
  --|+

  begin

    if FILE_HANDLE = null then
      raise INVALID_FILE;
    end if;

  end CHECK_VALID;
  pragma PAGE;
  procedure CLEAR_TEXT(TEXT_HANDLE : in VARIABLE_STRING_ARRAY_HANDLE) is

  --|-Algorithm:
  --| If valid access to text array
  --|    then return text array storage to the heap (access set to null)
  --| Exit
  --|+

  begin

    if TEXT_HANDLE /= null then
      for I in TEXT_HANDLE'range loop
        STRING_PKG.FLUSH(TEXT_HANDLE(I));
      end loop;
    end if;

  end CLEAR_TEXT;
  pragma PAGE;
  procedure SET_TEXT(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     TEXT_STRING : in VARIABLE_STRING_ARRAY) is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| If requested text array is too large
  --|    then raise an error
  --| Clear old text array
  --| Set new text array with specified justification (top or bottom)
  --| in the area as specified
  --| Exit
  --|+

    TEXT_INDEX : INTEGER;

  begin
    CHECK_VALID(FILE_HANDLE);
    TEXT_INDEX := 1;
    if FILE_HANDLE.HEADER_SIZE < TEXT_STRING'LAST then
      raise TEXT_OVERFLOW;
    end if;
    CLEAR_TEXT(FILE_HANDLE.PAGE_HEADER);
    for I in TEXT_STRING'range loop
      FILE_HANDLE.PAGE_HEADER(TEXT_INDEX) := STRING_PKG.MAKE_PERSISTENT(
        TEXT_STRING(I));
      TEXT_INDEX := TEXT_INDEX + 1;
    end loop;
  end SET_TEXT;
  pragma PAGE;
  function TILDE_SUBSTITUTE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                            INPUT_TEXT  : in STRING_PKG.STRING_TYPE) return
    STRING is

  --|-Algorithm:
  --| Set the length of the text in question
  --| Clear the result string to null
  --| Loop until all input characters are processed
  --|    Fetch one character
  --|    If the character is a tilde (~)
  --|       then bump input index and if past the end exit the loop
  --|            Fetch the next character
  --|            Based on this character substitute appropriately
  --|        else add this to the output
  --|     Bump input index and loop
  --| Return the output (substituted) string
  --| Exit
  --|+

    OUTPUT_TEXT : STRING_PKG.STRING_TYPE;
    S_STR       : STRING_PKG.STRING_TYPE;
    LETTER      : CHARACTER;
    INDEX       : NATURAL;

  begin

    S_STR := INPUT_TEXT;
    loop
      INDEX := STRING_PKG.MATCH_C(S_STR, '~');
      if INDEX = 0 then
        OUTPUT_TEXT := OUTPUT_TEXT & S_STR;
        exit;
      end if;
      if INDEX > 1 then
        OUTPUT_TEXT := OUTPUT_TEXT & STRING_PKG.SUBSTR(S_STR, 1, INDEX - 1);
      end if;
      if INDEX < STRING_PKG.LENGTH(S_STR) then
        LETTER := STRING_PKG.FETCH(S_STR, INDEX + 1);
      else
        exit;
      end if;
      case LETTER is
        when 'f' | 'F' =>
          OUTPUT_TEXT := OUTPUT_TEXT & FILE_HANDLE.FILE_NAME;
        when 'c' | 'C' =>
          OUTPUT_TEXT := OUTPUT_TEXT & FILE_HANDLE.CURRENT_CALENDAR;
        when 'd' | 'D' =>
          OUTPUT_TEXT := OUTPUT_TEXT & FILE_HANDLE.CURRENT_DATE;
        when 't' | 'T' =>
          OUTPUT_TEXT := OUTPUT_TEXT & FILE_HANDLE.CURRENT_TIME;
        when 'p' | 'P' =>
          OUTPUT_TEXT := OUTPUT_TEXT & CONVERT(FILE_HANDLE.CURRENT_PAGE, 0);
        when others =>
          OUTPUT_TEXT := OUTPUT_TEXT & ("" & LETTER);
      end case;
      INDEX := INDEX + 2;
      if INDEX > STRING_PKG.LENGTH(S_STR) then
        exit;
      end if;
      S_STR := STRING_PKG.SUBSTR(S_STR, INDEX, STRING_PKG.LENGTH(S_STR) - INDEX
        + 1);
    end loop;

    return STRING_PKG.VALUE(OUTPUT_TEXT);

  end TILDE_SUBSTITUTE;
  pragma PAGE;
  procedure PUT_TEXT(FILE_HANDLE : in PAGINATED_FILE_HANDLE) is

  --|-Algorithm:
  --| If access to text array is null
  --|    then write appropriate number of line terminators
  --|         exit
  --| Loop over the depth of the text array
  --|    If text is null
  --|       then write line terminator
  --|       else resolve tilde substitution
  --|            write a line of text followed by a line terminator
  --| Exit
  --|+

    TEXT_SIZE : INTEGER;

  begin
    if FILE_HANDLE.HEADER_SIZE = 0 then
      return;
    end if;
    TEXT_SIZE := FILE_HANDLE.HEADER_SIZE;
    if FILE_HANDLE.PAGE_HEADER = null then
      TEXT_IO.NEW_LINE(FILE_HANDLE.FILE_REFERENCE, TEXT_IO.POSITIVE_COUNT(
        TEXT_SIZE));
      return;
    end if;
    for I in 1 .. TEXT_SIZE loop
      STRING_PKG.MARK;
      if STRING_PKG.IS_EMPTY(FILE_HANDLE.PAGE_HEADER(I)) then
        TEXT_IO.NEW_LINE(FILE_HANDLE.FILE_REFERENCE, 1);
      else
        TEXT_IO.PUT_LINE(FILE_HANDLE.FILE_REFERENCE, TILDE_SUBSTITUTE(
          FILE_HANDLE, FILE_HANDLE.PAGE_HEADER(I)));
      end if;
      STRING_PKG.RELEASE;
    end loop;

  end PUT_TEXT;
  pragma PAGE;
  procedure FREE_STRUCTURE is
    new UNCHECKED_DEALLOCATION(PAGINATED_FILE_STRUCTURE, PAGINATED_FILE_HANDLE)
      ;

  procedure ABORT_PAGINATED_OUTPUT(FILE_HANDLE : in out PAGINATED_FILE_HANDLE)
    is

  --|-Algorithm:
  --| If given handle is null
  --|    return
  --| Return header/footer text array storage to the heap
  --| Close file
  --| Return file structure storage to the heap
  --| Exit
  --|+

  begin
    if FILE_HANDLE = null then
      return;
    end if;
    CLEAR_TEXT(FILE_HANDLE.PAGE_HEADER);
    STRING_PKG.FLUSH(FILE_HANDLE.CURRENT_CALENDAR);
    STRING_PKG.FLUSH(FILE_HANDLE.FILE_NAME);
    TEXT_IO.CLOSE(FILE_HANDLE.FILE_REFERENCE);
    FREE_STRUCTURE(FILE_HANDLE);

  exception

    when TEXT_IO.STATUS_ERROR =>
      FREE_STRUCTURE(FILE_HANDLE);

  end ABORT_PAGINATED_OUTPUT;
  pragma PAGE;
  procedure LINE_FEED(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                      COUNT       : in INTEGER) is

  --|-Algorithm:
  --| If at top of the page
  --|    then write header
  --| If the request count is 0
  --|    then return
  --| If the request is greater than the remainder on the page
  --|    then write remainder number of new lines
  --|         decrement request by this amount
  --|         write footer
  --|         eject page and update page and line count
  --|         if more space needed
  --|            then recursively call self with count
  --|    else write requested number of new lines
  --|         update line count
  --| Exit
  --|+

    SKIP_COUNT : INTEGER;

  begin

    if FILE_HANDLE.CURRENT_LINE = 0 and FILE_HANDLE.PAGE_SIZE /= 0 then
      FILE_HANDLE.CURRENT_LINE := 1;
      FILE_HANDLE.CURRENT_PAGE := FILE_HANDLE.CURRENT_PAGE + 1;
      TEXT_IO.NEW_PAGE(FILE_HANDLE.FILE_REFERENCE);
      PUT_TEXT(FILE_HANDLE);
    end if;
    if COUNT <= 0 then
      return;
    end if;
    SKIP_COUNT := FILE_HANDLE.MAXIMUM_LINE - FILE_HANDLE.CURRENT_LINE + 1;
    if COUNT >= SKIP_COUNT and FILE_HANDLE.PAGE_SIZE /= 0 then
      TEXT_IO.NEW_LINE(FILE_HANDLE.FILE_REFERENCE, TEXT_IO.POSITIVE_COUNT(
        SKIP_COUNT));
      SKIP_COUNT := COUNT - SKIP_COUNT;
      FILE_HANDLE.CURRENT_LINE := 0;
      if SKIP_COUNT /= 0 then
        LINE_FEED(FILE_HANDLE, SKIP_COUNT);
      end if;
    else
      TEXT_IO.NEW_LINE(FILE_HANDLE.FILE_REFERENCE, TEXT_IO.POSITIVE_COUNT(COUNT)
        );
      if FILE_HANDLE.PAGE_SIZE /= 0 then
        FILE_HANDLE.CURRENT_LINE := FILE_HANDLE.CURRENT_LINE + COUNT;
      end if;
    end if;

  end LINE_FEED;
  pragma PAGE;
  procedure PAGE_EJECT(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       COUNT       : in INTEGER := 1) is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| Raise Invalid_Count if page request is too large
  --| Convert the number of pages to skip into number of lines
  --| Write out this number of new line control characters
  --| while taking into account header, footer, and pagination.
  --| Exit
  --|+

  begin

    if FILE_HANDLE.PAGE_SIZE = 0 then
      LINE_FEED(FILE_HANDLE, 1);
      return;
    end if;
    if COUNT > 99 then
      raise INVALID_COUNT;
    end if;
    if FILE_HANDLE.CURRENT_LINE = 0 then
      LINE_FEED(FILE_HANDLE, (COUNT*FILE_HANDLE.MAXIMUM_LINE));
    else
      LINE_FEED(FILE_HANDLE, (COUNT*FILE_HANDLE.MAXIMUM_LINE - FILE_HANDLE.
        CURRENT_LINE + 1));
    end if;

  end PAGE_EJECT;
  pragma PAGE;
  procedure SET_TEXT_AREA(TEXT_HANDLE : in out VARIABLE_STRING_ARRAY_HANDLE;
                          AREA_SIZE   : in INTEGER) is

    TEMP_HANDLE : VARIABLE_STRING_ARRAY_HANDLE;

  begin

    if AREA_SIZE <= 0 then
      return;
    end if;
    if TEXT_HANDLE = null or else TEXT_HANDLE'LAST < AREA_SIZE then
      TEMP_HANDLE := TEXT_HANDLE;
      TEXT_HANDLE := new VARIABLE_STRING_ARRAY(1 .. AREA_SIZE);
      if TEMP_HANDLE /= null then
        for I in TEMP_HANDLE'range loop
          TEXT_HANDLE(I) := STRING_PKG.MAKE_PERSISTENT(TEMP_HANDLE(I));
        end loop;
        CLEAR_TEXT(TEMP_HANDLE);
      end if;
    end if;

  end SET_TEXT_AREA;
  pragma PAGE;
  procedure WRITE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                  TEXT_LINE   : in STRING;
                  FEED        : in BOOLEAN) is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| If at the top of the page
  --|    then write out the header
  --| Output the given line of text to the paginated file
  --| Write out a new line control character
  --| If at the bottom of the page
  --|    then write out the footer and eject the page
  --| Exit
  --|+

  begin

    CHECK_VALID(FILE_HANDLE);
    LINE_FEED(FILE_HANDLE, 0);
    TEXT_IO.PUT(FILE_HANDLE.FILE_REFERENCE, TEXT_LINE);
    if FEED then
      LINE_FEED(FILE_HANDLE, 1);
    end if;
  end WRITE;
  pragma PAGE;
  procedure CREATE_PAGINATED_FILE(FILE_NAME   : in HOST_FILE_NAME := "";
                                  FILE_HANDLE : in out PAGINATED_FILE_HANDLE;
                                  PAGE_SIZE   : in INTEGER := 60;
                                  HEADER_SIZE : in INTEGER := 6) is

  --|-Algorithm:
  --| If an active (ie. non-null) handle is given
  --|    then close that file first
  --| Create a paginated file structure
  --| If no file name is given
  --|    then assume standard output
  --|    else create (open) an external file
  --| Fill the paginated file structure with external file information,
  --| page layout information, and current date/time
  --| Return access to the completed structure
  --| Exit
  --|+

  begin

    CLOSE_PAGINATED_FILE(FILE_HANDLE);
    FILE_HANDLE := new PAGINATED_FILE_STRUCTURE;
    if FILE_NAME /= "" then
      FILE_HANDLE.FILE_NAME := STRING_PKG.MAKE_PERSISTENT(FILE_NAME);
      TEXT_IO.CREATE(FILE => FILE_HANDLE.FILE_REFERENCE, NAME => FILE_NAME);
    end if;
    SET_PAGE_LAYOUT(FILE_HANDLE, PAGE_SIZE, HEADER_SIZE);
    SET_DATE_TIME(FILE_HANDLE);

  exception

    when TEXT_IO.STATUS_ERROR =>
      ABORT_PAGINATED_OUTPUT(FILE_HANDLE);
      raise FILE_ALREADY_OPEN;
    when TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR =>
      ABORT_PAGINATED_OUTPUT(FILE_HANDLE);
      raise FILE_ERROR;
    when PAGE_LAYOUT_ERROR =>
      ABORT_PAGINATED_OUTPUT(FILE_HANDLE);
      raise PAGE_LAYOUT_ERROR;

  end CREATE_PAGINATED_FILE;
  pragma PAGE;
  pragma PAGE;
  procedure SET_PAGE_LAYOUT(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                            PAGE_SIZE   : in INTEGER;
                            HEADER_SIZE : in INTEGER) is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| If page layout is contradictory
  --|    then raise an error
  --| If not at the top of the page
  --|    then eject current page
  --| Set page size, header size, footer size, and text area size
  --| per page
  --| Exit
  --|+

    TEMP_HANDLE : VARIABLE_STRING_ARRAY_HANDLE;

  begin

    CHECK_VALID(FILE_HANDLE);
    if PAGE_SIZE < 0 or HEADER_SIZE < 0 or (PAGE_SIZE /= 0 and PAGE_SIZE <=
      HEADER_SIZE) then
      raise PAGE_LAYOUT_ERROR;
    end if;
    if FILE_HANDLE.CURRENT_LINE /= 0 and FILE_HANDLE.PAGE_SIZE /= 0 then
      PAGE_EJECT(FILE_HANDLE, 1);
    end if;
    FILE_HANDLE.PAGE_SIZE := PAGE_SIZE;
    if PAGE_SIZE = 0 then
      FILE_HANDLE.MAXIMUM_LINE := 0;
    else
      FILE_HANDLE.MAXIMUM_LINE := PAGE_SIZE - HEADER_SIZE;
    end if;
    FILE_HANDLE.HEADER_SIZE := HEADER_SIZE;
    SET_TEXT_AREA(FILE_HANDLE.PAGE_HEADER, FILE_HANDLE.HEADER_SIZE);
  end SET_PAGE_LAYOUT;

  procedure SET_HEADER(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       HEADER_TEXT : in VARIABLE_STRING_ARRAY) is

  --|-Algorithm:
  --| Set given header text as odd page header
  --| Exit
  --|+

  begin

    SET_TEXT(FILE_HANDLE, HEADER_TEXT);

  end SET_HEADER;
  pragma PAGE;
  procedure SET_HEADER(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       HEADER_LINE : in INTEGER;
                       HEADER_TEXT : in STRING_PKG.STRING_TYPE) is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| If requested header line number is out of range
  --|     then raise an error
  --| Set header text at requested line for odd pages
  --| Exit
  --|+

  begin

    CHECK_VALID(FILE_HANDLE);
    if HEADER_LINE < 1 then
      raise TEXT_UNDERFLOW;
    end if;
    if HEADER_LINE > FILE_HANDLE.HEADER_SIZE then
      raise TEXT_OVERFLOW;
    end if;
    FILE_HANDLE.PAGE_HEADER(HEADER_LINE) := STRING_PKG.MAKE_PERSISTENT(
      HEADER_TEXT);

  end SET_HEADER;
  pragma PAGE;
  procedure SET_HEADER(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       HEADER_LINE : in INTEGER;
                       HEADER_TEXT : in STRING) is

  --|-Algorithm:
  --| Create a variable string
  --| Set odd page header
  --| Exit
  --|+

    TEXT : STRING_PKG.STRING_TYPE;

  begin

    TEXT := STRING_PKG.MAKE_PERSISTENT(HEADER_TEXT);
    SET_HEADER(FILE_HANDLE, HEADER_LINE, TEXT);
    STRING_PKG.FLUSH(TEXT);

  end SET_HEADER;

  procedure CLOSE_PAGINATED_FILE(FILE_HANDLE : in out PAGINATED_FILE_HANDLE) is

  --|-Algorithm:
  --| If no file (ie. handle is null)
  --|    then return
  --| If not at the top of the page
  --|    then eject current page
  --| Return all storage used for this file to the heap
  --| Close the external file
  --| Exit
  --|+

  begin

    if FILE_HANDLE = null then
      return;
    end if;
    if FILE_HANDLE.CURRENT_LINE /= 0 and FILE_HANDLE.PAGE_SIZE /= 0 then
      PAGE_EJECT(FILE_HANDLE, 1);
    end if;
    ABORT_PAGINATED_OUTPUT(FILE_HANDLE);

  end CLOSE_PAGINATED_FILE;
  pragma PAGE;
  procedure PUT(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                TEXT        : in CHARACTER) is

  begin

    WRITE(FILE_HANDLE, "" & TEXT, FALSE);

  end PUT;
  pragma PAGE;
  procedure PUT(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                TEXT        : in STRING) is

  --|-Algorithm:
  --| Execute Write procedure with feed
  --| Exit
  --|+

  begin

    WRITE(FILE_HANDLE, TEXT, FALSE);

  end PUT;
  pragma PAGE;
  procedure PUT(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                TEXT        : in STRING_PKG.STRING_TYPE) is

  --|-Algorithm:
  --| Create a fixed length string
  --| Output the line
  --| Exit
  --|+

  begin

    WRITE(FILE_HANDLE, STRING_PKG.VALUE(TEXT), FALSE);

  end PUT;
  pragma PAGE;
  procedure PUT(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                TEXT        : in VARIABLE_STRING_ARRAY) is

  --|-Algorithm:
  --| Loop for all elements of the variable string array
  --|    Create a fixed length string
  --|    Output the line
  --| Exit
  --|+

  begin

    for I in TEXT'range loop
      WRITE(FILE_HANDLE, STRING_PKG.VALUE(TEXT(I)), FALSE);
    end loop;

  end PUT;
  pragma PAGE;
  procedure SPACE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                  COUNT       : in INTEGER) is

  begin

    CHECK_VALID(FILE_HANDLE);
    if COUNT <= 0 then
      return;
    end if;
    declare
      SPACE_STRING : STRING(1 .. COUNT) := (1 .. COUNT => ' ');
    begin
      WRITE(FILE_HANDLE, SPACE_STRING, FALSE);
    end;

  end SPACE;
  pragma PAGE;
  procedure PUT_LINE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     TEXT_LINE   : in STRING) is

  --|-Algorithm:
  --| Execute Write procedure with feed
  --| Exit
  --|+

  begin

    WRITE(FILE_HANDLE, TEXT_LINE, TRUE);

  end PUT_LINE;
  pragma PAGE;
  procedure PUT_LINE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     TEXT_LINE   : in STRING_PKG.STRING_TYPE) is

  --|-Algorithm:
  --| Create a fixed length string
  --| Output the line
  --| Exit
  --|+

  begin

    WRITE(FILE_HANDLE, STRING_PKG.VALUE(TEXT_LINE), TRUE);

  end PUT_LINE;
  pragma PAGE;
  procedure PUT_LINE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     TEXT_LINE   : in VARIABLE_STRING_ARRAY) is

  --|-Algorithm:
  --| Loop for all elements of the variable string array
  --|    Create a fixed length string
  --|    Output the line
  --| Exit
  --|+

  begin

    for I in TEXT_LINE'range loop
      WRITE(FILE_HANDLE, STRING_PKG.VALUE(TEXT_LINE(I)), TRUE);
    end loop;

  end PUT_LINE;
  pragma PAGE;
  procedure SPACE_LINE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                       COUNT       : in INTEGER := 1) is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| Raise Invalid_Count if space request is too large
  --| Write out the given number of new line control characters
  --| while taking into account header, footer, and pagination.
  --| Exit
  --|+

  begin

    CHECK_VALID(FILE_HANDLE);
    LINE_FEED(FILE_HANDLE, COUNT);

  end SPACE_LINE;
  pragma PAGE;
  procedure SKIP_LINE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                      COUNT       : in INTEGER := 1) is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| Set the number of new line characters to be written as the
  --| number specified or the number of lines remaining on the
  --| page which ever is smaller.
  --| Write out this number of new line control characters
  --| while taking into account header, footer, and pagination.
  --| (If at the top of the page then Skip_Lines does nothing)
  --| Exit
  --|+

    SKIP_COUNT : INTEGER;

  begin

    CHECK_VALID(FILE_HANDLE);
    if FILE_HANDLE.CURRENT_LINE /= 0 or FILE_HANDLE.PAGE_SIZE = 0 then
      SKIP_COUNT := FILE_HANDLE.MAXIMUM_LINE - FILE_HANDLE.CURRENT_LINE + 1;
      if SKIP_COUNT > COUNT or FILE_HANDLE.PAGE_SIZE = 0 then
        SKIP_COUNT := COUNT;
      end if;
      LINE_FEED(FILE_HANDLE, SKIP_COUNT);
    end if;
  end SKIP_LINE;
  pragma PAGE;
  procedure PUT_PAGE(FILE_HANDLE : in PAGINATED_FILE_HANDLE;
                     COUNT       : in INTEGER := 1) is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| Raise Invalid_Count if page request is too large
  --| Convert the number of pages to skip into number of lines
  --| Write out this number of new line control characters
  --| while taking into account header, footer, and pagination.
  --| Exit
  --|+

  begin

    CHECK_VALID(FILE_HANDLE);
    PAGE_EJECT(FILE_HANDLE, COUNT);

  end PUT_PAGE;
  pragma PAGE;
  function AVAILABLE_LINES(FILE_HANDLE : in PAGINATED_FILE_HANDLE) return
    INTEGER is

  --|-Algorithm:
  --| Validate paginated file structure (raise error if not valid)
  --| Return the number of lines remaining on the page
  --|+

  begin

    CHECK_VALID(FILE_HANDLE);
    if FILE_HANDLE.PAGE_SIZE = 0 then
      return -1;
    end if;
    if FILE_HANDLE.CURRENT_LINE = 0 then
      return FILE_HANDLE.MAXIMUM_LINE;
    else
      return FILE_HANDLE.MAXIMUM_LINE - FILE_HANDLE.CURRENT_LINE + 1;
    end if;

  end AVAILABLE_LINES;

end SIMPLE_PAGINATED_OUTPUT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--cli.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG; use STRING_PKG;

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

package COMMAND_LINE_INTERFACE is
--| Provides primitives for getting at the command line arguments.

--| Overview
--| This package provides a universal and portable interface to
--| the arguments typed on a command line when a program is invoked.
--| Each command line argument is either a Word (sequence of non-blank
--| characters) or a quoted string, with embedded quotes doubled.
--|
--| Both named and positional arguments may be given on the command
--| line.  However, once a named parameter is used, all the subseqent
--| parameters on the command line must be named parameters.  For example,
--| the commands
--|-
--|     compile  abc pqr xyz library => plib
--|     compile  abc,pqr,unit=>xyz,library=>plib
--|+
--| have one named argument and three positional arguments.  This
--| package separates the named parameters from the positional
--| parameters, ignores spaces around the "bound to" (=>) symbol, and
--| allows parameters to be separated by either spaces or commas,
--| so these command lines are indistinguishable.
--|
--| At program elaboration time, the command line string is automatically
--| obtained from the host operating system and parsed into
--| individual arguments.  The following operations may then be used:
--|-
--| Named_arg_count()        Returns number of named arguments entered
--| Positional_arg_count()    Returns number of positional arguments
--| Positional_arg_value(N)    Returns the Nth positional argument
--| Named_arg_value(Name, Fnd, val) Returns value of a named argument
--| Arguments()            Returns the entire command line
--|+

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

  MAX_ARGS : constant := 255;
  --| Maximum number of command line arguments (arbitrary).

  subtype ARGUMENT_COUNT is INTEGER range 0 .. MAX_ARGS;
  --| For number of arguments
  subtype ARGUMENT_INDEX is ARGUMENT_COUNT range 1 .. ARGUMENT_COUNT'LAST;
  --| Used to number the command line arguments.

  NO_ARG                    : exception;
  --| Raised when request made for nonexistent argument

  MISSING_POSITIONAL_ARG    : exception;
  --| Raised when command line is missing positional argument (A,,B)

  INVALID_NAMED_ASSOCIATION : exception;
  --| Raised when command line is missing named argument value (output=> ,A,B)

  UNREFERENCED_NAMED_ARG    : exception;
  --| Raised when not all named parameters have been retrieved

  INVALID_PARAMETER_ORDER   : exception;
  --| Raised when a positional parameter occurs after a named parameter
  --  in the command line

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

  procedure INITIALIZE( --| Initializes command_line_interface
                       ARG_STRING : in STRING);

  --| N/A: modifies, errors, raises

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

  function NAMED_ARG_COUNT --| Return number of named arguments
  return ARGUMENT_COUNT;
  --| N/A: modifies, errors, raises


  function POSITIONAL_ARG_COUNT --| Return number of positional arguments
  return ARGUMENT_COUNT;
  --| N/A: modifies, errors, raises


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

  function POSITIONAL_ARG_VALUE( --| Return an argument value
                                N : in ARGUMENT_INDEX
                                --| Position of desired argument
                                ) return STRING;  --| Raises: no_arg

  --| Effects: Return the Nth argument.  If there is no argument at
  --| position N, no_arg is raised.

  --| N/A: modifies, errors


  function POSITIONAL_ARG_VALUE( --| Return an argument value
                                N : in ARGUMENT_INDEX
                                    --| Position of desired argument
                                ) return STRING_TYPE;  --| Raises: no_arg

  --| Effects: Return the Nth argument.  If there is no argument at
  --| position N, no_arg is raised.

  --| N/A: modifies, errors

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

  procedure NAMED_ARG_VALUE( --| Return a named argument value
                            NAME      : in STRING;
                            FOUND     : out BOOLEAN;
                            ARG_VALUE : out STRING);

  --| Effects: Return the value associated with Name on the command
  --| line.  If there was none, return Default.

  --| N/A: modifies, errors


  procedure NAMED_ARG_VALUE( --| Return a named argument value
                            NAME      : in STRING;
                            FOUND     : out BOOLEAN;
                            ARG_VALUE : out STRING_TYPE);

  --| Effects: Return the value associated with Name on the command
  --| line.  If there was none, return Default.

  --| N/A: modifies, errors

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

  function ARGUMENTS --| Return the entire argument string
  return STRING;
  --| Effects: Return the entire command line, except for the name
  --| of the command itself.

  --| N/A: modifies, errors, raises

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

  procedure FINALIZE;  --| Raises: unrecognized parameters

  --| Effects: If not all named parameters have been retrieved
  --| unrecognized parameters is raised.
  --| N/A: modifies, errors

end COMMAND_LINE_INTERFACE;

----------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--cli.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO; use TEXT_IO;
with STRING_PKG;
with STRING_SCANNER;
----------------------------------------------------------------

package body COMMAND_LINE_INTERFACE is
--| Provides primitives for getting at the command line arguments.

--| Overview

  package SP renames STRING_PKG;
  package SS renames STRING_SCANNER;

  type NAME_VALUE is  --| Name/Value pair
    record
      NAME          : SP.STRING_TYPE;  --| Name of value
      VALUE         : SP.STRING_TYPE;  --| Value associated with name
      WAS_RETRIEVED : BOOLEAN := FALSE;  --| Flag indicating whether name-value
    end record;  --  association has been retrieved by tool

  type TOKEN_TYPE is (ADA_ID, WORD, BOUND_TO, NONE);

  package TOKEN_TYPE_IO is
    new ENUMERATION_IO(TOKEN_TYPE);
  use TOKEN_TYPE_IO;

  ARGUMENT_STRING : STRING(1 .. 132);
  BLANKS          : STRING(1 .. 132) := (others => ' ');
  N_ARG_COUNT     : ARGUMENT_COUNT;  --| Count of named args
  P_ARG_COUNT     : ARGUMENT_COUNT;  --| Count of positional args
  REJECTED        : BOOLEAN := FALSE;

  NAMED_ARGS      : array(ARGUMENT_INDEX) of NAME_VALUE;

  POSITIONAL_ARGS : array(ARGUMENT_INDEX) of SP.STRING_TYPE;

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

  -- Local functions:

  procedure GET_TOKEN(SCAN_STRING : in out SS.SCANNER;
                      ARGUMENT    : in out SP.STRING_TYPE;
                      KIND        : in out TOKEN_TYPE) is

    LAST_ARG     : SP.STRING_TYPE;
    LAST_KIND    : TOKEN_TYPE;
    FOUND        : BOOLEAN;
    DELIMETER    : SP.STRING_TYPE;
    DELIM_STRING : SS.SCANNER;
    MORE_COMMAS  : BOOLEAN := FALSE;
    TAIL         : SP.STRING_TYPE;

  begin

    if REJECTED then
      ARGUMENT := LAST_ARG;
      KIND := LAST_KIND;
      REJECTED := FALSE;
    else
      if SS.IS_SEQUENCE(" ,", SCAN_STRING) then
        SS.SCAN_SEQUENCE(" ,", SCAN_STRING, FOUND, DELIMETER);
        DELIM_STRING := SS.MAKE_SCANNER(DELIMETER);
        loop
          SS.SKIP_SPACE(DELIM_STRING);
          exit when not SS.MORE(DELIM_STRING);
          SS.FORWARD(DELIM_STRING);
          if MORE_COMMAS then
            raise MISSING_POSITIONAL_ARG;
          end if;
          MORE_COMMAS := TRUE;
        end loop;
      end if;
      if SS.IS_ADA_ID(SCAN_STRING) then
        SS.SCAN_ADA_ID(SCAN_STRING, FOUND, ARGUMENT);
        if SS.IS_LITERAL("=>", SCAN_STRING) or SS.IS_LITERAL("""", SCAN_STRING)
          or SS.IS_SEQUENCE(" ,", SCAN_STRING) or not SS.MORE(SCAN_STRING)
          then
          KIND := ADA_ID;
        else
          if SS.IS_NOT_SEQUENCE(" ,", SCAN_STRING) then
            SS.SCAN_NOT_SEQUENCE(" ,", SCAN_STRING, FOUND, TAIL);
            ARGUMENT := SP."&"(ARGUMENT, TAIL);
            KIND := WORD;
          else
            SS.SCAN_WORD(SCAN_STRING, FOUND, TAIL);
            ARGUMENT := SP."&"(ARGUMENT, TAIL);
            KIND := WORD;
          end if;
        end if;
      elsif SS.IS_LITERAL("=>", SCAN_STRING) then
        SS.SCAN_LITERAL("=>", SCAN_STRING, FOUND);
        ARGUMENT := SP.CREATE("=>");
        KIND := BOUND_TO;
      elsif SS.IS_QUOTED(SCAN_STRING) then
        SS.SCAN_QUOTED(SCAN_STRING, FOUND, ARGUMENT);
        KIND := WORD;
      elsif SS.IS_ENCLOSED('(', ')', SCAN_STRING) then
        SS.SCAN_ENCLOSED('(', ')', SCAN_STRING, FOUND, ARGUMENT);
        KIND := WORD;
      elsif SS.IS_NOT_SEQUENCE(" ,", SCAN_STRING) then
        SS.SCAN_NOT_SEQUENCE(" ,", SCAN_STRING, FOUND, ARGUMENT);
        KIND := WORD;
      elsif SS.IS_WORD(SCAN_STRING) then
        SS.SCAN_WORD(SCAN_STRING, FOUND, ARGUMENT);
        KIND := WORD;
      else
        ARGUMENT := SP.CREATE("");
        KIND := NONE;
      end if;
      LAST_KIND := KIND;
      LAST_ARG := ARGUMENT;
    end if;
  end GET_TOKEN;

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

  procedure SAVE_NAMED(NAME  : in SP.STRING_TYPE;
                       VALUE : in SP.STRING_TYPE) is

  begin
    N_ARG_COUNT := N_ARG_COUNT + 1;
    NAMED_ARGS(N_ARG_COUNT).NAME := NAME;
    NAMED_ARGS(N_ARG_COUNT).VALUE := VALUE;
  end SAVE_NAMED;

  procedure SAVE_POSITIONAL(VALUE : in SP.STRING_TYPE) is

  begin
    if N_ARG_COUNT > 0 then
      raise INVALID_PARAMETER_ORDER;
    end if;
    P_ARG_COUNT := P_ARG_COUNT + 1;
    POSITIONAL_ARGS(P_ARG_COUNT) := VALUE;
  end SAVE_POSITIONAL;

  procedure REJECT_TOKEN is

  begin
    REJECTED := TRUE;
  end REJECT_TOKEN;

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

  procedure INITIALIZE(ARG_STRING : in STRING) is

  begin

    declare

      type STATE_TYPE is (HAVE_NOTHING, HAVE_ADA_ID, HAVE_BOUND_TO);

      INDEX       : INTEGER;  --| Index of characters in argument string
      SCAN_STRING : SS.SCANNER;  --| Scanned argument string
      ARGUMENT    : SP.STRING_TYPE;  --| Argument scanned from argument string
      KIND        : TOKEN_TYPE;  --| Kind of argument- WORD, =>, Ada_ID
      OLD_ARG     : SP.STRING_TYPE;  --| Previously scanned argument
      FOUND       : BOOLEAN;

      STATE       : STATE_TYPE := HAVE_NOTHING;
      --| State of argument in decision tree

    begin

      INDEX := ARG_STRING'FIRST;
      N_ARG_COUNT := 0;
      P_ARG_COUNT := 0;

      -- Remove trailing blanks and final semicolon
      for I in reverse ARG_STRING'range loop
        if ARG_STRING(I) /= ' ' then
          if ARG_STRING(I) = ';' then
            INDEX := I - 1;
          else
            INDEX := I;
          end if;
          exit;
        end if;
      end loop;

      -- Convert argument string to scanner and remove enclosing parantheses
      SCAN_STRING := SS.MAKE_SCANNER(SP.CREATE(ARG_STRING(ARG_STRING'FIRST ..
        INDEX)));
      if SS.IS_ENCLOSED('(', ')', SCAN_STRING) then
        SS.MARK(SCAN_STRING);
        SS.SCAN_ENCLOSED('(', ')', SCAN_STRING, FOUND, ARGUMENT);
        SS.SKIP_SPACE(SCAN_STRING);
        if not SS.MORE(SCAN_STRING) then
          SS.DESTROY_SCANNER(SCAN_STRING);
          SCAN_STRING := SS.MAKE_SCANNER(ARGUMENT);
        else
          SS.RESTORE(SCAN_STRING);
        end if;
      end if;

      -- Parse argument string and save arguments
      loop
        GET_TOKEN(SCAN_STRING, ARGUMENT, KIND);
        case STATE is
          when HAVE_NOTHING =>
            case KIND is
              when ADA_ID =>
                OLD_ARG := ARGUMENT;
                STATE := HAVE_ADA_ID;
              when WORD =>
                SAVE_POSITIONAL(ARGUMENT);
                STATE := HAVE_NOTHING;
              when BOUND_TO =>
                STATE := HAVE_NOTHING;
                raise INVALID_NAMED_ASSOCIATION;
              when NONE =>
                null;
            end case;
          when HAVE_ADA_ID =>
            case KIND is
              when ADA_ID =>
                SAVE_POSITIONAL(OLD_ARG);
                OLD_ARG := ARGUMENT;
                STATE := HAVE_ADA_ID;
              when WORD =>
                SAVE_POSITIONAL(OLD_ARG);
                SAVE_POSITIONAL(ARGUMENT);
                STATE := HAVE_NOTHING;
              when BOUND_TO =>
                STATE := HAVE_BOUND_TO;
              when NONE =>
                SAVE_POSITIONAL(OLD_ARG);
            end case;
          when HAVE_BOUND_TO =>
            case KIND is
              when ADA_ID | WORD =>
                SAVE_NAMED(OLD_ARG, ARGUMENT);
                STATE := HAVE_NOTHING;
              when BOUND_TO =>
                STATE := HAVE_BOUND_TO;
                raise INVALID_NAMED_ASSOCIATION;
              when NONE =>
                raise INVALID_NAMED_ASSOCIATION;

            end case;
        end case;
        exit when KIND = NONE;
      end loop;
    end;
    ARGUMENT_STRING(1 .. ARG_STRING'LENGTH) := ARG_STRING;
    ARGUMENT_STRING(ARG_STRING'LENGTH + 1 .. 132) := BLANKS(ARG_STRING'LENGTH +
      1 .. 132);
  end INITIALIZE;

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

  function NAMED_ARG_COUNT --| Return number of named arguments
  return ARGUMENT_COUNT is

  begin
    return N_ARG_COUNT;
  end NAMED_ARG_COUNT;

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

  function POSITIONAL_ARG_COUNT --| Return number of positional arguments
  return ARGUMENT_COUNT is

  begin
    return P_ARG_COUNT;
  end POSITIONAL_ARG_COUNT;

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

  function POSITIONAL_ARG_VALUE( --| Return an argument value
                                N : in ARGUMENT_INDEX
                                --| Position of desired argument
                                ) return STRING is  --| Raises: no_arg

  --| Effects: Return the Nth argument.  If there is no argument at
  --| position N, no_arg is raised.

  --| N/A: modifies, errors

  begin
    if N > P_ARG_COUNT then
      raise NO_ARG;
    else
      return SP.VALUE(POSITIONAL_ARGS(N));
    end if;
  end POSITIONAL_ARG_VALUE;

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

  function POSITIONAL_ARG_VALUE( --| Return an argument value
                                N : in ARGUMENT_INDEX
                                --| Position of desired argument
                                ) return SP.STRING_TYPE is  --| Raises: no_arg

  --| Effects: Return the Nth argument.  If there is no argument at
  --| position N, no_arg is raised.

  --| N/A: modifies, errors

  begin
    if N > P_ARG_COUNT then
      raise NO_ARG;
    else
      return POSITIONAL_ARGS(N);
    end if;
  end POSITIONAL_ARG_VALUE;

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

  procedure NAMED_ARG_VALUE( --| Return a named argument value
                            NAME      : in STRING;
                            FOUND     : out BOOLEAN;
                            ARG_VALUE : out STRING) is

  --| Effects: Return the value associated with Name on the command
  --| line.
    FOUND_FLAG : BOOLEAN := FALSE;

  begin
    for I in 1 .. N_ARG_COUNT loop
      if SP.EQUAL(SP.UPPER(NAMED_ARGS(I).NAME), SP.UPPER(SP.CREATE(NAME))) then
        NAMED_ARGS(I).WAS_RETRIEVED := TRUE;
        ARG_VALUE := SP.VALUE(NAMED_ARGS(I).VALUE);
        FOUND_FLAG := TRUE;
        exit;
      end if;
    end loop;
    if FOUND_FLAG = FALSE then
      ARG_VALUE := "   ";
    end if;
    FOUND := FOUND_FLAG;
  end NAMED_ARG_VALUE;
  ----------------------------------------------------------------

  procedure NAMED_ARG_VALUE( --| Return a named argument value
                            NAME      : in STRING;
                            FOUND     : out BOOLEAN;
                            ARG_VALUE : out SP.STRING_TYPE) is

  --| Effects: Return the value associated with Name on the command
  --| line.  If there was none, return Default.


  begin
    FOUND := FALSE;
    for I in 1 .. N_ARG_COUNT loop
      if SP.EQUAL(SP.UPPER(NAMED_ARGS(I).NAME), SP.UPPER(SP.CREATE(NAME))) then
        NAMED_ARGS(I).WAS_RETRIEVED := TRUE;
        ARG_VALUE := NAMED_ARGS(I).VALUE;
        FOUND := TRUE;
        exit;
      end if;
    end loop;
  end NAMED_ARG_VALUE;

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

  function ARGUMENTS --| Return the entire argument string
  return STRING is

  --| Effects: Return the entire command line, except for the name
  --| of the command itself.

  begin
    return ARGUMENT_STRING;
  end ARGUMENTS;
  ----------------------------------------------------------------

  procedure FINALIZE is  --| Raises: unreferenced_named_arg

  begin
    for I in 1 .. NAMED_ARG_COUNT loop
      if NAMED_ARGS(I).WAS_RETRIEVED = FALSE then
        raise UNREFERENCED_NAMED_ARG;
      end if;
    end loop;
  end FINALIZE;

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

end COMMAND_LINE_INTERFACE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--fileman.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
package File_Manager is

--| Overview
--| This package provides some host independent file functions.  The provided
--| functions are: Copy, Rename, and Append.  Each of these works on text
--| files only and with a maximun line length of 255 (constant declared in
--| the body which can be changed).  Due to Ada's limitations each file
--| ends up with a form feed inserted as the last character.

--| Requires
--| Each procedure is passed two strings which are the file names to be used.

  procedure Copy(In_File_Name : in string;
                 Out_File_Name: in string);

--| Effects
--| This procedure will take the file specified as In_file_name and make a
--| second copy of the file in the file specified in Out_file_name.
--| The copy of the file in Out_file_name will have a form feed inserted
--| as the last character of the file.

--| Requires
--| The parameter In_file_name must specify a valid file name of an existing
--| file.  The parameter Out_file_name must specify a valid file name for a
--| file that currently does not exist

--| Raises
--| status_error, name_error, use_error

  procedure Rename(In_File_Name : in string;
                   Out_File_Name: in string);

--| Effects
--| This procedure will take the file specified in In_file_name and rename
--| it as the file specified as Out_file_name.  The original file will no
--| longer exist.  The new file will have a form feed inserted as the last
--| character of the file.

--| Requires
--| The parameter In_file_name must specify a valid file name of an existing
--| file.  The parameter Out_file_name must specify a valid file name for a
--| file that currently does not exist

--| Raises
--| status_error, use_error, name_error

  procedure Append(Append_File_Name : in string;
                   To_File_Name     : in string);

--| Effects
--| This procedure will Append one file onto the end of another file.  The
--| First file specified will be added onto the end of the second file
--| specified.

--| Requires
--| Both parameters must be valid file names and must specify files that
--| currently exist.

--| Raises
--| status_error, name_error, use_error

end File_Manager;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--fileman.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with Text_Io; use Text_Io;
package body File_Manager is

--| Overview
--| This package provides some host independent file functions.  These
--| functions work on text files.  The maximun line lengths of the
--| files is specified in the parameter Maximun_Line_Size which can be
--| changed.

  Maximum_Line_Size: constant := 255;

  procedure Copy(In_File_Name : in string;
                 Out_File_Name: in string) is
    Input_Buffer: string(1..Maximum_Line_Size);
    Input_File: File_Type;
    Output_File: File_Type;
    Line_Length: natural;
  begin
    Open(Input_File,In_File, In_File_Name);
    Create(Output_File,Out_File, Out_File_Name);

    while not End_Of_File(Input_File) loop
      Get_Line(Input_File, Input_Buffer, Line_Length);
      Put_Line(Output_File, Input_Buffer(1..Line_Length));
      end loop;

    Close(Input_File);
    Close(Output_File);
  exception
    when
      status_error =>
        put_line("status_error - trying to open a file that is already open");
    when
      name_error =>
        put_line("name_error - trying to open a file that does not exist");
    when
      use_error =>
        put_line("use_error - incorrect form of file name");
  end Copy;

  procedure Rename(In_File_Name : in string;
                   Out_File_Name: in string) is
    Input_File: File_Type;
  begin
    Copy(In_File_Name,Out_File_Name);
    Open(Input_File,In_File,In_File_Name);
    Delete(Input_File);
  exception
    when
      status_error =>
        put_line("status_error - trying to open/close file");
    when
      name_error =>
        put_line("name_error - trying to open a file that does not exist");
    when
      use_error =>
        put_line("use_error - delete access not allowed");
  end Rename;

  procedure Append(Append_File_Name : in string;
                   To_File_Name     : in string) is
    Append_File: File_Type;
    To_File: File_Type;
    Input_Buffer: string(1..Maximum_Line_Size);
    Line_Length: natural;
  begin
    Rename(To_File_Name,"temp0097.rlr");
    Open(Append_File,In_File, "temp0097.rlr");
    Create(To_File,Out_File, To_File_Name);

    while not End_Of_File(Append_File) loop
      Get_Line(Append_File, Input_Buffer, Line_Length);
      Put_Line(To_File, Input_Buffer(1..Line_Length));
      end loop;

    Delete(Append_File);
    Open(Append_File,In_File, Append_File_Name);

    while not End_Of_File(Append_File) loop
      Get_Line(Append_File, Input_Buffer, Line_Length);
      Put_Line(To_File, Input_Buffer(1..Line_Length));
      end loop;

    Close(Append_File);
    Close(To_File);
  exception
    when
      status_error =>
        put_line("status_error - trying to open/close file");
    when
      name_error =>
        put_line("name_error - trying to open a file that does not exist");
    when
      use_error =>
        put_line("use_error - delete access not allowed");
  end Append;

end File_Manager;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--dynarray.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


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

  with function EQUAL(E1, E2 : in ELEM_TYPE) return BOOLEAN is "=";
                                 --| An equality relation on elem_type.

package DYNARRAY_PKG is

--| Overview:
--| This package provides the dynamic array (darray) abstract data type.
--| A darray has completely dynamic bounds, which change during runtime as
--| elements are added to/removed from the top/bottom. darrays are similar
--| to deques, differing only in that operations for indexing into the
--| structure are also provided.  A darray is indexed by integers that
--| fall within the current bounds.  The component type, elem_type, of a
--| darray is a generic formal parameter of this package, along with a
--| function, equal, that is assumed to form an equality relation over
--| over elem_type.
--|
--| The notation, <first, elts>, will be used to denote a darray.
--| first is the current low bound of the darray.  elts is the sequence
--| of elements contained in the darray.  For a given darray, d, the
--| dot selection mechanism is used to refer to these components, e.g.,
--| d.first and d.elts.  & is used for sequence concatenation, and also
--| for prepending/postpending a single element to a sequence.  |s| is
--| the number of elements in a sequence, s, and () is the null sequence.
--| Standard Ada array indexing notation is adopted for sequences.
--|
--| The following is a complete list of operations, written in the order
--| in which they appear in the spec:
--|
--| Constructors:
--|        create
--|        array_to_darray
--|        set_first
--|        add_low, add_high
--|        remove_low, remove_high
--|        store
--|        copy, copy_deep (generic)
--|
--| Query Operations:
--|        fetch
--|        low, high
--|        first, last
--|        is_empty
--|        length
--|        equal
--|
--| Iterators:
--|        make_elements_iter, more, next
--|
--| Heap Management:
--|        destroy
--|

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

-- Primary Types:

  type DARRAY is private;  --| The darray abstract data type.

  type ARRAY_TYPE is array(INTEGER range <>) of ELEM_TYPE;
  --| darray/array_type conversion operations are provided.


  -- Storage Management Constants and Types:  (see create procedure)

  DEFAULT_PREDICT      : constant POSITIVE := 100;

  DEFAULT_HIGH         : constant POSITIVE := 50;

  DEFAULT_EXPAND       : constant POSITIVE := 100;


  -- Exceptions:

  NO_MORE              : exception;  --| Raised on incorrect use of an iterator.

  OUT_OF_BOUNDS        : exception;  --| Raised on index out of current bounds.

  UNINITIALIZED_DARRAY : exception;
  --| Raised on use of uninitialized darray by most operations.


  -- Iterators:

  type ELEMENTS_ITER is private;  --| Component elements iterator.


  -- Constructors:

  procedure CREATE(FIRST          : in INTEGER := 1;
                   PREDICT        : in POSITIVE := DEFAULT_PREDICT;
                   HIGH_PERCENT   : in POSITIVE := DEFAULT_HIGH;
                   EXPAND_PERCENT : in POSITIVE := DEFAULT_EXPAND;
                   D              : in out DARRAY);

  --| Effects:
  --| Sets d to <first, ()>.  If d has previously been initialized,
  --| then a destroy(d) is first performed.  The predict parameter
  --| specifies the initial space allocated.  (predict  = #elements).
  --| The high_percent parameter is the caller's expectation of the
  --| percentage of add_highs, out of total adds, to the darray.  For
  --| example, a caller would specify 100 if it was known that no
  --| add_lows would be performed.  The expand_percent parameter
  --| specifies the amount of additional space, as a percentage of
  --| currently allocated space, that is to be allocated whenever an
  --| expansion becomes necessary.  For example, 100 doubles the
  --| allocated space.

  procedure ARRAY_TO_DARRAY(A              : in ARRAY_TYPE;
                            FIRST          : in INTEGER := 1;
                            PREDICT        : in POSITIVE;
                            HIGH_PERCENT   : in POSITIVE := DEFAULT_HIGH;
                            EXPAND_PERCENT : in POSITIVE := DEFAULT_EXPAND;
                            D              : in out DARRAY);

  --| Raises: out_of_bounds
  --| Effects:
  --| Sets d to <first, a(a'first..a'last)>.  If d has previously
  --| been initialized, then an implicit destroy(d) is performed.
  --| The high_percent and expand_percent parameters are defined
  --| as for create.  Raises out_of_bounds iff predict < a'length.

  procedure SET_FIRST(D     : in out DARRAY;
                      FIRST : in INTEGER);

  --| Raises: uninitialized_darray
  --| Effects:
  --| Sets d.first to first.
  --| Raises uninitialized_darray if d has not been initialized.

  procedure ADD_LOW(D : in out DARRAY;
                    E : in ELEM_TYPE);

  --| Raises: uninitialized_darray
  --| Effects:
  --| Sets d to <d.first - 1, e & d.elts>.
  --| Raises uninitialized_darray if d has not been initialized.

  procedure ADD_HIGH(D : in out DARRAY;
                     E : in ELEM_TYPE);

  --| Raises: uninitialized_darray
  --| Effects:
  --| Sets d.elts to d.elts & e.
  --| Raises uninitialized_darray if d has not been initialized.

  procedure REMOVE_LOW(D : in out DARRAY);

  --| Raises: out_of_bounds, uninitialized_darray
  --| Effects:
  --| Sets d to <d.first + 1, d.elts(d.first + 1 .. last(d))>.
  --| Raises out_of_bounds iff is_empty(d).
  --| Raises uninitialized_darray if d has not been initialized.

  procedure REMOVE_HIGH(D : in out DARRAY);

  --| Raises: out_of_bounds, uninitialized_darray
  --| Effects:
  --| Sets d.elts to d.elts(d.first..last(d) - 1).
  --| Raises out_of_bounds iff is_empty(d).
  --| Raises uninitialized_darray if d has not been initialized.

  procedure STORE(D : in out DARRAY;
                  I : in INTEGER;
                  E : in ELEM_TYPE);

  --| Raises: out_of_bounds, uninitialized_darray
  --| Effects:
  --| Replaces d.elts(i) with e.  Raises out_of_bounds iff
  --| either is_empty(d) or i is not in d.first..last(d).
  --| Raises uninitialized_darray if d has not been initialized.

  function COPY(D : in DARRAY) return DARRAY;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Returns a copy of d.  Subsequent changes to the structure of d
  --| will not be visible through the application of operations to
  --| the copy of d, and vice versa.  Assignment or parameter passing
  --| without using copy (or copy_deep, described below) will result
  --| in a single darray value being shared among objects.
  --| Raises uninitialized_darray if d has not been initialized.
  --| The assignment operation is used to transfer the values of
  --| the elem_type component objects of d; consequently, changes
  --| in these values may be observable through both darrays if
  --| elem_type is an access type, or contains access type
  --| components.

  generic
    with function COPY(E : in ELEM_TYPE) return ELEM_TYPE;

  function COPY_DEEP(D : in DARRAY) return DARRAY;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Returns a copy of d.  Subsequent changes to the structure of d
  --| will not be visible through the application of operations to
  --| the copy of d, and vice versa.  Assignment or parameter passing
  --| without using copy_deep or copy will result in a single
  --| darray value being shared among objects.
  --| Raises uninitialized_darray if d has not been initialized.
  --| The transfer of elem_type component objects is accomplished by
  --| using the assignment operation in conjunction with the copy
  --| function.  Consequently, the user can prevent sharing of
  --| elem_type access components.


  -- Query Operations:

  function FETCH(D : in DARRAY;
                 I : in INTEGER) return ELEM_TYPE;

  --| Raises: out_of_bounds, uninitialized_darray
  --| Effects:
  --| Returns d.elts(i).  Raises out_of_bounds iff either is_empty(d)
  --| or i is not in d.first..last(d).
  --| Raises uninitialized_darray if d has not been initialized.

  function LOW(D : in DARRAY) return ELEM_TYPE;

  --| Raises: out_of_bounds, uninitialized_darray
  --| Effects:
  --| Returns d.elts(d.first).  Raises out_of_bounds iff is_empty(d).
  --| Raises uninitialized_darray if d has not been initialized.

  function HIGH(D : in DARRAY) return ELEM_TYPE;

  --| Raises: out_of_bounds, uninitialized_darray
  --| Effects:
  --| Returns d.elts(last(d)).  Raises out_of_bounds iff is_empty(d).
  --| Raises uninitialized_darray if d has not been initialized.

  function FIRST(D : in DARRAY) return INTEGER;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Returns d.first.
  --| Raises uninitialized_darray if d has not been initialized.

  function LAST(D : in DARRAY) return INTEGER;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Returns d.first + |d.elts| - 1.
  --| Raises uninitialized_darray if d has not been initialized.

  function IS_EMPTY(D : in DARRAY) return BOOLEAN;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Returns length(d) = 0, or equivalently, last(d) < d.first.
  --| Raises uninitialized_darray if d has not been initialized.

  function LENGTH(D : in DARRAY) return NATURAL;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Returns |d.elts|.
  --| Raises uninitialized_darray if d has not been initialized.

  function EQUAL(D1, D2 : in DARRAY) return BOOLEAN;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Return (d1.first = d2.first and
  --|         last(d1) = last(d2) and
  --|         for each i in d1.first..last(d1),
  --|             equal(d1.elts(i), d2.elts(i)).
  --| Raises uninitialized_darray if either d1 or d2 has not been
  --| initialized.  Note that (d1 = d2) implies that equal(d1, d2)
  --| will always hold.  "=" is object equality, equal is state
  --| equality.

  function DARRAY_TO_ARRAY(D : in DARRAY) return ARRAY_TYPE;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Let bounds_range be d.first..d.first + length(d) - 1.  If
  --| bounds_range is empty, then return an empty array with bounds
  --| of 1..0.  Otherwise, return bounds_range'(d.elts).
  --| Raises uninitialized_darray if d has not been initialized.


  -- Iterators:

  function MAKE_ELEMENTS_ITER(D : in DARRAY) return ELEMENTS_ITER;

  --| Raises: uninitialized_darray
  --| Effects:
  --| Create and return an elements itererator based on d.  This
  --| object can then be used in conjunction with the more function
  --| and the next procedure to iterate over the components of d.
  --| Raises uninitialized_darray if d has not been initialized.

  function MORE(ITER : in ELEMENTS_ITER) return BOOLEAN;

  --| Effects:
  --| Return true iff the elements iterator has not been exhausted.

  procedure NEXT(ITER : in out ELEMENTS_ITER;
                 E    : out ELEM_TYPE);

  --| Raises: no_more
  --| Effects:
  --| Let iter be based on the darray, d.  Successive calls of next
  --| will return, in e, successive elements of d.elts.  Each call
  --| updates the state of the elements iterator.  After all elements
  --| have been returned, an invocation of next will raise no_more.
  --| Requires:
  --| d must not be changed between the invocations of
  --| make_elements_iterator(d) and next.


  -- Heap Management:

  procedure DESTROY(D : in out DARRAY);
  --| Effects:
  --| Return space consumed by the darray value associated with object
  --| d to the heap.  (If d is uninitialized, this operation does
  --| nothing.)  If other objects share the same darray value, then
  --| further use of these objects is erroneous.  Components of type
  --| elem_type, if they are access types, are not garbage collected.
  --| It is the user's responsibility to dispose of these objects.
  --| d is left in the uninitialized state.


private

  type ARRAY_PTR is access ARRAY_TYPE;

  type DARRAY_INFO is
    record
      FIRST_IDX      : POSITIVE;
      LAST_IDX       : NATURAL;
      FIRST          : INTEGER;
      HIGH_PERCENT   : POSITIVE;
      EXPAND_PERCENT : POSITIVE;
      ARR            : ARRAY_PTR := null;
    end record;

  type DARRAY is access DARRAY_INFO;

  --| Let r be an instance of the representation type.
  --| Representation Invariants:
  --| 1. r /= null, r.arr /= null (must be initialized to be valid.)
  --| 2. r.arr'first = 1 and
  --|    r.arr'last >= 1
  --| 3. r.first_idx <= r.last_idx or
  --|    r.first_idx = r.last_idx + 1
  --| 4. r.first_idx <= r.last_idx =>
  --|        r.first_idx, r.last_idx in r.arr'range
  --| 5. r.expand_percent, r.high_percent get values at creation time,
  --|    and these never change.
  --|
  --| Abstraction Function:  (denoted by A(r))
  --| if r.last_idx < r.first_idx then
  --|     <r.first, ()>
  --| else
  --|     <r.first, (r.arr(r.first_idx),...,r.arr(r.last_idx))>
  --|
  --| These properties follow:
  --| 1. length(A(r)) = r.last_idx - r.first_idx + 1
  --| 2. last(A(r)) = r.first + r.last_idx - r.first_idx
  --| 3. fetch(A(r), i) =
  --|        if (i - r.first + r.first_idx) in r.first_idx..r.last_idx
  --|            then r.arr(i - r.first + r.first_idx)
  --|            else undefined.  (out_of_bounds)

  type ELEMENTS_ITER is
    record
      LAST    : INTEGER := 0;
      CURRENT : INTEGER := 1;
      ARR     : ARRAY_PTR;
    end record;

    --| Let d be the darray that an elements_iter, i, is based on.
    --| Initially, i.current = d.first_idx, i.last = d.last_idx, and
    --| i.arr = d.arr.
    --| more(i) = i.current <= i.last.
    --| next(i) = i.arr(current).  i.current incremented by next.
    --| Note that if an elements_iter object is not initialized, then
    --| more is false.

end DYNARRAY_PKG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--dynarray.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with UNCHECKED_DEALLOCATION;

package body DYNARRAY_PKG is

-- Utilities:

  procedure FREE_ARRAY_PTR is
    new UNCHECKED_DEALLOCATION(ARRAY_TYPE, ARRAY_PTR);

  procedure FREE_DARRAY is
    new UNCHECKED_DEALLOCATION(DARRAY_INFO, DARRAY);

  function DOWN_INDEX(I : in INTEGER;
                      D : in DARRAY) return INTEGER;

  --| Raises: out_of_bounds
  --| Effects:
  --| Map from abstraction indices to representation indices.
  --| Raises out_of_bounds iff either is_empty(d) or i is not in
  --| d.first..last(d).
  --| Requires: d must be initialized.

  procedure INITIALIZATION_CHECK(D : in DARRAY);

  --| Raises: uninitialized_darray
  --| Effects:
  --| Returns normally iff d has been the target of a create, copy,
  --| or array_to_darray operation, and has not since been destroyed.
  --| Otherwise, raises uninitialized_darray.
  --| This procedure will not detect the case where another object
  --| sharing the same darray value has been destroyed; this is
  --| erroneous use.

  procedure EXPAND(D : in out DARRAY);

  --| Effects:
  --| Allocates additional space in d.arr.  The old contents of d.arr
  --| are copied to a slice of the new array.  The expansion amount is
  --| a percentage (d.expand_percent) of currently allocated space.
  --| Sets d.first_idx and d.last_idx to appropriate positions in the
  --| new array; these positions are selected according to the
  --| expected distribution of add_highs/add_lows (d.high_percent).
  --| Requires: d must be initialized.

  procedure CONTRACT(D : in out DARRAY);

  --| Effects:
  --| Checks whether d.arr consumes too much space in proportion to
  --| the slice that is being used to hold the darray elements.  If
  --| so, halves the size of d.arr.  The old contents of d.arr are
  --| copied to a slice of the new array.  Sets d.first_idx and
  --| and d.last_idx to appropriate positions in the new array; these
  --| positions are selected according to the expected distribution of
  --| add_highs/add_lows (d.high_percent).
  --| Requires: d must be initialized and nonempty.

  procedure REALLOCATE(D          : in out DARRAY;
                       NEW_LENGTH : in POSITIVE);

  --| Raises: out_of_bounds
  --| Effects:
  --| Replaces d.arr with a pointer to an array of length new_length,
  --| fills a slice of this array with the old contents of d.arr, and
  --| adjusts d.first_idx and d.last_idx appropriately.  Everything is
  --| done according to d.high_percent.  Used by both expand/contract.
  --| Raises out_of_bounds iff new_length < length(d).
  --| Requires: d must be initialized.

  procedure DETERMINE_POSITION(ARRAY_LENGTH : in POSITIVE;
                               SLICE_LENGTH : in NATURAL;
                               HIGH_PERCENT : in POSITIVE;
                               FIRST_IDX    : out POSITIVE;
                               LAST_IDX     : out NATURAL);

  --| Raises: out_of_bounds
  --| Effects:
  --| Determines the appropriate position of a slice of length
  --| slice_length in an array with range 1..array_length.  This
  --| position is calculated according to the high_percent parameter.
  --| Raises out_of_bounds iff slice_length > array_length.
  --| Used by create, array_to_darray, reallocate.


  -- Constructors:

  procedure CREATE(FIRST          : in INTEGER := 1;
                   PREDICT        : in POSITIVE := DEFAULT_PREDICT;
                   HIGH_PERCENT   : in POSITIVE := DEFAULT_HIGH;
                   EXPAND_PERCENT : in POSITIVE := DEFAULT_EXPAND;
                   D              : in out DARRAY) is
  begin
    DESTROY(D);
    D := new DARRAY_INFO;
    DETERMINE_POSITION(PREDICT, 0, HIGH_PERCENT, D.FIRST_IDX, D.LAST_IDX);
    D.FIRST := FIRST;
    D.HIGH_PERCENT := HIGH_PERCENT;
    D.EXPAND_PERCENT := EXPAND_PERCENT;
    D.ARR := new ARRAY_TYPE(1 .. PREDICT);
  exception
    when OUT_OF_BOUNDS =>

      -- determine_position fails
      DESTROY(D);
      raise;
  end CREATE;

  procedure ARRAY_TO_DARRAY(A              : in ARRAY_TYPE;
                            FIRST          : in INTEGER := 1;
                            PREDICT        : in POSITIVE;
                            HIGH_PERCENT   : in POSITIVE := DEFAULT_HIGH;
                            EXPAND_PERCENT : in POSITIVE := DEFAULT_EXPAND;
                            D              : in out DARRAY) is
  begin
    if D /= null then
      FREE_ARRAY_PTR(D.ARR);
    end if;
    D := new DARRAY_INFO;
    DETERMINE_POSITION(PREDICT, A'LENGTH, HIGH_PERCENT, D.FIRST_IDX, D.LAST_IDX)
      ;
    D.FIRST := FIRST;
    D.HIGH_PERCENT := HIGH_PERCENT;
    D.EXPAND_PERCENT := EXPAND_PERCENT;
    D.ARR := new ARRAY_TYPE(1 .. PREDICT);
    D.ARR.all := A;
  exception
    when OUT_OF_BOUNDS =>

      -- determine_position fails
      DESTROY(D);
      raise;
  end ARRAY_TO_DARRAY;

  procedure SET_FIRST(D     : in out DARRAY;
                      FIRST : in INTEGER) is
  begin
    INITIALIZATION_CHECK(D);
    D.FIRST := FIRST;
  end SET_FIRST;

  procedure ADD_LOW(D : in out DARRAY;
                    E : in ELEM_TYPE) is
  begin
    INITIALIZATION_CHECK(D);
    D.ARR(D.FIRST_IDX - 1) := E;
    D.FIRST_IDX := D.FIRST_IDX - 1;
    D.FIRST := D.FIRST - 1;
  exception
    when CONSTRAINT_ERROR =>

      -- on array store
      EXPAND(D);
      D.ARR(D.FIRST_IDX - 1) := E;
      D.FIRST_IDX := D.FIRST_IDX - 1;
      D.FIRST := D.FIRST - 1;
  end ADD_LOW;

  procedure ADD_HIGH(D : in out DARRAY;
                     E : in ELEM_TYPE) is
  begin
    INITIALIZATION_CHECK(D);
    D.ARR(D.LAST_IDX + 1) := E;
    D.LAST_IDX := D.LAST_IDX + 1;
  exception
    when CONSTRAINT_ERROR =>

      -- on array store
      EXPAND(D);
      D.ARR(D.LAST_IDX + 1) := E;
      D.LAST_IDX := D.LAST_IDX + 1;
  end ADD_HIGH;

  procedure REMOVE_LOW(D : in out DARRAY) is
  begin
    INITIALIZATION_CHECK(D);
    if D.LAST_IDX < D.FIRST_IDX then
      raise OUT_OF_BOUNDS;
    end if;

    D.FIRST_IDX := D.FIRST_IDX + 1;
    D.FIRST := D.FIRST + 1;
    CONTRACT(D);
  end REMOVE_LOW;

  procedure REMOVE_HIGH(D : in out DARRAY) is
  begin
    INITIALIZATION_CHECK(D);
    if D.LAST_IDX < D.FIRST_IDX then
      raise OUT_OF_BOUNDS;
    end if;

    D.LAST_IDX := D.LAST_IDX - 1;
    CONTRACT(D);
  end REMOVE_HIGH;

  procedure STORE(D : in out DARRAY;
                  I : in INTEGER;
                  E : in ELEM_TYPE) is
  begin
    INITIALIZATION_CHECK(D);
    D.ARR(DOWN_INDEX(I, D)) := E;
  end STORE;

  function COPY(D : in DARRAY) return DARRAY is
    D2 : DARRAY;
  begin
    INITIALIZATION_CHECK(D);
    D2 := new DARRAY_INFO'(FIRST_IDX => D.FIRST_IDX, LAST_IDX => D.LAST_IDX,
      FIRST => D.FIRST, HIGH_PERCENT => D.HIGH_PERCENT, EXPAND_PERCENT => D.
      EXPAND_PERCENT, ARR => new ARRAY_TYPE(1 .. D.ARR'LENGTH));
    D2.ARR.all := D.ARR.all;
    return D2;
  end COPY;

  function COPY_DEEP(D : in DARRAY) return DARRAY is
    D2 : DARRAY;
    I  : INTEGER;
  begin
    INITIALIZATION_CHECK(D);
    D2 := new DARRAY_INFO'(FIRST_IDX => D.FIRST_IDX, LAST_IDX => D.LAST_IDX,
      FIRST => D.FIRST, HIGH_PERCENT => D.HIGH_PERCENT, EXPAND_PERCENT => D.
      EXPAND_PERCENT, ARR => new ARRAY_TYPE(1 .. D.ARR'LENGTH));
    for I in D.FIRST_IDX .. D.LAST_IDX loop
      D2.ARR(I) := COPY(D.ARR(I));
    end loop;
    return D2;
  end COPY_DEEP;


  -- Query Operations:

  function FETCH(D : in DARRAY;
                 I : in INTEGER) return ELEM_TYPE is
  begin
    INITIALIZATION_CHECK(D);
    return D.ARR(DOWN_INDEX(I, D));
  end FETCH;

  function LOW(D : in DARRAY) return ELEM_TYPE is
  begin
    INITIALIZATION_CHECK(D);
    return D.ARR(DOWN_INDEX(D.FIRST, D));
  end LOW;

  function HIGH(D : in DARRAY) return ELEM_TYPE is
  begin
    if IS_EMPTY(D) then

      -- is_empty checks for initialization
      raise OUT_OF_BOUNDS;
    end if;
    return D.ARR(D.LAST_IDX);
  end HIGH;

  function FIRST(D : in DARRAY) return INTEGER is
  begin
    INITIALIZATION_CHECK(D);
    return D.FIRST;
  end FIRST;

  function LAST(D : in DARRAY) return INTEGER is
  begin
    INITIALIZATION_CHECK(D);
    return D.FIRST + D.LAST_IDX - D.FIRST_IDX;
  end LAST;

  function IS_EMPTY(D : in DARRAY) return BOOLEAN is
  begin
    INITIALIZATION_CHECK(D);
    return D.LAST_IDX < D.FIRST_IDX;
  end IS_EMPTY;

  function LENGTH(D : in DARRAY) return NATURAL is
  begin
    INITIALIZATION_CHECK(D);
    return D.LAST_IDX - D.FIRST_IDX + 1;
  end LENGTH;

  function EQUAL(D1, D2 : in DARRAY) return BOOLEAN is
    I2 : INTEGER;
  begin
    INITIALIZATION_CHECK(D1);
    INITIALIZATION_CHECK(D2);

    if D1.FIRST /= D2.FIRST or else LENGTH(D1) /= LENGTH(D2) then
      return FALSE;
    end if;

    I2 := D2.FIRST_IDX;
    for I1 in D1.FIRST_IDX .. D1.LAST_IDX loop
      if not EQUAL(D1.ARR(I1), D2.ARR(I2)) then
        return FALSE;
      end if;
      I2 := I2 + 1;
    end loop;

    return TRUE;
  end EQUAL;

  function DARRAY_TO_ARRAY(D : in DARRAY) return ARRAY_TYPE is
    subtype DBOUNDS_ARRAY is ARRAY_TYPE(D.FIRST .. LAST(D));
    -- invocation of last performs initialization check.
  begin
    return DBOUNDS_ARRAY'(D.ARR(D.FIRST_IDX .. D.LAST_IDX));
  end DARRAY_TO_ARRAY;


  -- Iterators:

  function MAKE_ELEMENTS_ITER(D : in DARRAY) return ELEMENTS_ITER is
  begin
    INITIALIZATION_CHECK(D);
    return (CURRENT => D.FIRST_IDX, LAST => D.LAST_IDX, ARR => D.ARR);
  end MAKE_ELEMENTS_ITER;

  function MORE(ITER : in ELEMENTS_ITER) return BOOLEAN is
  begin
    return ITER.CURRENT <= ITER.LAST;
  end MORE;

  procedure NEXT(ITER : in out ELEMENTS_ITER;
                 E    : out ELEM_TYPE) is
  begin
    if not MORE(ITER) then
      raise NO_MORE;
    end if;

    E := ITER.ARR(ITER.CURRENT);
    ITER.CURRENT := ITER.CURRENT + 1;
  end NEXT;


  -- Heap Management:

  procedure DESTROY(D : in out DARRAY) is
  begin
    FREE_ARRAY_PTR(D.ARR);
    FREE_DARRAY(D);
  exception
    when CONSTRAINT_ERROR =>

      -- d is null, d.arr is illegal.
      return;
  end DESTROY;


  -- Utilities:

  function DOWN_INDEX(I : in INTEGER;
                      D : in DARRAY) return INTEGER is
    DOWN_IDX : INTEGER := I - D.FIRST + D.FIRST_IDX;
  begin
    if D.LAST_IDX < D.FIRST_IDX or else

    -- empty array
    not (DOWN_IDX in D.FIRST_IDX .. D.LAST_IDX) then

      -- bogus index
      raise OUT_OF_BOUNDS;
    end if;

    return DOWN_IDX;
  end DOWN_INDEX;

  procedure INITIALIZATION_CHECK(D : in DARRAY) is
  begin
    if D = null then
      raise UNINITIALIZED_DARRAY;
    end if;
  end INITIALIZATION_CHECK;

  procedure EXPAND(D : in out DARRAY) is
    NEW_LENGTH : INTEGER := (D.ARR'LENGTH*(100 + D.EXPAND_PERCENT))/100;
  begin

    -- Specified percent, in relation to length, may be too small to
    -- force any growth.  In this case, force growth.  This is rare.
    -- The choice to double is arbitrary.
    if NEW_LENGTH = D.ARR'LENGTH then
      NEW_LENGTH := 2*D.ARR'LENGTH;
    end if;

    REALLOCATE(D, NEW_LENGTH);
  end EXPAND;

  procedure CONTRACT(D : in out DARRAY) is
  -- <<A better contraction strategy is needed.  Justification is weak
  -- for this one.>>
  begin
    null;
  end CONTRACT;

  procedure REALLOCATE(D          : in out DARRAY;
                       NEW_LENGTH : in POSITIVE) is

    NEW_ARR       : ARRAY_PTR;
    NEW_FIRST_IDX : INTEGER;
    NEW_LAST_IDX  : INTEGER;

  begin
    DETERMINE_POSITION(NEW_LENGTH, LENGTH(D), D.HIGH_PERCENT, NEW_FIRST_IDX,
      NEW_LAST_IDX);
    NEW_ARR := new ARRAY_TYPE(1 .. NEW_LENGTH);
    NEW_ARR(NEW_FIRST_IDX .. NEW_LAST_IDX) := D.ARR(D.FIRST_IDX .. D.LAST_IDX);
    FREE_ARRAY_PTR(D.ARR);
    D.ARR := NEW_ARR;
    D.FIRST_IDX := NEW_FIRST_IDX;
    D.LAST_IDX := NEW_LAST_IDX;
  end REALLOCATE;

  procedure DETERMINE_POSITION(ARRAY_LENGTH : in POSITIVE;
                               SLICE_LENGTH : in NATURAL;
                               HIGH_PERCENT : in POSITIVE;
                               FIRST_IDX    : out POSITIVE;
                               LAST_IDX     : out NATURAL) is

    LEFT_OVER  : INTEGER := ARRAY_LENGTH - SLICE_LENGTH;
    HIGH_SPACE : INTEGER := (HIGH_PERCENT*LEFT_OVER)/100;
    LOW_SPACE  : INTEGER := LEFT_OVER - HIGH_SPACE;

  begin
    if LEFT_OVER < 0 then
      raise OUT_OF_BOUNDS;
    end if;

    FIRST_IDX := LOW_SPACE + 1;
    LAST_IDX := LOW_SPACE + SLICE_LENGTH;
  end DETERMINE_POSITION;

end DYNARRAY_PKG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--dynarray.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with DYNARRAY_PKG;
with TYPE_DEFINITIONS; use TYPE_DEFINITIONS;
package DYNAMIC_ARRAY_PKG is
  new DYNARRAY_PKG(COUNT_RANGE);

  --|overview
  --|This is the instantiation of the dynamic array package for the
  --|path analyzer report writer. It must be used by both the Breakpoint
  --|package and the report writer itself. It is instantiated with the
  --|count_range data type to facilitate the tracking of breakpoint
  --|execution count data which is of this type.

  --|n/a effects,requires,modifies,errors,tuning,notes
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--hostdep.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

package HOST_DEPENDENCIES is
--| Simple data types and constants involving the Host Machine.

-- Types and Objects --

  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;

  -- 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.

end HOST_DEPENDENCIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--hostdep.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

package body HOST_DEPENDENCIES is
--| Simple data types and constants involving the host machine

-- Operations --

  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;

end HOST_DEPENDENCIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--errmsg.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


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

with HOST_DEPENDENCIES;  -- 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 HD renames HOST_DEPENDENCIES;

  --------------------------------------------------------------
  -- 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 HD.SOURCE_LINE;
                                          --| line number of error.
                           IN_COLUMN     : in HD.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 HD.SOURCE_LINE;
                                          --| line number of error.
                           IN_COLUMN         : in HD.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 HD.SOURCE_LINE;
                           IN_COLUMN     : in HD.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: " & HD.SOURCE_LINE'IMAGE(IN_LINE) & " Column: " & HD
      .SOURCE_COLUMN'IMAGE(IN_COLUMN) & " - " & MESSAGE_TEXT(IN_MESSAGE_ID));

  end OUTPUT_MESSAGE;

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

  procedure OUTPUT_MESSAGE(IN_LINE           : in HD.SOURCE_LINE;
                           IN_COLUMN         : in HD.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: " & HD.SOURCE_LINE'IMAGE(IN_LINE) & " Column: " & HD
      .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 HOST_DEPENDENCIES;  -- 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 ..
    HOST_DEPENDENCIES.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 HOST_DEPENDENCIES;  -- 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 HD renames HOST_DEPENDENCIES;
  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   : HD.SOURCE_LINE;
      SRCPOS_COLUMN : HD.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 HOST_DEPENDENCIES;  -- 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 HD renames HOST_DEPENDENCIES;
  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 HD.SOURCE_LINE;

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

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

end LEX;

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


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

with HOST_DEPENDENCIES;  -- 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     : HD.SOURCE_COLUMN := 1;
  CURRENT_LINE       : HD.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 .. ((HD.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    : HD.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(HD.
    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 HD.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
    CURRENT_COLUMN := LINE_BUFFER_LAST + 1;
    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 := HD.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 < HD.SOURCE_LINE'LAST) then
        begin -- block
          CURRENT_LINE := HD.SOURCE_LINE -- type conversion
          (TEXT_IO.LINE(FILE => TEXT_IO.CURRENT_INPUT));
          if (CURRENT_LINE >= HD.SOURCE_LINE'LAST) then
            raise CONSTRAINT_ERROR;
          end if;
        exception
          when others =>
            CURRENT_LINE := HD.SOURCE_LINE'LAST;
            LEM.OUTPUT_MESSAGE(CURRENT_LINE, CURRENT_COLUMN, HD.SOURCE_LINE'
              IMAGE(HD.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_LINEwhen (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 HD.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_USEDnot  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 HD.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: " & HD.SOURCE_LINE'IMAGE(IN_PSE.
      LEXED_TOKEN.SRCPOS_LINE) & " Column: " & HD.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;

----------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--impldep.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
-----------------------------------
package Implementation_Dependencies is --| Ada Compiler dependencies
-----------------------------------

--| Overview
--| This package contains Ada Compiler Implementation dependencies.
--| The purpose of this package is to isolate compiler dependencies
--| to a single package to simplify rehosting of the Ada Testing
--| and Evaluation Tools Set (ATETS).

--| This version of Implementation_Dependencies is configured for:
--|
--|   - DEC VAX Ada Compiler
--|
--|   - TeleSoft Ada Compiler ( VAX VMS Version 2.5 )


-- Jeff England  04/30/85 (TeleSoft Ada)
--               05/09/85 (DEC VAX Ada)

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


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

--    type Long_Float    is new float;    --| Not implemented in TeleSoft Ada

--    type Short_Integer is new integer;  --| Not implemented in TeleSoft Ada

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

    Line_length : constant := 256;

end Implementation_Dependencies;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--Timelib1.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with Calendar, Text_IO;

----------------------
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



type Timing_Type is ( Raw, Wall_Clock );


----------------
function Date_of ( --| Convert the date to a string
    Date : 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 : 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


-------------------------
procedure Put_Time_of_Day ( --| Put the time of day to the file
    Fyle    : in Text_IO.File_Type;    --| The output file
    Seconds : in Calendar.Day_Duration --| The time to be output
    );

  --| Effects
  --| If Timing = WALL_CLOCK then the time is put to the file in the
  --| format HH:MM:SS.FF. If Timing = RAW then the time of
  --| day is put to the file using new Fixed_IO( Day_Duration ).
  --|
  --| Requires
  --| Fyle must have been previously opened by the calling program.

  --| N/A:  Raises, Modifies, Errors


------------------
procedure Put_Time ( --| Put the time to the file
    Fyle : in Text_IO.File_Type;  --| The output file
    Date : in Calendar.Time       --| The time to be output
    );

  --| Effects
  --| If Timing = WALL_CLOCK then the time is put to the file in the
  --| format MM/DD/YYYY HH:MM:SS.FF. If Timing = RAW then the time of
  --| day is put to the file using new Fixed_IO( Day_Duration ).
  --|
  --| Requires
  --| Fyle must have been previously opened by the calling program.

  --| N/A:  Raises, Modifies, Errors


--------------------
procedure Set_Timing ( --| Set the method of recording timing data

    Timing : Timing_Type  --| The type of timing data to be recorded

    );

  --| Effects
  --| Sets th method of recording timing data to either RAW or Wall_Clock.
  --| If Timing = WALL_CLOCK then the time is put to the file in the
  --| format MM/DD/YYYY HH:MM:SS.FF. If Timing = RAW then the time of
  --| day is put to the file using new Fixed_IO( Day_Duration ).
  --| Overhead for either method may vary from system to system.

  --| N/A:  Raises, Requires, Modifies, Errors


end Time_Library_1;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--timelib1.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with Text_IO, Calendar;

---------------------------
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


package Time_IO is new Text_IO.Fixed_IO( Calendar.Day_Duration );
package Int_IO  is new Text_IO.Integer_IO( Integer );

Timing_Method : Timing_Type := Wall_Clock;
            --| When Timing_Method = WALL_CLOCK then Put_Time
            --| puts the time to the file in the form HH:MM:SS:FF.
            --| When Timing_Method = RAW the time put using
            --| Fixed_IO(Day_Duration).


----------------
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

    Int_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 : Calendar.Day_Duration
    ) return string is

Temp_Secs : String(1..10);

begin
    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 : 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 : 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;


-------------------------
procedure Put_Time_of_Day ( --| Put the time of day to the file
    Fyle : in Text_IO.File_Type;        --| The output file
    Seconds : in Calendar.Day_Duration  --| The time to be output
    ) is

  --| Effects
  --| If Timing = WALL_CLOCK then the time is put to the file in the
  --| format HH:MM:SS.FF. If Timing = RAW then the time of
  --| day is put to the file using new Fixed_IO( Day_Duration ).
  --|
  --| Requires
  --| Fyle must have been previously opened by the calling program.

  --| N/A:  Raises, Modifies, Errors


begin

    if Timing_Method = Wall_Clock then
        Text_IO.Put( Fyle, Wall_Clock_of( Seconds ) );
    else
        Time_IO.Put( Fyle, Seconds, 0, 2, 0 );
    end if;

end Put_Time_of_Day;


------------------
procedure Put_Time ( --| Put the time to the file
    Fyle : in Text_IO.File_Type;  --| The output file
    Date : in Calendar.Time       --| The time to be output
    ) is

  --| Effects
  --| If Timing = WALL_CLOCK then the time is put to the file in the
  --| format MM/DD/YYYY HH:MM:SS.FF. If Timing = RAW then the time of
  --| day is put to the file using new Fixed_IO( Day_Duration ).
  --|
  --| Requires
  --| Fyle must have been previously opened by the calling program.

  --| N/A:  Raises, Modifies, Errors


begin

    Text_IO.Put( Fyle, Date_of( Date ) );

    Text_IO.Put( Fyle, ' ' );

    Put_Time_of_Day( Fyle, Calendar.Seconds( Date ) );

end Put_Time;


--------------------
procedure Set_Timing ( --| Set the method of recording timing data

    Timing : Timing_Type  --| The type of timing data to be recorded

    ) is

  --| Effects
  --| Sets th method of recording timing data to either RAW or Wall_Clock.
  --| If Timing = WALL_CLOCK then the time is put to the file in the
  --| format MM/DD/YYYY HH:MM:SS.FF. If Timing = RAW then the time of
  --| day is put to the file using new Fixed_IO( Day_Duration ).
  --| Overhead for either method may vary from system to system.

  --| N/A:  Raises, Requires, Modifies, Errors

begin

    Timing_Method := Timing; --| Set timing method to RAW or WALL_CLOCK

end Set_Timing;

end Time_Library_1;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--prefix.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
package Test_Library_prefix_Definition

is

  File_Prefix_Limit   : constant natural := 8;

  Test_Library_Prefix : constant string := "[USER.MRKTOOL.TESTLIB]";

end;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--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 :=
         8573 ;
        --| Length (number of entries) in map ActionTableOne.
    subtype ActionTableOneRange is GC.ParserInteger
            range 1..ActionTableOneLength;

    ActionTableTwoLength : constant GC.ParserInteger :=
         8573 ;
        --| Length (number of entries) in map ActionTableTwo.
    subtype ActionTableTwoRange is GC.ParserInteger
            range 1..ActionTableTwoLength;

    DefaultMapLength : constant GC.ParserInteger :=
         1039 ;
        --| Length (number of entries) in map Defaults.
    subtype DefaultMapRange is GC.ParserInteger range 1..DefaultMapLength;

    FollowMapLength : constant GC.ParserInteger :=
          300 ;
        --| Length (number of entries) in the FollowMap.

    GrammarSymbolCountPlusOne : constant GC.ParserInteger :=
          397 ;
        --| 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, 1569
, 1570, 1596, 1597, 1612, 1613, 1616, 1617, 1630, 1631, 1647
, 1648, 1652, 1653, 1672, 1673, 1687, 1688, 1701, 1702, 1714
, 1715, 1737, 1738, 1758, 1759, 1779, 1780, 1803, 1804, 1815
, 1816, 1829, 1830, 1849, 1850, 1885, 1886, 1905, 1906, 1948
, 1949, 1955, 1956, 1979, 1980, 1985, 1986, 1994, 1995, 2018
, 2019, 2034, 2035, 2038, 2039, 2062, 2063, 2084, 2085, 2105
, 2106, 2115, 2116, 2137, 2138, 2148, 2149, 2157, 2158, 2172
, 2173, 2184, 2185, 2193, 2194, 2210, 2211, 2228, 2229, 2237
, 2238, 2245, 2246, 2265, 2266, 2287, 2288, 2296, 2297, 2330
, 2331, 2351, 2352, 2378, 2379, 2408, 2409, 2426, 2427, 2455
, 2456, 2490, 2491, 2528, 2529, 2536, 2537, 2559, 2560, 2581
, 2582, 2604, 2605, 2633, 2634, 2661, 2662, 2701, 2702, 2708
, 2709, 2765, 2766, 2801, 2802, 2805, 2806, 2812, 2813, 2846
, 2847, 2852, 2853, 2882, 2883, 2906, 2907, 2915, 2916, 2935
, 2936, 2954, 2955, 2976, 2977, 2997, 2998, 3017, 3018, 3040
, 3041, 3053, 3054, 3065, 3066, 3074, 3075, 3085, 3086, 3107
, 3108, 3123, 3124, 3141, 3142, 3160, 3161, 3168, 3169, 3189
, 3190, 3209, 3210, 3223, 3224, 3235, 3236, 3251, 3252, 3265
, 3266, 3280, 3281, 3295, 3296, 3310, 3311, 3322, 3323, 3336
, 3337, 3352, 3353, 3368, 3369, 3383, 3384, 3403, 3404, 3417
, 3418, 3431, 3432, 3445, 3446, 3460, 3461, 3474, 3475, 3479
, 3480, 3518, 3519, 3566, 3567, 3596, 3597, 3605, 3606, 3625
, 3626, 3695, 3696, 3727, 3728, 3753, 3754, 3774, 3775, 3792
, 3793, 3805, 3806, 3817, 3818, 3831, 3832, 3846, 3847, 3879
, 3880, 3893, 3894, 3937, 3938, 3961, 3962, 3980, 3981, 3996
, 3997, 4020, 4021, 4036, 4037, 4059, 4060, 4085, 4086, 4095
, 4096, 4099, 4100, 4121, 4122, 4149, 4150, 4165, 4166, 4186
, 4187, 4215, 4216, 4240, 4241, 4256, 4257, 4291, 4292, 4317
, 4318, 4329, 4330, 4344, 4345, 4370, 4371, 4414, 4415, 4446
, 4447, 4478, 4479, 4509, 4510, 4526, 4527, 4553, 4554, 4610
, 4611, 4639, 4640, 4678, 4679, 4692, 4693, 4714, 4715, 4730
, 4731, 4745, 4746, 4763, 4764, 4787, 4788, 4834, 4835, 4860
, 4861, 4878, 4879, 4895, 4896, 4916, 4917, 4948, 4949, 4972
, 4973, 5003, 5004, 5015, 5016, 5055, 5056, 5068, 5069, 5079
, 5080, 5111, 5112, 5141, 5142, 5148, 5149, 5166, 5167, 5179
, 5180, 5195, 5196, 5209, 5210, 5234, 5235, 5241, 5242, 5266
, 5267, 5283, 5284, 5303, 5304, 5314, 5315, 5343, 5344, 5363
, 5364, 5379, 5380, 5396, 5397, 5410, 5411, 5457, 5458, 5475
, 5476, 5501, 5502, 5517, 5518, 5536, 5537, 5552, 5553, 5583
, 5584, 5612, 5613, 5635, 5636, 5653, 5654, 5675, 5676, 5694
, 5695, 5716, 5717, 5740, 5741, 5792, 5793, 5816, 5817, 5840
, 5841, 5853, 5854, 5886, 5887, 5900, 5901, 5928, 5929, 5951
, 5952, 5970, 5971, 5986, 5987, 6002, 6003, 6018, 6019, 6030
, 6031, 6045, 6046, 6054, 6055, 6063, 6064, 6117, 6118, 6142
, 6143, 6155, 6156, 6168, 6169, 6183, 6184, 6205, 6206, 6233
, 6234, 6251, 6252, 6282, 6283, 6294, 6295, 6313, 6314, 6336
, 6337, 6367, 6368, 6382, 6383, 6401, 6402, 6419, 6420, 6435
, 6436, 6462, 6463, 6478, 6479, 6497, 6498, 6523, 6524, 6554
, 6555, 6580)  ;

    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'
,'_','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','_','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','a','m','b','i','g','u','o','u','s'
,'_','s','t','a','t','e','m','e','n','t'
,'{','l','a','b','e','l','}','+','b','r'
,'e','a','k','_','e','v','e','r','y','_'
,'s','t','a','t','e','m','e','n','t','b'
,'r','e','a','k','_','d','e','c','i','s'
,'i','o','n','_','p','o','i','n','t','e'
,'x','i','t','_','s','t','a','t','e','m'
,'e','n','t','b','r','e','a','k','_','a'
,'l','w','a','y','s','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'
,'i','f','_','s','t','a','t','e','m','e'
,'n','t','c','a','s','e','_','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','b','r'
,'e','a','k','_','a','m','b','i','g','u'
,'o','u','s','a','s','s','i','g','n','m'
,'e','n','t','_','s','t','a','t','e','m'
,'e','n','t','c','a','l','l','_','s','t'
,'a','t','e','m','e','n','t','c','o','d'
,'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'
,'r','e','s','o','l','v','e','_','s','i'
,'m','p','l','e','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',']','i','t','e'
,'r','a','t','i','o','n','_','r','u','l'
,'e','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','E','L','A','Y','_','_','s','t','a'
,'r','t','_','d','e','l','a','y','_','e'
,'x','p','r','e','s','s','i','o','n','s'
,'i','m','p','l','e','_','e','x','p','r'
,'e','s','s','i','o','n','_','_','e','n'
,'d','_','d','e','l','a','y','_','e','x'
,'p','r','e','s','s','i','o','n','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','_','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,  155,  157,  159,  159,  161,  161,  137,  164
,  164,  164,  167,  130,  170,  176,  176,  174,  178,  178
,  178,  138,  125,  125,  181,  181,  179,  184,  184,  184
,  187,  187,  187,  187,  187,  187,  187,  182,  182,  188
,  188,  188,  158,  158,  158,  158,  158,  158,  193,  194
,  194,  196,  196,  196,  195,  197,  197,  197,  197,  199
,  198,  198,  198,  198,  198,  198,   99,   99,   99,  121
,  121,  121,  121,  121,  121,  208,  208,  147,  218,  221
,  221,  223,  219,  219,  219,  219,  219,  219,  219,  226
,  226,  226,  226,  226,  226,  227,  227,  227,  228,  228
,  222,  222,  229,  229,  229,  229,  230,  225,  225,  224
,  224,  224,  224,  235,  233,  233,  233,  233,  233,  233
,  236,  236,  236,  236,  236,  236,  236,  237,  237,  237
,  237,  238,  238,  238,  238,  238,  240,  241,  243,  253
,  259,  260,  171,  254,  249,  264,  250,  268,  268,  257
,  257,  273,  273,  273,  275,  274,  277,  258,  258,  242
,  242,  242,  242,  244,  244,  245,  104,  281,  281,  281
,  281,  285,  285,  283,  286,  286,  287,  287,  287,  190
,  255,  105,  290,  290,  191,  191,  295,  126,  126,  126
,  126,  186,  296,  114,  114,  109,  109,  106,  106,  106
,  106,  192,  303,  251,  251,  246,  306,  307,  252,  252
,  252,  308,  312,  312,  315,  315,  315,  316,  317,  318
,  322,  309,  310,  319,  321,  327,  247,   98,  330,  331
,  331,  331,  333,  333,  333,  333,  333,  333,  333,  332
,  338,  336,  189,  189,  189,  334,  113,  342,  342,  345
,  343,  347,  248,  248,  107,  107,  348,  351,  351,  351
,  351,  352,  352,  352,  352,  352,  352,  352,  352,  108
,  108,  108,  108,  108,  108,  354,  357,  355,  359,  359
,  360,  185,  185,  185,  185,  361,  362,  364,  364,  368
,  367,  363,  256,  165,  165,  369,  369,  232,  232,  370
,  370,  117,  117,  123,  123,  142,  231,  231,  149,  149
,  152,  152,  156,  156,  160,  160,  166,  166,  131,  131
,  372,  372,  373,  373,  180,  180,  180,  183,  183,  200
,  200,  202,  203,  203,  201,  201,  204,  376,  376,  376
,  205,  205,  206,  207,  207,  377,  377,  209,  209,  210
,  210,  211,  211,  212,  212,  213,  213,  214,  214,  215
,  215,  216,  216,  216,  217,  217,  220,  220,  234,  234
,  239,  239,  261,  262,  262,  263,  263,  380,  380,  270
,  270,  272,  272,  279,  279,  278,  278,  382,  340,  340
,  341,  341,  284,  284,  289,  289,  289,  297,  297,  384
,  384,  385,  385,  302,  302,  302,  302,  304,  304,  304
,  304,  313,  313,  320,  320,  328,  328,  329,  329,  335
,  335,  387,  387,  337,  337,  388,  388,  350,  350,  353
,  353,  353,  356,  356,  358,  358,  389,  389,  163,  168
,  169,  162,  365,  172,  391,  392,  265,  349,  390,  175
,  177,  267,  269,  266,  271,  276,  173,  280,  291,  282
,  292,  299,  293,  294,  298,  300,  301,  305,  311,  323
,  386,  326,  314,  393,  381,  344,  346,  288,  366,  339
,  394,  146,  375,  395,  396,  396,  374,  374,  378,  379
,  324,  325,  371,  383,  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,    2,    1,    1,    3,    5,    4
,    4,    2,    5,    5,    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,    1,    2,    2,    2
,    2,    2,    2,    2,    2,    2,    2,    2,    2,    2
,    2,    2,    2,    2,    2,    2,    0,    0,    0,    0
,    0,    3,    2,    5,    7,    1,    5,    2,    2,    7
,    8,    2,    4,    5,    2,    4,    1,    5,    4,    2
,    4,    3,    5,    2,    3,    3,    2,    2,    6,    5
,    9,    1,    1,    4,    1,    2,    1,    2,    3,    4
,    3,    2,    4,    6,    5,    4,    1,    6,   10,    5
,    9,    4,    2,    6,    6,    5,    4,    3,    4,    5
,    5,    4,    4,    4,    5,    3,    1,    1,    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,    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,    5,    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 :=
          ( 7335,  413,  414,    0, 7337,    0, 7339,   33,  249,    0
,    0,    0,  929,    0, 7342,   65, 7344,   67,    0, 7346
, 7348, 7350, 7353, 7355,    0,    0,   73,  672,    0,    0
,    0,  893,  286,  492,  618,    0,    0,    0,    0,    0
,   25,    0,   26, 7357,    0,    0,   28,    0,    0,    0
,  218,    0,  219,  106,    0,    0,    0,    0,    0,    0
,    0,    0,    0,  195,    0,    0,    0,    0,    0,    0
,    0,  265,    0,    0,    0, 1036,    0,    0, 7360, 7362
,   54,    0,  796,  797,   55, 7364,    0,    0,  589,    0
,    0,  333,    0,   58,   59,   60,   61, 7366, 7368,    0
,   32, 7370,   65,   66,   67,    0,   68,   69,   70,   71
,   72,    0,    0,   73,    0,    0,    0, 7372,   53,   54
,    0,    0,    0,   55,    0,  174,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,  241,    0,    0,    0
,   64,   65, 7375,   67,  340,   68,   69,   70,   71, 7377
,    0,    0, 7379,    0,    0,    0,    0,    0,    0, 1578
,    0,    0,    0,    0,    0,    0,    0,  626,    0,    0
,    0,    0,    0,    0, 7381, 1578, 7383,    0,    0,    0
,    0,  443,  444, 7385, 7387,  447,  448,  349,    0,    0
,    0, 1578, 1578,  243, 1578,    0,    0,    0,    0,    0
,  116,    0,    0,  493, 1578, 1578,    0,    0, 1578, 1578
,    0,  269,  270,    0, 1578,    0,    0,    0,    0,    0
,    0,    0,    0,   37,    0,    0,    0,    0,    0,   78
,    0,    0,    0,    0,    0,    0,  879,    0,    0,    0
, 1018,    0,  271,    0,    0,  691,    0,    0,    0,    0
,    0, 1010,    0,    0,    0,   38,   39,   40,    0,    0
,  272,    0,  604,    0,    0, 7389,   45,    0,    0,  942
,    0,    0,  943,  852,    0,  550,    0,  118,    0,    0
,    0,    0,   91,   79,    0,  122,   42,   43,   44,    0
,    0, 7391,    0,    0,   46,    0,   47, 7393,  360,   37
,    0,    0,    0,    0,    0, 1143,    0,    0,    0,    0
,    0,    0,    0,  424, 7395,   79,    0,    0,  627,    0
,  147,    0,    0,    0,    0,    0,  741,    0, 1143,    0
,    0,   38, 7397,   40, 1143,    0,    0, 1143,    0,    0
, 7399,  635,   43,   44,    0, 1143,   84, 1143,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,  456,  799
,  555, 7401, 7404, 7406,   44,    0,  390, 7408, 1143, 7411
, 1143, 1143, 7413, 7415, 7417, 1143, 1143, 1063,  171, 1143
, 1143, 1143,    0,  176, 1143, 1143,    0, 1143, 1143, 1143
,    0,  144,  273,    0,  274,    0,    0,  930,    0,    0
,    0,    0,  122,   42,   43,   44,    0,    0,   45,    0
,    0,   46,    0, 7419,   53, 7421,    0,    0,  275,   55
,    0,    0,    0,    0,    0,    0,  377,  854,   58, 7423
, 7425,   61,   62, 7427,    0,    0,   64,   65,   66,   67
,    2, 7430, 7432,   70,   71,   72,    0,    0, 7434,    0
,    0,   86,    0,  503, 7436,    0,    0,    0,  635,    0
,    0,    0,    0,    0,    0,    0,    0,    0,   52,   53
,   54,    0,    0,    0,    0,    0,    0,    0,    0,  836
,    0,    0,  154,    0, 7438,  674,    0,  675,  676, 7440
,   53, 7442,    0,    0,    0, 7444,    0,  574,    0,    0
,   80,    0,    0,    0,    0,    0,    0,    0,    0,    0
,   37,    0,    0,   65, 7450,   67,    0, 7452,   69, 7454
,   71,   72,    0,    0, 7456,  614,    0,    0,    0,  337
,   52,   53, 7458,   37,    0,    0,   55,    0,    0,    0
,    0,    0,   38,   39,   40,   58,   59, 7460, 7464,   62
,   63,    0,  378,   64, 7466,   66, 7468,  804,   68,   69
,   70,   71,   72,  805,    0, 7470,   39,   40,    0,    0
,    0,  730,  122,   42,   43, 7472,    0,    0,   45,    0
,    0,   46,    0, 7474,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  403, 7476,   42,   43,   44,    0
,    0, 7478,    0,    0,   46,    0,   47,    0,    0,    0
,    0, 7480,  404,    0,    0,    0,    0,    0,    0,    0
, 7482,    0,    0,   86,  247,    0,    0,   38,   39, 7484
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,  381,  692, 7486,   39,   40,    0,  872,    0,    0
,    0,   49,    0,    0,  462,    0,  341, 7488,   42,   43
, 7490,    0,    0,   45,    0, 7492,   46,    0,   47,    0
,    0,    0,    0,  309,   42,  310,   44,   50,  429, 7494
,   79,    0,   46,    0, 7496,  126,    0,  424, 7498, 7500
,   39, 7502,    0,    0, 7504,  718,    0,    0,    0,    0
,   52,   53,   54,    0,    0,    0,   55,    0,    0,  466
,    0, 7506,  649, 7508,    0, 1237,    0,    0,  826,  122
, 7510, 7512,   44, 7514, 7517, 7519, 7523, 7526, 7528, 7531
, 7535,   71, 7538,    0,    0, 7541, 7544,  540,   58, 7546
, 7549,   61, 7551, 7553, 7556,    0,   64,   65, 7558, 7560
, 7562,   68,   69, 7564, 7566, 7568,  761, 7572,   73,  763
,  764,    0, 1239,    0, 1238,  145, 7574,   37,    0,  731
,    0,    0,  147, 1240,   79,  123, 1240,  299, 1240, 1240
,    0,    0,    0,    0,    0,   52,   53,   54,  189,    0
, 7576,   55,    0,    0,    0,    0,    0,   56,   57, 7579
, 7581, 7583, 7587, 7589,   62,   63,    0,   55,   64, 7592
,   66,   67,  125,   68,   69,   70, 7594, 7596,   60,   61
, 7598,   63,  116,    0,   64,   65, 7600,   67,    0, 7602
, 7604, 7606, 7609, 7613,    0,   45,   73,    0, 7615,    0
,   47,    0,    0,    0,    0, 7617,    0,   52,   53,   54
,    0,    0,  127,   55, 7619,    0,  129,    0,  130, 7622
,    0,  122, 7624, 7626, 7629, 7631,   62, 7633,    0,    0
, 7636,   65, 7638, 7640,  857, 7642, 7646, 7648, 7650, 7653
,    0,    0,   73,    0,    0,   49,   38,   39,   40,  100
,    0,    0,    0,    0,    0,    0,    0, 7655,    0,  118
,    0,    0,    0,    0,    0,    0, 7657,  309,   42,  310
,   44, 7659,    0,   45,    0,    0, 7661, 7663, 7665,   44
,    0,    0, 7667,    0,    0,   46,    0,   47,    0,    0
,    0,    0,  960,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,  286, 7669, 7671,    0,  409,  410,  411
, 7673,  413,  414, 7675, 7677,  241,  390,   52,   53,   54
,  805,    0,    0, 7680,  416,    0,  313,  314, 7683,   56
,   57,  417,   58,   59,   60,   61, 7685,   63,  192,    0
,   64,   65, 7688,   67,    0,   68,   69,   70, 7690, 7692
,   53, 7695,   73,    0,    0, 7697,    0,    0, 7699,  424
, 7701,    0,    0,    0,   58, 7703, 7705,   61,   62, 7707
,  975,    0, 7709,   65,   66,   67,    0,   68,   69,   70
,   71, 7712,    0,  102, 7714,  104,    0,    0,    0,    0
,    0,    0,    0,    0,  882,   52,   53,   54,    0,  693
,    0,   55,    0,    0,   52,   53,   54,    0,    0,    0
, 7716,   59, 7718, 7720, 7723,   63,  279,  280,   64, 7725
, 7727,   67,  581,   68,   69,   70,   71, 7729,   65,   66
, 7731,    0,   68,   69,   70,   71,   72,    0,    0,   73
,    0,  323,    0,   82,  324,    0,    0,    0,    0,    0
,  323,    0,  719,  743,    0,    0,  377,    0,  862,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0, 7733,    0,    0,  733,    0,    0
,    0,   25,    0,    0,    0,    0, 7735,   28,    0,    0
,    0,    0,    0,    0,  106,    0,    0,    0,    0,    0
,   74,    0,    0,    0,    0,    0,    0,    0,    0,    0
,  363,    0,    0,  620,    0,    0,    0,    0,    0,  841
,  863, 1003,    0,    0,  471,    0,    0,    0,    0,    0
,    0,    0,    0,  997,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  281,    0,  344,    0,    0
,    0,  651,    0,  652,    0,    0,    0,  615,  263,    0
, 7737,  314,  315,    0,  818,    0,    0,    0,    0,    0
,   37,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,  608,    0,  894,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  819,    0,    0,    0,    0,    0
,    0,    0,   38,   39,   40,    0,    0,    0,    0,    0
,  931,    0,    0,    0,    0,    0,   98,    0,    0,    0
,    0,    0,    0,    0,  790,    0,    0,    0,    0,    0
,    0,    0, 7739,   42,   43, 7742,  744,    0,   45,    0
,    0,    0,    0,    0,    0,    0,  249, 1040,    0,  961
,    0,    0,    0,  450,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,   37,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  188,    0,    0
,    0,  653,    0,  156,    0,    0,   38,   39,   40,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,  724,  323,    0, 7744, 7746,   42,   43,   44
,    0,    0,   45,    0,    0,   46,    0,   47,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,  364
,    0,    0,  194,    0,    0,    0,    0,    0,    0,    0
,   52,   53,   54,    0,    0,    0,   55,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  248,    0,    0
,    0,    0,    0,    0, 7748,  296, 7750,    0,   68,   69
,   70,   71,   72,    0,    0,    0,  694,    0,    0,    0
,    0,    0,    0,    0,  229,    0,    0,    0,  467,  407
,    0,    0,    0,  686,    0,    0,  687,    0,    0, 7752
,    0,    0,    0,    0,    0,    0,    0,    0,    0, 7754
,    0,    0,  431,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,  241,    0,    0,    0,   52,   53,   54,    0,    0,    0
, 7756,   38,   39,   40,    0,    0,    0,    0,    0,    0
,    0,  108,  176,    0,    0,    0,    0,   64,   65,   66
, 7758, 7760,   68,   69,   70,   71,   72,    0,    0,   73
,    0,  122,   42,   43,   44,    0,  944,   45, 7762,    0
, 7764,    0, 7767,    0,    0,    0,    0,  243,    0,    0
,    0,    0,    0,    0,    0,    0,    0, 7769,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  543,  229,    0
,  433,    0,  495,    0,  496,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0, 7771,  800,  190,    0,    0,    0,  655,    0,  472
,  116,    0,  553,    0,    0,  554,    0,    0,    0,  838
,  839,    0,    0, 7773, 7775, 1520,    0,    0,    0,    0
,    0,    0,    0,    0,  811,  986,    0,  798,    0, 7777
, 1520,    2,    0, 1520,    0,    0,    0,    0,    0,  604
,    0,  593, 1520,    0,  594,    0,    0,    0,    0,    0
,    0, 7779,    0,    0,  705,    0,    0,    0,    0,   52
, 7784,   54,    0,    0,    0,   55,    0,  616, 7786,    0
,  340,    0,    0,  157,    0,  550,    0,  118,    0,    0
,    0,    0,   64, 7788, 7790,   67,  397,   68,   69,   70
,   71,   72,    0,    0,   73,  194,    0,    0,    0,    0
, 7792,   37,    0,    0,    0,    0,    0,    0,  301,    0
,  229,    0,    0,  745,    0, 1425,  561,    0,    0,    0
,  545,    0,    0,    0,    0,    0, 1425,    0,    0,    0
, 1425, 1425, 1425, 7794,   39, 7797,    0,    0,    0,  451
,    0,    0,    0,    0,    0,  777,    0, 1425,  194, 1425
, 1425,  575,  657,    0,    0,    0, 1029, 7799,    0,    0
, 7801, 1425,    0, 7803, 7805, 7807, 7809,    0,    0,   45
, 1588,    0,   46,  895,   47,  351,    0,    0,    0,    0
,    0,    0,    0,    0,  883,    0, 7811,    0,  116,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  195,    0,    0,  550,    0
,  118,    0,    0,    0,    0,    0,    0,    0,   38,   39
,   40,    0,    0,    0,    0,    0,    0,    0, 7813,  251
,    0,    0,    0, 7816,    0,    0,    0,    0,    0, 1012
,    0,  583,    0,    0,    0,  468,    0,    0,   41, 7818
,   43,   44,    0,  840,   45,    0, 7820,   46, 1237,   47
,    0,    0,    0,  550, 1240,  118, 1238,    0, 1240, 1237
,    0,    0,    0, 1214, 1214, 1214,  249, 1214, 1238, 1240
,    0,    0, 1237, 1238,    0,    0,    0, 1240,    0,    0
,    0, 7822,   53, 7824,    0,    0,    0,   55,    0,  390
, 1237,    0, 7826,  116,   49, 1239,    0, 1238,    0,    0
,    0,    0,    0,    0, 7828, 7830, 7833, 7835,    5, 7838
, 7842, 7845, 7848, 7850,    0,    0,   73,    0,    0,    0
,   50,  352,    0,    0,    0,  175,    0,    0,    0,    0
,    0,   51,    0,    0,    0,    0,  406,    0,    0,  598
,    0,    0,    0,    0,  390,  176,  821,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,  842
,    0,  269,  270,    0, 7853,    0,   52, 7855,   54,    0
,    0,   37,   55,    0,    0,    0,    0,    0,    0,  282
,    0,   58,   59,   60,   61,   62,   63,    0,    0,   64
,   65, 7858, 7860,  679,   68, 7862, 7864,   71,   72,    0
,    0,   73,    0, 7866,   39,   40,    0,    0,    0, 1237
,  272, 1237,    0,    0,    0, 7868,    0, 1240,    0, 1238
,    0, 1240, 1237,    0,    0,    0,    0,    0,   38,   39
,   40, 7870, 7872, 7874, 7876, 7878, 7880,    0,  932, 7882
, 1240, 7886,   46,  502, 7888,    0,   11,    0,    0,  241
,  194,    0,    0, 1237, 7890,   12,    0,  822, 7892, 7894
, 7896,   44,    0,    0,   45,  977,    0,   46,    0, 7898
,    0,    0, 1240,    0, 1240, 1240,    0,  621,    0,  680
, 7900,  410, 7902,  412,  413,  414,  111,  415,    0,    0
,  706,    0, 7904,    0,   88,    0,  751,  416,    0, 7906
,  752,    0,    0,    0, 7908,    0, 7910, 7912,    0,    0
,  326,   37,    0,    0,  599,  286,    0,  196,   13,   14
,    0,    0, 1418,    0, 1031,    0,  171,    0,    0,    0
,  390, 1540,    0,    0,  197,  778,    0,   16,    0,  407
,  265,    0,  273,   38, 7914,   40, 1039,  198,  199,  283
,    0, 7917, 7919,  194,  798,    0,    0,    0,    0,  122
,    0, 7921, 7923,   54,    0,    0,    0,   55,    0,    0
,    0, 1540,    0,  122,   42, 7926, 7928,    0,    0,   45
,    0,    0,   46,    0, 7930,   65, 7932, 7934, 7936,   68
,   69,   70, 7938, 7940,  203,  204, 7943, 7945,  207,  208
,  209, 7947,    0,    0,    0,    0,    0,    0,    0,   64
, 7949,   66,   67,    0,   68,   69, 7951, 7955, 7957,    0
, 7959,   73, 1143,    0,    0, 1143,    0,    0,  178,  366
,    0,   86,   52,   53,   54, 1143,  828,  241,    0,    0
, 7961,    0,    0,  409,  410, 7963,  412,  413,  414,    0
, 7965,    0,  905,    0,    0, 7967, 1143, 1143, 1143, 7969
, 7971, 1143, 7973, 7975, 1143,    0,  171, 7977, 1143, 1143
,    0, 1379,    0, 1143,    0, 1143, 7979, 7982,  216,    0
,    0,    0,    0,    0,    0,  754,    0, 7984,   53,   54
,  755,    0,    0,    0, 7986, 7988,  969,  779,  734,    0
,    0,   52,   53,   54,    0,    0,    0,   55,   38,   39
,   40,    0,    0,    0,    0,    0,   58,   59,   60,   61
,   62,   63, 7990,    0,   64,   65,   66,   67,  584,   68
,   69,   70,   71,   72,    0,    0, 7992,    0,  122, 7994
,   43,   44,    0,    0, 7996, 7998,    0,   46,    0,   47
,    0,  555,  556,  757, 8000, 8003, 8005,  761,  762,    0
,  763,  764,  765,    0,    0,  323,  766,    0, 8007, 1005
,    0,    0,    0,  217,    0,   79,    0,   38,   39,   40
,    0,    0, 8009,   27,  122, 8011, 8013, 8015,   40,    0
, 8017,    0,  219,   46,  896,   47,    0,  915,    0,    0
,   38, 8019,   40,    0,    0,    0,  673,  122, 8021,   43
,   44,    0,    0,   45,    0,    0, 8023,   42, 8026,   44
,  286,    0,   45,    0,    0,   46,    0,   47,    0,    0
,  122, 8028, 8031,   44,    0,    0,   45,    0,    0,   46
,   32, 8033,    0,  659,  660,  661, 8036,  663, 8038, 8040
,   40,    0,    0,  220,  221,  222,  223,    0,  195,    0
,    0,    0,    0,    0,    0,    0, 8042,   53,   54,    0
,    0,    0,   55,    0,  452,  600, 8044, 8046, 8048, 8051
, 8053, 8055,   59,   60, 8057, 8059, 8061,   46, 8063, 8065
,   65,   66, 8068,    0,   68,   69,   70,   71, 8070,    0
,  171,   73,    0,    0,    0,    0,    0,  962,   37,  171
,  224,    0, 8072,   53, 8074,    0,    0,    0,   55,  159
,    0,    0,  435,  171,  160,    0,  161,    0,    0,    0
,    0,    0,    0,  225,  865, 8076, 8078, 8080,   67,  601
, 8082, 8084, 8087,   71, 8089,   53,   54,   73,    0,    0
,   55,    0,    0,  179,    0,    0,  604,  284, 8091, 8093
, 8095,   67,    0,   68, 8098,   70,   71, 8100,   65,   66
, 8102, 8106, 8108, 8111, 8114, 8116, 8118,    0,    0, 8121
,    0, 8123,   65,   66,   67, 8126,   68,   69,   70,   71
, 8128,    0,  236,   73,    0,    0,  194,    0,    0,    0
,    0,    0,   38,   39, 8130,    0,   52,   53,   54,    0
,    0,    0,   55, 1145,    0,    0,    0, 1145,  471, 1145
,    0,   58, 8132,   60,   61, 8134, 8136, 1559,    0,   64
,   65, 8139, 8141, 8146, 8148, 8150, 8152,   71, 8154,    0
,    0, 8156,    0, 8159,    0,    0,    0, 8161, 8163, 8165
, 1559, 1559, 8167, 8169, 1145, 1145, 1145, 1145, 1145, 8171
, 1145, 8174, 1559,  171, 8176, 8178, 8182, 1426, 1380,    0
, 1145, 1559, 1145, 1145, 1145,    0,    0, 8185, 8187,    0
,    0, 1426, 1426,    0,    0,    0,    0, 1587,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,   52,   53
,   54,    0,   80,    0,   55,    0,    0,  721,    0,    0
,  134,  135,  136,   58, 8189, 8191,   61,   62, 8193, 8195
,  140,   64, 8197,   66,   67,  171, 8199,   69,   70,   71
,   72,    0,    0,   73,    0,    0,    0,    0,    0,  949
,    0,  950,    0,    0,    0,  585,    0,  113,    0, 8201
,    0,   38,   39,   40,    0,    0,    0,    0,  604,    0
,   52,   53, 8203,    0,    0,    0,   55,    0,    0,  935
,    0,    0,  471,    0,    0,  287,    0,    0, 1022,    0
,  472, 8205, 8207, 8210, 8214,   66,   67, 8216,   68,   69
, 8219,   71, 8221,    0,    0, 8223,   14,    0,    0,    0
,    0,    0,    0,    0,  116,    0,    0,    0,    0,    0
,    0, 8225,   42,   43, 8227,    0,    0,   45,    0,    0
,   46,    0,   47,   17,  418,    0,    0,    0,    0,    0
,    0,    0,  477,    0,    0,    0,    0,    0,    0,    0
,  866,    0,    0,  141,  142,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  143,    0,  424, 8229,    0
,    0,    0,    0,  682,  147,    0,    0,  963,    0,    0
,    0,  454,    0,   18, 8231,    0,   20,   21,    0,    0
,    0,  163,    0,    0,    0,    0,    0,    0,    0,    0
,    0,  116,    0,  264,    0,    0,  164,    0,    0,    0
,    0,    0,    0,    0,  171,    0,    0,    0,    0, 8233
,   53,   54,    0,    0,    0,   55,    0,    0,    0,    0
, 8235, 8238, 8240,  222, 8242,  166,    0,    0, 8244,  474
, 1238,    0, 8246, 8248,   66,   67,    0,   68,   69, 8250
, 8252, 8254, 1238, 1240,   73,   55, 1237, 1238,  505,    0
,    0, 1240,    0,    0,    0, 1237,    0,    0,    0, 8256
, 8258,    0,   64,   65, 8260,   67,    0, 8262,   69, 8265
, 8267, 8269,    0,  114,   73,    0,    0,    0,    0,    0
, 1240,    0,    0, 8271,    0, 1240, 1240,    0,    0,  642
,    0,    0,    0,    0,    0,    0,    0,  253,    0,   38
, 8273,   40,    0,    0,    0,    0,    0,    0,    0,  194
,  406,    0,    0,    0,    0,    0,    0,    0,    0,    0
,  906,    0,  229,    0,    0,  829,    0,    0,    0,  122
, 8275,   43,   44,    0,    0,   45,    0,    0,   46,    0
,   47,    0,    0,    0,    0,    0,    0,    0,    0,    0
,   24,    0,    0,    0,    0,    0,    0, 8277,    0,   26
,   27,    0,    0,   28,    0,    0,  195,    0,    0,    0
,    0,    0,    0,  144,  305, 8279, 8281,   37,    0,  419
,    0,    0, 8283, 8285, 8287,    0,   43,   44,  323,    0
,    0,  628,    0,    0,    0,    0, 8289,  146,    0,    0
,    0,    0,   29, 8291,    0,    0,    0,    0,   31,   38
,   39, 8293,  656,  609,    0,    0,    0,   32,   33,    0
,    0,    0,  171,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  345,    0,    0,    0,  122
,   42,   43,   44,    0,    0,   45,  353,    0, 8295,    0
,   47,    0,    0,    0, 8297,  498,  499, 8299, 8301, 8303
,    0,  415,    0, 8305,    0,    0,    0,    0,    0, 8308
,    0, 8310, 8312,  978,    0,    0,    0,  436,  500,    0
,   64,   65, 8314,   67,  238, 8316, 8318,   70,   71, 8320
,    0,    0, 8322, 8324,    0, 8326,    0,    0,    0,    0
,  590, 8328,    0,   38,   39,   40,  380,    0,  844,  988
,    0,    0, 8330,   53,   54,    0, 8332,   38,   39,   40
,    0,  286,    0,    0,    0,    0,    0,    0,  593, 8334
,    0,  594, 8336,  122,   42,   43,   44,    0,    0,   45
,    0,    0,   46,    0,   47,    0,    0,  122,   42,   43
,   44,    0,  549,   45,    0,  595, 8338,    0,    0,    0
,    0, 8340,    0,    0,    0,    0,    0, 8342,   53,   54
,    0,    0,   37,   55,    0,    0,  550,    0,  118,    0
,    0,  228,   58,   59,   60,   61, 8345,   63, 8347, 8349
, 8351,   65,   66, 8353,    0, 8355,   69,   70,   71,   72
,    0,    0, 8357,  561,   38,   39,   40,    0,    0,    0
,  769,    0,    0,    0,    0,  462,    0,  501,  122, 8359
, 8361,   44,  597,    0,   45,    0,  125, 8363,   39, 8365
,  503,    0,    0,    0, 8368, 8370, 8372,   44,  575,  121
, 8374,    0,  999, 8376,  194,   47,  845,    0,    0,    0
,   37,    0, 8378,    0,    0,    0,    0,  122, 8380,   43
,   44, 8382,   53, 8385, 8387,   42, 8389, 8391, 8394,    0
,   45,    0,    0,   46,    0, 8396,   53,   54,    0,  329
,    0,   55,   38,   39, 8398,   65, 8400,   67,    0,   68
, 8402,   70, 8404,   72, 8406,  661, 8408, 8411,   40,    0
,  629, 8414,    0, 8416, 8418, 8420, 8422, 8424,  255,    0
,    0, 8426, 8428, 8431, 8433, 8435, 8437,    0,   45, 8439
, 8441,   46,   86,   47,    0,    0,  122, 8443,   43,   44
,    0,    0,   45,    0,    0,   46,    0,   47,    0,  665
,  424,  146,    0,    0,    0,    0, 8445, 8447,   54,    0
,  171,  604,   55,    0,  806,    0,    0,  125,    0, 8449
,    0,    0, 8451,   53,   54,  241,    0,    0, 8453, 8455
,   65,   66, 8457,    0, 8459, 8461,   70, 8463, 8466,   60
, 8468, 8470,   63,    0,    0, 8472, 8474, 8477,   67,  736
,   68, 8479, 8481, 8483, 8485,    0,    0, 8488,   55,    0
,    0,  369,    0,  370, 8490,  171,  990,   58, 8492, 8495
, 8497, 8499,   63,   68,   69, 8501, 8504, 8507,   67,  171
, 8509,   69, 8511, 8513,   72,    0,    0,   73,    0, 8515
,   39,   40,    0,  176,    0,    0, 8517,  142,    0,    0
,   52,   53,   54,    0,    0,  229,   55,    0,  143,    0
,    0,  937,    0,    0,   52, 8519, 8521, 8523,   61, 8525
, 8528, 8534, 8536, 8538, 8540, 8544, 8546,    0, 8549, 8551
, 8554,   71,   72,    0,    0,   73,    0,   64,   65,   66
,   67,    0,   68,   69,   70,   71,   72,    0,    0,   73
,    0,  182,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,  424, 8556,    0,  311,  242,    0,    0,  147
,  513,  514,    0,  243,    0,  867,  587,    0,    0,    0
,  832,    0,    0,    0,  495,    0, 8558, 1485,    0,    0
,    0, 8560,  727,    0,    0,   74,    0,    0,    0,    0
,    0,  424, 8562,   37,    0,    0,  684,    0,  147,    0
, 8565,    0,    0,    0,    0,    0,  421,  116,    0,    0
,    0,    0,    0,    0,    0,  422,    0,    0,    0,    0
,    0,    0,    0, 8567,    0,   38, 8569, 8571,   53, 8573
,    0,    0,   37,   55,    0,  899,    0,    0,    0, 8576
,  979,    0,   58,   59,   60,   61,   62,   63,    0,    0
,   64,   65,   66,   67,    0, 8578, 8580, 8582, 8584, 8586
,    0,   45,   73,  474, 8588,   39, 8591,    0,  168,  121
,    0,   38,   39, 8593,    0,    0,  516,    0,    0,    0
,    0,  517, 8595,  195,  118,  229,    0,    0,    0,    0
,    0,    0, 1007,    0,  122,   42,   43,   44,    0,  354
,   45, 8597, 8599, 8601,   44, 8603,  144,   45,  554,    0
, 8606, 8608, 8610,    0,  457,  144, 8612, 8614,    0,    0
,    0,    0,    0,    0,    0,  807,    0,    0,    0,  145
,  146,    0,  953,   38,   39, 8616,  147, 8618,    0,    0
, 8620,    0,    0,    0,  954,    0,    0,  144,  171,  887
,  666,    0, 8622,    0,    0,    0,    0,    0,    0,    0
,  971,    0,   91,  122, 8624,   43,   44,    0,    0,   45
,    0,  560,   46,  119, 8626,    0,  124, 8628,    0,    0
,    0,    0,    0, 8631,   53,   54,    0,  125,    0,   55
,    0,    0,  244,    0, 8633,    0,    0,    0,   58,   59
,   60, 8635, 8638,   63,    0,  390,   64, 8641,   66,   67
,    0, 8643,   69,   70,   71,   72,    0,    0,   73,  561
,  698,    0,   52,   53,   54,    0,    0,  127, 8646, 8648
,   53, 8650,    0, 8652, 8654, 8657, 8660, 8662, 8665, 8667
, 8669,   62,   63,  570,  571, 8671,   65,   66,   67,    0
,   68, 8674, 8676, 8678, 8681,   67,  171, 8684,   69,   70
,   71,   72,  576,    0,   73,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,  384,    0,    0,    0,    0,    0,  645,    0,  346
,    0,   52, 8686,   54,  519,    0, 1583,   55,    0,    0
,    0,  520,  521,    0,  522,    0,  291, 1583,  249,    0
,    0, 1583, 1583, 1583,   64,   65,   66, 8688,    0,   68
,   69,   70,   71,   72,    0,    0,   73, 8690, 1583,  194
, 1583, 1583,    0,    0,    0,    0, 1023,    0,    0,    0
,    0, 1583, 1583,  991,    0, 8693, 1583,    0,    0,    0
,    0, 1585,    0,    0,    0,    0,    0,    0,  116,    0
,  524,  525, 8695, 8697,   54,    0,    0,    0,  308,    0
,    0,   94,    0,    0,  241,    0,    0,    0,    0,  728
,  269,  270,    0,    0,    0,    0,  195,    0,    0,  176
,    0,    0,  423,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  980,    0,    0,    0,    0
,    0,  271,    0,    0,    0,    0,  809,    0,    0,    0
,  332,    0,    0,    0,    0,    0,    0,    0,    0,  272
,    0,  606,    0,  389,    0,  118,    0,    0,  231,    0
,    0,    0,    0,    0,  938,    0,  458,  965,  632,    0
,    0,    0,  116,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  633,    0,    0
,    0,    0,    0,    0,  667, 8699, 1000,    0, 8701,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,   37,    0
,  528,    0,    0,    0,    0,    0,    0,   38,   39,   40
,    0,    0,  144,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  390,    0,    0,    0,  874,    0
,   38,   39,   40,    0,    0, 1014,    0, 8703,   42,   43
,   44,    0,    0,   45,    0,  889, 8705,    0,   47,    0
,    0, 8707,    0,    0, 1034,    0,    0,    0,    0,    0
,  122, 8709,   43,   44,    0,    0,   45,    0,    0, 8711
,   39, 8713,  438,  323,    0,    0,  868,    0, 8715, 8717
,   40,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,   37,    0,    0,    0,  399,    0,    0,  309
,   42,  310, 8719,    0,    0,   45, 1578,    0, 8721, 8724
, 8726, 8728,    0,    0,   45,    0,    0, 8730,  634, 8732
,    0, 1578, 1578, 8734,   38,   39,   40,    0,    0,    0
,  171, 8736,    0,    0,    0,    0,  407,    0, 1578, 1578
,    0, 1578,  286,    0,    0,    0,    0,    0,    0,    0
,    0, 1578, 1578, 8738,  122, 8740, 8743,   44,    0,  195
,   45, 1578,    0,   46,  635, 8745,   53,   54,    0,    0
,    0,   55,    0,    0,    0,  646,  146,    0,  900,    0
,  385,  286, 8747,    0,    0,    0,    0,    0, 8749, 8751
, 8753, 8757,  171, 8759, 8762,   70, 8764, 8766,    0,   88
, 8768,  171,    0,  292,    0,    0,  711,    0,    0,  686
,    0,   64, 8770,   66,   67,    0,   68,   69,   70,   71
,   72,    0,    0,   73,    0,    0,    0,   52,   53,   54
,    0,    0, 8772, 8774,   40,    0, 8776,   53,   54,    0
,    0,    0, 8778,   59,   60,   61,   62, 8780, 8782,    0
, 8785, 8787, 8789, 8792,   61, 8794, 8796,   70,   71, 8798
,   65,   66, 8800,   42, 8803, 8805,   70, 8808, 8810,  391
,  924, 8812,    0,   47,    0,    0,    0,    0,  122,   42
,   43,   44, 8814,   53, 8816,    0,    0, 8818,   55,    0
,    0,  668,  688,   89,  689,  472,   48,    0,    0, 8820
,  146,  713,    0,    0,    0,   64, 8822, 8824,   67,    0
, 8826, 8828, 8830,   71, 8832,    0,    0, 8834, 8837,   38
,   39,   40,  195,  714,    0,  118,    0,    0,    0,  257
,    0,    0,    0,  459,  981,    0,    0,    0,    0,    0
, 8839, 8841, 8843,   44,   50,    0,   45,  966,  623, 8846
,   42,   43,   44, 8848,    0, 8850, 1484,  763, 8852,    0
, 8854,    0,  973,    0,  647,    0,    0,    0,    0,    0
,    0, 8856,    0,    0,    0,    0,    0,    0,    0, 8858
,    0,   76,    0,    0,    0,    0,    0,    0,    0,  312
,   52,   53, 8860,  314,  315,   37, 8862,    0,    0, 8864
,    0,    0,   56, 8866,   37, 8868, 8871, 8874, 8876,   62
, 8880,  530,   55, 8882, 8884, 8888,   67,  890,   68, 8891
,   70,   71,   72,    0,    0, 8893,    0,   38,   39,   40
,    0, 8895,  298,  171,  848, 8897, 8899, 8901, 8903,    0
,    0,    0,  171,    0,  993,    0,    0,    0,    0,    0
,  134,  135,  136,    0,    0,    0,    0,  122, 8905, 8907
, 8909,    0,    0,   45,    0,    0, 8911,   42, 8913, 8917
,   54,    0,   45,    0,   55,   46,  392, 8919,   53,   54
,    0,    0,    0,   55,    0,    0,  974,    0,    0, 8923
,    0,    0,   58,   59, 8925, 8927,   62,   63,   70,   71
, 8929,   65,   66, 8931,  531,   68,   69,   70, 8933,   72
,    0,    0,   73,    0,    0,    0,    0,    0,    0,    0
,    0,   38, 8935,   40,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,  334,    0,    0,    0,    0, 8937
,   53,   54,    0,    0,    0,  636,  243,    0, 8940,    0
,  171,  122,   42,   43,   44,    0,    0,   45,    0,  171
,   46,    0,   47,    0,    0,    0,  901,    0,    0,  553
,    0,    0,  554,   74,   37,    0, 1001,    0,    0,    0
,  555,  556,    0,  141,  142,   52,   53,   54,    0,    0
,   79, 8942,    0,    0,   52, 8944, 8946,    0,  474, 8948
, 8950,  533,  534,  535,  536,    0,   38, 8953, 8955, 8958
, 8960, 8962,   61, 8965, 8967,   70, 8969, 8971,   65, 8973
, 8975,    0,   68,   69,   70, 8977,   72,    0,    0,   73
, 1024,    0,  357,  286,    0, 8979,  122,   42,   43,   44
, 1143,    0,   45,    0,  171, 8981,    0,   47,  940,  852
,    0,    0,  680,    0,   37,    0,    0,    0,    0,    0
,    0,    0,  638, 1143,    0,    0,    0, 1143,    0, 1143
,    0,    0, 1143,    0,  715,    0,    0,    0,    0,   52
, 8983, 8986, 1143,  561,    0,   55, 8988, 8990,   40,    0
,    0,    0,  562,    0,   58,   59,   60, 8993, 8996, 8998
, 9000,  567, 9002, 9005, 9008, 9010, 1143, 9012, 9016, 9019
, 9022, 9024,    0,    0, 9026, 9029, 9031, 9033, 9036, 9040
, 1143,    0, 9042, 9045, 1143,   46,  576,   47,    0,  171
,    0,    0,  266,    0,    0,    0,    0,  855,    0,   37
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,   52,   53,   54,    0,    0,    0
,   55,   38,   39,   40,    0,    0,  336,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,   64,   65,   66
,   67,    0,   68,   69,   70,   71,   72,    0,  982,   73
,  670,  810,   42, 9047,   44,    0,    0, 9049,    0, 9052
,   46,    0,   47,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,  259,    0,    0,    0,    0
,    0,    0,  926,    0,  502,    0,    0,    0,    0,    0
,  229,    0,    0,    0,   52, 9054,   54,  294,    0,    0
,   55,  300,    0,    0,    0,    0,    0,    0,  243,    0
,    0,    0,  176,    0,    0,    0,    0,   64,   65, 9056
, 9058,  394,   68, 9060,   70,   71,   72,    0,  723,   73
,    0,    0,    0,  265,    0,    0,    0,  751,    0,    0
,    0,  752,    0,  612,  811,  812,  479,  798,  739,    0
,    0,    0,    0,    0,    0,    0,    0,  870,    0,    0
,    0,    0,    0,    0,  249,    0,    0,  740,  122,    0
, 9062,   44,  701,    0,    0,  116,  149,    0,    0,   52
, 9064,   54,    0,    0,    0,   55,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,  260,   64,   65,   66,   67,    0,   68,   69,   70
,   71, 9066,    0,    0,   73,  194,    0,    0,    0,    0
,  185,   37,  194,   37,  316,    0,    0,   91,    0,    0
,    0,    0,    0,    0,    0,    0,    0,   37,    0,    0
,    0,    0,   92,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,   38,   39, 9068,   39,   40,    0,    0
,  120, 9070,  902,    0,    0,    0,    0,    0,    0, 9072
,   39,   40,  195,    0,    0,    0,  471,    0,    0,  195
,    0,    0,    0,  122, 9074, 9076, 9078,   43,   44,   45
,    0,   45,   46,    0, 9081,    0, 9083, 9086,   54,  309
,   42,  310,   44,    0,  180,   45,   75,    0, 9088,    0
,   47,    0,    0,    0,  941,    0,    0,    0,    0,    0
,    0,  716,    0,  426,    0,  377,  754,    0,    0,    0
,    0,  755,    0,    0,    0,    0,  825,    0,    0,    0
,    0, 9090,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,  891,    0,   93, 9092,    0,    0,  323,    0
,    0,  786,    0,    0,    0,  267,    0, 9094,    0,  233
,    0,    0,    0,    0,    0,    0,  171,   37,  171,    0
,    0,  286,    0,    0,    0,  513,  514,    0,    0,    0
,    0,    0,  171,    0,  757,  758,  759,  760, 9096,  762
,    0, 9098, 9100,    0,    0,    0,    0,    0,    0,   38
,   39, 9102, 9104, 9106, 9108, 9110,   37,   55,    0,   55
,    0,    0,    0,    0,    0,    0,    0,   52,   53,   54
,    0,    0,    0,   55, 9112, 9114, 9116, 9120,   66, 9122
, 9125, 9128, 9131, 9136, 9139, 9142, 9145, 9147, 9149,   39
, 9152, 9155,   66,   67,    0, 9158,   69,   70,   71,   72
,    0,    0,   73, 9160,  122,   42,   43,   44,    0,    0
,   45,  877,    0, 9162,    0,   47,    0,    0,  122,   42
, 9164,   44,    0,    0,   45,  702,    0,   46,    0,   47
,    0,    0,    0,    0,    0, 9166,    0,    0,    0,    0
, 9168,   13,   14,    0,    0,    0,    0,    0,    0,    0
,  471,    0,  442,    0,    0,    0,    0, 9170,  472,    0
,   16,  124,    0,    0,    0,    0,   77,    0,    0,    0
,  198,  318,  125,    0,  200,  201,    0,    0,    0,    0
,  613,    0,    0,  479,    0,    0,  265,    0,    0,    0
,    0,    0,  126,    0,    0,    0,    0,  811,  928,    0
, 9172,    0,    0,    0,    0,    0,    0,   52,   53,   54
,  957,  171, 9175,   55,    0,  809, 9177,  203, 9179,  205
, 9181,  207, 9183, 9186, 9188,   61,   62, 9190, 1240,  395
, 9192,   65, 9194, 9199, 9203, 9205, 9207, 9209, 9211, 9213
, 9216,  213, 9218, 9221,  122,    0, 9223, 9226,   54,    0
,    0, 9229,   55,    0,   16, 9231,   65, 9233, 9235,    0
,   68, 9237,   70,   71, 9240,  318,    0, 9242,  358, 9244
, 9247, 9249,   67,  359,   68,   69, 9251,   71, 9253,    0
, 9255,   73,    0, 1240,    0, 1240, 1240,    0,    0,    0
,   38,   39,   40,    0,    0,    0,    0,  319,    0,  214
,  215,  216,    0,  320,  321, 9257,  103,  104,  717,    0
,  406,    0,    0, 9259,  485,  486,  487,  488,  407,    0
,  122,   42,   43,   44,    0,    0,   45,    0,  941,   46
,    0,   47,    0,    0,    0,    0,    0,  903, 1009,    0
,    0,  427,    0,    0,    0, 9261,    0,    0,    0,    0
,    0,    0,    0,    0,  967,    0,    0,    0,    0,    0
,  849,    0,    0,  577,    0,    0,    0,    0,    0,    0
,  243,    0,   52, 9263, 9267,    0,    0,   38, 9270,   40
,    0,    0,    0,    0,   37,    0,    0,    0,    0,    0
,    0,  489,    0,    0,   97,  490, 9272,  320,  321,  102
,  103,  104, 9275,   25,    0,   26,   27,  122,   42, 9277
,   44,    0,    0, 9279,    0,  219, 9282,   39, 9285,    0
,    0,  460,    0,  241,    0,  858,  859,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,  229,    0,    0
,    0,    0,    0,    0,    0,    0,  122,   42, 9287, 9290
,   54,  919,   45,    0, 9292, 9295,  411,  412,   47,  474
,  415,  194,  635,   32,  416,   64,  577,   66,  220,   68
,  221,   69,  417,  222,   70,  223,   71,  243,   72,  171
,   27,  402,   52,  729,  795,   53,  798,  151,   62,   79
,  958,   63,   64,   33,   52,  703,  152,   66,  153,   72
,  774,   73,  116, 1578,   84,  996, 1578,  788,  445, 1377
,  446,  968,  249, 1025,   45,  405,  187,  146,  334, 1143
,   39,  122,   37,  860,  556,  122, 1143,   42,  175,   43
, 1143,  286,   45, 1143,  469,   38, 1143,   39, 1063,   40
, 1143,   47,   52,   54,  673,  505,   59,  984,   60, 1019
,  985,   63,   68,  177,  502,   69,   73,   85,  262,  171
,  286,  850,  677,   52,   94,   54,  959,  171,  751,  573
,   55,    3,  323,  173,  775,   68,  742,   70,  880,  188
,   54,  428,   60,  904,  145,  121,   61,  146,   65,  147
, 1037,   67,   73,   38,  254,   44, 1026,   47,   41,   37
,  910,   45,  494,   37,  881,   85,  361,   40,  116,   38
,   41,   37,  579,   44,  580,  125,  704,   45,  754,   47
,  146,   51,  755,   38,  276,   40,  147,  121,  176,  376
, 1237,   49,  118,   42, 1240,   43, 1238,   64,   52,   65
,   53, 1240,   66,   54,   45, 1237,   67,    4,  430,    5
,   68,   46,    6,   69,  311,   55,    7, 1571,   70,   47
, 1571,   72,    8, 1238,   73,   56, 1240,   57, 1237,   59
,   50, 1238,   60,  144,   62,  513,  619,   63, 1240,  514
, 1237,   66,  541,   67, 1571,   51,  861,   70,  759,   71
,  911,  760,  286,   72, 1237,  762,  146,  171,  116,  342
,  190,   37,   38,   39,   58,   40,   52,   59,  124,   53
,   60,  406,   54,   61,  390,   65,   58,   71,   59,   72
,   62,   73,  505,   66,   41,   68,   42,   69,   38,   43
,   70,   39,   44,   71,  126,   40,   72,  881,   46,  815
,   37,   37,  838,  128,   98,    9,   42,   58,   43,  542
,   59,   44,   60,  470,   61,   45,  118,   63,   46,   64
,   47,   66,  816,   67,  817,  343,   68,   99,  851,   69
,   38,   70,   39,   71,   16,   40,   72,  550,   81,  789
,   74,   50,  155,  122,   46,   42,  635,   43,   47,   45
,   51,  621,  732,  648,  449,  412,  776, 1038,  649,  804
,  415,  171,  311,   55,  396,  315,   74, 1011,   62,  191
,  650,   66,  390,   71,   52,  286,   72,   54,  350,   55
,  277,  265,   45,  146,  171,  300,   59,  147,   60,  811
,   63,  243,  798,   64,   72,  101,   73,  103,   55,   58
,   60,  424,   61,  146,  341,   62,  278,   65,  147,  837
,   66,   64,   72,   67,   73,  249,  105,  362,  325,  313
,  193,  343,  122,  107,   44,   16,  639,  171,  912,  122
,   65,  249,  745,   67,  791,  171,   37,  640,  194,   55
,   67,  109,  432,   27,  689,  229, 1027,   46,  300, 1028
,   47,  407,  234,  654,  471,  265,  590,  591, 1520,  592
,  544,  678,  582,  473,  405, 1520,   53,  792,  820,  595
,   65,  793,   66, 1328,  544,   84,  116,  596,   38,  597
,   40, 1030,  546,  323, 1425,  913,  122,   42, 1425,   43
, 1425,  390,   44,  365,   37, 1020,  864,  250,  945,  695
,  827,   42, 1237,  171, 1237,   52,   54,  302,  474,  303
,  841,   64, 1214,   65,  174, 1240,   66,  976,   67,  131
,  746, 1240,   68,   10,  747,   69,    7,  748, 1240,   70
, 1240,   71, 1004,   72,    8,  116,   85,   86,   53,  110
, 1557,   66,  271,   67,  914,   69,   37,   70,   38,  177
,  801,  379, 1118, 1238,  176, 1240,  749,  122,  750,   42
, 1237,   43, 1238,   44,  933,  550,   87,   45,  118,   88
, 1237,   47,  503,  617,  122, 1239,   42,  434,   43, 1238
,   47, 1240,  725,  409,  194,  411,   87,  158,  577,  406
,  122,  417,   43,  243,   44,  407, 1015,  194,   39,  811
,  200,  797,  201,   43,   52,   44,  656,   53, 1418,   43
,  387,   44,   64,   47,   52,   66,   53,   67,   54,  235
,   55,   71, 1143,   72,  202,   73,  205,  753,  206,  657
,  210,  195,   65,   70, 1143,  252,  211,   71,  212,   72
,  213,  696, 1143,  408,  304,  411,  284,  415, 1143, 1143
,  286,  720, 1143,  416, 1143,  475, 1143,  707, 1143,  417
, 1143,   37, 1143,  214, 1143,  215,  946,   52,  243,  756
,  372,  249,  116,   37,   73,   79,  947,   42,   45,  513
,  514,   37,   37,  758,   38,  759,   39,  760,   40,  920
,   37,  144,   26,  823,   42,   38,   43,   39,   44,   45
,  218,  194,   39, 1021,   42,  122,   37,   46,   43,   47
,  171,  401,   42,  767,   43,  658,   47,   33,  662,  122
,   38,   43,   39,   44,   52,  681,  674,  112,  726,  171
,  604,  122,  675,   42,  676,   43,  677,   58,   44,   61
,   45,   62,   79,   63,  573,  574,  780,   64,   47,  547
,   67,  327,  934,   72,   52,  286,   54,  176,   64,   52
,   65,   53,   66,   54,   68,   38,   69,   55,   39,   70
,   40,   52,   72,   64,   52,   65,   53,  286,   66,   54
,   69,   55,   64,   72,   67,   73,  122,   37,  171,   42
,   68,  453,   43,   69,  388,   44,   70,   52,   71,   53
,   72,   54,   45,   73,   46,  948,   64,   47,  998,  196
, 1145,   72,  781,   40,   59, 1145,   62,  285,  472,   63
,  367,   66, 1559,   67, 1426, 1145, 1559,  122, 1559,   42
,   68,   43,   69,   44,   70,  735,   72,   45,   73, 1377
,   46, 1426,   47, 1426, 1145, 1426, 1559, 1426, 1559, 1145
,  286,  407, 1145,  476, 1145,  132, 1145, 1559, 1426, 1145
,  194, 1145, 1559,  133, 1426, 1145, 1559, 1426,  162, 1032
, 1426,   59,  286,   60,  137,   63,  138,   37,  139,  195
,   65,  987,   68,  768,   37,  921,   54,  122,   38,   42
,   39,  226,  843,   43,   64,   40,   44,   65,  897,   45
,  237,   46,   70,   47,   72,   73,   13,  122,   15,   44
,   16,  146,  602,  171,   19,   52,  641,  708, 1237,  165
,  884,  220,  221, 1237,  885,  223, 1240,  229,   64, 1240
,   65, 1237,   70,   52,   71,   53,   72,   54,  951,   22
,  471,   23, 1237,   66,  664,   37,   68, 1239,   70,  548
,   71, 1238,   72, 1240,  288,   39,  254,  830,   42,  780
,   25,  821,  803,  804,  167,  916,  805,  474,  306,  604
,  122,  180,  145,  147,   30,   40,  286,   46,  382,  643
,  497,  683,   52,  413,   53,  414,   54, 1006,   55,   34
,  478,  148,   37,  416,  479,  289,  420,   66,   37,   68
,  898,   69,  553,   72,  554,   73,  936,  455,  644,  115
,  591,  116,  989,   52,  592,  603,  586,   35,  709,  171
,   37,  120,  461,  227,  886,   52,  456,   62,  328,   38
,   43,   39,   44,   64,   40,   67,  188,   37,   68,   73
,   37,   42,  502,  596,   43,   38,   46,   40,   47, 1458
,   41,   38,   42,   39,   43,   40,   45,  171,   46,  504
,  505,  132,   42,  133,   52,  506, 1458,   54,   45,  122
,   37,   46,   43,   55,  390,   44,  794,   47,   47,   52
,   64,   40,   66, 1458,   69,   49,   71,  782,  783, 1458
,   73,  784,   38,  663,   39, 1458,  195,   67,  297,  134
,   69,  135,   70,  136,   71, 1119,   72, 1119,  171,  138
,  471,  810,  139,   42,  140,   43,   52,   44,   53,   50
,  330,  229,  181,  472,  368,   51,   42,   52,  124,  147
,   53,  873,  194,  300,   52,  831,   55,  243,   64, 1033
,   67,   56,   68,   57,   69,   58,   71,  126,   59,   72
,  952,   61,   62,   73,   64,   52,   65,   53,  507,   66
,   54,   69,   55,   70,   52,   71,   53,  286,   72,   54
,   73,   37,   98,   36,   64,   59,  286,   65,   60,   66
,   61,   67,   62,   70,   64,  300,   71,  195,   65,   72
,   66,   73,   68,   70,  243,   71,   16,  116,   38,  964
,  141,   58,   53,   59,   54,   60,  189,   62,  122,  190
,   63,  630,  508,   42,   55,  239,  509,   43,  510,   44
,   64,  511,  745,   65,  551,  240,   66,   45,   67,  512
,  241,   68,   46,  907,   69,  290,   70,   47,  146,  552
,  970,  802, 1485,  286,  146, 1481,  171, 1481,  604,   79
,  307,  194,   39,   40,   52, 1481,  605,   54,  116,   37
,  122,   68,   42,   69,   43,   70,   44,   71, 1013,   72
,   38,   46,  515,   40,   47,  398,   40,  922,  117,  122
,   37,  833,   42,   46,   43,  553,   47,  518,  746,   46
,  917,  631,  748,   47,  555,  118,  556,  471,  558,   40
,  323,  286,  846,  383,  888,   83,  834,   42,  437,   47
,  808,  737,   92,   52,  371,  480,  171,   61,  169,   84
,   62,  116,  256,  126,   65,  697,   68,  170,  955,   55
,  128,   52,  129,   54,  563,  130,  564,  749,  122,  565
,  750,   55,  566,   43,  567,   58,   44,  568,   59,  569
,   60,   61,  331,  572,   64,  286,  573,   69,   70,   64
,  574,   71,   65,  575,   72,   66,   73,   68,   53,  230
,  523,   67,  791,  685,  622, 1583,  183,   52,  526,   53
,  527,   37,   85,  194,   86,  122,   37,   37,   46,  503
,  793,  273,   42,   38,   46,   40,   47,   38,  610,  194
,   39,  194,   44,  122,  697,   46, 1015,   42,   43,   47
, 1016,   44,   46,  699,   47,  286,  770, 1578,   79, 1377
,  588,  171,   42,  311, 1578,   43, 1578,   47,   52,  847
,  147,   64,   52,   65,   53,  923,  286,   66,   54,   67
,  355,  529,   79,   68,   69,   55,  710,   71,   72,   87
,   73,   37,  687,   65,  824,   38,   55,   39,   52,  462
,   55,   58,  125,   63,  992,  116,   38,   64,   40,   58
,   65,  852,   59,   66,   60,   67,   62,   68,   63,   69
,   64,   72,   67,   73,   41,   68,   43,   69,  194,   44
,   71,  463,   72,   45,   73,   46,  754,   52,   54,   45
,  471,   37,  712,  424,   65,  147,  738,   66,   68,   38
,   69,  333,   70,   40,  323,   72,  785,   73,   79,  869
,   49,  853,  122,  771,   42,  514,  116,   43,  772,  122
,  972,  439,   45,   51,  241,   46,   47, 1484, 1480,  171
, 1480,   75,  313,   54,  908,   55,  132,  356,  669,   57
,  635,  133,   58,  854,   52,   59,   53,   60,  300, 1480
,   54,   61,  481,   63,   43,   64,  390,   44,  372,   65
,  243,  373,   66,  118,   69,  258,   73,  323,  286,  925
,  440,   38,   70,   39,   71,   40,   72,  138,   42,  139
,   43,  140,   44,  122,   46,   43,  441,   47,   52,   44
,   53,  875,   47,   52,  393,  241,   37,   60,  172,   61
,   90,   64,   72,  994,   67,  390,   71,  722,   39,  300
,   52,  286,  286,  637, 1008,   55,   53,  143,   54,  557
,  558,  232,   55,  532,  293,  464,   39,  559,   64,   40
,   58,   65,   59,   66,   60,  144,   67,   62,   68,   63
,   69,  537,   71,   64,   72,  918,   66,   67,   73,   71
,  538,  560,  339,  939,   46,   53,  145, 1143,   54,  146
,   38,  425,   39,  347,  147,  563,   61, 1143,  564,   62
,  565,   63,  229,  566,  568,   64, 1143,  569,   65, 1143
,   66, 1143,   67, 1143,  611,  570,   68, 1143,  571,   69
, 1143,  572,   70, 1143,   71, 1143,   72, 1143,   73,  335
, 1143,  573, 1143,  122, 1143,   42,  574, 1446,   43,  575
,  265, 1446,   44, 1143,   45,   78, 1143,  773, 1143,  854
,   43,   45,  700,  482, 1017,  171,   53,  503,   66,  245
,   67,  116,   69,  194,  956,   43,  407,   53,   72,  184
,   38,   40,  771,  876,  813,   38,  807,   42,  122,   43
,   42,  400,   44,   46,   47,   47,   52,  856,   53,  835
,   46,   76,  194,  624,  194,  311,  268,  871,  195,  761
,  763,  892,  764,   37,   40,   52,  195,   53,   52,   54
,   53,  121,   54,  348,   38,   64,   39,   65,   64,   40
,   66,   94,   65,   67,   67,  122,   68,  909,   42,   69
,   68,   43,   70,   69,   58,   44,  337,   71,   70,   59
,   72,   71,  249,   60,   72,   61,   45,   62,   73,  671
,   63,   73,   38,   46,   64,   40,   47,  927,  607,   65
,   68,  295,  814,  401,  767,   46,  838,   43, 1035,  374
,  857,  196,   79,  317,  995,  798,  286,  878,  186,  375
,  202,  376,  204, 1237,  206, 1237,   58,  208,   59,  209
,   60,  210,  625,   63, 1238,   64,   52, 1240,  313,   66
,  338,   53, 1237,  314,   67,   54,  315,   13,   68,   14
,   69, 1514,   70,   55,   71, 1514,   72,  211,  212,  261
,  144, 1238,   73, 1240,  787, 1237,   43,   52, 1238,   44
,   53, 1240,  483,   64, 1237,   66, 1514,   67,   37,   69
,  194,  386,   72, 1237,   73,  181, 1239,  201,   64,   86
,   65, 1238,   66,   70,  201,   72,   87, 1240,   95,  690
,  102,  241,  484,   37,  150,  983,   53,  255,  465,   54
,  331,   96,   39,  578,  249,  491,  322,  268,  246,   43
,   28,   45,  218,  171,   38,   46,  106,   40,   47,   43
,  539,   52,   44,   53, 1002,  409,   55,  410,   46,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    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 :=
         (    0,338484,338485,    0,    0,    0,    0,74588,154907,    0
,    0,    0,344232,    0,    0,57385,    0,57387,    0,    0
,    0,    0,    0,    0,    0,    0,57396,218033,    0,    0
,    0,321303,258197,160669,195092,    0,    0,    0,    0,    0
,160676,    0,160678,    0,    0,    0,160682,    0,    0,    0
,160686,    0,160688,160689,    0,    0,    0,    0,    0,    0
,    0,    0,    0,281176,    0,    0,    0,    0,    0,    0
,    0,269710,    0,    0,    0,407402,    0,    0,    0,    0
,258245,    0,269721,269722,258249,    0,    0,    0,177935,    0
,    0,126305,    0,258258,258259,258260,258261,    0,    0,    0
,160736,    0,258267,258268,258269,    0,258271,258272,258273,258274
,258275,    0,    0,258278,    0,    0,    0,    0,269757,269758
,    0,    0,    0,269762,    0,86180,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,137824,    0,    0,    0
,269779,269780,    0,269782,86199,269784,269785,269786,269787,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,160795
,    0,    0,    0,    0,    0,    0,    0,200962,    0,    0
,    0,    0,    0,    0,    0,160811,    0,    0,    0,    0
,    0,137869,137870,    0,    0,137873,137874,91979,    0,    0
,    0,160827,160828,137881,160830,    0,    0,    0,    0,    0
,390316,    0,    0,160839,160840,160841,    0,    0,160844,160845
,    0,57581,57582,    0,160850,    0,    0,    0,    0,    0
,    0,    0,    0,298547,    0,    0,    0,    0,    0, 5966
,    0,    0,    0,    0,    0,    0,315771,    0,    0,    0
,396093,    0,57612,    0,    0,223988,    0,    0,    0,    0
,    0,390367,    0,    0,    0,298579,298580,298581,    0,    0
,57630,    0,401852,    0,    0,    0,57636,    0,    0,350226
,    0,    0,350229,304334,    0,390391,    0,390393,    0,    0
,    0,    0,34704, 6020,    0,298609,298610,298611,298612,    0
,    0,    0,    0,    0,298618,    0,298620,    0,97827,28984
,    0,    0,    0,    0,    0,321577,    0,    0,    0,    0
,    0,    0,    0,247004,    0,132266,    0,    0,201113,    0
,247011,    0,    0,    0,    0,    0,252754,    0,321600,    0
,    0,29016,    0,29018,321606,    0,    0,321609,    0,    0
,    0,298665,373247,373248,    0,321617,195404,321619,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,155257,269998
,218366,    0,    0,    0,29049,    0,390482,    0,321640,    0
,321642,321643,    0,    0,    0,321647,321648,321649,298702,321651
,321652,321653,    0,92175,321656,321657,    0,321659,321660,321661
,    0,218397,57762,    0,57764,    0,    0,344617,    0,    0
,    0,    0,333148,333149,333150,333151,    0,    0,333154,    0
,    0,333157,    0,    0,298738,    0,    0,    0,57788,298743
,    0,    0,    0,    0,    0,    0,103692,304488,298752,    0
,    0,298755,298756,    0,    0,    0,298760,298761,298762,298763
,  440,    0,    0,298767,298768,298769,    0,    0,    0,    0
,    0,86506,    0,304514,    0,    0,    0,    0,333204,    0
,    0,    0,    0,    0,    0,    0,    0,    0,373373,373374
,373375,    0,    0,    0,    0,    0,    0,    0,    0,293066
,    0,    0,23430,    0,    0,218491,    0,218493,218494,    0
,29175,    0,    0,    0,    0,    0,    0,218503,    0,    0
, 6237,    0,    0,    0,    0,    0,    0,    0,    0,    0
,149672,    0,    0,29198,    0,29200,    0,    0,29203,    0
,29205,29206,    0,    0,    0,189846,    0,    0,    0,230009
,333276,333277,    0,98062,    0,    0,333282,    0,    0,    0
,    0,    0,149704,149705,149706,333291,333292,    0,    0,333295
,333296,    0,103818,333299,    0,333301,    0,407884,333304,333305
,333306,333307,333308,407890,    0,    0,98095,98096,    0,    0
,    0,247262,149734,149735,149736,    0,    0,    0,149740,    0
,    0,149743,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,126808,    0,98125,98126,98127,    0
,    0,    0,    0,    0,98133,    0,98135,    0,    0,    0
,    0,    0,126826,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,195681,46520,    0,    0,57997,57998,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,109644,224385,    0,121121,121122,    0,310445,    0,    0
,    0,98180,    0,    0,149816,    0,86711,    0,58028,58029
,    0,    0,    0,58033,    0,    0,58036,    0,58038,    0
,    0,    0,    0,121150,121151,121152,121153,98206,132629,    0
, 6417,    0,121159,    0,    0,149847,    0,299011,    0,    0
,17901,    0,    0,    0,    0,235912,    0,    0,    0,    0
,149862,149863,149864,    0,    0,    0,149868,    0,    0,149871
,    0,    0,258877,    0,    0,385094,    0,    0,287568,17930
,    0,    0,17933,    0,    0,    0,    0,    0,    0,    0
,    0,149893,    0,    0,    0,    0,    0,167110,98267,    0
,    0,98270,    0,    0,    0,    0,98275,98276,    0,    0
,    0,98280,98281,    0,    0,    0,304817,    0,98287,304820
,304821,    0,385141,    0,385143,322037,    0,167140,    0,247460
,    0,    0,322044,385152,92566,17986,385155,69621,385157,385158
,    0,    0,    0,    0,    0,58155,58156,58157,35210,    0
,    0,58161,    0,    0,    0,    0,    0,58167,58168,    0
,    0,    0,    0,    0,58174,58175,    0,121284,58178,    0
,58180,58181,18023,58183,58184,58185,    0,    0,121295,121296
,    0,121298,281935,    0,121301,121302,    0,121304,    0,    0
,    0,    0,    0,    0,    0,167208,121313,    0,    0,    0
,167213,    0,    0,    0,    0,    0,    0,18058,18059,18060
,    0,    0,18063,18064,    0,    0,18067,    0,18069,    0
,    0,293448,    0,    0,    0,    0,18077,    0,    0,    0
,    0,18082,    0,    0,304935,    0,    0,    0,    0,    0
,    0,    0,18093,    0,    0,167258,368054,368055,368056,12363
,    0,    0,    0,    0,    0,    0,    0,    0,    0,282012
,    0,    0,    0,    0,    0,    0,    0,190228,190229,190230
,190231,    0,    0,190234,    0,    0,    0,    0,    0,368087
,    0,    0,    0,    0,    0,368093,    0,368095,    0,    0
,    0,    0,356626,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,293530,    0,    0,    0,385326,385327,385328
,    0,385330,385331,    0,    0,379597,155855,167330,167331,167332
,408287,    0,    0,    0,385343,    0,121443,121444,    0,167342
,167343,385350,167345,167346,167347,167348,    0,167350,35400,    0
,167353,167354,    0,167356,    0,167358,167359,167360,    0,    0
,293577,    0,167365,    0,    0,    0,    0,    0,    0,391115
,    0,    0,    0,    0,293591,    0,    0,293594,293595,    0
,368178,    0,    0,293600,293601,293602,    0,293604,293605,293606
,293607,    0,    0,12497,    0,12499,    0,    0,    0,    0
,    0,    0,    0,    0,316569,190356,190357,190358,    0,224782
,    0,190362,    0,    0,368212,368213,368214,    0,    0,    0
,    0,190372,    0,    0,    0,190376,58426,58427,190379,    0
,    0,190382,173172,190384,190385,190386,190387,    0,368236,368237
,    0,    0,368240,368241,368242,368243,368244,    0,    0,368247
,    0,75662,    0, 6820,75665,    0,    0,    0,    0,    0
,253518,    0,236309,253521,    0,    0,184680,    0,305159,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,247808,    0,    0
,    0,12595,    0,    0,    0,    0,    0,12601,    0,    0
,    0,    0,    0,    0,12608,    0,    0,    0,    0,    0
,167513,    0,    0,    0,    0,    0,    0,    0,    0,    0
,98679,    0,    0,196211,    0,    0,    0,    0,    0,305220
,305221,385540,    0,    0,322436,    0,    0,    0,    0,    0
,    0,    0,    0,379815,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,58555,    0,87242,    0,    0
,    0,213460,    0,213462,    0,    0,    0,190518,52831,    0
,    0,190522,190523,    0,282317,    0,    0,    0,    0,    0
,64317,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,184806,    0,322496,    0,    0,    0,    0,    0
,    0,    0,    0,    0,282347,    0,    0,    0,    0,    0
,    0,    0,64349,64350,64351,    0,    0,    0,    0,    0
,345470,    0,    0,    0,    0,    0,12730,    0,    0,    0
,    0,    0,    0,    0,265166,    0,    0,    0,    0,    0
,    0,    0,    0,64380,64381,    0,253704,    0,64385,    0
,    0,    0,    0,    0,    0,    0,356980, 1287,    0,356983
,    0,    0,    0,138981,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,150466,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,213596,    0,    0
,    0,213600,    0,24281,    0,    0,150498,150499,150500,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,242316,334109,    0,    0,    0,150529,150530,150531
,    0,    0,150534,    0,    0,150537,    0,150539,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,98918
,    0,    0,339875,    0,    0,    0,    0,    0,    0,    0
,64507,64508,64509,    0,    0,    0,64513,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,47313,    0,    0
,    0,    0,    0,    0,    0,64532,    0,    0,64535,64536
,64537,64538,64539,    0,    0,    0,225179,    0,    0,    0
,    0,    0,    0,    0,173554,    0,    0,    0,150610,339932
,    0,    0,    0,351410,    0,    0,351413,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,133423,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,70334,    0,    0,    0,150656,150657,150658,    0,    0,    0
,    0,374406,374407,374408,    0,    0,    0,    0,    0,    0
,    0,12985,133463,    0,    0,    0,    0,150679,150680,150681
,    0,    0,150684,150685,150686,150687,150688,    0,    0,150691
,    0,374436,374437,374438,374439,    0,351493,374442,    0,    0
,    0,    0,    0,    0,    0,    0,    0,70391,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,167940,93360,    0
,133521,    0,162208,    0,162210,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,271231,213862,    0,    0,    0,213866,    0,156498
,219606,    0,179449,    0,    0,179452,    0,    0,    0,294196
,294197,    0,    0,    0,    0, 1615,    0,    0,    0,    0
,    0,    0,    0,    0,374529,374530,    0,374532,    0,    0
, 1630, 1631,    0, 1633,    0,    0,    0,    0,    0,282752
,    0,179488, 1642,    0,179491,    0,    0,    0,    0,    0
,    0,    0,    0,    0,231134,    0,    0,    0,    0,374564
,    0,374566,    0,    0,    0,374570,    0,190988,    0,    0
,127884,    0,    0,24621,    0,219681,    0,219683,    0,    0
,    0,    0,374587,    0,    0,374590,122163,374592,374593,374594
,374595,374596,    0,    0,374599,254123,    0,    0,    0,    0
,    0,150863,    0,    0,    0,    0,    0,    0,70552,    0
,368878,    0,    0,254141,    0,36137,179563,    0,    0,    0
,168093,    0,    0,    0,    0,    0,36148,    0,    0,    0
,36152,36153,36154,    0,150896,    0,    0,    0,    0,139427
,    0,    0,    0,    0,    0,259910,    0,36169,36170,36171
,36172,179598,254180,    0,    0,    0,403346,    0,    0,    0
,    0,36183,    0,    0,    0,    0,    0,    0,    0,150931
,36192,    0,150934,323045,150936,93567,    0,    0,    0,    0
,    0,    0,    0,    0,317319,    0,    0,    0,391904,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,36227,    0,    0,317343,    0
,317345,    0,    0,    0,    0,    0,    0,    0,59188,59189
,59190,    0,    0,    0,    0,    0,    0,    0,    0,47725
,    0,    0,    0,    0,    0,    0,    0,    0,    0,391955
,    0,173951,    0,    0,    0,151007,    0,    0,59218,    0
,59220,59221,    0,294440,59224,    0,    0,59227,196916,59229
,    0,    0,    0,391979,196922,391981,196924,    0,196926,196927
,    0,    0,    0,196931,196932,196933,122353,196935,196936,196937
,    0,    0,196940,196941,    0,    0,    0,196945,    0,    0
,    0,    0,151054,    0,    0,    0,    0,151059,    0,317434
,196958,    0,    0,133854,59274,196963,    0,196965,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0, 1918,    0
,    0,    0,    0,    0,    0,    0,151088,    0,    0,    0
,59300,93723,    0,    0,    0,30620,    0,    0,    0,    0
,    0,59311,    0,    0,    0,    0,197004,    0,    0,179796
,    0,    0,    0,    0,392070,30640,283069,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,294556
,    0,168344,168345,    0,    0,    0,59346,    0,59348,    0
,    0,116721,59352,    0,    0,    0,    0,    0,    0,59359
,    0,59361,59362,59363,59364,59365,59366,    0,    0,59369
,59370,    0,    0,220009,59374,    0,    0,59377,59378,    0
,    0,59381,    0,    0,116754,116755,    0,    0,    0,128233
,168393,128235,    0,    0,    0,    0,    0,128241,    0,128243
,    0,128245,128246,    0,    0,    0,    0,    0,357732,357733
,357734,    0,    0,    0,    0,    0,    0,    0,346268,    0
,128264,    0,116792,254481,    0,    0, 2056,    0,    0,179906
,128274,    0,    0,128277,    0, 2065,    0,283180,    0,    0
,    0,357765,    0,    0,357768,369243,    0,357771,    0,    0
,    0,    0,128296,    0,128298,128299,    0,197145,    0,220095
,    0,197149,    0,197151,197152,197153,13570,197155,    0,    0
,231580,    0,    0,    0,42263,    0,254534,197165,    0,    0
,254538,    0,    0,    0,    0,    0,    0,    0,    0,    0
,76701,99650,    0,    0,179971,116865,    0,36549,36550,36551
,    0,    0,392248,    0,403724,    0,116876,    0,    0,    0
,271779,392257,    0,    0,36566,260310,    0,36569,    0,254577
,357844,    0,168525,99682,    0,99684,409483,36579,36580,59529
,    0,    0,    0,392279,357858,    0,    0,    0,    0,329178
,    0,    0,    0,116913,    0,    0,    0,116917,    0,    0
,    0,392297,    0,99712,99713,    0,    0,    0,    0,99718
,    0,    0,99721,    0,    0,116935,    0,    0,    0,116939
,116940,116941,    0,    0,36626,36627,    0,    0,36630,36631
,36632,    0,    0,    0,    0,    0,    0,    0,    0,357913
,    0,357915,357916,    0,357918,357919,    0,    0,    0,    0
,    0,357925,122709,    0,    0,122712,    0,    0,30923,99768
,    0,30926,254670,254671,254672,122722,289096,352204,    0,    0
,    0,    0,    0,128467,128468,    0,128470,128471,128472,    0
,    0,    0,329271,    0,    0,    0,122743,122744,122745,    0
,    0,122748,    0,    0,122751,    0,99805,    0,122755,122756
,    0,122758,    0,122760,    0,122762,    0,    0,36710,    0
,    0,    0,    0,    0,    0,254723,    0,    0,329307,329308
,254728,    0,    0,    0,    0,    0,363737,260472,248999,    0
,    0,99840,99841,99842,    0,    0,    0,99846,323590,323591
,323592,    0,    0,    0,    0,    0,99855,99856,99857,99858
,99859,99860,    0,    0,99863,99864,99865,99866,174448,99868
,99869,99870,99871,99872,    0,    0,    0,    0,323620,    0
,323622,323623,    0,    0,    0,    0,    0,323629,    0,323631
,    0,283474,283475,254791,    0,    0,    0,254795,254796,    0
,254798,254799,254800,    0,    0,340858,254804,    0,    0,386758
,    0,    0,    0,36805,    0,42544,    0,168760,168761,168762
,    0,    0,    0,36815,220400,    0,    0,    0,346618,    0
,    0,    0,36824,220409,323676,220411,    0,335153,    0,    0
,117150,    0,117152,    0,    0,    0,283529,168790,    0,168792
,168793,    0,    0,168796,    0,    0,    0,346647,    0,346649
,323702,    0,346652,    0,    0,346655,    0,346657,    0,    0
,117180,    0,    0,117183,    0,    0,117186,    0,    0,117189
,36872,    0,    0,214722,214723,214724,    0,214726,    0,    0
,306521,    0,    0,36885,36886,36887,36888,    0,231948,    0
,    0,    0,    0,    0,    0,    0,    0,323749,323750,    0
,    0,    0,323754,    0,140172,180332,    0,    0,    0,    0
,    0,    0,323764,323765,    0,    0,    0,306558,    0,    0
,323772,323773,    0,    0,323776,323777,323778,323779,    0,    0
,168883,323783,    0,    0,    0,    0,    0,358211,100047,346739
,36942,    0,    0,220529,    0,    0,    0,    0,220534,25477
,    0,    0,134483,117273,25482,    0,25484,    0,    0,    0
,    0,    0,    0,36965,306605,    0,    0,    0,220554,180396
,    0,    0,    0,220559,    0,346775,346776,220563,    0,    0
,346780,    0,    0,31248,    0,    0,381208,151729,    0,    0
,    0,168944,    0,168946,    0,168948,168949,    0,346798,346799
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,117332,117333,117334,    0,117336,117337,117338,117339
,    0,    0,42761,117343,    0,    0,289456,    0,    0,    0
,    0,    0,59982,59983,    0,    0,306677,306678,306679,    0
,    0,    0,306683,123100,    0,    0,    0,123104,404218,123106
,    0,306692,    0,306694,306695,    0,    0,71481,    0,306700
,306701,    0,    0,    0,    0,    0,    0,306708,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,71504,71505,    0,    0,123141,123142,123143,123144,123145,    0
,123147,    0,71516,100202,    0,    0,    0,134628,123155,    0
,123157,71525,123159,123160,123161,    0,    0,    0,    0,    0
,    0,134642,134643,    0,    0,    0,    0,134648,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,100237,100238
,100239,    0,192033,    0,100243,    0,    0,237934,    0,    0
,19931,19932,19933,100252,    0,    0,100255,100256,    0,    0
,19941,100260,    0,100262,100263,60105,    0,100266,100267,100268
,100269,    0,    0,100272,    0,    0,    0,    0,    0,352706
,    0,352708,    0,    0,    0,174865,    0,14231,    0,    0
,    0,220767,220768,220769,    0,    0,    0,    0,324040,    0
,60140,60141,    0,    0,    0,    0,60146,    0,    0,346999
,    0,    0,157681,    0,    0,60155,    0,    0,398641,    0
,157689,    0,    0,    0,    0,60165,60166,    0,60168,60169
,    0,60171,    0,    0,    0,    0, 2806,    0,    0,    0
,    0,    0,    0,    0,169187,    0,    0,    0,    0,    0
,    0,    0,54455,54456,    0,    0,    0,54460,    0,    0
,54463,    0,54465, 2833,129048,    0,    0,    0,    0,    0
,    0,    0,157741,    0,    0,    0,    0,    0,    0,    0
,306911,    0,    0,20064,20065,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,20076,    0,358561,    0,    0
,    0,    0,    0,220879,358568,    0,    0,358571,    0,    0
,    0,140569,    0, 2883,    0,    0, 2886, 2887,    0,    0
,    0,25839,    0,    0,    0,    0,    0,    0,    0,    0
,    0,370069,    0,54536,    0,    0,25854,    0,    0,    0
,    0,    0,    0,    0,54547,    0,    0,    0,    0,    0
,220926,220927,    0,    0,    0,220931,    0,    0,    0,    0
,    0,    0,    0,175043,    0,25883,    0,    0,    0,404529
,163576,    0,    0,    0,220950,220951,    0,220953,220954,    0
,    0,    0,163588,163589,220960,54588,163592,163593,278334,    0
,    0,163597,    0,    0,    0,163601,    0,    0,    0,    0
,    0,    0,54605,54606,    0,54608,    0,    0,54611,    0
,    0,    0,    0,14457,54617,    0,    0,    0,    0,    0
,163626,    0,    0,    0,    0,163631,163632,    0,    0,209531
,    0,    0,    0,    0,    0,    0,    0,48903,    0,60379
,    0,60381,    0,    0,    0,    0,    0,    0,    0,352976
,163656,    0,    0,    0,    0,    0,    0,    0,    0,    0
,330039,    0,175142,    0,    0,289885,    0,    0,    0,60409
,    0,60411,60412,    0,    0,60415,    0,    0,60418,    0
,60420,    0,    0,    0,    0,    0,    0,    0,    0,    0
, 3060,    0,    0,    0,    0,    0,    0,    0,    0, 3069
, 3070,    0,    0, 3073,    0,    0,353033,    0,    0,    0
,    0,    0,    0,20294,71928,    0,    0,209619,    0,129303
,    0,    0,    0,    0,    0,    0,135047,135048,203893,    0
,    0,203896,    0,    0,    0,    0,    0,20318,    0,    0
,    0,    0, 3112,    0,    0,    0,    0,    0, 3118,209651
,209652,    0,261287,186707,    0,    0,    0, 3127, 3128,    0
,    0,    0,60502,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,89200,    0,    0,    0,209681
,209682,209683,209684,    0,    0,209687,94948,    0,    0,    0
,209692,    0,    0,    0,    0,163801,163802,    0,    0,    0
,    0,163807,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,370351,    0,    0,    0,135138,163824,    0
,60560,60561,    0,60563,43353,    0,    0,60567,60568,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,358904,    0,    0,295800,295801,295802,106482,    0,295805,376124
,    0,    0,    0,135174,135175,    0,    0,66334,66335,66336
,    0,209763,    0,    0,    0,    0,    0,    0,358932,    0
,    0,358935,    0,295830,295831,295832,295833,    0,    0,295836
,    0,    0,295839,    0,295841,    0,    0,66364,66365,66366
,66367,    0,169635,66370,    0,358959,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,209810,209811
,    0,    0,267184,209815,    0,    0,169659,    0,169661,    0
,    0,37713,209824,209825,209826,209827,    0,209829,    0,    0
,    0,209833,209834,    0,    0,    0,209838,209839,209840,209841
,    0,    0,    0,359007,267216,267217,267218,    0,    0,    0
,255748,    0,    0,    0,    0,295912,    0,163963,204123,    0
,    0,204126,359026,    0,204129,    0,295923,    0,215607,    0
,163976,    0,    0,    0,    0,    0,    0,267249,359042,100878
,    0,    0,381994,    0,393470,267257,295943,    0,    0,    0
,290210,    0,    0,    0,    0,    0,    0,215636,    0,215638
,215639,    0,295959,    0,    0,100904,    0,    0,    0,    0
,100909,    0,    0,100912,    0,    0,66493,66494,    0,77970
,    0,66498,290242,290243,    0,295982,    0,295984,    0,295986
,    0,295988,    0,295990,    0,261570,    0,    0,60778,    0
,204205,    0,    0,    0,    0,    0,    0,    0,49314,    0
,    0,    0,    0,    0,    0,    0,    0,    0,290278,    0
,    0,290281,32117,290283,    0,    0,60806,    0,60808,60809
,    0,    0,60812,    0,    0,60815,    0,60817,    0,215718
,238667,238668,    0,    0,    0,    0,    0,    0,204253,    0
,215729,353418,204257,    0,278840,    0,    0,100996,    0,    0
,    0,    0,    0,267375,267376,72319,    0,    0,    0,    0
,204275,204276,    0,    0,    0,    0,204281,    0,    0,267391
,    0,    0,267394,    0,    0,    0,    0,    0,267400,250190
,267402,    0,    0,    0,    0,    0,    0,    0,101037,    0
,    0,101040,    0,101042,    0,290365,376421,101046,    0,    0
,    0,    0,101051,215792,215793,    0,    0,    0,101057,60899
,    0,101060,    0,    0,101063,    0,    0,101066,    0,    0
,158439,158440,    0,32228,    0,    0,    0,49443,    0,    0
,290400,290401,290402,    0,    0,387934,290406,    0,49454,    0
,    0,347781,    0,    0,60934,    0,    0,    0,290418,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,290431,290432,    0,    0,290435,    0,60957,60958,60959
,60960,    0,60962,60963,60964,60965,60966,    0,    0,60969
,    0,32286,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,347842,    0,    0,158524,43785,    0,    0,347849
,164266,164267,    0,43792,    0,307696,175746,    0,    0,    0
,290490,    0,    0,    0,365075,    0,    0,256075,    0,    0
,    0,    0,244606,    0,    0,267557,    0,    0,    0,    0
,    0,359355,    0,204458,    0,    0,221672,    0,359362,    0
,    0,    0,    0,    0,    0,    0,129890,15151,    0,    0
,    0,    0,    0,    0,    0,129899,    0,    0,    0,    0
,    0,    0,    0,    0,    0,204490,    0,    0,158597,    0
,    0,    0,215971,158602,    0,324977,    0,    0,    0,    0
,370878,    0,158611,158612,158613,158614,158615,158616,    0,    0
,158619,158620,158621,158622,    0,    0,    0,    0,    0,    0
,    0,204526,158631,405323,    0,216004,    0,    0,26686,216008
,    0,101270,101271,    0,    0,    0,164382,    0,    0,    0
,    0,164387,    0,319288,15228,38177,    0,    0,    0,    0
,    0,    0,388141,    0,216033,216034,216035,216036,    0,95561
,216039,    0,    0,    0,101303,    0,49672,101306,353735,    0
,    0,    0,    0,    0,141472,227528,    0,    0,    0,    0
,    0,    0,    0,    0,    0,279171,    0,    0,    0,49695
,49696,    0,353759,61173,61174,    0,49702,    0,    0,    0
,    0,    0,    0,    0,353771,    0,    0,353774,204613,319354
,216089,    0,    0,    0,    0,    0,    0,    0,    0,    0
,365261,    0,89887,61203,    0,61205,61206,    0,    0,61209
,    0,353798,61212,15317,    0,    0,216115,    0,    0,    0
,    0,    0,    0,    0,204649,204650,    0,216126,    0,204654
,    0,    0,44021,    0,    0,    0,    0,    0,204663,204664
,204665,    0,    0,204668,    0,141563,204671,    0,204673,204674
,    0,    0,204677,204678,204679,204680,    0,    0,204683,353846
,227633,    0,216161,216162,216163,    0,    0,216166,    0,    0
,101429,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,216180,216181,353870,353871,    0,216185,216186,216187,    0
,216189,    0,    0,    0,    0,101454,61296,    0,101457,101458
,101459,101460,353889,    0,101463,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,112954,    0,    0,    0,    0,    0,210489,    0,90014
,    0,61331,    0,61333,164600,    0,233446,61337,    0,    0
,    0,164607,164608,    0,164610,    0,61346,233457,158877,    0
,    0,233461,233462,233463,61354,61355,61356,    0,    0,61359
,61360,61361,61362,61363,    0,    0,61366,    0,233478,233479
,233480,233481,    0,    0,    0,    0,399859,    0,    0,    0
,    0,233491,233492,376918,    0,    0,233496,    0,    0,    0
,    0,233501,    0,    0,    0,    0,    0,    0,118768,    0
,164666,164667,    0,    0,199092,    0,    0,    0,72882,    0
,    0,90096,    0,    0,181891,    0,    0,    0,    0,245003
,256478,256479,    0,    0,    0,    0,233536,    0,    0,359753
,    0,    0,130276,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,371243,    0,    0,    0,    0
,    0,256509,    0,    0,    0,    0,279462,    0,    0,    0
,78671,    0,    0,    0,    0,    0,    0,    0,    0,256527
,    0,181948,    0,118843,    0,118845,    0,    0,38530,    0
,    0,    0,    0,    0,348334,    0,141804,359811,204913,    0
,    0,    0,204917,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,204932,    0,    0
,    0,    0,    0,    0,216413,    0,382788,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,61538,    0
,164806,    0,    0,    0,    0,    0,    0,113180,113181,113182
,    0,    0,227925,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,118934,    0,    0,    0,313996,    0
,61570,61571,61572,    0,    0,394321,    0,    0,113211,113212
,113213,    0,    0,113216,    0,319750,    0,    0,113221,    0
,    0,    0,    0,    0,405814,    0,    0,    0,    0,    0
,61600,    0,61602,61603,    0,    0,61606,    0,    0,    0
,73084,    0,136193,308304,    0,    0,308307,    0,    0,    0
,250941,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,147687,    0,    0,    0,124743,    0,    0,73113
,73114,73115,    0,    0,    0,73119,32961,    0,    0,    0
,    0,    0,    0,    0,250975,    0,    0,    0,205083,    0
,    0,32976,32977,    0,147719,147720,147721,    0,    0,    0
,113303,    0,    0,    0,    0,    0,365737,    0,32993,32994
,    0,32996,61682,    0,    0,    0,    0,    0,    0,    0
,    0,33006,33007,    0,147749,    0,    0,147752,    0,314127
,147755,33016,    0,147758,251025,    0,113339,113340,    0,    0
,    0,113344,    0,    0,    0,210877,210878,    0,325620,    0
,113353,73195,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,73206,    0,    0,113368,    0,    0,    0,10106
,    0,251062,    0,61743,    0,    0,233856,    0,    0,222385
,    0,61751,    0,61753,61754,    0,61756,61757,61758,61759
,61760,    0,    0,61763,    0,    0,    0,73241,73242,73243
,    0,    0,    0,    0, 4404,    0,    0,251098,251099,    0
,    0,    0,    0,73257,73258,73259,73260,    0,    0,    0
,    0,    0,    0,    0,251115,    0,    0,73271,73272,    0
,251121,251122,    0, 4433,    0,    0,251127,    0,    0,119179
,342923,    0,    0, 4443,    0,    0,    0,    0,67555,67556
,67557,67558,    0,147878,    0,    0,    0,    0,147883,    0
,    0,216730,222468,10200,222470,360159, 4466,    0,    0,    0
,130684,233951,    0,    0,    0,147900,    0,    0,147903,    0
,    0,    0,    0,147908,    0,    0,    0,    0,    0,205284
,205285,205286,245446,233973,    0,233975,    0,    0,    0,50395
,    0,    0,    0,142191,371672,    0,    0,    0,    0,    0
,    0,    0,    0,27461, 4514,    0,27464,360211,199576,    0
,205315,205316,205317,    0,    0,    0,165162,365958,    0,    0
,    0,    0,365963,    0,211066,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,38973,    0,    0,    0,    0,    0,    0,    0,73403
, 4560, 4561,    0,73407,73408,61935,    0,    0,    0,    0
,    0,    0, 4572,    0,239791,    0,    0,    0,    0, 4579
,    0,165217,67689,    0,    0,    0, 4586,320122, 4588,    0
, 4590, 4591, 4592,    0,    0,    0,    0,61967,61968,61969
,    0,    0,67709,27551,297191,    0,    0,    0,    0,    0
,    0,    0,205407,    0,377519,    0,    0,    0,    0,    0
,113623,113624,113625,    0,    0,    0,    0,61997,    0,    0
,    0,    0,    0,62003,    0,    0,    0,239854,    0,    0
,27588,    0,239859,    0,27592,239862,119386,    0,205443,205444
,    0,    0,    0,205448,    0,    0,366087,    0,    0,    0
,    0,    0,205457,205458,    0,    0,205461,205462,27616,27617
,    0,205466,205467,    0,165310,205470,205471,205472,    0,205474
,    0,    0,205477,    0,    0,    0,    0,    0,    0,    0
,    0,148116,    0,148118,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,79285,    0,    0,    0,    0,    0
,165346,165347,    0,    0,    0,205510,188300,    0,    0,    0
,62090,148146,148147,148148,148149,    0,    0,148152,    0,239946
,148155,    0,148157,    0,    0,    0,326008,    0,    0,171112
,    0,    0,171115, 4743,56377,    0,383388,    0,    0,    0
,171123,171124,    0,113756,113757,62125,62126,62127,    0,    0
,159659,    0,    0,    0,239981,    0,    0,    0,360462,    0
,    0,165407,165408,165409,165410,    0,56409,    0,    0,    0
,    0,    0,239999,    0,    0,62155,    0,    0,240005,    0
,    0,    0,240009,240010,240011,    0,240013,    0,    0,240016
,400653,    0,96594,148228,    0,    0,56439,56440,56441,56442
,16284,    0,56445,    0,148239,    0,    0,56450,349038,303143
,    0,    0,326094,    0,371992,    0,    0,    0,    0,    0
,    0,    0,205627,16307,    0,    0,    0,16311,    0,16313
,    0,    0,16316,    0,234324,    0,    0,    0,    0,148274
,    0,    0,16326,171226,    0,148280,    0,    0,372026,    0
,    0,    0,171235,    0,148289,148290,148291,    0,    0,    0
,    0,171244,    0,    0,    0,    0,16350,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,16364,    0,    0,    0,16368,372063,171269,372065,    0,56532
,    0,    0,56535,    0,    0,    0,    0,303231,    0,280285
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,56567,56568,56569,    0,    0,    0
,56573,280317,280318,280319,    0,    0,79527,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,56590,56591,56592
,56593,    0,56595,56596,56597,56598,56599,    0,372136,56602
,217239,280347,280348,    0,280350,    0,    0,    0,    0,    0
,280356,    0,280358,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,50891,    0,    0,    0,    0
,    0,    0,343485,    0,366435,    0,    0,    0,    0,    0
,291860,    0,    0,    0,372182,    0,372184,62387,    0,    0
,372188,280397,    0,    0,    0,    0,    0,    0,280404,    0
,    0,    0,354989,    0,    0,    0,    0,372205,372206,    0
,    0,119781,372210,    0,372212,372213,372214,    0,240265,372217
,    0,    0,    0,280429,    0,    0,    0,366488,    0,    0
,    0,366492,    0,188647,280440,280441,188650,280443,251759,    0
,    0,    0,    0,    0,    0,    0,    0,309138,    0,    0
,    0,    0,    0,    0,251775,    0,    0,251778,314886,    0
,    0,314889,228835,    0,    0,200153,22307,    0,    0,280475
,    0,280477,    0,    0,    0,280481,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,51017,280498,280499,280500,280501,    0,280503,280504,280505
,280506,    0,    0,    0,280510,160034,    0,    0,    0,    0
,33825,56774,45301,349363,73988,    0,    0,10884,    0,    0
,    0,    0,    0,    0,    0,    0,    0,119897,    0,    0
,    0,    0,10899,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,56806,56807,    0,349396,349397,    0,    0
,16654,    0,326454,    0,    0,    0,    0,    0,    0,    0
,119930,119931,160091,    0,    0,    0,286309,    0,    0,45358
,    0,    0,    0,56836,    0,    0,    0,349427,349428,56842
,    0,349431,56845,    0,    0,    0,    0,    0,315016,119959
,119960,119961,119962,    0,131438,119965, 5226,    0,    0,    0
,119970,    0,    0,    0,349454,    0,    0,    0,    0,    0
,    0,234721,    0,131457,    0,183092,366677,    0,    0,    0
,    0,366682,    0,    0,    0,    0,286369,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,320807,    0,11011,    0,    0,    0,263443,    0
,    0,263446,    0,    0,    0,56918,    0,    0,    0,39711
,    0,    0,    0,    0,    0,    0,56929,102826,349518,    0
,    0,120041,    0,    0,    0,366736,366737,    0,    0,    0
,    0,    0,120052,    0,366745,366746,366747,366748,    0,366750
,    0,    0,    0,    0,    0,    0,    0,    0,    0,102858
,102859,    0,    0,    0,    0,    0,114339,56970,    0,349559
,    0,    0,    0,    0,    0,    0,    0,120087,120088,120089
,    0,    0,    0,120093,    0,    0,    0,    0,349578,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,114372
,    0,    0,120112,120113,    0,    0,120116,120117,120118,120119
,    0,    0,120122,    0,343867,343868,343869,343870,    0,    0
,343873,315189,    0,    0,    0,343878,    0,    0,114401,114402
,    0,114404,    0,    0,114407,229148,    0,114410,    0,114412
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,74265,74266,    0,    0,    0,    0,    0,    0,    0
,355387,    0,137383,    0,    0,    0,    0,    0,355395,    0
,74284,102970,    0,    0,    0,    0, 5446,    0,    0,    0
,74294,74295,102981,    0,74298,74299,    0,    0,    0,    0
,189044,    0,    0,189047,    0,    0,343949,    0,    0,    0
,    0,    0,103001,    0,    0,    0,    0,343960,343961,    0
,    0,    0,    0,    0,    0,    0,    0,103016,103017,103018
,355447,114494,    0,103022,    0,286608,    0,74341,    0,74343
,    0,74345,    0,    0,    0,103034,103035,    0,338254,120249
,    0,103040,    0,    0,    0,    0,    0,    0,    0,    0
,    0,74365,    0,    0,326796,    0,    0,    0,114531,    0
,    0,    0,114535,    0,160433,    0,344019,    0,    0,    0
,344023,    0,344025,344026,    0,160444,    0,    0,97340,    0
,    0,    0,114555,97345,114557,114558,    0,114560,    0,    0
,    0,114564,    0,338309,    0,338311,338312,    0,    0,    0
,57203,57204,57205,    0,    0,    0,    0,74421,    0,74423
,74424,74425,    0,74427,74428,    0,74430,74431,235068,    0
,338336,    0,    0,    0,160493,160494,160495,160496,338344,    0
,57233,57234,57235,57236,    0,    0,57239,    0,401461,57242
,    0,57244,    0,    0,    0,    0,    0,326889,389997,    0
,    0,131835,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,361328,    0,    0,    0,    0,    0
,298227,    0,    0,172016,    0,    0,    0,    0,    0,    0
,172023,    0,326924,    0,    0,    0,    0,258085,    0,258087
,    0,    0,    0,    0,269566,    0,    0,    0,    0,    0
,    0,160570,    0,    0,11411,160574,    0,160576,160577,160578
,160579,160580,    0,74527,    0,74529,74530,258115,258116,    0
,258118,    0,    0,    0,    0,74539,    0,269599,    0,    0
,    0,143389,    0,321238,    0,304029,304030,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,91772,    0,    0
,    0,    0,    0,    0,    0,    0,269628,269629,    0,    0
,57363,338477,269634,    0,    0,    0,338482,338483,269639,355698
,338487,281119,258171,74587,338497,57384,321288,57386,74600,57389
,74601,57390,338504,74602,57391,74603,57392,321295,57393,258208
,160679,126257,258243,246769,269718,258244,269724,23033,258262,126311
,355792,258263,258266,160737,269756,229597,23065,269781,23090,269788
,258314,269791,200947,160810,86229,378818,160812,264085,137871,160820
,137872,361696,172375,401881,298615,195355,34719,247005,126528,321604
,29017,373245,333086,304422,218367,29046,321634,29047,92155,29048
,321639,298691,29052,321641,155268,333118,321644,333119,321645,333120
,321646,333159,298737,298739,218421,407756,298753,373335,298754,396286
,373338,298757,298765,92233,304503,298766,298772,86503,52087,29139
,333230,298808,218495,29174,34913,29176,356189,333241,304556,218501
,29180,  495,258679,29199,258682,29202,252947,29204,316059,34946
,333278,132483,333293,327556,316082,149709,333294,316083,333300,316089
,407883,333302,333311,98094,264477,149737,402173,149745,98124,57965
,333347,98130,161247,121088,316155,195678,98158,57999,287493,121120
,58027,17868,172770,58030,172775,149827,230159,121156,304745,121161
,299012,98217,304750,17900,58061,17902,299018,17905,247402,149873
,385092,58083,287570,17931,385100,17932,385102,149885,98252,149886
,98253,385104,149887,98254,17936,385105,149888,  726,132678,  727
,149890,17939,  728,149891,121206,98258,  729,385109,149892,17941
,385111,149894,  732,385114,149897,98264,385115,98265,385118,98268
,58109,385119,98269,322014,98271,304804,195801,98272,385123,304805
,385127,98277,167122,98278,385129,58120,304814,98282,304815,98283
,333501,304816,121232,98284,385136,304818,322038,121243,155689,86845
,35212,293386,167172,167173,58170,167174,121278,58171,18012,121279
,58172,385182,121280,58173,287659,58179,121293,58186,121294,58187
,121297,58190,408153,121303,167202,121306,167203,121307,293418,167204
,121308,293419,167205,121309,18043,293420,121310,322110,167211,281958
,190166,368022,304915,18065,12333,  859,293449,18073,293450,167236
,18074,293451,18075,155764,18076,293454,155766,18078,293457,18081
,293459,18083,281986,18084,281988,86930,18086,12349,299200,18087
,190198,18088,190199,18089,12352,190200,18090,282010, 6634,264808
,98435,167284,23859,368084,190237,368085,293504,368086,190239,368090
,167295,385323,247635,213214,138633,385329,259115,408280,213222,408281
,385333,293541,190284,167336,121440,121445,58338,391092,167349,35398
,213251,167355,282101,167361,293576,190310,167362,293578,92783,293582
,58365,368166,98527,391116,190321,379647,293592,391122,293593,368177
,293596,379654,368180,293599,293608,12495,293611,12498,368218,190371
,190373,173162,190374,173163,87108,190375,58424,190380,173169,293647
,190381,368235,190388,368238,190391,247805,12588,98655,75707,190521
,35622,87327,64379,12746,64382,12749,207897,64472,334112,150528
,64531,47320,403016,64533,265361,150621,374374,208001,196558,150662
,150682,12994,133472,12995,351495,259703,403130,374445,70384,403132
,374447,196615,41716,213860,156490,374518,179460,179461, 1614,179476
,168002,219657,173761,156550,127865, 1651,374565,265562,282781,179515
,374588,265585,374589, 1684,305761,127914,317268,179580,150895,179582
,150897,403347,168130,334506,36182,334509,150925,150926,36186,150927
,36187,219772,150928,99315,59156,397681,305889,47724,351790,225576
,288699,59219,196914,151018,196949,151053,151055,70737,156801,70746
,294501,151076,196973,151077,30600,196974,151078,369085,151079,19128
,254347,196977,151081, 1919,254348,151082, 1920,254349,196979,151083
,196980,151084,386302,151085, 1923,271613,128188,128191,59347,13451
,409328,59371,168375,59372,334751,59375,357700,59376,116753,30698
,271664,105291,409368,128255,231522,128256,254471,116783,254472,116784
,128259,116785,128260,116786,346269,271688,260214,116789,271690,260216
,128268,116794,254492,191385,357762,128282,357763,134020,357764,128284
,357773,128293,243044,197148,254520,197150,42261,25050,179956,128323
,254542,197172,254544,179963,254545,128331,409481,214423,99683,357855
,36583,357856,36584,329180,116911,329181,214441,116912,392301,99714
,116926,99715,116934,99723,357890,116936,357891,116937,357892,42357
,357896,116942,122680,116943,36625,116946,36628,254635,36629,214480
,36633,392336,357914,357920,122703,48122,36648,357921,36649,357922
,36650,225973,122707,128464,71094,128469,59625,128474,122737,122742
,99794,237486,122746,128484,122747,157171,122749,231753,122750,128491
,122754,323558,122763,36708,122764,36709,352254,329306,352261,254732
,363736,248996,260497,220338,99875,31031,352306,323621,323626,254782
,254783,168728,346584,254792,220370,254793,220371,254794,220372,340861
,117118,283505,36814,283508,220401,346616,220402,346617,220403,220406
,36822,231891,117151,398271,168791,346646,306487,168799,346648,168801
,323713,191762,117181,254870,117182,214720,117191,36873,214725,180303
,306519,180305,306520,180306,323748,220482,283599,13960,243441,220493
,358182,306549,283601,306550,283602,306551,283603,323763,306552,323766
,306555,323767,191816,323768,283609,283611,260663,323771,306560,168872
,323774,77083,346728,323780,220528,117262,220530,140212,220551,168918
,220552,168919,220553,168920,220556,100079,220557,168924,100080,220558
,100081,346774,220560,168941,117308,168942,117309,306631,168943,117310
,168947,117314,346797,168950,346800,168953,100109,59950,306642,100110
,346802,140270,100111,346803,117323,100112,346804,180431,346805,180432
,346806,180433,100115,346809,100118,352548,117331,100120,381237,174705
,123077,117340,260779,59984,306693,123109,306696,60005,404226,306697
,100165,306702,71485,306703,134593,123119,71486,60012,71487,60013
,306705,60014,306706,60015,306707,249337,306709,60018,306712,71495
,60021,134604,60023,134608,123134,134609,71502,134610,71503,123139
,100191,289513,123140,157568,123146,19880,123148,71515,134625,123151
,134626,123152,71519,19886,134627,123153,71520,134638,25635,404278
,134639,100253,60094,100254,19936,100257,19939,220735,19940,134683
,100261,375641,100265,255187,54392,341255,60142,220797,54424,220798
,54425,37214,295380,220799,60163,54426,220800,60164,324069,220803
,42956,220806,60170,220808,60172,60175, 2805,54454, 2821,54457
, 2824,358562,180715,220890, 2884,220925,209451,232410,163566,25878
,318466,175041,175042,163568,318469,175044,163574,88993,220948,163578
,220949,163579,220955,54582,220956,54583,220957,54584,352926, 2969
,329979, 2970,163610,54607,215246,60347,54610,163615,54612,169353
,54613,163617,54614,163629,60363,60380,48906,289890,60410,370235
, 3067,324357,278461,278462,26034,335838,278468,157992,71937,186678
,135045,31791,20317,20324, 3113,209653,60491,209690,112161,209696
,163800,221173,60537,163804,60538,163805,60539,387552,60543, 3173
,158078,20390,295768,163817,158081,60552,129406,60562,66302,60565
,324468,60566,358893,60569,358896,60572,347423,140891,209737,14679
,358905,169584,376127,135173,358920,181073,175349, 3239,232722,209774
,204061,152428,146696,37693,318812,209809,140965,209828,77877,204093
,77879,204094,77880,209832,204095,209835,37725,215574,209837,209844
,100841,204124,163965,359024,204125,215606,204132,215608,204134,49235
,267246,100873,267247,100874,267248,100875,267252,66457,267255,163989
,163998,49258,215637,49264,295958,164007,49267,295960,215642,100903
,60744,215645,100905,295964,169750,100906,267280,215647,100914,66492
,295981,290244,295983,49292,295987,267302,295989,261567,261569,49300
,295993,261571,60776,261572,60777,49303,393527,66518,66520,49309
,66521,49310,66522,49311,66523,49312,66524,49313,204216,49317
,405012,290272,49318,290273,49319,290274,78005,290275,78006,267328
,78007,175539,32114,405020,100959,267339,60807,204251,100985,238674
,204252,313267,135420,290322,267374,290328,267380,290329,204274,405072
,204277,267386,204279,267387,204280,267389,204282,101016,267390,204283
,353447,267392,267393,204286,267397,215764,267398,215765,164132,267399
,215766,267403,215770,267404,101031,267405,101032,290354,267406,101033
,267409,158406,95306, 3514,215787,101047,60888,215788,101048,215789
,101049,215790,101050,215794,101054,72369,215795,135477,101055,215796
,101056,215799,101059,101061,72376,101062,95325,324811,158438,359240
,49442,290415,60935,290416,60936,290417,37989,290419,158468,37991
,290420,204365,164206,158469,60940,43729,164207,158470,164208,158471
,290423,164209,336320,290424,169947,43733,290425,158474,290426,164212
,43735,290428,158477,330588,290429,60949,290430,158479,347843,169996
,365077,273285,256079,158550,359356,256090,158561,256098,181517,78274
,72537,319231,204491,204492,158596,256127,181546,158598,141397,101238
,204520,158624,204521,158625,204522,158626,204523,158627,393845,158628
,216003,204529,164370,216005,204531,124220,101272,342235,15226,101300
,61141,290622,101301,216042,101302,353732,216044,164411,336526,101309
,336527,204576,336528,101311,353743,141474,353744,279163,353762,61175
,296394,204602,296397,112813,319357, 9559,290684,61204,135795,61214
,279223,250538,89902,204648,101382,158763,101393,204666,26819, 9608
,204667,72716,49768,216146,204672,227624,204676,26829,353855,216167
,216168,101428,216170,101430,353860,216172,353861,336650,198962,353862
,336651,101434,353863,198964,353864,216176,198965,353865,216177,353866
,216178,216179,78491,353872,216184,61285,353878,216190,216191,101451
,353880,216192,101452,353881,216193,101453,216196,101456,61332,38384
,164623,61357,313795,222003,199055,233495,32700,199090,164668,199091
,164669,113148, 9882,394264, 9885,113210,73051,250907,113219,365652
,314019,256659,61601,73083,61609,73085,61611,250939,187832,365680
,250940,314070,73116,250969,228021,73122,394395,250970,250971,73124
,394397,250972,250978,228030,250980,113292,256721,32978,199359,32986
,176433,61693,147750,73169,33010,147751,33011,147760,113338,296939
,210884,113361,61728,113362,61729,342843,251051,113363,61730,113364
,96153,164999,159262,113366,113367,61734,233846,113369,113370,10104
,113373, 4370,222388,61752,285515, 4402,73247, 4403,251097,147831
,251103,73256,147842,73261,377323,233898,67525,73264,67527,251112
,73265,302746,251113,73266,251114,73267,251116,73269,251117,73270
,251120,73273,251123,73276, 4432,251125, 4434,251126,245389, 4435
,251128,147862,251129, 4438,251132, 4441,365883,147877,147879,67561
,360151,205252,233949,130683,147901,130690,251168,147902,147905,27428
,147906,79062,147907,27430,262649,147909,262652,147912,79068,308549
, 4488,302834,27458,256939,27459,365943,320047,27460,256947,205314
,365954,136474,205320, 4525,383170,205323,205325,165166,165177,67648
,165185,38971,73406, 4562,331575, 4566,113572,96361,216842, 4573
,205370,113578, 4575,302900,67683, 4576,67684, 4577,383220,165214
,67685, 4578,159479, 4580,165219, 4583,234064,165220,102113, 4584
,383227,102114, 4585,320124, 4589,50491, 4595,297188,205396,343088
,136556,239823,67713,239824,67714,239825,67715,113631,61998,113632
,61999,113633,62000,239853,62006,239855,136589,62008,27586,239856
,27587,314445,239864,205442,119387,188243,148084,205459,27612,205460
,10402,205465,27618,377578,205468,320213,205473,239909,148117,188293
,165345,62079,239935,205513,389140,62131,239982,113768,239983,171139
,171142,39191,239987,165406,62140,148202,56410,171151,62148,56411
,239996,62149,239997,62150,239998,171154,62151,240000,62153,240001
,62154,165422,62156,240004,62157,337535,240006,240007,62160,240012
,165431,171178,85123,349035,56448,148275,67957,16324,148276,67958
,372024,131070,372025,90912,67964,171240,148292,16341,171241,148293
,171242,148294,308931,171243,171245,148297,16346,171246,148298,16347
,148299,16348,148300,16349,188461,171250,148302,16351,171251,148303
,16352,171252,148304,16353,148305,16354,148306,16355,148309,79465
,16358,171258,16359,372054,16360,372055,171260,16361,372056,171261
,56521,16362,372057,16363,372060,39314,16366,257321,16367,303297
,280349,280353,228720,159876,395095,372147,372183,366446,372207,45198
,372208,125517,372211,366474,355047,314888,366531,280476,280507,33816
,349395,56808,337927,314979,280565,119929,286317,56837,349425,56838
,349426,125683,56839,349434,56847,349436,315014,303540,315015,292067
,119968, 5228,372429,200319,142963,120015,349507,309348,372486,366749
,366752,320856,366753,343805,102860,56964,143020,56965,349553,56966
,349554,102863,349555,91390,343837,56987,343838,56988,349576,343839
,56989,11093,349577,56990,349579,102888,56992,332369,102889,56993
,349581,102890,56994,349582,120102,102891,79943,56995,349583,120103
,56996,349584,217633,120104,349585,120105,102894,120106,56999,217636
,120107,349588,114371,102897,120110,114373,102899,343854,183218,120111
,120115,62745,280759,125860,366824,343876,303724,114403,407005,102944
,303744,74264,125914,74281,378385,343963,114483,315290,34177,103025
,74340,103027,74342,338246,74344,338248,103031,74346,103032,74347
,103033,74348,200565,103036,338256,103039,343995,338258,120252,103041
,80093,343996,338259,120253,103042,343997,120254,160414,103044,160415
,103045,338263,103046,344001,103047,338265,103048,74363,74364,51416
,389901,338268,103051,338269,263688,338272,326798,114529,338273,326799
,114530,338277,160430,344018,338281,344020,338283,344021,57171,344024
,338287,114544,344027,338290,344030,131761,338295,160448,114552,131764
,114553,338297,114554,114559,45715,114561,11295,338306,11297,223591
,74429,171966,160492,258053,22836,372821,326925,183500,149078,326926
,126131,11391,258086,172031,309737,160575,74520,57315,45841,258117
,74533,258121,74537,57326,269598,258124,74540,269600,258126,269630
,166364,57361,269631,57362,384376,338480,57367,338481,269637,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    0
,    0,    0,    0,    0,    0,    0,    0,    0,    0,    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 :=
         ( 1520,    0,    0,    0,    0, 1518,    0, 1340, 1329, 1519
,    0, 1331,    0, 1548,    0,    0,    0, 1333, 1334, 1335
, 1336, 1337, 1338,    0, 1127,    0, 1394, 1127, 1332, 1339
,    0,    0, 1528,    0,    0, 1394, 1201,    0, 1202, 1184
,    0, 1183, 1145, 1144,    0, 1199, 1200,    0, 1438, 1458
, 1185, 1146, 1147, 1148, 1188, 1167, 1444, 1170, 1171, 1172
, 1173, 1174, 1175, 1178, 1179, 1462, 1467, 1465,    0, 1189
, 1186, 1187,    0, 1441, 1272, 1273,    0,    0, 1560,    0
, 1268, 1582,    0, 1267,    0,    0, 1394,    0, 1495, 1282
,    0, 1561,    0, 1584, 1287, 1482,    0,    0,    0,    0
, 1346, 1140, 1141, 1142,    0, 1127,    0,    0,    0, 1357
, 1580, 1342, 1524, 1522, 1521, 1407, 1210, 1080, 1406,    0
,    0, 1143,    0,    0, 1185, 1423,    0, 1435, 1433, 1166
,    0, 1460,    0, 1192, 1190, 1194,    0, 1191, 1195, 1193
, 1176,    0,    0,    0,    0,    0,    0, 1440,    0, 1169
,    0,    0,    0,    0,    0,    0,    0,    0, 1198, 1196
, 1197,    0, 1205, 1206, 1203, 1204,    0, 1207, 1180,    0
, 1185, 1181, 1463, 1377, 1582, 1595,    0,    0,    0,    0
,    0,    0,    0,    0, 1374, 1582, 1125, 1556, 1255, 1398
, 1496, 1497,    0,    0, 1395,    0,    0,    0,    0,    0
, 1582, 1043, 1128, 1044, 1045, 1046, 1047, 1048, 1049, 1050
, 1064, 1065, 1066, 1394, 1129, 1130,    0, 1394, 1394, 1382
, 1383, 1384, 1385, 1482, 1563, 1394, 1427, 1586, 1483,    0
, 1482,    0,    0, 1578, 1482,    0, 1355, 1356,    0,    0
, 1063,    0, 1404, 1529,    0, 1394,    0,    0,    0,    0
,    0,    0, 1182,    0,    0, 1121,    0, 1160,    0, 1161
, 1435, 1330, 1461, 1439, 1107, 1177, 1459, 1086, 1158, 1157
, 1159, 1156, 1155, 1208, 1209,    0, 1151, 1152, 1154, 1153
, 1150, 1444, 1442,    0,    0, 1458, 1448,    0, 1450, 1452
, 1449, 1451, 1453,    0,    0, 1464, 1466, 1468,    0,    0
, 1493,    0, 1372, 1564,    0, 1370, 1493, 1581,    0,    0
, 1381, 1533, 1378,    0, 1535,    0,    0,    0, 1394, 1138
, 1139,    0,    0, 1257, 1486, 1280,    0, 1143,    0, 1148
,    0,    0,    0,    0, 1069,    0,    0, 1498,    0,    0
, 1500,    0, 1502,    0, 1283,    0,    0, 1286,    0,    0
,    0, 1559,    0, 1530, 1277,    0, 1062,    0, 1341, 1523
,    0, 1213, 1212, 1408, 1447, 1443, 1437, 1430, 1433, 1165
, 1120,    0,    0, 1431, 1433, 1436,    0, 1164,    0,    0
, 1149, 1168, 1446, 1445, 1454, 1456, 1455, 1457, 1270, 1406
, 1277,    0, 1275,    0, 1533, 1533,    0,    0,    0, 1376
,    0,    0, 1428, 1126,    0,    0, 1399, 1398, 1215, 1216
, 1217,    0,    0,    0,    0,    0, 1471, 1575,    0, 1400
,    0, 1042, 1542,    0,    0,    0,    0,    0, 1565, 1298
, 1542, 1123,    0, 1293,    0,    0, 1482,    0, 1394, 1562
, 1482, 1482, 1051, 1394, 1052, 1053, 1054,    0, 1285, 1567
, 1302,    0,    0,    0,    0, 1278, 1402,    0, 1525, 1211
, 1435, 1119, 1424, 1432, 1435, 1434, 1108, 1087, 1276, 1402
, 1596, 1594,    0,    0,    0,    0, 1269,    0,    0, 1536
,    0,    0,    0, 1132, 1133, 1134, 1135, 1137, 1131, 1136
, 1394,    0,    0,    0, 1469,    0, 1218, 1219, 1220, 1472
,    0,    0, 1307,    0,    0,    0, 1221, 1224, 1225, 1226
, 1227, 1230, 1398,    0,    0,    0,    0, 1569, 1222, 1228
, 1229, 1231, 1400, 1309, 1310, 1311, 1398,    0, 1223, 1143
, 1241, 1232, 1233, 1234, 1235, 1236,    0,    0, 1256,    0
, 1487,    0,    0,    0,    0,    0,    0,    0,    0, 1078
, 1566, 1299,    0,    0,    0,    0,    0, 1582,    0,    0
, 1100, 1067,    0,    0,    0,    0,    0,    0,    0, 1092
, 1093, 1094, 1411, 1411, 1099,    0,    0, 1419, 1582, 1292
, 1297,    0, 1504, 1501, 1394,    0, 1284,    0, 1059,    0
,    0,    0, 1367,    0,    0, 1368, 1369,    0, 1419, 1532
, 1531, 1361, 1279,    0,    0, 1405, 1163, 1162, 1274, 1582
, 1494,    0,    0, 1375, 1534, 1564, 1567, 1429, 1343, 1242
, 1398, 1516, 1508,    0, 1243, 1353,    0,    0, 1308,    0
,    0,    0, 1260,    0, 1246, 1474,    0, 1398,    0,    0
,    0, 1512, 1264,    0,    0, 1241,    0,    0, 1555,    0
, 1398,    0, 1558, 1482, 1127,    0, 1401, 1491, 1488, 1349
, 1398, 1489, 1398,    0,    0,    0, 1543, 1394, 1387, 1386
, 1296, 1077,    0, 1079, 1081, 1082, 1083, 1122,    0,    0
, 1098, 1096,    0,    0, 1290, 1090, 1091, 1409, 1089, 1070
, 1071, 1072, 1073, 1074, 1075, 1076, 1412, 1095, 1097, 1539
, 1394, 1582,    0, 1499, 1300,    0,    0, 1503, 1301, 1059
,    0, 1402,    0, 1078, 1365, 1364, 1366, 1363,    0, 1359
,    0, 1403, 1358,    0, 1373, 1371,    0,    0, 1470,    0
,    0,    0, 1266, 1354, 1482, 1306, 1547,    0,    0, 1262
, 1476, 1589, 1473,    0,    0, 1398, 1478, 1398, 1552, 1553
,    0,    0, 1241, 1325, 1324, 1326, 1313, 1314, 1315, 1316
, 1317, 1398, 1398, 1398,    0, 1398,    0, 1476, 1265,    0
, 1281,    0,    0, 1252,    0, 1398,    0, 1482,    0, 1352
, 1526, 1348, 1492, 1490, 1350, 1351, 1041, 1392,    0, 1394
, 1537,    0, 1579,    0, 1413, 1185, 1415, 1106,    0, 1288
, 1085,    0,    0, 1417, 1394,    0, 1593,    0,    0,    0
, 1185,    0, 1493, 1303,    0, 1402,    0,    0, 1347,    0
,    0, 1060,    0, 1362,    0, 1271, 1344, 1345,    0, 1327
,    0, 1493, 1568, 1304,    0, 1261,    0, 1591,    0,    0
, 1398, 1398,    0,    0, 1423, 1248, 1554, 1249, 1321,    0
,    0,    0, 1318, 1515, 1319, 1320, 1592, 1398, 1398, 1570
, 1573,    0, 1398,    0,    0,    0,    0,    0, 1259,    0
, 1577,    0,    0,    0,    0,    0, 1394, 1084,    0,    0
, 1105,    0, 1102, 1088,    0,    0, 1541,    0, 1112, 1402
, 1542, 1124, 1420, 1506,    0,    0,    0, 1060,    0, 1055
,    0, 1402,    0,    0, 1517, 1510,    0, 1305, 1263,    0
,    0, 1477, 1475, 1247, 1546,    0, 1479, 1574, 1398,    0
,    0,    0,    0, 1513, 1393, 1244,    0, 1253, 1482,    0
, 1258,    0, 1576,    0,    0,    0,    0, 1538,    0,    0
, 1103, 1104,    0, 1410, 1109,    0, 1394,    0, 1394, 1396
,    0, 1114,    0,    0, 1068,    0, 1505, 1061, 1056, 1402
, 1295,    0, 1294,    0,    0, 1509, 1590,    0, 1545,    0
,    0, 1572,    0,    0, 1254,    0, 1482, 1527, 1391,    0
, 1388,    0,    0, 1414,    0, 1416,    0,    0, 1110, 1549
, 1111,    0, 1118, 1544,    0, 1291, 1493,    0, 1057, 1360
, 1493, 1245,    0,    0, 1312, 1250,    0, 1389,    0, 1101
,    0, 1402,    0, 1397,    0, 1421, 1289,    0, 1058,    0
, 1322,    0, 1251, 1390,    0,    0, 1394, 1394, 1550, 1551
,    0, 1507, 1511, 1323, 1113, 1115, 1116, 1117, 1422)  ;
        --| 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,  480,  481,  482
,  483,  483,  484,  517,  518,  520,  521,  522,  523,  532
,  533,  533,  534,  537,  538,  539,  540,  560,  561,  562
,  563,  567,  568,  569,  570,  570,  571,  573,  574,  600
,  601,  602,  603,  603,  604,  604,  605,  608,  609,  610
,  611,  614,  615,  616,  617,  629,  630,  641,  642,  643
,  644,  652,  653,  660,  661,  674,  675,  688,  689,  704
,  705,  713,  714,  725,  726,  734,  735,  746,  747,  758
,  759,  770,  771,  804,  805,  838,  839,  873,  874,  907
,  908,  942,  943,  943,  944,  973,  974,  975,  976,  976
,  977,  978,  979,  980,  981,  981,  982,  983,  984,  985
,  986,  987,  988,  997,  998, 1005, 1006, 1013, 1014, 1021
, 1022, 1029, 1030, 1037, 1038, 1047, 1048, 1058, 1059, 1083
, 1084, 1112, 1113, 1137, 1138, 1167, 1168, 1196, 1197, 1225
, 1226, 1232, 1233, 1262, 1263, 1292, 1293, 1322, 1323, 1333
, 1334, 1342, 1343, 1351, 1352, 1360, 1361, 1367, 1368, 1404
, 1405, 1432, 1433, 1459, 1460, 1485, 1486, 1490, 1491, 1517
, 1518, 1544, 1545, 1571, 1572, 1591, 1592, 1597, 1598, 1601
, 1602, 1628, 1629, 1629, 1630, 1656, 1657, 1683, 1684, 1710
, 1711, 1737, 1738, 1764, 1765, 1791, 1792, 1818, 1819, 1845
, 1846, 1872, 1873, 1880, 1881, 1907, 1908, 1934, 1935, 1961
, 1962, 1988, 1989, 2015, 2016, 2018, 2019, 2038, 2039, 2041
, 2042, 2044, 2045, 2045, 2046, 2049, 2050, 2051, 2052, 2052
, 2053, 2073, 2074, 2075, 2076, 2096, 2097, 2099, 2100, 2120
, 2121, 2121, 2122, 2122, 2123, 2125, 2126, 2128, 2129, 2149
, 2150, 2151, 2152, 2152, 2153, 2154, 2155, 2166, 2167, 2169
, 2170, 2174, 2175, 2176, 2177, 2178, 2179, 2181, 2182, 2182
, 2183, 2183, 2184, 2195, 2196, 2196, 2197, 2197, 2198, 2210
, 2211, 2212, 2213, 2224, 2225, 2237, 2238, 2238, 2239, 2240
, 2241, 2242, 2243, 2246, 2247, 2247, 2248, 2251, 2252, 2263
, 2264, 2264, 2265, 2268, 2269, 2270, 2271, 2291, 2292, 2302
, 2303, 2303, 2304, 2330, 2331, 2357, 2358, 2384, 2385, 2392
, 2393, 2395, 2396, 2398, 2399, 2401, 2402, 2404, 2405, 2407
, 2408, 2410, 2411, 2413, 2414, 2437, 2438, 2440, 2441, 2464
, 2465, 2468, 2469, 2470, 2471, 2491, 2492, 2496, 2497, 2497
, 2498, 2520, 2521, 2522, 2523, 2530, 2531, 2532, 2533, 2540
, 2541, 2545, 2546, 2553, 2554, 2561, 2562, 2567, 2568, 2569
, 2570, 2571, 2572, 2579, 2580, 2583, 2584, 2585, 2586, 2586
, 2587, 2587, 2588, 2588, 2589, 2609, 2610, 2611, 2612, 2632
, 2633, 2634, 2635, 2637, 2638, 2643, 2644, 2649, 2650, 2655
, 2656, 2656, 2657, 2657, 2658, 2659, 2660, 2661, 2662, 2663
, 2664, 2664, 2665, 2666, 2667, 2667, 2668, 2669, 2670, 2683
, 2684, 2697, 2698, 2711, 2712, 2725, 2726, 2730, 2731, 2731
, 2732, 2736, 2737, 2741, 2742, 2743, 2744, 2745, 2746, 2746
, 2747, 2748, 2749, 2750, 2751, 2751, 2752, 2763, 2764, 2765
, 2766, 2767, 2768, 2788, 2789, 2809, 2810, 2811, 2812, 2813
, 2814, 2814, 2815, 2815, 2816, 2818, 2819, 2820, 2821, 2823
, 2824, 2830, 2831, 2832, 2833, 2836, 2837, 2837, 2838, 2858
, 2859, 2879, 2880, 2882, 2883, 2883, 2884, 2884, 2885, 2885
 ) ;

    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,   72,   75
,   72,   75,   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
,   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,   15,   28,   37,   46,   12,   24,   29
,   53,    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,   10,   14,   25,   33,   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,    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,   71,   80,   88,    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,   33,   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,    3,   35,   36,   37,   65,   66,   67,   68,   71
,   74,   76,   80,    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,   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,  406
,  407,  406,  407,  407,  408,  409,  410,  410,  411,  424
,  425,  426,  427,  427,  428,  428,  429,  439,  440,  439
,  440,  439,  440,  448,  449,  448,  449,  448,  449,  448
,  449,  448,  449,  448,  449,  449,  450,  450,  451,  450
,  451,  453,  454,  454,  455,  455,  456,  457,  458,  458
,  459,  458,  459,  458,  459,  458,  459,  458,  459,  458
,  459,  458,  459,  458,  459,  458,  459,  458,  459,  458
,  459,  458,  459,  458,  459,  458,  459,  458,  459,  458
,  459,  458,  459,  461,  462,  461,  462,  461,  462,  461
,  462,  461,  462,  461,  462,  461,  462,  462,  463,  462
,  463,  462,  463,  462,  463,  462,  463,  462,  463,  463
,  464,  464,  465,  466,  467,  467,  468,  467,  468,  468
,  469,  469,  470,  469,  470,  469,  470,  470,  471,  472
,  473,  472,  473,  473,  474,  473,  474,  473,  474,  475
,  476,  475,  476,  486,  487,  487,  488,  488,  489,  489
,  490,  500,  501,  511,  512,  511,  512,  523,  524,  534
,  535,  534,  535,  536,  537,  536,  537,  548,  549,  548
,  549,  549,  550,  549,  550,  549,  550,  549,  550,  550
,  551,  550,  551,  550,  551,  551,  552,  551,  552,  551
,  552,  551,  552,  551,  552,  551,  552,  551,  552,  551
,  552,  552,  553,  552,  553,  552,  553,  552,  553,  552
,  553,  552,  553,  552,  553,  552,  553,  553,  554,  564
,  565,  572,  573,  572,  573,  583,  584,  583,  584,  583
,  584,  583,  584,  583,  584,  583,  584,  594,  595,  605
,  606,  605,  606,  605,  606,  605,  606,  606,  607,  607
,  608,  607,  608,  618,  619,  618,  619,  618,  619,  629
,  630,  629,  630,  629,  630,  630,  631,  655,  656,  680
,  681,  680,  681,  680,  681,  680,  681,  681,  682,  681
,  682,  682,  683,  684,  685,  687,  688,  687,  688,  687
,  688,  687,  688,  690,  691,  711,  712,  711,  712,  712
,  713,  712,  713,  714,  715,  715,  716,  718,  719,  719
,  720,  721,  722,  722,  723,  723,  724,  725,  726,  725
,  726,  728,  729,  729,  730,  729,  730,  743,  744,  746
,  747,  747,  748,  748,  749,  749,  750,  750,  751,  750
,  751,  751,  752,  752,  753,  752,  753,  753,  754,  754
,  755,  755,  756,  755,  756,  757,  758,  758,  759,  759
,  760,  760,  761,  761,  762,  762,  763,  762,  763,  763
,  764,  764,  765,  764,  765,  764,  765,  764,  765,  764
,  765,  764,  765,  764,  765,  764,  765,  764,  765,  764
,  765,  764,  765,  775,  776,  786,  787,  786,  787,  786
,  787,  786,  787,  798,  799,  798,  799,  809,  810,  820
,  821,  820,  821,  821,  822,  821,  822,  821,  822,  821
,  822,  821,  822,  821,  822,  821,  822,  821,  822,  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,  867,  868,  887,  888,  893,  894,  897,  898,  898
,  899,  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, 1035
, 1036, 1038, 1039, 1039, 1040, 1039, 1040, 1040, 1041, 1041
, 1042, 1043, 1044, 1043, 1044, 1043, 1044, 1043, 1044, 1043
, 1044, 1043, 1044, 1043, 1044, 1043, 1044, 1054, 1055, 1065
, 1066, 1068, 1069, 1079, 1080, 1079, 1080, 1079, 1080, 1079
, 1080, 1079, 1080, 1079, 1080, 1079, 1080, 1079, 1080, 1079
, 1080, 1079, 1080, 1079, 1080, 1091, 1092, 1091, 1092, 1092
, 1093, 1095, 1096, 1095, 1096, 1095, 1096, 1095, 1096, 1095
, 1096, 1095, 1096, 1098, 1099, 1100, 1101, 1100, 1101, 1102
, 1103, 1102, 1103, 1103, 1104, 1114, 1115, 1126, 1127, 1127
, 1128, 1128, 1129, 1129, 1130, 1131, 1132, 1132, 1133, 1136
, 1137, 1136, 1137, 1136, 1137, 1137, 1138, 1138, 1139, 1149
, 1150, 1160, 1161, 1161, 1162, 1161, 1162, 1162, 1163, 1164
, 1165, 1164, 1165, 1164, 1165, 1165, 1166, 1166, 1167, 1167
, 1168, 1168, 1169, 1169, 1170, 1170, 1171, 1171, 1172, 1171
, 1172, 1171, 1172, 1171, 1172, 1172, 1173, 1173, 1174, 1173
, 1174, 1174, 1175, 1175, 1176, 1175, 1176, 1175, 1176, 1175
, 1176, 1175, 1176, 1176, 1177, 1177, 1178, 1178, 1179, 1178
, 1179, 1179, 1180, 1179, 1180, 1193, 1194, 1196, 1197, 1197
, 1198, 1198, 1199, 1199, 1200, 1199, 1200, 1200, 1201, 1201
, 1202, 1201, 1202, 1201, 1202, 1202, 1203, 1202, 1203, 1202
, 1203, 1205, 1206, 1205, 1206, 1205, 1206, 1216, 1217, 1217
, 1218, 1217, 1218, 1217, 1218, 1217, 1218, 1217, 1218, 1217
, 1218, 1217, 1218, 1218, 1219, 1219, 1220, 1219, 1220, 1219
, 1220, 1220, 1221, 1221, 1222, 1222, 1223, 1222, 1223, 1222
, 1223, 1222, 1223, 1225, 1226, 1226, 1227, 1228, 1229, 1228
, 1229, 1228, 1229, 1230, 1231, 1231, 1232, 1231, 1232, 1232
, 1233, 1233, 1234, 1244, 1245, 1244, 1245, 1247, 1248, 1247
, 1248, 1247, 1248, 1248, 1249, 1248, 1249, 1249, 1250, 1251
, 1252, 1259, 1260, 1259, 1260, 1259, 1260, 1260, 1261, 1265
, 1266, 1269, 1270, 1271, 1272, 1272, 1273, 1272, 1273, 1283
, 1284, 1283, 1284, 1284, 1285, 1284, 1285, 1285, 1286, 1285
, 1286, 1287, 1288, 1287, 1288, 1288, 1289, 1288, 1289, 1288
, 1289, 1288, 1289, 1288, 1289, 1288, 1289, 1289, 1290, 1290
, 1291, 1291, 1292, 1292, 1293, 1292, 1293, 1292, 1293, 1292
, 1293, 1292, 1293, 1292, 1293, 1303, 1304, 1303, 1304, 1303
, 1304, 1303, 1304, 1303, 1304, 1303, 1304, 1314, 1315, 1315
, 1316, 1315, 1316, 1315, 1316, 1316, 1317, 1317, 1318, 1317
, 1318, 1317, 1318, 1317, 1318, 1317, 1318, 1317, 1318, 1317
, 1318, 1317, 1318, 1317, 1318, 1317, 1318, 1317, 1318, 1317
, 1318, 1317, 1318, 1317, 1318, 1317, 1318, 1317, 1318, 1317
, 1318, 1318, 1319, 1318, 1319, 1320, 1321, 1320, 1321, 1320
, 1321, 1331, 1332, 1332, 1333, 1333, 1334, 1333, 1334, 1335
, 1336, 1337, 1338, 1338, 1339, 1339, 1340, 1344, 1345, 1344
, 1345, 1344, 1345, 1344, 1345, 1344, 1345, 1345, 1346, 1345
, 1346, 1347, 1348, 1347, 1348, 1347, 1348, 1348, 1349, 1348
, 1349, 1348, 1349, 1349, 1350, 1350, 1351, 1351, 1352, 1353
, 1354, 1364, 1365, 1366, 1367, 1366, 1367, 1366, 1367, 1367
, 1368, 1367, 1368, 1367, 1368, 1368, 1369, 1379, 1380, 1379
, 1380, 1381, 1382, 1381, 1382, 1381, 1382, 1382, 1383, 1394
, 1395, 1394, 1395, 1394, 1395, 1394, 1395, 1394, 1395, 1394
, 1395, 1395, 1396, 1406, 1407, 1409, 1410, 1409, 1410, 1409
, 1410, 1409, 1410, 1409, 1410, 1409, 1410, 1409, 1410, 1409
, 1410, 1409, 1410, 1409, 1410, 1409, 1410, 1409, 1410, 1411
, 1412, 1411, 1412, 1414, 1415, 1416, 1417, 1416, 1417, 1417
, 1418, 1417, 1418, 1428, 1429, 1429, 1430, 1429, 1430, 1430
, 1431, 1430, 1431, 1431, 1432, 1432, 1433, 1433, 1434, 1434
, 1435, 1434, 1435, 1434, 1435, 1434, 1435, 1434, 1435, 1434
, 1435, 1434, 1435, 1434, 1435, 1434, 1435, 1435, 1436, 1435
, 1436, 1436, 1437, 1437, 1438, 1440, 1441, 1441, 1442, 1441
, 1442, 1445, 1446, 1445, 1446, 1445, 1446, 1446, 1447, 1446
, 1447, 1446, 1447, 1448, 1449, 1449, 1450, 1450, 1451, 1450
, 1451, 1451, 1452, 1451, 1452, 1453, 1454, 1454, 1455, 1481
, 1482, 1485, 1486, 1486, 1487, 1486, 1487, 1486, 1487, 1497
, 1498, 1498, 1499, 1499, 1500, 1500, 1501, 1500, 1501, 1501
, 1502, 1502, 1503, 1502, 1503, 1505, 1506, 1505, 1506, 1506
, 1507, 1506, 1507, 1506, 1507, 1506, 1507, 1509, 1510, 1509
, 1510, 1510, 1511, 1510, 1511, 1510, 1511, 1510, 1511, 1511
, 1512, 1511, 1512, 1512, 1513, 1512, 1513, 1523, 1524, 1524
, 1525, 1524, 1525, 1524, 1525, 1525, 1526, 1526, 1527, 1526
, 1527, 1526, 1527, 1527, 1528, 1527, 1528, 1527, 1528, 1528
, 1529, 1529, 1530, 1553, 1554, 1553, 1554, 1553, 1554, 1553
, 1554, 1554, 1555, 1554, 1555, 1554, 1555, 1554, 1555, 1554
, 1555, 1554, 1555, 1555, 1556, 1555, 1556, 1556, 1557, 1557
, 1558, 1569, 1570, 1570, 1571, 1571, 1572, 1571, 1572, 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, 1614
, 1615, 1623, 1624, 1623, 1624, 1623, 1624, 1624, 1625, 1626
, 1627, 1627, 1628, 1628, 1629, 1628, 1629, 1630, 1631, 1630
, 1631, 1641, 1642, 1642, 1643, 1646, 1647, 1654, 1655, 1657
, 1658, 1658, 1659, 1660, 1661, 1660, 1661, 1660, 1661, 1661
, 1662, 1662, 1663, 1662, 1663, 1662, 1663, 1662, 1663, 1662
, 1663, 1664, 1665, 1664, 1665, 1664, 1665, 1664, 1665, 1665
, 1666, 1667, 1668, 1668, 1669, 1673, 1674, 1673, 1674, 1673
, 1674, 1673, 1674, 1684, 1685, 1684, 1685, 1685, 1686, 1686
, 1687, 1686, 1687, 1687, 1688, 1687, 1688, 1688, 1689, 1689
, 1690, 1690, 1691, 1701, 1702, 1702, 1703, 1703, 1704, 1706
, 1707, 1706, 1707, 1706, 1707, 1717, 1718, 1717, 1718, 1717
, 1718, 1718, 1719, 1718, 1719, 1719, 1720, 1719, 1720, 1719
, 1720, 1720, 1721, 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, 1751
, 1752, 1752, 1753, 1752, 1753, 1753, 1754, 1754, 1755, 1754
, 1755, 1755, 1756, 1756, 1757, 1756, 1757, 1756, 1757, 1757
, 1758, 1757, 1758, 1758, 1759, 1759, 1760, 1759, 1760, 1763
, 1764, 1763, 1764, 1764, 1765, 1769, 1770, 1769, 1770, 1769
, 1770, 1770, 1771, 1771, 1772, 1772, 1773, 1772, 1773, 1773
, 1774, 1773, 1774, 1773, 1774, 1774, 1775, 1774, 1775, 1774
, 1775, 1774, 1775, 1774, 1775, 1775, 1776, 1776, 1777, 1776
, 1777, 1776, 1777, 1777, 1778, 1777, 1778, 1778, 1779, 1778
, 1779, 1779, 1780, 1780, 1781, 1781, 1782, 1781, 1782, 1782
, 1783, 1782, 1783, 1782, 1783, 1784, 1785, 1784, 1785, 1786
, 1787, 1786, 1787, 1787, 1788, 1787, 1788, 1787, 1788, 1788
, 1789, 1789, 1790, 1790, 1791, 1791, 1792, 1791, 1792, 1791
, 1792, 1793, 1794, 1793, 1794, 1793, 1794, 1793, 1794, 1793
, 1794, 1793, 1794, 1793, 1794, 1793, 1794, 1793)  ;

    Action_Token_Map : constant Action_Token_Array :=
         (   43,   65,   27,   42,   43,   45,   54,   26,   63,   71
,   80,   27,   54,   26,   42,   45,   63,   37,   66,   76
,    3,   35,   36,   65,   67,   68,   71,   74,   65,   67
,   11,   65,   65,   71,   31,   80,   80,   56,   26,   42
,   45,   26,   42,   45,   72,   65,   65,    7,   30,   34
,   36,   39,   49,   73,   87,   91,   47,   64,   69,   70
,   71,   72,   74,   75,   76,   77,   78,   81,   82,   83
,   84,   85,   86,   89,   90,   36,   65,   68,    3,   35
,   37,   40,   66,   67,   71,   74,   76,   72,   81,   82
,   83,   91,   30,   36,   86,   89,   90,   47,   71,   70
,   77,   75,    7,   39,   64,    7,   39,   64,    7,   39
,   69,   74,   76,   34,   49,   78,   73,   87,   68,   71
,   35,   37,   65,   66,   67,    3,   35,   37,   68,   36
,   65,   66,   67,   71,   51,   71,   31,   65,   31,   71
,   10,   25,   26,   42,   43,   45,   55,   56,   65,   27
,   35,   59,   60,   80,   71,   35,   10,   67,   65,   10
,   21,   25,   26,   27,   42,   43,   44,   45,   56,   65
,   55,   59,   60,   25,   26,   27,   42,   45,   55,   56
,   59,   60,   21,   44,   10,   65,   21,   67,   65,   11
,   11,   31,   65,   80,   80,   59,   63,   65,   43,   60
,   71,   70,   77,   85,   84,   85,   72,   75,   86,    7
,   30,   36,   39,   64,   72,   75,   81,   82,   83,   84
,   85,   89,   90,   91,   47,   70,   71,   77,   72,   75
,   80,   30,   66,   67,   71,   74,   76,    3,   35,   36
,   37,   65,   68,    3,   35,   65,   66,   67,   68,   71
,   76,   36,   37,   74,    3,   35,   36,   65,   71,   74
,   37,   66,   67,   68,   76,   35,   36,   37,   65,   66
,   67,   68,   71,   74,   76,    3,   16,   17,   47,   65
,   71,   35,   36,   66,   67,   71,   74,   76,    3,   37
,   65,   68,   67,   68,    6,   65,   35,   36,   37,   65
,   67,   68,   71,   74,   76,    3,   66,   75,   35,   36
,    3,   37,   58,   65,   66,   67,   68,   71,   74,   76
,   35,   37,   65,   67,   68,   71,   74,   76,    3,   19
,   36,   66,   37,   65,   67,   68,   71,   74,   76,    3
,   35,   36,   66,   35,   36,   65,   67,   68,   71,   74
,    3,   37,   66,   76,    3,   35,   36,   37,   65,   67
,   68,   71,   66,   74,   76,    3,   35,   36,   37,   65
,   71,   66,   67,   68,   74,   76,   58,   19,    3,   35
,   36,   37,   66,   67,   71,   65,   68,   35,   36,   37
,   65,   66,   67,   68,   71,    3,   65,   66,   67,   68
,   35,   37,   71,   70,   71,   77,   65,   71,   80,   31
,   21,   44,   45,   56,   65,   25,   26,   27,   35,   42
,   43,   55,   59,   60,   71,   80,   65,   65,   36,   65
,   66,   67,   71,    3,   35,   37,   68,   74,   76,   26
,   27,   45,   55,   56,   59,   60,   25,   42,   80,   65
,   65,   67,   68,   65,   65,   59,   65,   65,   31,   50
,   80,   65,   80,   65,   71,   51,   65,   65,   31,   65
,   26,   45,   79,   75,   80,    3,   36,   37,   66,   67
,   68,   74,   76,   35,   65,   71,   71,   65,   65,    3
,   35,   37,   65,   66,   71,   74,   36,   67,   68,   76
,    3,   35,   36,   37,   65,   66,   67,   68,   71,   74
,   76,   40,   66,   71,   74,    3,   35,   36,   37,   65
,   67,   68,   76,   35,   36,   68,   71,    3,   37,   65
,   66,   67,   74,   76,   84,   85,    3,   35,   36,   37
,   40,   65,   66,   67,   68,   71,   74,   76,   75,   86
,   86,   72,   65,   35,   36,   37,   66,   67,   68,   71
,   76,    3,   65,   74,   81,   82,   83,   30,   36,   89
,   90,   91,    3,   36,   65,   66,   68,   71,   74,   76
,   35,   37,   67,    3,   36,   37,   74,   35,   65,   66
,   67,   68,   71,   76,   35,   37,   65,   68,   71,   74
,    3,   36,   66,   67,   76,   65,   79,    3,   36,   37
,   65,   66,   67,   68,   71,   76,   35,   74,   36,   37
,   65,   66,   67,   68,   74,    3,   35,   71,   76,   77
,   36,   39,   49,   70,   71,   72,   75,   78,   82,   83
,   85,   87,   89,    7,   30,   34,   64,   69,   73,   74
,   76,   77,   81,   90,   91,   30,   34,   36,   71,   72
,   73,   74,   75,   77,   85,   87,   89,   90,   91,    7
,   39,   49,   64,   69,   70,   76,   78,   81,   82,   83
,   85,   65,   11,   65,   59,   11,   65,   50,   31,   80
,    2,    4,   10,   12,   14,   15,   33,   43,   46,   65
,   67,   68,   24,   25,   28,   29,   37,   51,   53,   62
,   92,   23,   71,   80,   60,   71,   70,   77,   60,   31
,   50,   31,   65,   31,   80,   31,   71,   80,   65,   45
,   59,   60,   65,   10,   21,   25,   26,   27,   42,   43
,   44,   55,   56,   67,   68,   65,   43,   21,   22,   21
,   21,   65,   80,   31,   80,   31,   71,   31,   30,   65
,   75,   65,   43,   72,    3,   35,   36,   37,   65,   68
,   71,   74,   66,   67,   76,   35,   37,   65,   66,   67
,   68,   71,   74,   76,    3,   36,    3,   35,   36,   37
,   65,   66,   67,   71,   74,   40,   68,   76,    3,   35
,   36,   37,   66,   67,   68,   71,   74,   76,   65,    3
,   36,   71,   74,   76,   35,   37,   65,   66,   67,   68
,   75,   77,   30,   41,   65,   80,   72,   72,   80,   72
,   75,   36,   37,    3,   35,   65,   66,   67,   68,   71
,   74,   76,   77,   65,   65,   43,   45,   56,   26,   27
,   42,   60,   10,   26,   42,   43,   45,   54,   55,   56
,   59,   60,   65,   25,   27,   35,   65,   12,   24,   25
,   28,   29,   33,   37,   62,   67,   68,   92,    2,    4
,   10,   14,   15,   46,   51,   53,   65,    2,   15,    4
,   28,   37,   46,   24,   29,   12,   53,   51,   10,   65
,   14,   25,   33,   62,   67,   68,   21,    3,   71,   76
,   35,   36,   37,   65,   66,   67,   68,   74,    9,   71
,   16,   17,   65,   47,   35,   36,   37,   65,   67,   68
,   71,    3,   66,   74,   76,   65,   65,   31,   80,    5
,    8,   16,   17,   32,   35,   44,   47,   71,   65,   77
,   75,   80,   80,   70,   71,   77,   65,   65,   25,   65
,   65,   79,    5,    8,   44,   47,   16,   17,   32,   71
,   65,   94,   65,   67,   68,   80,   41,   88,   65,   75
,   86,   75,   88,   51,   65,   72,   75,   72,   75,   80
,   65,   66,   67,   68,   71,    3,   35,   36,   37,   74
,   76,   31,   31,   11,   65,   80,   31,   80,   93,   43
,    4,   10,   12,   14,   15,   19,   20,   21,   23,   24
,   25,   28,   29,   33,   46,   51,   53,   92,    2,   37
,   61,   62,   65,   67,   68,   65,   67,   68,   65,   65
,   80,   80,   65,   65,   68,   71,    3,   35,   36,   37
,   66,   67,   74,   76,    3,   35,   71,   36,   37,   65
,   66,   67,   68,   74,   76,   61,   65,   80,   35,   36
,   37,   66,   67,   68,    3,   65,   71,   74,   76,    3
,   35,   36,   65,   66,   67,   68,   71,   76,   37,   74
,   80,   79,   70,   71,   77,   25,   33,   62,   10,   14
,   43,   61,   72,   36,   65,   67,   68,    3,   35,   37
,   66,   71,   74,   76,    3,   36,   40,   65,   66,   67
,   68,   71,   35,   37,   74,   76,   48,   80,   80,   77
,   80,   80,   16,   47,   17,   71,   65,   71,   65,   74
,   76,    3,   35,   36,   37,   66,   67,   68,   71,   35
,   36,   37,    3,   65,   66,   67,   68,   71,   74,   76
,   44,   80,   65,   68,   80,   80,   80,   80,   80,   80
,   80,   47,   47,   48,   79,   80,   71,   43,   80,   10
,   21,   25,   26,   27,   42,   43,   44,   45,   55,   56
,   60,   65,   59,   23,   13,   65,   94,   94,   44,   94
,   94,   80,   70,   71,   77,    3,   66,   71,   74,   35
,   36,   37,   65,   67,   68,   76,   80,   80,   80,   54
,   54,   43,   70,   77,   71,   71,   80,   77,   80,   77
,   21,   80,   31,   37,   71,    3,   35,   36,   65,   66
,   67,   68,   74,   76,   61,   77,   80,   58,   21,   43
,   61,    4,   57,   61,   15,   43,   65,   67,   68,   80
,   10,   14,   25,   33,   62,   16,   17,   47,   65,   80
,   88,   65,   35,   37,   65,   66,   68,    3,   36,   67
,   71,   74,   76,   33,   65,   40,   65,   61,   80,   80
,   75,    9,    3,   35,   36,   37,   68,   76,   65,   66
,   67,   71,   74,    3,   36,   65,   66,   71,   76,   35
,   37,   67,   68,   74,   38,   80,   65,   37,   80,   72
,    3,   35,   36,   37,   65,   66,   68,   74,   76,   67
,   71,   80,   43,   65,   88,   50,   80,   88,    8,   16
,   17,   71,   47,   50,   72,   72,   80,   65,   80,   80
,   43,   75,   80,    3,   35,   36,   71,   74,   76,   37
,   65,   66,   67,   68,   18,   80,   65,   80,   65,    3
,   35,   36,   37,   66,   67,   68,   71,   74,   76,   19
,   20,   12,   35,   36,   37,   40,   65,   66,   67,   68
,   71,   74,   76,    3,   80,    3,   35,   36,   37,   65
,   66,   67,   68,   74,   76,   71,   70,   71,   77,   19
,   39,   15,    4,   57,   39,   19,   71,   37,   74,    3
,   35,   36,   65,   66,   67,   68,   71,   76,   30,   21
,   80,   65,   85,   77,   34,   43,   21,   65,   68,   67
,   72,   47,   70,   71,   77,   65,   72,   75,   21,   43
,   65,   31,   80,   65,    7,   30,   36,   39,   47,   49
,   70,   72,   73,   77,   78,   79,   81,   82,   83,   86
,   87,   89,   90,   91,   34,   64,   69,   71,   74,   75
,   76,   70,   77,   47,   71,   72,   35,   36,   37,   65
,   67,   68,   74,   76,    3,   66,   71,   88,    8,   65
,   80,   71,   65,   67,   68,   31,   65,   67,   68,   72
,   80,   80,   65,   66,   67,   68,   71,   74,    3,   35
,   36,   37,   76,   21,   80,   85,   61,   85,   80,   10
,   65,   67,   68,   92,    2,    4,   12,   14,   15,   19
,   21,   24,   25,   28,   29,   33,   37,   39,   43,   46
,   51,   53,   62,   43,   21,   80,   80,   65,   66,   67
,   68,   71,   76,    3,   35,   36,   37,   52,   74,   33
,   21,   80,   84,   85,   37,   66,   68,   71,   74,   76
,    3,   35,   36,   65,   67,   21,   48,    9,   70,   77
,   71,   75,   72,    3,   36,   37,   67,   68,   71,   94
,   35,   65,   66,   74,   76,   72,   75,   65,   68,   48
,   65,   12,   43,   88,    8,   32,   44,   47,   71,    5
,   16,   17,   35,   71,   72,   80,   80,   80,   77,   80
,   35,   36,   37,   68,   71,   74,    3,   65,   66,   67
,   76,   88,   70,   77,   80,   71,   16,   44,   47,   71
,    5,    8,   17,   32,   70,   77,   71,   71,   80,   72
,   58,   29,   85,   84,   21,   15,   43,   53,    4,   57
,   61,   15,   43,   35,   36,   37,   68,   74,   76,    3
,   65,   66,   67,   71,   65,   33,   65,   80,   48,   80
,    3,   37,   74,   76,   35,   36,   65,   66,   67,   68
,   71,   43,   38,   67,   68,   65,   35,   36,   37,   65
,   66,   67,   68,   71,    3,   74,   76,   79,   65,   31
,   44,   80,   65,   88,   80,   80,   65,   80,    4,   51
,   53,   62,   65,   67,   68,    2,   10,   12,   14,   15
,   19,   21,   24,   25,   28,   29,   33,   37,   39,   46
,   92,   53,   21,   80,   80,   65,   80,   47,   65,   70
,   47,   71,   77,   65,   12,   21,   43,   61,   65,   43
,   21,   43,   80,   80,   80,   53,   80,   80,   94,   88
,   12,   61,   72,   80,   72,   80,   80,   80,   80,   37
,   37,   21,   61)  ;
        --| 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,   55,   56,   56,   57,   58,   59,   59,   60,   61
,   62,   63,   64,   64,   65,   65,   66,   67,   68,   71
,   72,   91,   92,   94,   95,   97,   98,   99,  100,  102
,  103,  104,  105,  106,  107,  108,  109,  112,  113,  115
,  116,  117,  118,  123,  124,  125,  126,  132,  133,  133
,  134,  134,  135,  139,  140,  144,  145,  145,  146,  149
,  150,  152,  153,  153,  154,  157,  158,  161,  162,  162
,  163,  165,  166,  166,  167,  170,  171,  173,  174,  176
,  177,  181,  182,  182,  183,  184,  185,  186,  187,  215
,  216,  216,  217,  221,  222,  224,  225,  225,  226,  229
,  230,  245,  246,  261,  262,  262,  263,  264,  265,  277
,  278,  279,  280,  281,  282,  282,  283,  288,  289,  382
,  383,  383,  384,  384,  385,  385,  386,  388,  389,  397
,  398,  401,  402,  402,  403,  405,  406,  406,  407,  407
,  408,  408,  409,  409,  410,  410,  411,  416,  417,  416
,  417,  416,  417,  416,  417,  417,  418,  422,  423,  426
,  427,  427,  428,  428,  429,  429,  430,  432,  433,  435
,  436,  437,  438,  440,  441,  443,  444,  444,  445,  445
,  446,  446,  447,  447,  448,  448,  449,  449,  450,  454
,  455,  462,  463,  470,  471,  472,  473,  475,  476,  477
,  478,  493,  494,  495,  496,  496,  497,  497,  498,  498
,  499,  499,  500,  500,  501,  502,  503,  510,  511,  513
,  514,  515,  516,  525,  526,  526,  527,  527,  528,  528
,  529,  530,  531,  531,  532,  533,  534,  534,  535,  542
,  543,  543,  544,  544,  545,  551,  552,  553,  554,  555
,  556,  562,  563,  580,  581,  582,  583,  583,  584,  584
,  585,  585,  586,  587,  588,  588,  589,  589,  590,  591
,  592,  592,  593,  593,  594,  608,  609,  613,  614,  614
,  615,  616,  617,  618,  619,  619,  620,  622,  623,  638
,  639,  639,  640,  640,  641,  641,  642,  642,  643,  643
,  644,  645,  646,  646,  647,  647,  648,  648,  649,  649
,  650,  651,  652,  652,  653,  655,  656,  656,  657,  658
,  659,  660,  661,  662,  663,  663,  664,  664,  665,  666
,  667,  669,  670,  670,  671,  672,  673,  673,  674,  675
,  676,  677,  678,  678,  679,  679,  680,  680,  681,  682
,  683,  683,  684,  684,  685,  685,  686,  690,  691,  691
,  692,  695,  696,  699,  700,  702,  703,  705,  706,  706
,  707,  709,  710,  711,  712,  722,  723,  723,  724,  724
,  725,  725,  726,  726,  727,  727,  728,  728,  729,  729
,  730,  730,  731,  731,  732,  734,  735,  737,  738,  738
,  739,  740,  741,  741,  742,  744,  745,  745,  746,  746
,  747,  747,  748,  748,  749,  749,  750,  750,  751,  751
,  752,  762,  763,  770,  771,  773,  774,  775,  776,  787
,  788,  789,  790,  791,  792,  793,  794,  794,  795,  795
,  796,  796,  797,  797,  798,  798,  799,  799,  800,  800
,  801,  802,  803,  803,  804,  804,  805,  805,  806,  806
,  807,  808,  809,  809,  810,  810,  811,  811,  812,  813
,  814,  814,  815,  815,  816,  816,  817,  819,  820,  821
,  822,  822,  823,  823,  824,  825,  826,  831,  832,  832
,  833,  833,  834,  834,  835,  836,  837,  837,  838,  838
,  839,  840,  841,  852,  853,  853,  854,  855,  856,  859
,  860,  860,  861,  861,  862,  862,  863,  863,  864,  864
,  865,  871,  872,  882,  883,  889,  890,  895,  896,  897
,  898,  898,  899,  900,  901,  901,  902,  902,  903,  904
,  905,  905,  906,  907,  908,  908,  909,  909,  910,  910
,  911,  912,  913,  913,  914,  914,  915,  916,  917,  917
,  918,  918,  919,  919,  920,  920,  921,  921,  922,  922
,  923,  923,  924,  924,  925,  925,  926,  926,  927,  927
,  928,  928,  929,  930,  931,  931,  932,  932,  933,  934
,  935,  935,  936,  937,  938,  938,  939,  939,  940,  942
,  943,  943,  944,  944,  945,  945,  946,  947,  948,  949
,  950,  950,  951,  951,  952,  952,  953,  953,  954,  954
,  955,  956,  957,  957,  958,  958,  959,  959,  960,  960
,  961,  961,  962,  962,  963,  963,  964,  964,  965,  965
,  966,  966,  967,  967,  968,  969,  970,  970,  971,  972
,  973,  973,  974,  975,  976,  976,  977,  977,  978,  978
,  979,  979,  980,  981,  982,  982,  983,  985,  986,  989
,  990,  992,  993,  993,  994,  994,  995,  995,  996,  997
,  998,  998,  999,  999, 1000, 1000, 1001, 1001, 1002, 1002
, 1003, 1004, 1005, 1005, 1006, 1006, 1007, 1007, 1008, 1009
, 1010, 1010, 1011, 1011, 1012, 1013, 1014, 1014, 1015, 1015
, 1016, 1017, 1018, 1018, 1019, 1019, 1020, 1020, 1021, 1021
, 1022, 1022, 1023, 1023, 1024, 1024, 1025, 1025, 1026, 1026
, 1027, 1027, 1028, 1028, 1029, 1029, 1030, 1030, 1031, 1031
, 1032, 1033, 1034, 1035, 1036, 1036, 1037, 1037, 1038, 1038
, 1039, 1039)  ;

    Shift_State_Map : constant Shift_State_Array :=
         (    1,  501,   37,  502,  553,  277,  151,  154,  157,  554
,  821,  543,  789,  937,  188,   78,  233,  401,  402,  515
,  843,  948, 1026,  710,  653,  503,  269,  555,  590,  270
,  556,  591,  833,  288,  295,  838,  839,  224,  231,  437
,  441,  442,  539,  735,  744,  867,  875,  886,  911,  922
,  930,  935,  971, 1004, 1013,  438,  418,  711,  516,  196
,  648,   13,   98,   14,  504,  517,  968,  132,  263,  456
,  866,   83,  174,  180,  234,  304,  352,  405,  427,  429
,  431,  450,  452,  454,  551,  616,  617,  737,  891,  904
,  994,  557,  592,  953,  649,  929,  977,  163,  873,   38
,  186,  558,   39,  133,   40,  505,  799,  983,  152,  155
,  158,  857,  121,  779,  844,  469,  603,   15,   99,  107
,  197,  317,  483,    2,  194,  225,  559,  593,  683,  717
,  954,  995,   16,  506,  144,  271,  594,  880, 1011,  667
,  700,  936,  945,  980,  164,  340,  426,  818,  823,  175
,  528,  610,  927,  518,  974, 1003, 1022,   17,  493,  727
,  728,  198,  100,  199,  318,  751,  285,  294,  742,  967
,  200,  239,  333,  201,  423,  425,  632,  656,  739,  745
,  752,  650,   35,  240,  153,  156,    9,   41,   75,   79
,  112,  116,  122,  191,  229,  241,  272,  278,  309,  327
,  328,  332,  335,  353,  364,  365,  383,  459,  494,  530
,  583,  686,  773,  810,  990,   42,   43,   76,  192,  279
,  310,   44,  280,  687,  159,  145,  248,  424,  646,   11
,   45,   82,  146,  176,  184,  247,  302,  305,  421,  544
,  560,  595,  673,  679,  901,  111,  131,  253,  258,  381
,  460,  471,  478,  612,  613,  664,  824,  878,  884,  939
,  942,  165,   46,  160,  149,  254,  259,  284,  358,  377
,  458,  479,  579,  829,  885,  940,  943,   47,  161,  147
,  249,  166,  355,  391,  589,  645,  702,  987,   12,   84
,   90,  185,  237,  238,  262,  303,  306,  326,  348,  359
,  422,  430,  432,  449,  451,  472,  552,  580,  581,  602
,  614,  619,  625,  626,  633,  643,  669,  670,  671,  672
,  685,  690,  691,  692,  693,  694,  695,  696,  705,  709
,  720,  723,  725,  726,  733,  734,  736,  740,  769,  771
,  787,  788,  800,  807,  814,  819,  827,  828,  830,  834
,  836,  849,  869,  892,  900,  908,  909,  914,  925,  926
,  931,  958,  959,  961,  963,  979,  981,  996,  999, 1000
, 1002, 1005, 1006, 1008, 1017, 1019, 1021, 1023, 1024, 1034
, 1035, 1036,  134,  135,  136,  250,  372,  932,  251,  252
,  373,  399,  871,  915,  918,  933,  969,  137,  255,  379
,  380,  168,  604,  772,  815,  138,  139,  140,  406,  620
,  600,  715,  716,  718,  719,  941,    3,   48,  276,  361
,  542,  794,  195,  407,  657, 1014,  202,  203,  204,   18
,  205,  484,   19,  206,  485,  207,  486,   20,  208,  487
,   21,  209,  488,  210,  443,  444,  445,  446,  447,  242
,  300,  448,  577,  946,  549,  678,  712,  801,  816,  883
, 1010, 1012,  605,  609,  820,  897,  952,  962,  998, 1025
,  713,  817,  561,  822,  898,  902,  960,   49,  123,  311
,  366,  367,  368,  374,  464,  631,  635,  644,  666,  722
,  831,  865,  896,  243,  606,  357,  211,  212,  213,  336
,  562,  955,  177,  182,  433,  453,  706,  731,  956,  965
,  578,  599,  893,  703,  721,  473,  477,  808,  825,  894
,  906,  957,  966, 1032, 1033,  563,  564,  565,  566,  596
,  567,  568,  597,  569,  117,  389,  457,  470,  550,  714
,  826,  890,  674,  118,  148,  256,  570,  675,  697,  881
, 1009,  571,  676,  572,  677,  183,  299,  316,  337,  684
,  724,  806,   50,  124,  264,  265,  267,  268,  286,  371
,  462,  467,  468,  547,  629,  665,  681,  682,  934,  982
,  688,  944,  802,  689,  573,  698,  699,  574,  575,  795
,  984,  879,  680,   51,  125,  171,  329,  436,  531,  601
,  622,  753,  796,  811,  876,  903,  905,  985,  797,  812
,  928,  975,  986,  882,  266,  798,  545,  576,  701,  803
, 1037, 1038,   91,  114,  339,  341,  360,  403,  584,  588
,  618,  708,  791,  804,  889,  938,  988,  991,  887,  947
,  989,  888,  949,  507,  805,  950,  992, 1015, 1027, 1016
, 1039, 1028,  126,  463,  845,   87,   92,  187,   88,   95
,  319,  489,  404,  214,  215,  585,  216,  246,  490,  491
,  101,  320,  321,   22,  102,   23,  103,  104,   52,   53
,   54,  330,  281,  273,  127,   55,  274,  362,  546,  864
,  128,  260,  378,  607,  608,  129,  369,  375,  466,  261
,  461,  465,  130,  370,  376,   56,   57,  282,  384,  150
,  382,   58,  287,  289,  290,  291,  292,  293,  385,  386
,  387,  388,   59,   60,   61,   62,   63,  141,  142,   64
,   65,   66,  173,  296,   67,  172,  298,  169,   68,  297
,   69,   70,  275,  363,   71,   72,  143,  162,   73,  167
,  170,  119,  308,  390,  400,  434,  548,  624,  627,  634
,  780,  899,  323,  495,  641,  729,  852,  856,  921,  923
,  408,  621,  919,  496,  970,  324,  628,  743,  775,  785
,  786,  846,  848,  868,  912,  913,  920,  409,  497,  410
,  498,  411,  499,  412,  413,  414,  519,  415,  529,  508
,  509,  754,  510,  511,  520,  521,  512,  755,  522,  416
,  532,  533,  756,  534,  535,  536,  647,  770,  851,  417
,  500,  636,  741,  840,  862,  637,  738,  774,  837,  850
,  910,  523,  639,  746,  747,  917,  748,  537,  651,  776
,  230,  345,  349,  351,  582,  586,  587,  777,  835,  870
,  976, 1007,  652,  189,  654,   89,   96,  235,  778,  190
,  325,  419,  538,  655,   24,  105,  108,  217,  322,  354
,  492,   80,   81,  179,  236,  331,  334,  350,  428,  481
,  482,  623,  301,  307,  611,  813,  832,  997, 1001,  394
,  397,  895,  907, 1018, 1020,   77,  232,  392,  356,  393
,   25,  193,   26,  109,   27,   93,  346,  226,   28,   97
,  338,  704,  435,  218,  342,  344,  219,  106,  707,  439
,  732,  513,  514,  630,  524,  525,  526,  527,  642,  924
,  768,  757,  758,  861,  759,  760,  972,  761,  762,  853
,  855,  860,  763,  764,  765,  841,  858,  859,  863,  973
,  766,  730,    4,    5,    6,   10,    7,   29,   30,    8
,  113,  245,   36,   31,  658,  782,  659,  660,  783,  661
,  662,  784,  663,  781,  978,   32,   33,  110,  244,  598
,  964,  455,   85,  178,  181,  312,  395,  396,  615,  398
,  475,  476,   86,  313,  314,  315,  480,  220,  221,  222
,  223,  668,  792,  874,  790,  877,  993,  540,  640,  809
, 1031,  257,  916,   94,  227,   74,  283,  120,  638,  842
,  847,  420,  541,  474,  343,  440,  854,  115,  872,  793
,  951,  749, 1029,  750, 1030,  767,   34,  228,  347)  ;
        --| 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   396 ;
    end setGrammarSymbolCount;

    function setActionCount return ParserInteger is
    begin
        return  1598 ;
    end setActionCount;

    function setStateCountPlusOne return ParserInteger is
    begin
        return  1040 ;
    end setStateCountPlusOne;

    function setLeftHandSideCount return ParserInteger is
    begin
    return   556 ;
    end setLeftHandSideCount;

    function setRightHandSideCount return ParserInteger is
    begin
        return   556 ;
    end setRightHandSideCount;

end Grammar_Constants;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--sidecls.dat
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with ParseTables;
with Simple_Paginated_Output;
with LISTS;
with STRING_PKG;

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

    ----------------------------------------------------------------
    --  File Declarations
    ----------------------------------------------------------------

    Instrumented_File : Simple_Paginated_Output.Paginated_File_Handle;
    --| File handle to pass to Paginated Output routines for
    --| Instrumented source

    Listing_File: Simple_Paginated_Output.Paginated_File_Handle;
    --| File handle for listing file

    ----------------------------------------------------------------
    -- 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_Columns : constant := 133;
    subtype Column_Range is Positive range Positive'First .. Max_Columns;
    Page_Width : Column_Range := 74;
    --| Width of output page

    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 := "tbx7_";


    package STRING_LISTS is
      new LISTS (STRING_PKG.STRING_TYPE);

    subtype STRING_LIST is STRING_LISTS.LIST;

    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;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--ui.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with LISTS;
with TYPE_DEFINITIONS; use TYPE_DEFINITIONS;
package USER_INTERFACE is

--|  Overview
--|
--|  This package performs the user interface function for the source
--|  instrumenter.  It queries the user for the information neccesary for
--|  instrumenting a program.  The definitons of possible tracing modes(type and

  type TRACE_MODES is (ENTRY_EXIT, DECISION_POINT, ALL_STATEMENTS, MIXED);
   --|  The possible trace modes.  Mixed mode means that the user specifies
   --|  a trace level for each program unit in a compilation.

  subtype TRACE_LEVEL is TRACE_MODES range ENTRY_EXIT .. ALL_STATEMENTS;
   --|  The possible trace levels for a program unit.  Mixed mode can only
   --|  be for a compilation unit.  Each program unit must have a trace level

  subtype UNIT_SPECIFICATION is STRING;
   --|  The string containing the specification unit of a unit used for printing

  procedure GET_INSTRUMENTING_INSTRUCTIONS(TRACING_MODE      : out TRACE_MODES;
                                           TYPE_TRACING_MODE : out BOOLEAN);

--|  Overview
--|
--|  This unit gets the instrumenting instructions for a compilation unit.  The
--|  statement trace level and type tracing are both returned.  These are used
--|  throughtout the compilation unit.  If the user picks mixed statement
--|  mode then each program unit in the compilation unit gets its own statement
--|  trace level.

  procedure GET_UNIT_INSTRUCTIONS(CURRENT_UNIT         : in UNIT_SPECIFICATION;
                                 IS_PACKAGE_SPEC       : in BOOLEAN;
                                 REQUESTED_TRACE_LEVEL : out TRACE_LEVEL;
                                 SCOPE_NAME            : in STRING;
                                 LIST_OF_VARIABLES     : out STRING_LIST);

--|  Overview
--|
--|  This procedure will get the instrumenting instructions for an individual
--|  unit.  This procedure is called only when type tracing is being
--|  done or statment trace mode is mixed.  In these cases, This unit is
--|  called to get either the variables to trace, the trace level for the
--|  unit, or both.

end USER_INTERFACE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--ui.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO; use TEXT_IO;
with IMPLEMENTATION_DEPENDENCIES;
with STRING_PKG; use STRING_PKG;

package body USER_INTERFACE is

--|  Overview
--|
--|  This package performs the user interface for the source instrumenter.
--|  The procedures are used to return the statement trace level and
--|  variable trace mode for the unit. The first procedure gets the options
--|  for a compilation unit and the second gets any optins needed for an
--|  individual program unit.

  INPUT_LINE      : STRING(1 .. IMPLEMENTATION_DEPENDENCIES.LINE_LENGTH);
    --|  Used to hold the users input.

  LENGTH_OF_INPUT : NATURAL;
    --|  The number of characters in the users input

  TRACE_MODE      : TRACE_MODES := DECISION_POINT;
    --|  The tracing level for the compilation unit.  If the tracing mode
    --|  for the compilation unit is mixed.  Then the user is asked for
    --|  the tracing mode for each nested unit.

  DO_TYPE_TRACING : BOOLEAN;
    --|  Indicates whether type tracing is being done for the current
    --|  compilation unit.

  --------------------------------------------------------------------
  --  Local Procedure Definitions
  --------------------------------------------------------------------

  procedure GET_USER_OPTIONS(TRACING_MODE      : out TRACE_MODES;
                             TYPE_TRACING_MODE : out BOOLEAN);
    --|  Get user options when he wants to supply his own optins

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

  procedure PRINT_INSTRUMENTING_HELP;
    --|  Prints an explantion of tracing options

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

  procedure PRINT_TRACING_HELP;
    --|  Prints an explanation of statement tracing options for a
    --|  compilation unit.

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

  procedure PRINT_UNIT_TRACING_HELP;
    --|  Prints an explanation of statement tracing options for a
    --|  program unit.

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

  procedure PRINT_TYPE_HELP;
    --|  Prints an explanation of type tracing.

  --------------------------------------------------------------------
  --  External Procedures
  --------------------------------------------------------------------

  procedure GET_INSTRUMENTING_INSTRUCTIONS(TRACING_MODE      : out TRACE_MODES;
                                           TYPE_TRACING_MODE : out BOOLEAN) is

  --|  Effects
  --|
  --|  This procedure will get the instrumenting instructions from the user
  --|  for the current compilation unit.  The variables TRACE_MODE and
  --|  DO_TYPE_TRACING are set to indeicate the user selected options for
  --|  the compilation unit.  These options are also returned to the
  --|  calling procedure.

    VALID_INPUT : BOOLEAN := FALSE;
      --|  Used to loop until the user supplies a valid input.


    procedure DISPLAY_OPTIONS is

    --|  Effects
    --|
    --|  This procedure will display the menu for selecting trace options
    --|  for a compilation unit.

    begin
      PUT_LINE("Instrumenting Options are:");
      NEW_LINE;
      PUT_LINE("1 - Path/Autopath Analyzer Defaults");
      PUT_LINE("2 - Performance Analyzer Defaults");
      PUT_LINE("3 - Self Metric Defaults");
      PUT_LINE("4 - User Supplied Options");
      NEW_LINE;
      PUT("Enter option (1, 2, 3, 4, ?, or <cr> for default of 1): ");
    end DISPLAY_OPTIONS;


  begin     -- GET_INSTRUMENTING_INSTRUCTIONS
    NEW_LINE;
    PUT_LINE("       Source Instrumenter Version 1.0");
    NEW_LINE;
    NEW_LINE;
    DISPLAY_OPTIONS;

 --  Loop until the user provides a valid input.

    while not VALID_INPUT loop
      GET_LINE(TEXT_IO.STANDARD_INPUT, INPUT_LINE, LENGTH_OF_INPUT);
      if LENGTH_OF_INPUT < 1 then -- no input, use defaults
        TRACE_MODE := DECISION_POINT;
        DO_TYPE_TRACING := FALSE;
        VALID_INPUT := TRUE;
      else -- determine users input and set appropriate trace modes
        case INPUT_LINE(1) is
          when '1' =>
            TRACE_MODE := DECISION_POINT;
            DO_TYPE_TRACING := FALSE;
            VALID_INPUT := TRUE;
          when '2' =>
            TRACE_MODE := ENTRY_EXIT;
            DO_TYPE_TRACING := FALSE;
            VALID_INPUT := TRUE;
          when '3' =>
            TRACE_MODE := DECISION_POINT;
            DO_TYPE_TRACING := TRUE;
            VALID_INPUT := TRUE;
          when '4' =>   --  user doesn't want defaults, so prompt for input
            GET_USER_OPTIONS(TRACE_MODE, DO_TYPE_TRACING);
            VALID_INPUT := TRUE;
          when '?' =>
            PRINT_INSTRUMENTING_HELP;
            DISPLAY_OPTIONS;
          when others =>   -- bad input, repeat loop
            PUT_LINE("Invalid input, try again:  ");
            NEW_LINE;
            DISPLAY_OPTIONS;
        end case;
      end if;
    end loop;

-- Set the TRACING_MODE and TYPE_TRACING_MODE for the compilation unit.
-- These will be used in determining what to prompt the user for, for
-- nested unit.

    TRACING_MODE := TRACE_MODE;
    TYPE_TRACING_MODE := DO_TYPE_TRACING;
  end GET_INSTRUMENTING_INSTRUCTIONS;

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

  procedure GET_UNIT_INSTRUCTIONS(CURRENT_UNIT         : in UNIT_SPECIFICATION;
                                 IS_PACKAGE_SPEC       : in BOOLEAN;
                                 REQUESTED_TRACE_LEVEL : out TRACE_LEVEL;
                                 SCOPE_NAME            : in STRING;
                                 LIST_OF_VARIABLES     : out STRING_LIST) is

--|  Effects
--|
--|  This procedure gets the instrumenting instruction for a nested unit.
--|  It determines whether it needs to ask for statement trace level, type
--|  tracing level, or both,by looking at the modes for the compilation
--|  unit.  The current units name is displayed and then the user is
--|  prompted for the required inputs

    VALID_INPUT : BOOLEAN := FALSE;
      --|  Used to loop until user supplies valid input

    TEMP_LIST   : STRING_LIST := STRING_LISTS.CREATE;
      --|  Used to contain the list of variables the user wants to trace

    procedure DISPLAY_UNIT_TRACE_OPTIONS is

    --|  Effects
    --|
    --|  This procedure displays the menu of statement trace options for
    --|  a program unit.

    begin
      NEW_LINE;
      NEW_LINE;
      PUT_LINE("Available trace levels are:");
      PUT_LINE("1 - Entry/Exit only");
      PUT_LINE("2 - Entry/Exit and Decision Point");
      PUT_LINE("3 - Every statement");
      NEW_LINE;
      PUT("Enter option ( default is 2): ");
    end DISPLAY_UNIT_TRACE_OPTIONS;

    procedure DISPLAY_UNIT(UNIT_TO_DISPLAY : in UNIT_SPECIFICATION) is

    --|  Effects
    --|
    --|  This program displays the Name of the current unit.

    begin
      NEW_LINE;
      NEW_LINE;
      PUT_LINE("Current Unit Being Instrumented is:");
      NEW_LINE;
      for INDEX in 1 .. UNIT_TO_DISPLAY'LAST loop
        PUT(UNIT_TO_DISPLAY(INDEX));
        if UNIT_TO_DISPLAY(INDEX) = ';' then
          NEW_LINE;
          PUT("       ");
        end if;
      end loop;
      NEW_LINE;
      NEW_LINE;
    end DISPLAY_UNIT;

    procedure STRIP_BLANKS(FROM : in out STRING;
                           LEN  : in out NATURAL) is

    --|  Effects
    --|
    --|  This procedure strips all of the blanks out of a string. It
    --|  returns the string padded with blank on the right, and it
    --|  returns the length of the string.

      INDEX : NATURAL := 1;
        --|  Used to index into the string.

    begin
      while INDEX <= LEN loop  -- loop through the string
        if FROM(INDEX) = ' ' then
          FROM(INDEX .. LEN - 1) := FROM(INDEX + 1 .. LEN);
          LEN := LEN - 1;
        else
          INDEX := INDEX + 1;
        end if;
      end loop;
    end STRIP_BLANKS;

  begin

    -- Display current unit
    DISPLAY_UNIT(CURRENT_UNIT);

  -- Determine if statement trace level needs to be prompted for

    if not IS_PACKAGE_SPEC then   -- package specs have no statements
      if TRACE_MODE = MIXED then  -- only need to get if in mixed mode
        DISPLAY_UNIT_TRACE_OPTIONS;
        while not VALID_INPUT loop  -- loop until valid statement trace option
          GET_LINE(TEXT_IO.STANDARD_INPUT, INPUT_LINE, LENGTH_OF_INPUT);
          if LENGTH_OF_INPUT < 1 then   -- no input, use defaults
            REQUESTED_TRACE_LEVEL := DECISION_POINT;
            VALID_INPUT := TRUE;
          else   -- determine user response
            case INPUT_LINE(1) is
              when '1' =>
                REQUESTED_TRACE_LEVEL := ENTRY_EXIT;
                VALID_INPUT := TRUE;
              when '2' =>
                REQUESTED_TRACE_LEVEL := DECISION_POINT;
                VALID_INPUT := TRUE;
              when '3' =>
                REQUESTED_TRACE_LEVEL := ALL_STATEMENTS;
                VALID_INPUT := TRUE;
              when '?' =>
                PRINT_UNIT_TRACING_HELP;
                DISPLAY_UNIT_TRACE_OPTIONS;
              when others =>
                PUT_LINE("Invalid input, try again:  ");
                DISPLAY_UNIT_TRACE_OPTIONS;
            end case;
          end if;
        end loop;
      else   --  trace mode is not mixed
        REQUESTED_TRACE_LEVEL := TRACE_MODE;   -- return trace level for comp
      end if;
    end if;

-- Do we need to prompt for variables to trace?

    if DO_TYPE_TRACING then
      PUT_LINE("Enter variables to trace.  Enter one variable per line ");
      PUT_LINE("or *ALL to trace all variables in the scope.");
      PUT_LINE("Terminate the list with a blank line");
      loop   -- loop until blank line encountered
        PUT(">> ");
        GET_LINE(TEXT_IO.STANDARD_INPUT, INPUT_LINE, LENGTH_OF_INPUT);
        exit when LENGTH_OF_INPUT < 1;

  -- strip blanks out of user requested variable name and then add
  -- the variable name to the list with its scope name prepended

        STRIP_BLANKS (INPUT_LINE(1..LENGTH_OF_INPUT), LENGTH_OF_INPUT);
        if SCOPE_NAME = "" then
          STRING_LISTS.ATTACH(TEMP_LIST, CREATE(INPUT_LINE(1 .. LENGTH_OF_INPUT)
            ));
        else
          STRING_LISTS.ATTACH(TEMP_LIST, CREATE(SCOPE_NAME) & "." & INPUT_LINE(1
            .. LENGTH_OF_INPUT));
        end if;
      end loop;
    end if;
    LIST_OF_VARIABLES := TEMP_LIST; -- return the list of variables
  end GET_UNIT_INSTRUCTIONS;


  --------------------------------------------------------------
  --  Local Procedure Bodies
  --------------------------------------------------------------

  procedure GET_USER_OPTIONS(TRACING_MODE      : out TRACE_MODES;
                             TYPE_TRACING_MODE : out BOOLEAN) is

--|  Effects
--|
--|  This procedure is called when the user specifies that she wants to
--|  select her own instrumenting options instead of using one of
--|  the predefined options.  The procedure will prompt the user for
--|  the statement trace level and whether to do type tracing.

    VALID_INPUT : BOOLEAN := FALSE;
      --|  used to loop until valid user input

    procedure DISPLAY_TRACE_OPTIONS is

    --|  Effects
    --|
    --|  This procedure displays the possible trace modes for a compilation unit.

    begin
      NEW_LINE;
      NEW_LINE;
      PUT_LINE("Available trace levels are:");
      PUT_LINE("1 - Entry/Exit only");
      PUT_LINE("2 - Entry/Exit and Decision Point");
      PUT_LINE("3 - Every statement");
      PUT_LINE("4 - Mixed (Each program unit has its own trace level)");
      NEW_LINE;
      PUT("Enter option ( default is 2): ");
    end DISPLAY_TRACE_OPTIONS;

  begin

 -- Prompt user for statement trace mode and loop until he responds
 -- with a valid input

    DISPLAY_TRACE_OPTIONS;
    while not VALID_INPUT loop
      GET_LINE(TEXT_IO.STANDARD_INPUT, INPUT_LINE, LENGTH_OF_INPUT);
      if LENGTH_OF_INPUT < 1 then
        TRACING_MODE := DECISION_POINT;
        VALID_INPUT := TRUE;
      else
        case INPUT_LINE(1) is
          when '1' =>
            TRACING_MODE := ENTRY_EXIT;
            VALID_INPUT := TRUE;
          when '2' =>
            TRACING_MODE := DECISION_POINT;
            VALID_INPUT := TRUE;
          when '3' =>
            TRACING_MODE := ALL_STATEMENTS;
            VALID_INPUT := TRUE;
          when '4' =>
            TRACING_MODE := MIXED;
            VALID_INPUT := TRUE;
          when '?' =>
            PRINT_TRACING_HELP;
            DISPLAY_TRACE_OPTIONS;
          when others =>
            PUT_LINE("Invalid input, try again:  ");
            DISPLAY_TRACE_OPTIONS;
        end case;
      end if;
    end loop;

-- now determine whether the user wants to do type tracing

    VALID_INPUT := FALSE;
    NEW_LINE;
    NEW_LINE;
    PUT("Do you want to do type tracing (default is no): ");
    while not VALID_INPUT loop
      GET_LINE(TEXT_IO.STANDARD_INPUT, INPUT_LINE, LENGTH_OF_INPUT);
      if LENGTH_OF_INPUT < 1 then
        TYPE_TRACING_MODE := FALSE;
        VALID_INPUT := TRUE;
      elsif INPUT_LINE(1) = 'y' or INPUT_LINE(1) = 'Y' then
        TYPE_TRACING_MODE := TRUE;
        VALID_INPUT := TRUE;
      elsif INPUT_LINE(1) = 'n' or INPUT_LINE(1) = 'N' then
        TYPE_TRACING_MODE := FALSE;
        VALID_INPUT := TRUE;
      elsif INPUT_LINE(1) = '?' then
        PRINT_TYPE_HELP;
        PUT("Do you want to do type tracing (default is no): ");
      else
        PUT_LINE("Invalid input, try again: ");
        NEW_LINE;
        NEW_LINE;
        PUT("Do you want to do type tracing (default is no): ");
      end if;
    end loop;
  end GET_USER_OPTIONS;

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

  procedure PRINT_INSTRUMENTING_HELP is

  --|  Effects
  --|
  --|  This procedure displays help on selecting trace modes

  begin
    NEW_LINE;
    NEW_LINE;
    PUT_LINE("When instrumenting code two options need to be specified.");
    PUT_LINE("The user can use the defaults provided for one of the");
    PUT_LINE("tools (options 1 to 3) or may supply his own options.");
    NEW_LINE;
    PUT_LINE("The first option determines where breakpoints are put.");
    PUT_LINE("There are four choices for this option: ");
    PUT_LINE("   Entry/Exit       - breakpoints are placed at entry exit only")
      ;
    PUT_LINE(
      "   Decision Point   - breakpoints are also placed at decision points");
    PUT_LINE("   Every Statement  - A breakpoint is placed at each statement");
    PUT_LINE("   Mixed            - Each program unit gets its own trace level")
      ;
    NEW_LINE;
    PUT_LINE("The second option determines whether variables and types are");
    PUT_LINE("traced.  This option is either on or off.");
    NEW_LINE;
    PUT_LINE("When selecting options, the user can use either one of the");
    PUT_LINE("sets of predefined defaults or specify his own options.  The");
    PUT_LINE("predefined defaults are as follows:");
    NEW_LINE;
    PUT_LINE("DEFAULT                      TRACE                   TYPE");
    PUT_LINE("NAME                         LEVEL                  TRACING");
    PUT_LINE("-------------------------------------------------------------");
    NEW_LINE;
    PUT_LINE("Path/Autopath Analyzer      Decision point           No");
    PUT_LINE("Performance Analyzer        Entry/Exit               No");
    PUT_LINE("Self Metric                 Decision point           Yes");
    NEW_LINE;
  end PRINT_INSTRUMENTING_HELP;

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

  procedure PRINT_TRACING_HELP is

  --|  Effects
  --|
  --|  Display information about trace modes

  begin
    NEW_LINE;
    NEW_LINE;
    PUT_LINE("There are four possible trace modes.  The four modes are:");
    NEW_LINE;
    PUT_LINE("Entry/Exit      - This mode provides breakpoints at entry to");
    PUT_LINE("                  and exit from each program unit");
    PUT_LINE("Decision Point  - This mode provides breakpoints at every ");
    PUT_LINE("                  decision point as well as at entry to and");
    PUT_LINE("                  exit from each program unit");
    PUT_LINE("Every Statement - This mode provides breakpoints at every");
    PUT_LINE("                  statement");
    PUT_LINE("Mixed           - This mode allows the user to instrument");
    PUT_LINE("                  each program unit at any level.  The user");
    PUT_LINE("                  will be prompted to provide the desired");
    PUT_LINE("                  trace level for each program unit in the");
    PUT_LINE("                  compilation");
    NEW_LINE;
  end PRINT_TRACING_HELP;

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

  procedure PRINT_UNIT_TRACING_HELP is

  --|  Effects
  --|
  --|  Display possible trace modes for a unit

  begin
    NEW_LINE;
    NEW_LINE;
    PUT_LINE("There are three possible trace modes.  They are:");
    NEW_LINE;
    PUT_LINE("Entry/Exit      - This mode provides breakpoints at entry to");
    PUT_LINE("                  and exit from each program unit");
    PUT_LINE("Decision Point  - This mode provides breakpoints at every ");
    PUT_LINE("                  decision point as well as at entry to and");
    PUT_LINE("                  exit from each program unit");
    PUT_LINE("Every Statement - This mode provides breakpoints at every");
    PUT_LINE("                  statement");
    NEW_LINE;
  end PRINT_UNIT_TRACING_HELP;

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

  procedure PRINT_TYPE_HELP is

  --|  Effects
  --|
  --|  Displays informatin about type tracing

  begin
    NEW_LINE;
    NEW_LINE;
    PUT_LINE("The user can enable or disable type and variable tracing. ");
    PUT_LINE("If the user responds yes to this question then type tracing");
    PUT_LINE("will be enabled, and the user will be prompted to provide");
    PUT_LINE("the variables to be traced.");
    NEW_LINE;
    PUT_LINE("NOTE:  If a package specification is instrumented without");
    PUT_LINE("type tracing, then all modules that with that package must");
    PUT_LINE("also be instrumented without type tracing");
    NEW_LINE;
  end PRINT_TYPE_HELP;

end USER_INTERFACE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--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 : PD.Source_Text;  --| text to be changed
                         To_Case    : 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 : 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 : 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.

end Change_Text;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--change.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

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 SID renames Source_Instrumenter_Declarations;

    -----------------------------------------------------------------------
    -- Local Subprogram Specifications
    -----------------------------------------------------------------------

    function Uppercase (Char : 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 : 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 : PD.Source_Text;
                          To_Case    : 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 : 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 : 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 SID.Delimiters = SID.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 : 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 : 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;

end Change_Text;

---------------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--bkpt.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STRING_PKG; use STRING_PKG;
with TYPE_DEFINITIONS; use 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 CURRENT_UNIT_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 CURRENT_UNIT_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.  The procedure is also added to the list of procedures
  --| for the current compilation unit.

  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(TYPE_OF_BREAKPOINT : in BREAKPOINT_TYPES;
                              PUTVARS_TO_CALL    : in ADA_NAME);

  --| 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_TYPE;

  --| Effects
  --|
  --| This procedure return a String_type containing the current
  --| Program unit identifier.  This can be used for printing the
  --| Current Program unit for calls to the RTM

end CREATE_BREAKPOINT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--bkpt.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with STACK_PKG;
with LISTS;
with SIMPLE_PAGINATED_OUTPUT; use SIMPLE_PAGINATED_OUTPUT;
with SOURCE_INSTRUMENTER_DECLARATIONS;
with CHANGE_TEXT;

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 SID renames SOURCE_INSTRUMENTER_DECLARATIONS;

  type PROGRAM_UNIT_INFORMATION is   --|  Information needed to identify a unit
    record
      UNIT_NUMBER : PROGRAM_UNIT_NUMBER_RANGE; --|  unique unit number
      UNIT_TYPE   : PROGRAM_UNIT_TYPE;         --|  type of unit
    end record;

  CURRENT_COMPILATION_UNIT : CURRENT_UNIT_NAME;
    --|  The name of the current compilation unit being processed

  BREAKPOINT_NUMBER        : BREAKPOINT_NUMBER_RANGE;
    --|  The number of breakpoints that have been created

  NUMBER_OF_PROGRAM_UNITS  : PROGRAM_UNIT_NUMBER_RANGE;
    --|  The number of program units in the current compilation unit that have
    --|  been processed so far

  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(PROGRAM_UNIT_NAME);            -- 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 CURRENT_UNIT_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.

    if TYPE_OF_UNIT = PACKAGE_TYPE then
      NUMBER_OF_PROGRAM_UNITS := 0;
    else
      -- add the procedure or function to the list of program units
      NUMBER_OF_PROGRAM_UNITS := 1;
      PROGRAM_UNIT_LIST_PACKAGE.ATTACH(PROGRAM_UNIT_LIST, (UNIT_NAME,
        TYPE_OF_UNIT));
    end if;
    CURRENT_PROGRAM_UNIT := (NUMBER_OF_PROGRAM_UNITS, TYPE_OF_UNIT);

  end NEW_COMPILATION_UNIT;

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

  procedure START_PROGRAM_UNIT(UNIT_NAME    : in CURRENT_UNIT_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);
    NUMBER_OF_PROGRAM_UNITS := NUMBER_OF_PROGRAM_UNITS + 1;
    CURRENT_PROGRAM_UNIT := (NUMBER_OF_PROGRAM_UNITS, TYPE_OF_UNIT);
    PROGRAM_UNIT_LIST_PACKAGE.ATTACH(PROGRAM_UNIT_LIST,
      (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

  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 not (CURRENT_PROGRAM_UNIT.UNIT_TYPE = PACKAGE_TYPE and
      CURRENT_NESTING_LEVEL > 1) then
      SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
      if CURRENT_NESTING_LEVEL = 1 and CURRENT_PROGRAM_UNIT.UNIT_TYPE =
           PROCEDURE_TYPE then
        PUT_LINE(SID.INSTRUMENTED_FILE,
         CHANGE_TEXT.CONVERT_PERIODS_TO_UNDERSCORES(
         VALUE(CURRENT_COMPILATION_UNIT))
         & "_Call_Unit_Information;");
      end if;
      PUT(SID.INSTRUMENTED_FILE, "RTM.Entering_Unit");
      PUT(SID.INSTRUMENTED_FILE, GET_PROGRAM_UNIT);
      PUT(SID.INSTRUMENTED_FILE, ";");
      if CURRENT_PROGRAM_UNIT.UNIT_TYPE = PACKAGE_TYPE then
        SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
      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
      SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
      PUT(SID.INSTRUMENTED_FILE, "RTM.Exiting_Unit(");
      PUT(SID.INSTRUMENTED_FILE, GET_PROGRAM_UNIT);
      PUT_LINE(SID.INSTRUMENTED_FILE, ");");
      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 then
        SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
        PUT_LINE(SID.INSTRUMENTED_FILE, "separate(" & CURRENT_COMPILATION_UNIT
          & ")");
        PUT_LINE(SID.INSTRUMENTED_FILE, "procedure "
          & CHANGE_TEXT.CONVERT_PERIODS_TO_UNDERSCORES(
          VALUE(CURRENT_COMPILATION_UNIT))
          & "_Call_Unit_Information is");
        PUT_LINE(SID.INSTRUMENTED_FILE, "begin");
        CREATE_UNIT_INFORMATION;
        PUT_LINE(SID.INSTRUMENTED_FILE, "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(TYPE_OF_BREAKPOINT : in BREAKPOINT_TYPES;
                              PUTVARS_TO_CALL    : in ADA_NAME) is

--|  Effects
--|
--|  This procedure will create a breakpoint in the souce code.  The breakpoint
--|  type is added to the breakpoint call.  If we are tracing variables then
--|  a call to the current putvars is added after the breakpoint.  Due to
--|  grammar ambiguities, there are several places where multiple calls to
--|  create breakpoint are made.  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.

  begin

--  Currently breakpoints are not added to package initializations

    if CURRENT_PROGRAM_UNIT.UNIT_TYPE /= PACKAGE_TYPE then
      if 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

        SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
        PUT(SID.INSTRUMENTED_FILE, "RTM.Breakpoint_At(");
        PUT(SID.INSTRUMENTED_FILE, GET_PROGRAM_UNIT);
        PUT(SID.INSTRUMENTED_FILE, ",");
        SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
        if TYPE_OF_BREAKPOINT = OTHER_BREAKPOINT then
          PUT(SID.INSTRUMENTED_FILE, "       Other_Breakpoint, ");
        else
          PUT(SID.INSTRUMENTED_FILE, "       Loop_Breakpoint, ");
        end if;
        PUT(SID.INSTRUMENTED_FILE, NATURAL'IMAGE(BREAKPOINT_NUMBER));
        PUT(SID.INSTRUMENTED_FILE, ");");
        BREAKPOINT_PRINTED_LAST := TRUE;

        -- If there is a putvars to call, then add the call to
        -- the instrumented source

        if not IS_EMPTY(PUTVARS_TO_CALL) then
          SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
          PUT(SID.INSTRUMENTED_FILE, PUTVARS_TO_CALL & "_" & SID.PREFIX &
            "putvars;");
        end if;
      end if;
    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          : PROGRAM_UNIT_NAME;
      --|  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
    PUT(SID.INSTRUMENTED_FILE, "RTM.Unit_Information(Create(""" & VALUE(
      CURRENT_COMPILATION_UNIT) & """), ");
    PUT(SID.INSTRUMENTED_FILE, NATURAL'IMAGE(BREAKPOINT_NUMBER));
    PUT(SID.INSTRUMENTED_FILE, ", (");

    --  Iterate throught the list of program units printing each to
    --  the listing file

    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);
      SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
      PUT(SID.INSTRUMENTED_FILE, INTEGER'IMAGE(PROGRAM_UNIT_NUMBER) & " => ");
      PUT(SID.INSTRUMENTED_FILE, "(Create(""");
      PUT(SID.INSTRUMENTED_FILE, NEXT_PROGRAM_UNIT.UNIT_IDENTIFIER);
      PUT(SID.INSTRUMENTED_FILE, """),");
      PUT(SID.INSTRUMENTED_FILE, PROGRAM_UNIT_TYPE'IMAGE(NEXT_PROGRAM_UNIT.
        UNIT_TYPE));
      PUT(SID.INSTRUMENTED_FILE, ")");
      if PROGRAM_UNIT_LIST_PACKAGE.MORE(PROGRAM_UNIT_LIST_ITERATOR) then
        PUT(SID.INSTRUMENTED_FILE, ",");
      end if;
      PROGRAM_UNIT_NUMBER := PROGRAM_UNIT_NUMBER + 1;
    end loop;
    PUT(SID.INSTRUMENTED_FILE, "));");
    SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
  end CREATE_UNIT_INFORMATION;

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

  function GET_PROGRAM_UNIT return STRING_TYPE 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 CREATE("(Create(""" & VALUE(CURRENT_COMPILATION_UNIT) & """), " &
      NATURAL'IMAGE(CURRENT_PROGRAM_UNIT.UNIT_NUMBER) & ", " & PROGRAM_UNIT_TYPE
      'IMAGE(CURRENT_PROGRAM_UNIT.UNIT_TYPE) & ", " & SID.PREFIX &
      "Task_Number)");
  end GET_PROGRAM_UNIT;

end CREATE_BREAKPOINT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--bufrfile.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

with SOURCE_INSTRUMENTER_DECLARATIONS; use SOURCE_INSTRUMENTER_DECLARATIONS;
with SIMPLE_PAGINATED_OUTPUT;
with DIRECT_IO;
with LISTS;
with STRING_PKG; use STRING_PKG;

package BUFFER_FILE_PACKAGE --| This package creates and manages the
--| files needed by the source instrumenter
--| for saving information needed for
--| tracing types and variables.

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 "PKGFILES.SII".
--|
--| The current extensions used for the package tracing files are:
--|  ".PBS"  -- For the Public_Spec_File
--|  ".PBB"  -- For the Public_Body_File
--|  ".PVS"  -- For the Private_Spec_File
--|  ".PVB"  -- 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(CHARACTER);
  use DIO;

  package SPO renames SIMPLE_PAGINATED_OUTPUT;

  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
  --| indicates which file to copy into the instrumented source file
  (PUBLIC_SPEC, PUBLIC_BODY, PRIVATE_SPEC, PRIVATE_BODY);

  type FILE_GROUP is (PUBLIC_FILES, PRIVATE_FILES, ALL_FILES);
  --| used by various procedures when the operation is not always
  --| performed on all files

  FILE_PREFIX_LIMIT        : constant := 8;
  FILE_SUFFIX_LIMIT        : constant := 4;

  PUBLIC_SPEC_FILE_SUFFIX  : constant STRING(1 .. FILE_SUFFIX_LIMIT) := ".PBS";
  PUBLIC_BODY_FILE_SUFFIX  : constant STRING(1 .. FILE_SUFFIX_LIMIT) := ".PBB";
  PRIVATE_SPEC_FILE_SUFFIX : constant STRING(1 .. FILE_SUFFIX_LIMIT) := ".PVS";
  PRIVATE_BODY_FILE_SUFFIX : constant STRING(1 .. FILE_SUFFIX_LIMIT) := ".PVB";

  EXTERNAL_FILENAME        : constant STRING := "PKGFILES.SII";
  --| Filename extension means "Source Instrumenter Information"

  subtype FILENAME_PREFIX_STRING is STRING(1 .. FILE_PREFIX_LIMIT);
  NO_FILENAME : constant FILENAME_PREFIX_STRING := (others => ' ');


  ------------------------------------------------------------------------
  -- The following procedures manage the Buffer_File
  ------------------------------------------------------------------------

  procedure INITIALIZE;  --| Initialize the Buffer_File

  --| 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;  --| Starts a new section in Buffer_File

  --| 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;  --| Release the section in Buffer_File

  --| 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( --| Write a string to the specified file
                              DIO_FILE     : in DIO.FILE_TYPE := BUFFER_FILE;
                              LINE_OF_TEXT : in STRING);
  --| Effects
  --|   This procedure writes the line to the specified file.  If no file
  --| is specified, the line is written to the Buffer_File.

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

  procedure SAVE_BUFFER_FILE( --| Save the current section of the Buffer_File
                             PO_FILE : in SPO.PAGINATED_FILE_HANDLE);

  --| Effects
  --|   This procedure saves the section starting at the current Starting_Index
  --| to the specified Simple_Paginated_Output file (the instrumented source
  --| file).



  ----------------------------------------------------------------------------
  -- The following procedures manage the package tracing files.
  ----------------------------------------------------------------------------

  procedure CREATE_PACKAGE_FILES( --| Create the files neccesary to
  --| save package information.
                                 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( --| Close the specified 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_PRIVATE_FILES( --| Reopen the private files associated
  --| with the Package_Name
                                 PACKAGE_NAME : in STRING);

  --| 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( --| Check for the existence of instrumenting
  --| information files for the given package
                               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 DELETE_PACKAGE_FILES( --| Delete the instrumenting information
  --| files for the given package, and
  --| remove the entry from the external file.
                                 PACKAGE_NAME            : in STRING;
                                 WHICH_FILES             : in FILE_GROUP :=
                                   ALL_FILES;
                                 CURRENT_FILENAME_PREFIX : in
                                   FILENAME_PREFIX_STRING := NO_FILENAME);

  --| 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 COPY_PACKAGE_FILES( --| Copy the specified file into the
  --| instrumented source file
                               WHICH_FILE   : in FILE_INDICATOR;
                               PACKAGE_NAME : in STRING;
                               SI_FILE      : in SPO.PAGINATED_FILE_HANDLE);

  --| Effects
  --|   This procedure copies the contents of the indicated file into the
  --| specified Simple_Paginated_Output file (The instrumented source).

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

  procedure SAVE_SPEC_WITH_LIST( --| Save the with list for the
  --| current package specification
                                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( --| Retrieve the saved with list for
  --| current unit
                              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;  --| Update the external file

  --| Effects
  --|   This procedure writes the internal table of package_name-file_name
  --| information to the permanent external table file.

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

end BUFFER_FILE_PACKAGE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--bufrfile.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO; use TEXT_IO;
with CALENDAR;
with TIME_LIBRARY_1; use TIME_LIBRARY_1;
with STACK_PKG;

package body BUFFER_FILE_PACKAGE --| File management for the SI

is
  use STRING_LISTS;  -- declared in the package spec

  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("");

  -- note: NO_FILENAME is declared in the spec because it is used
  -- as a default value for an external procedure

  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 build 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.

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

  procedure DELETE_INTERNAL_TABLE_ENTRY(PACKAGE_NAME : in STRING);
  --| Delete the entry for this package from the Internal_Table.



  ---------------------------------------------------------------
  --  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.

    PACKAGE_FILENAME_PREFIX : FILENAME_PREFIX_STRING;

  begin

    -- Call Start_Package which will make an entry in the internal
    -- table and then return the unique filename prefix
    PACKAGE_FILENAME_PREFIX := START_PACKAGE(PACKAGE_NAME);

    if WHICH_FILES /= PRIVATE_FILES then

      -- create the public_spec file
      begin

        DIO.OPEN(PUBLIC_SPEC_FILE, OUT_FILE,
          PACKAGE_FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);
        DIO.DELETE(PUBLIC_SPEC_FILE);
        DIO.CREATE(PUBLIC_SPEC_FILE, OUT_FILE,
          PACKAGE_FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);

      exception
        when DIO.NAME_ERROR =>
          DIO.CREATE(PUBLIC_SPEC_FILE, OUT_FILE,
            PACKAGE_FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);
      end;

      -- create the public_body file
      begin

        DIO.OPEN(PUBLIC_BODY_FILE, OUT_FILE,
          PACKAGE_FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);
        DIO.DELETE(PUBLIC_BODY_FILE);
        DIO.CREATE(PUBLIC_BODY_FILE, OUT_FILE,
          PACKAGE_FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);

      exception
        when DIO.NAME_ERROR =>
          DIO.CREATE(PUBLIC_BODY_FILE, OUT_FILE,
            PACKAGE_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, OUT_FILE,
          PACKAGE_FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);
        DIO.DELETE(PRIVATE_SPEC_FILE);
        DIO.CREATE(PRIVATE_SPEC_FILE, OUT_FILE,
          PACKAGE_FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);

      exception
        when DIO.NAME_ERROR =>
          DIO.CREATE(PRIVATE_SPEC_FILE, OUT_FILE,
            PACKAGE_FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);
      end;

      -- create the private_body file
      begin

        DIO.OPEN(PRIVATE_BODY_FILE, OUT_FILE,
          PACKAGE_FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
        DIO.DELETE(PRIVATE_BODY_FILE);
        DIO.CREATE(PRIVATE_BODY_FILE, OUT_FILE,
          PACKAGE_FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);

      exception
        when DIO.NAME_ERROR =>
          DIO.CREATE(PRIVATE_BODY_FILE, OUT_FILE,
            PACKAGE_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_PRIVATE_FILES(PACKAGE_NAME : in STRING) is
  --| Open the private files for the given package and set
  --| the file index to the end so that further writes are
  --| appended to the file rather that overwriting it.

    PACKAGE_FILENAME_PREFIX : FILENAME_PREFIX_STRING;
    FILE_INDEX              : DIO.COUNT;

  begin
    PACKAGE_FILENAME_PREFIX := GET_FILENAME_PREFIX(PACKAGE_NAME);

    -- If the files are not empty set the index to the next write
    -- write position, so the current stuff is not overwritten.
    DIO.OPEN(PRIVATE_SPEC_FILE, INOUT_FILE,
      PACKAGE_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, PACKAGE_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;

  exception
    when others =>
      null;

  end REOPEN_PRIVATE_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     : FILENAME_PREFIX_STRING :=
       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 = 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_PREFIX : in
                                   FILENAME_PREFIX_STRING := NO_FILENAME) 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;
    PACKAGE_FILENAME_PREFIX : FILENAME_PREFIX_STRING;

  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_Prefix.
    if CURRENT_FILENAME_PREFIX = NO_FILENAME then
      PACKAGE_FILENAME_PREFIX := GET_FILENAME_PREFIX(PACKAGE_NAME);
    else
      PACKAGE_FILENAME_PREFIX := CURRENT_FILENAME_PREFIX;
    end if;

    -- 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

      if WHICH_FILES /= PRIVATE_FILES then

        -- delete the public_spec_file
        begin
          DIO.OPEN(DIO_FILE, OUT_FILE,
            PACKAGE_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,
            PACKAGE_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,
            PACKAGE_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,
            PACKAGE_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 then
        DELETE_INTERNAL_TABLE_ENTRY(PACKAGE_NAME);
      end if;

    end if; -- Filename /= No_Filename
  end DELETE_PACKAGE_FILES;

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

  procedure COPY_PACKAGE_FILES(WHICH_FILE   : in FILE_INDICATOR;
                               PACKAGE_NAME : in STRING;
                               SI_FILE      : in SPO.PAGINATED_FILE_HANDLE) is
  --| Copy the indicated package tracing file into the instrumented
  --| source file.

    PACKAGE_FILENAME_PREFIX : FILENAME_PREFIX_STRING;
    DIO_FILE                : DIO.FILE_TYPE;

    FILE_START_INDEX        : DIO.COUNT := 1;
    FILE_END_INDEX          : DIO.COUNT;
    CH                      : CHARACTER;

  begin

    PACKAGE_FILENAME_PREFIX := GET_FILENAME_PREFIX(PACKAGE_NAME);
    case WHICH_FILE is
      when PUBLIC_SPEC =>
        OPEN(DIO_FILE, IN_FILE,
          PACKAGE_FILENAME_PREFIX & PUBLIC_SPEC_FILE_SUFFIX);

      when PUBLIC_BODY =>
        OPEN(DIO_FILE, IN_FILE,
          PACKAGE_FILENAME_PREFIX & PUBLIC_BODY_FILE_SUFFIX);

      when PRIVATE_SPEC =>
        OPEN(DIO_FILE, IN_FILE,
          PACKAGE_FILENAME_PREFIX & PRIVATE_SPEC_FILE_SUFFIX);

      when PRIVATE_BODY =>
        OPEN(DIO_FILE, IN_FILE,
          PACKAGE_FILENAME_PREFIX & PRIVATE_BODY_FILE_SUFFIX);
    end case;

    SPO.SPACE_LINE(SI_FILE, 1);

    -- 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, CH);
      if CH = ASCII.CR then
        SPO.PUT_LINE(SI_FILE, "");
      else
        SPO.PUT(SI_FILE, CH);
      end if;
    end loop;
    DIO.CLOSE(DIO_FILE);

  exception
    when others =>
      null;

  end COPY_PACKAGE_FILES;

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

  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;

    -- convert the list to a string_type and save it
    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;

  begin
    if INTERNAL_TABLE_CREATED and INTERNAL_TABLE_CHANGED then
      begin
        OPEN(EXTERNAL_FILE, OUT_FILE, EXTERNAL_FILENAME);
        RESET(EXTERNAL_FILE);

      exception
        when TEXT_IO.NAME_ERROR =>
          CREATE(EXTERNAL_FILE, OUT_FILE, 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, 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);
      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_OF_TEXT : in STRING) is

  begin
    for I in LINE_OF_TEXT'FIRST .. LINE_OF_TEXT'LAST loop
      DIO.WRITE(DIO_FILE, LINE_OF_TEXT(I));
    end loop;

    DIO.WRITE(DIO_FILE, ASCII.CR);
  end WRITELN_TO_BUFFER;

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

  procedure SAVE_BUFFER_FILE(PO_FILE : in SPO.PAGINATED_FILE_HANDLE) is

    CURRENT_INDEX : DIO.COUNT;
    CH            : CHARACTER;

  begin
    CURRENT_INDEX := DIO.INDEX(BUFFER_FILE) - 1;
    if STARTING_INDEX <= CURRENT_INDEX then
      SPO.PUT_LINE(PO_FILE, "");
    end if;

    for I in STARTING_INDEX .. CURRENT_INDEX loop
      DIO.READ(BUFFER_FILE, CH, I);
      if CH = ASCII.CR then
        SPO.PUT_LINE(PO_FILE, "");
      else
        SPO.PUT(PO_FILE, CH);
      end if;
    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
    TABLE_ENTRY : TABLE_ENTRY_RECORD;
  begin
    INTERNAL_TABLE := INTERNAL_LIST_PACKAGE.CREATE;
    TEXT_IO.OPEN(EXTERNAL_FILE, IN_FILE, 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.

    FILENAME_STRING : FILENAME_PREFIX_STRING := (others => 'X');
    --| Name that will be returned

    FINDEX          : NATURAL := 1;

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

  begin

  -- Loop to extract the first "file_prefix_limit" characters
  -- from the package name to form the prefix of the filename.
    for I in 1 .. PACKAGE_NAME'LENGTH loop
      if PACKAGE_NAME(I) /= '_' and PACKAGE_NAME(I) /= '.' then
        FILENAME_STRING(FINDEX) := PACKAGE_NAME(I);
        FINDEX := FINDEX + 1;
        exit when FINDEX > FILE_PREFIX_LIMIT;
      end if;
    end loop;

    --  Now check the Internal_Table to be sure that Filename_String
    --  is unique.  If not, replace successive characters in it from
    --  A to Z until a unique name is found.  This scheme allows
    --  208,827,100,000 unique names.  If this is not sufficient,
    --  digits could also be used for filename characters.

    MAIN_LOOP : for I in reverse 1 .. FILE_PREFIX_LIMIT loop
      for CH in A_TO_Z loop
        exit MAIN_LOOP when not FILENAME_IN_TABLE(FILENAME_STRING);
        FILENAME_STRING(I) := CH;
      end loop;
    end loop MAIN_LOOP;

    return FILENAME_STRING;

  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);

    -- Initialize the OUT parameters to a Table_Entry_Record with
    -- all fields initialized to null, and false.
    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
      -- update the OUT parameters
        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

  --  Check the Internal_Table to see if there is already an
  --  entry for this package.
    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, then delete it so the
    -- new one can be added with updated date and
    -- time fields.

      DELETEITEM(INTERNAL_TABLE, CURRENT_TABLE_ENTRY);

    end if;

    -- Get the date and time that the files are created or updated
    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 the Current_Table_Entry to the list and set the "changed" flag
    -- so that the external file will be rewritten.

    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;

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

  procedure DELETE_INTERNAL_TABLE_ENTRY(PACKAGE_NAME : in STRING) is
  --| 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;

----------------------------------------------------------------------
end BUFFER_FILE_PACKAGE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--siutils.spc
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with PARSERDECLARATIONS;
with LISTS;
with USER_INTERFACE; use USER_INTERFACE;
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;

  package COMMENT_LISTS is
    new LISTS(PD.PARSESTACKELEMENT);

  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 ADD_BREAKPOINT_TYPE is (EVERY_STATEMENT, DECISION_POINT, ALWAYS,
    AMBIGUOUS);

  type RESOLVE_BREAKPOINT_TYPE is (SIMPLE_STATEMENT, LOOP_NO_IDENTIFIER,
    LOOP_WITH_IDENTIFIER, BLOCK_NO_IDENTIFIER, BLOCK_WITH_IDENTIFIER);
  type SCOPE_TYPE is (PACKAGE_SPECIFICATION, PACKAGE_BODY, TASK_BODY,
    SUBPROGRAM_BODY, A_BLOCK);

  type IDENTIFIER_MODE is (READ_ONLY, WRITE_ONLY, READ_WRITE, NONE);

  type IDENTIFIER_LIST_TYPE is (OBJECT_LIST, RECORD_FIELD_LIST,
    DISCRIMINANT_LIST, PARAMETER_LIST, RENAMING_LIST, EXCEPTION_LIST,
    GENERIC_OBJECT_LIST);

  type TYPE_CLASS is (DERIVED_TYPE, ENUMERATION_TYPE, INTEGER_TYPE, FLOAT_TYPE,
    FIXED_TYPE, ACCESS_TYPE, ARRAY_TYPE, RECORD_TYPE, LIMITED_PRIVATE_TYPE,
    PRIVATE_TYPE, TASK_TYPE);

  DO_TYPE_TRACING     : BOOLEAN;
  CURRENT_TRACE_MODE : TRACE_MODES;


  -----------------------------------------------------------------
  --| 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
  --| Pretty_Printer_Declarations 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

  --| Paginated Output is used to put a space in 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 START_BUFFERING_COLON_DECLARATIONS;
  --| Starts buffering colon declarations

  --| Effects

  --| Starts buffering the colon declarations or other constructs
  --| containing colons.

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

  procedure PRINT_COLON_DECLARATIONS_BUFFER;
  --| Writes the colon declarations buffer to the output file

  --| Effects

  --| Writes the contents of the buffer to the output file,
  --| after lining up the colons.

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

  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
  --| PPD.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.

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

  procedure INSERT_IN_TOKEN;

  --| Effects

  --| Inserts the token "in" into the output.  Called when subprogram
  --| specification with default parameters is found in the source.

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

  procedure SWITCH_COMMENT_CONTEXT;

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


  -----------------------------------------------------------------
  --| 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.  If Type_Tracing is on, then 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;

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

  procedure END_BLOCK_SEQUENCE_OF_STATEMENTS;

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

  procedure ADD_BREAKPOINT(TYPE_OF_BREAKPOINT : in ADD_BREAKPOINT_TYPE);

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

  procedure RESOLVE_BREAKPOINT(RESOLVE_TYPE : in RESOLVE_BREAKPOINT_TYPE);

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

  procedure START_LOOP;

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

  procedure START_DELAY_EXPRESSION;

  --| Effects

  --| Start the "Starting_Delay" function call to inform the
  --| profiler tool that the currently executing unit is
  --| about to delay for the given amount of time.

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

  procedure END_DELAY_EXPRESSION;

  --| Effects

  --| End the "Starting_Delay" function call.

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

  procedure ADD_PACKAGE_BODY_BEGIN;

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

  procedure START_EXCEPTION_BRANCH;

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

  procedure END_EXCEPTION_SEQUENCE_OF_STATEMENTS;

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

  procedure ADD_OTHERS_HANDLER;

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

  procedure END_BLOCK_STATEMENT;

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

  procedure ADD_EXCEPTION_HANDLER;

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

  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, and
  --| Type_Tracing is on, then initialize the buffer files
  --| which will containg 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, and Type_Tracing is on, 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.  If Type_Tracing is on, and then 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

  --| If Type_Tracing is on, then 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

  --| If Type_Tracing is on, then 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 START_TRACE_PROCEDURE(TYPE_KIND : in TYPE_CLASS);

  --| Effects

  --| If type tracing is on, then start generating a
  --| procedure to trace the current type declaration.

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

  procedure END_TYPE_DECLARATION;

  --| Effects

  --| Finish the procedure to trace the current type
  --| declaration, and add the corresponding procedure
  --| declaration to the instrumented source.

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

  procedure START_ANONYMOUS_ARRAY_DEFINITION;

  --| Effects

  --| These procedures are currently not implemented, and just
  --| discard the current identifier list.  It is intended that
  --| they will create a named type so a tracing procedure
  --| can be generated to trace the anonymous variables.

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

  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

  --| If Type_Tracing is on, then initialize the private
  --| type tracing files.


end SOURCE_INSTRUMENTER_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--siutils.bdy
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


-- packages needed by parsing
with PARSETABLES;
with GRAMMAR_CONSTANTS; use GRAMMAR_CONSTANTS;  -- to get visibility on =
with PARSERDECLARATIONS; use PARSERDECLARATIONS;

-- 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 TYPE_DEFINITIONS; use TYPE_DEFINITIONS;

-- packages needed for source instrumenter output --
with CHANGE_TEXT;
with SIMPLE_PAGINATED_OUTPUT;
with BUFFER_FILE_PACKAGE; use BUFFER_FILE_PACKAGE;
with TEXT_IO;

package body SOURCE_INSTRUMENTER_UTILITIES is
--| Utilities for the Source Instrumenter

  package SID renames SOURCE_INSTRUMENTER_DECLARATIONS;
  package CT renames CHANGE_TEXT;
  package PO renames SIMPLE_PAGINATED_OUTPUT;
  package PT renames PARSETABLES;
  package BFP renames BUFFER_FILE_PACKAGE;

  package TOKEN_STACK_PKG is
    new STACK_PKG(PD.PARSESTACKELEMENT);

  -----------------------------------------------------------------
  -- 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        : SID.COLUMN_RANGE := SID.COLUMN_RANGE'FIRST;
  --| Current column in output file

  CURRENT_INDENT        : SID.INDENTATION_RANGE := 0;
  --| Current indentation in output file

  TEMPORARY_INDENT      : SID.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       : SID.INDENTATION_RANGE := 0;
  --| Saved indent for returning to after parameters or discriminants are
  --| lined up.

  CURRENT_CHANGE_COLUMN : SID.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));

  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.

  type CONTEXT is (DECLARATIVE_PART, BODY_PART);
  COMMENT_CONTEXT : CONTEXT := DECLARATIVE_PART;
  --| Current Context for formatting comments

  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;

  REQUESTS : REQUEST_DESCRIPTOR;

  type TOKEN_DESCRIPTOR is
    record
      TOKEN                 : PD.PARSESTACKELEMENT;
      COMMENTS              : COMMENT_LISTS.LIST;
      REQUESTS              : REQUEST_DESCRIPTOR;
      CURRENT_CHANGE_COLUMN : SID.INDENTATION_RANGE := 0;
      -- for lining up parameter/discriminant lists
      LEFT_SIDE_LENGTH      : NATURAL := 0;  -- for lining up colons
    end record;

  TOKEN_TO_BUFFER        : TOKEN_DESCRIPTOR;

  CURRENT_BUFFERED_TOKEN : TOKEN_DESCRIPTOR;

  package TOKEN_LISTS is
    new LISTS(TOKEN_DESCRIPTOR);

  TOKEN_BUFFER                 : TOKEN_LISTS.LIST;
  --|  The buffer used when buffering colon declarations.

  BUFFERED_TOKENS              : TOKEN_LISTS.LIST;
  --|  The buffer used when buffering ambiguous statements.  For example,
  --|  when processing a procedure call we don't know if it needs a
  --|  breakpont until the whole statement is processed.

  BUFFERING_COLON_DECLARATIONS : BOOLEAN := FALSE;
  --| Whether or not to save declarations in order to line up the colons.

  BUFFERING_TOKENS             : BOOLEAN := TRUE;
  --|  Whether not we are currently buffering an ambiguous statement.

  CURRENT_BLOCK_NUMBER         : NATURAL := 0;
  --|  The number of current block(within the compilation unit).  Used to
  --|  assign an unique ID for unnamed blocks.

  CURRENT_NESTING_LEVEL        : NATURAL := 0;
  --|  The current level of nesting.

  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_TRACE_LEVEL          : TRACE_LEVEL := DECISION_POINT;
  --|  The statement trace level of the current unit.

  type SCOPE_DESCRIPTOR is
    record
      SCOPE_NAME        : ADA_NAME;
      QUALIFIED_NAME    : ADA_NAME;
      TYPE_OF_SCOPE     : SCOPE_TYPE;
      PUTVAR_NAME       : ADA_NAME;
      IN_PRIVATE_PART   : BOOLEAN := FALSE;
      SCOPE_TRACE_LEVEL : TRACE_LEVEL := DECISION_POINT;
    end record;
  --|  Maintains the information about a unit.

  package SCOPE_STACK_PKG is
    new STACK_PKG(SCOPE_DESCRIPTOR);

  SCOPE_STACK                  : SCOPE_STACK_PKG.STACK;
  --|  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.

  CURRENT_SCOPE                : SCOPE_DESCRIPTOR;
  --|  Contains the information about the current unit.

  CURRENT_OUTER_SCOPE          : SCOPE_DESCRIPTOR;
  --|  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.

  -----------------------------------------------------------------
  -- 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.

  SAVING_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 Saving_Expanded_Name is
  --| again set to false.

  GENERATE_TRACEVAR_SPEC       : BOOLEAN := FALSE;
  --| This is set to true when the instrumenter is creating a
  --| a procedure body for tracing a type declaration.  The
  --| corresponding procedure declaration must be added to the
  --| instrumented source.

  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.

  TRACEVAR_HEADER              : array(1 .. 4) of STRING_TYPE :=
    ((CREATE("Procedure Source_Instrumenter_Added_Tracevar")),
     (CREATE("  (Current_Unit: Program_Unit_Unique_Identifier;")),
     (CREATE("   Variable_Name: String;")),
     (CREATE("   Current_Value:")));  -- the rest of this depends on
                                      -- the current type definition
  --| This is the invariant part of the tracevar procedure
  --| declaration.
  --| Note: It is declared as an array of variable length strings
  --| rather than as one string with imbedded "ascii.cr" characters
  --| so that a "put_line" may be done on each array element,
  --| without regard to whether some systems need a line feed
  --| character before or after the carriage return.

  type NAME_RECORD is
  --| for each identifier in an identifier list, save its name
  --| and its mode (Read_Only, Write_Only, Both, or None)
    record
      OBJECT_NAME : ADA_NAME;
      OBJECT_MODE : IDENTIFIER_MODE;
    end record;

  package NAME_LISTS is
    new LISTS(NAME_RECORD);
    --| A list of name records for collecting identifier lists.

  package LIST_STACK_PKG is
    new STACK_PKG(NAME_LISTS.LIST);
    --| A stack of lists of Name_Records.

  VISIBLE_LIST_STACK : LIST_STACK_PKG.STACK;
  --| The list of visible variables for the current scope
  --| is stacked when a nested scope is entered.

  package STRING_STACK_PKG is
    new STACK_PKG(STRING_LIST);
    --| A stack of lists of String_Type.

  VARS_TO_TRACE_STACK: STRING_STACK_PKG.STACK;
  --| The list of variables to be traced in this 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.

  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)

  CURRENT_LIST       : NAME_LISTS.LIST;
  --| A temporary list to collect identifiers until the type
  --| of identifier list is known.

  VARS_TO_TRACE     : STRING_lIST;
  --| A list of the variables the user wants to have traced
  --| in the current scope.

  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.

  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.

  -----------------------------------------------------------------
  -- Local subprogram specifications for pretty printing
  -----------------------------------------------------------------

  procedure INITIALIZE_DESCRIPTOR(DESCRIPTOR : in out TOKEN_DESCRIPTOR);
  --| Initializes an object of type Token_Descriptor

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

  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

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

  function TOKEN_TEXT(TOKEN : in PD.PARSESTACKELEMENT) return STRING;
  --| Returns the canonical "text" of a token (in extended character set)

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

  function SPACED_TOKEN(CURRENT, PREVIOUS : in PD.PARSESTACKELEMENT)
    return STRING;
  --| Returns the text of a token with appropriate spaces around it, in
  --| accordance with SID.Spacing_Table and any extra spaces that are
  --| necessary.

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

  procedure PRINT_NEW_LINE;
  --| Puts a newline in the output and updates column information.

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

  procedure PROCESS_INCREASE_REQUESTS;
  --| Increases the indentation unless SID.RH_Margin is exceeded,
  --| in which case Unperformed_Indents is incremented.

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

  procedure PROCESS_DECREASE_REQUESTS;
  --| Decreases the indentation unless there were unperformed indents,
  --| in which case Unperformed_Indents is decremented.

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

  procedure PROCESS_CHANGE_REQUESTS;
  --| Changes the indentation to the current column

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

  procedure PROCESS_RESUME_REQUESTS;
  --| Resumes the indentation level before the call to
  --| Process_Change_Requests.

  -----------------------------------------------------------------
  -- Local subprogram specifications for source instrumenting
  -----------------------------------------------------------------

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

  procedure PRINT_BUFFERED_TOKENS;
  --|  Prints any tokens that have been buffered due to an ambiguous
  --|  statement.

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

  function MATCH_NAMES(USER_NAME, SI_NAME : in STRING) return BOOLEAN;
  --| Compares the fully qualified name of the variable the user
  --| wants to trace with the fully qualified variable name found
  --| in the program.  The user requested variable name may have
  --| selected or indexed components.

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

  procedure CHECK_LISTS;
  --| In each scope, compare the list of variables the user requested
  --| to trace with the list of variables found in the program.  If
  --| the variable exists, trace it using the name the user gave to
  --| allow selected and indexed components.

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

  function GET_UNIT_NAME(TYPE_OF_SCOPE : in SCOPE_TYPE) return STRING;
  --|  Returns a string that contains the specification of the current
  --|  unit.  This string is printed to inform the user of the
  --|  current unit being processed.

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

  procedure WRITE_BODY_LINE(LINE : in STRING);
  --| The line of text is part of a procedure body being generated
  --| for type tracing.  It must be saved in one of the buffer files
  --| until the end of the current scope's "later_declarative_part".

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

  procedure WRITE_SPEC_LINE(LINE : in STRING);
  --| The line of text is a procedure declaration or part of a
  --| package specification being generated for type tracing.
  --| Write it to either the instrumented source file or one
  --| of the package specification tracing files.

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

  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 GENERATE_TRACEVAR_CALL(VARNAME : in STRING);
  --| Add the code to the appropriate buffer to call the tracing
  --| procedure for the current variable.  This procedure is called
  --| by Generate_Putvars for each local variable.

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

  procedure GENERATE_PUTVARS;
  --| Generate the body of the procedure which traces all of
  --| the variables visible in the current scope.

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

  procedure DISCARD_LIST(WHICH_LIST : in out NAME_LISTS.LIST);
  --| A general purpose procedure which flushes the string_type
  --| field of a name_record 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 SET_SCOPE_RECORDS(TYPE_OF_SCOPE : in SCOPE_TYPE);
  --| This is called by Increment_Scope to set the various fields
  --| of the Current_Scope and Current_Outer_Scope variables
  --| according to the current type of scope.

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

  function ASK_USER_ABOUT_PACKAGE return BOOLEAN;
  --| Ask the user if he really wants to recompile a library unit
  --| that is a package specification. Doing so will require
  --| recompilation of the corresponding body, which only the user
  --| knows if he has access to.
  --| 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;
    SCOPE_STACK := SCOPE_STACK_PKG.CREATE;
    BEGINNING_OF_LINE := TRUE;
    CURRENT_COLUMN := 1;
    CURRENT_INDENT := 0;
    TEMPORARY_INDENT := 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_COLON_DECLARATIONS := FALSE;
    BUFFERING_TOKENS := TRUE;
    BUFFERED_TOKENS := TOKEN_LISTS.CREATE;
    INITIALIZE_DESCRIPTOR(CURRENT_BUFFERED_TOKEN);
    INITIALIZE_DESCRIPTOR(TOKEN_TO_BUFFER);

    if CURRENT_TRACE_MODE /= MIXED then
      CURRENT_TRACE_LEVEL := CURRENT_TRACE_MODE;
    end if;

    if DO_TYPE_TRACING then
      BFP.INITIALIZE;
    end if;

    OUTPUT_SOURCE := TRUE;

    WITH_LIST     := STRING_LISTS.CREATE;
    PACKAGE_LIST  := STRING_LISTS.CREATE;
    VARS_TO_TRACE := STRING_LISTS.CREATE;
    PARAM_LIST    := NAME_LISTS.CREATE;
    VISIBLE_LIST  := NAME_LISTS.CREATE;
    CURRENT_LIST  := NAME_LISTS.CREATE;

    VISIBLE_LIST_STACK  := LIST_STACK_PKG.CREATE;
    VARS_TO_TRACE_STACK := STRING_STACK_PKG.CREATE;
    PACKAGE_LIST_STACK  := STRING_STACK_PKG.CREATE;
  end INITIALIZE;

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

  procedure PUT(NEXT_TOKEN : in out PD.PARSESTACKELEMENT) is
    TEMP_TOKEN : TOKEN_DESCRIPTOR;
  begin

    -- if the Token_To_Buffer belonged in the colon Token_Buffer, attach
    -- it there.  (Values have been assigned to Token_To_Buffer but it
    -- has not been attached to the buffer)
    if BUFFERING_COLON_DECLARATIONS and
       (TOKEN_TO_BUFFER.TOKEN.GRAM_SYM_VAL /= PT.COMMENT_TOKENVALUE) then
      TOKEN_LISTS.ATTACH(TOKEN_BUFFER, TOKEN_TO_BUFFER);
      INITIALIZE_DESCRIPTOR(TOKEN_TO_BUFFER);
    end if;

    if BUFFERING_TOKENS and
       (CURRENT_BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL /= PT.COMMENT_TOKENVALUE) and
       not BUFFERING_COLON_DECLARATIONS then
      CURRENT_BUFFERED_TOKEN.REQUESTS := REQUESTS;
      REQUESTS := (0, 0, 0, 0, 0);
      TOKEN_LISTS.ATTACH(BUFFERED_TOKENS, CURRENT_BUFFERED_TOKEN);
      INITIALIZE_DESCRIPTOR(CURRENT_BUFFERED_TOKEN);
    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 SAVING_EXPANDED_NAME then
      if IS_EMPTY(EXPANDED_NAME) then
        EXPANDED_NAME := CREATE(TOKEN_TEXT(NEXT_TOKEN));
      else
        EXPANDED_NAME := EXPANDED_NAME & TOKEN_TEXT(NEXT_TOKEN);
      end if;
    end if;

    if BUFFERING_COLON_DECLARATIONS then
      TOKEN_TO_BUFFER.TOKEN := NEXT_TOKEN;
      TOKEN_TO_BUFFER.COMMENTS := COMMENT_BUFFER;
    elsif BUFFERING_TOKENS then
      INITIALIZE_DESCRIPTOR(CURRENT_BUFFERED_TOKEN);
      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_COLON_DECLARATIONS then
      TOKEN_LISTS.ATTACH(TOKEN_BUFFER, TOKEN_TO_BUFFER);
      INITIALIZE_DESCRIPTOR(TOKEN_TO_BUFFER);
      TOKEN_TO_BUFFER.TOKEN := EMPTY_TOKEN;
      TOKEN_TO_BUFFER.TOKEN.LEXED_TOKEN.TEXT :=
         new STRING'(BLANK(1 .. SPACES));
    elsif BUFFERING_TOKENS then
      if CURRENT_BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL /= PT.COMMENT_TOKENVALUE
        then
        TOKEN_LISTS.ATTACH(BUFFERED_TOKENS, CURRENT_BUFFERED_TOKEN);
        INITIALIZE_DESCRIPTOR(CURRENT_BUFFERED_TOKEN);
        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 > SID.PAGE_WIDTH then
        PRINT_NEW_LINE;
        TEMPORARY_INDENT := SID.INDENTATION_LEVEL;
        CURRENT_COLUMN := CURRENT_INDENT + TEMPORARY_INDENT + 1;
      end if;

      if BEGINNING_OF_LINE then
        PO.SPACE(SID.LISTING_FILE, CURRENT_COLUMN - 1);
        if OUTPUT_SOURCE then
          PO.SPACE(SID.INSTRUMENTED_FILE, CURRENT_COLUMN - 1);
        end if;
      end if;
      PO.SPACE(SID.LISTING_FILE, SPACES);
      if OUTPUT_SOURCE then
        PO.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);
    if not COMMENT_LISTS.ISEMPTY(BUFFER) and (COMMENT_CONTEXT = BODY_PART) then

      -- process all "requests" dealing with indentation before printing
      -- comments if comments are being formatted and the context is the
      -- body part.  Process these first, so that Print_New_Line takes
      -- indentation into account.

      PROCESS_INCREASE_REQUESTS;
      PROCESS_DECREASE_REQUESTS;
      PROCESS_CHANGE_REQUESTS;
      PROCESS_RESUME_REQUESTS;
      if REQUESTS.NEW_LINES > 0 then
        PRINT_NEW_LINE;
        REQUESTS.NEW_LINES := 0;
      end if;

      -- print extra new line if not at the beginning of the line,
      -- to get to the beginning of a new line
      if not BEGINNING_OF_LINE then
        PRINT_NEW_LINE;
      end if;
      PRINT_NEW_LINE;
    end if;
    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;
      if (COMMENT_CONTEXT = DECLARATIVE_PART) or
         (PREVIOUS_TOKEN.GRAM_SYM_VAL = PT.COMMENT_TOKENVALUE) then
        for I in 1 .. NEW_LINES loop
          PRINT_NEW_LINE;
        end loop;
      end if;

      -- try to indent to level of source
      if ((SID.PAGE_WIDTH - CURRENT_COLUMN) >= TOKEN_TEXT(COMMENT_TOKEN)'LENGTH)
        then
        if BEGINNING_OF_LINE then
          PO.SPACE(SID.LISTING_FILE,
                   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
          PO.SKIP_LINE(SID.LISTING_FILE);
          PO.SPACE(SID.LISTING_FILE,
                   COMMENT_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN - 1 +
                   CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING'LENGTH);
        else
          PO.SPACE(SID.LISTING_FILE,
                   COMMENT_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN -
                   CURRENT_COLUMN +
                   CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING'LENGTH);
        end if;
      end if;
      PO.PUT(SID.LISTING_FILE, TOKEN_TEXT(COMMENT_TOKEN));

      FREE(COMMENT_TOKEN.LEXED_TOKEN.TEXT);
      PREVIOUS_TOKEN := COMMENT_TOKEN;
    end loop;

    -- process any requests not handled earlier
    PROCESS_INCREASE_REQUESTS;
    PROCESS_DECREASE_REQUESTS;
    PROCESS_CHANGE_REQUESTS;
    PROCESS_RESUME_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
    if BUFFERING_COLON_DECLARATIONS then
      TOKEN_TO_BUFFER.REQUESTS.NEW_LINES :=
         TOKEN_TO_BUFFER.REQUESTS.NEW_LINES + 1;
    else
      REQUESTS.NEW_LINES := REQUESTS.NEW_LINES + 1;
    end if;
  end NEW_LINE;

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

  procedure START_BUFFERING_COLON_DECLARATIONS is
  begin

    -- create new list if not already buffering tokens
    if not BUFFERING_COLON_DECLARATIONS then
      BUFFERING_COLON_DECLARATIONS := TRUE;
      TOKEN_LISTS.DESTROY(TOKEN_BUFFER);
      TOKEN_BUFFER := TOKEN_LISTS.CREATE;
    end if;
  end START_BUFFERING_COLON_DECLARATIONS;

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

  procedure PRINT_COLON_DECLARATIONS_BUFFER is
    ITERATOR       : TOKEN_LISTS.LISTITER;
    BUFFERED_TOKEN : TOKEN_DESCRIPTOR;
    SECOND_BUFFER  : TOKEN_LISTS.LIST := TOKEN_LISTS.CREATE;
    CURRENT_LENGTH : NATURAL := 0;
    MAX_LENGTH     : NATURAL := 0;
  begin
    if CURRENT_NESTING_LEVEL > 0 then

      -- attach last token to list.  Token would usually be attached
      -- in the call to put for the token following Token_To_Buffer.
      TOKEN_LISTS.ATTACH(TOKEN_BUFFER, TOKEN_TO_BUFFER);

      BUFFERING_COLON_DECLARATIONS := FALSE;

      -- get maximum identifier list length, updating tokens with length
      -- information, and attach each token to Second_Buffer with this
      -- new information.
      ITERATOR := TOKEN_LISTS.MAKELISTITER(TOKEN_BUFFER);
      while TOKEN_LISTS.MORE(ITERATOR) loop
        TOKEN_LISTS.NEXT(ITERATOR, BUFFERED_TOKEN);

        -- This can't be a case statement because of non-static bound
        -- of type for PT.xxxTokenValue
        if (BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL = PT.IDENTIFIERTOKENVALUE) or
           (BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL = PT.COMMA_TOKENVALUE) then
          if not COMMENT_LISTS.ISEMPTY(BUFFERED_TOKEN.COMMENTS) then
            if CURRENT_LENGTH > MAX_LENGTH then
              MAX_LENGTH := CURRENT_LENGTH;
            end if;
            CURRENT_LENGTH := 0;
          end if;
          CURRENT_LENGTH := CURRENT_LENGTH +
            SPACED_TOKEN(BUFFERED_TOKEN.TOKEN, PREVIOUS_TOKEN)'LENGTH;
          TOKEN_LISTS.ATTACH(SECOND_BUFFER, BUFFERED_TOKEN);
        elsif (BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL = PT.COLON_TOKENVALUE) or
              (BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL = PT.NULLTOKENVALUE) then
          if CURRENT_LENGTH > MAX_LENGTH then
            MAX_LENGTH := CURRENT_LENGTH;
          end if;
          if COMMENT_LISTS.ISEMPTY(BUFFERED_TOKEN.COMMENTS) then
            BUFFERED_TOKEN.LEFT_SIDE_LENGTH := CURRENT_LENGTH;
          end if;
          CURRENT_LENGTH := 0;
          TOKEN_LISTS.ATTACH(SECOND_BUFFER, BUFFERED_TOKEN);

          -- skip to semicolon
          while TOKEN_LISTS.MORE(ITERATOR) and
             BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL /= PT.SEMICOLON_TOKENVALUE loop
            TOKEN_LISTS.NEXT(ITERATOR, BUFFERED_TOKEN);
            TOKEN_LISTS.ATTACH(SECOND_BUFFER, BUFFERED_TOKEN);
          end loop;
        elsif BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL in PT.GRAMMARSYMBOLRANGE then
          TOKEN_LISTS.ATTACH(SECOND_BUFFER, BUFFERED_TOKEN);
        end if;
      end loop;

      -- Print out Second_Buffer
      ITERATOR := TOKEN_LISTS.MAKELISTITER(SECOND_BUFFER);
      while TOKEN_LISTS.MORE(ITERATOR) loop
        TOKEN_LISTS.NEXT(ITERATOR, BUFFERED_TOKEN);
        PRINT_COMMENTS(BUFFERED_TOKEN.COMMENTS);
        if (BUFFERED_TOKEN.TOKEN.GRAM_SYM_VAL = PT.COLON_TOKENVALUE) then
          PUT_SPACE(MAX_LENGTH - BUFFERED_TOKEN.LEFT_SIDE_LENGTH);
        end if;
        PRINT_TOKEN(BUFFERED_TOKEN.TOKEN);
        REQUESTS := BUFFERED_TOKEN.REQUESTS;
        CURRENT_CHANGE_COLUMN := BUFFERED_TOKEN.CURRENT_CHANGE_COLUMN;
      end loop;
      TOKEN_LISTS.DESTROY(SECOND_BUFFER);

      INITIALIZE_DESCRIPTOR(TOKEN_TO_BUFFER);
      BUFFERING_COLON_DECLARATIONS := FALSE;
    end if;
  end PRINT_COLON_DECLARATIONS_BUFFER;

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

  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
    if BUFFERING_COLON_DECLARATIONS then
      TOKEN_TO_BUFFER.REQUESTS.INCREASES :=
         TOKEN_TO_BUFFER.REQUESTS.INCREASES + 1;
    else
      REQUESTS.INCREASES := REQUESTS.INCREASES + 1;
    end if;
  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
    if BUFFERING_COLON_DECLARATIONS then
      TOKEN_TO_BUFFER.REQUESTS.DECREASES :=
         TOKEN_TO_BUFFER.REQUESTS.DECREASES + 1;
    else
      REQUESTS.DECREASES := REQUESTS.DECREASES + 1;
    end if;
  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
    if BUFFERING_COLON_DECLARATIONS then
      TOKEN_TO_BUFFER.REQUESTS.CHANGES := TOKEN_TO_BUFFER.REQUESTS.CHANGES + 1;
      TOKEN_TO_BUFFER.CURRENT_CHANGE_COLUMN := CURRENT_COLUMN;
    elsif BUFFERING_TOKENS then
      CURRENT_BUFFERED_TOKEN.REQUESTS.CHANGES :=
        CURRENT_BUFFERED_TOKEN.REQUESTS.CHANGES + 1;
      CURRENT_BUFFERED_TOKEN.CURRENT_CHANGE_COLUMN :=
        CURRENT_BUFFERED_TOKEN.TOKEN.LEXED_TOKEN.SRCPOS_COLUMN;
    else
      REQUESTS.CHANGES := REQUESTS.CHANGES + 1;
      CURRENT_CHANGE_COLUMN := CURRENT_COLUMN;
    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
    if BUFFERING_COLON_DECLARATIONS then
      TOKEN_TO_BUFFER.REQUESTS.RESUMES := TOKEN_TO_BUFFER.REQUESTS.RESUMES + 1;
    else
      REQUESTS.RESUMES := REQUESTS.RESUMES + 1;
    end if;
  end RESUME_NORMAL_INDENTATION;

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

  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);
      PUT(POPPED_TOKEN);
    end if;

    -- In case this was a subprogram declaration, then discard the
    -- parameter list that was built.
    TOKEN_LISTS.DESTROY(TOKEN_BUFFER);
    DISCARD_LIST(PARAM_LIST);
    SAVING_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(SAVED_TOKEN.LEXED_TOKEN.TEXT.all);
    TOKEN_STACK_PKG.PUSH(IDENTIFIER_STACK, SAVED_TOKEN);
    TOKEN_LISTS.DESTROY(TOKEN_BUFFER);
  end PUSH_IDENTIFIER;

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

  procedure PUSH_EMPTY_TOKEN is
  begin
    TOKEN_STACK_PKG.PUSH(IDENTIFIER_STACK, EMPTY_TOKEN);
  end PUSH_EMPTY_TOKEN;

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

  procedure INSERT_IN_TOKEN is
    IN_TOKEN : PD.PARSESTACKELEMENT :=
      (GRAM_SYM_VAL => PT.INTOKENVALUE,
       LEXED_TOKEN  => (TEXT => new STRING'("in"),
                        SRCPOS_LINE => 0,
                        SRCPOS_COLUMN => 0));
    --| "In" token with source line and column positions set to 0 so that
    --| new line and column positions may be assigned the token when it
    --| is output.
  begin
    PUT(IN_TOKEN);
  end INSERT_IN_TOKEN;

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

  procedure SWITCH_COMMENT_CONTEXT is
  begin
    if COMMENT_CONTEXT = DECLARATIVE_PART then
      COMMENT_CONTEXT := BODY_PART;
    else
      COMMENT_CONTEXT := DECLARATIVE_PART;
    end if;
  end SWITCH_COMMENT_CONTEXT;


  -----------------------------------------------------------------
  -- Local subprogram bodies for pretty printing
  -----------------------------------------------------------------

  procedure INITIALIZE_DESCRIPTOR(DESCRIPTOR : in out TOKEN_DESCRIPTOR) is
  begin

    DESCRIPTOR.TOKEN := EMPTY_TOKEN;

    -- Change grammar symbol to comment token value which it
    -- can never be (since comments are buffered separately)
    DESCRIPTOR.TOKEN.GRAM_SYM_VAL := PT.COMMENT_TOKENVALUE;
    DESCRIPTOR.REQUESTS := (0, 0, 0, 0, 0);
    DESCRIPTOR.CURRENT_CHANGE_COLUMN := 0;
    DESCRIPTOR.LEFT_SIDE_LENGTH := 0;
  end INITIALIZE_DESCRIPTOR;

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

  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;

    if (COMMENT_CONTEXT = DECLARATIVE_PART) or
        ((COMMENT_CONTEXT = BODY_PART) and
         (PREVIOUS_TOKEN.GRAM_SYM_VAL /= PT.COMMENT_TOKENVALUE)) then

      -- 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;

      -- 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 and (BLANK_LINES > 0) then
        PRINT_NEW_LINE;
      end if;
      PO.SKIP_LINE(SID.LISTING_FILE, BLANK_LINES);
      if OUTPUT_SOURCE then
        PO.SKIP_LINE(SID.INSTRUMENTED_FILE, BLANK_LINES);
      end if;
    end if;

    TOKEN_LENGTH := SPACED_TOKEN(NEXT_TOKEN, PREVIOUS_TOKEN)'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) > SID.PAGE_WIDTH then
      PRINT_NEW_LINE;
      TEMPORARY_INDENT := SID.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
      PO.PUT(SID.LISTING_FILE,
             CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING);
      CREATE_BREAKPOINT.BREAKPOINT_NUMBER_FOR_PRINTING := "      ";
      PO.SPACE(SID.LISTING_FILE, CURRENT_COLUMN - 1);
      if OUTPUT_SOURCE then
        PO.SPACE(SID.INSTRUMENTED_FILE, CURRENT_COLUMN - 1);
      end if;
    end if;

    -- Output token
    PO.PUT(SID.LISTING_FILE, SPACED_TOKEN(NEXT_TOKEN, PREVIOUS_TOKEN));
    if OUTPUT_SOURCE then
      PO.PUT(SID.INSTRUMENTED_FILE, SPACED_TOKEN(NEXT_TOKEN, PREVIOUS_TOKEN));
    end if;

    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 > SID.PAGE_WIDTH - CURRENT_INDENT then
      PRINT_NEW_LINE;
      TEMPORARY_INDENT := SID.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;

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

  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 SID.DELIMITERS = SID.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 CT.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 CT.CHANGE_CASE(TOKEN.LEXED_TOKEN.TEXT, CT.LOWERCASE);
    elsif TOKEN.GRAM_SYM_VAL = PT.IDENTIFIERTOKENVALUE then
      return CT.CHANGE_CASE(TOKEN.LEXED_TOKEN.TEXT, CT.UPPERCASE);
    elsif (TOKEN.GRAM_SYM_VAL = PT.NUMERICTOKENVALUE) and
          (SID.DELIMITERS = SID.BASIC) then
      return CT.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) 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;

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

  procedure PRINT_NEW_LINE is
  begin
    TEMPORARY_INDENT := 0;
    CURRENT_COLUMN := CURRENT_INDENT + 1;
    if OUTPUT_SOURCE then
      PO.SKIP_LINE(SID.INSTRUMENTED_FILE);
    end if;
    PO.SKIP_LINE(SID.LISTING_FILE);
    BEGINNING_OF_LINE := TRUE;
  end PRINT_NEW_LINE;

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

  procedure PROCESS_INCREASE_REQUESTS is
  begin
    for I in 1 .. REQUESTS.INCREASES loop
      if CURRENT_INDENT + SID.INDENTATION_LEVEL < SID.RH_MARGIN then
        CURRENT_INDENT := CURRENT_INDENT + SID.INDENTATION_LEVEL;
      else
        UNPERFORMED_INDENTS := UNPERFORMED_INDENTS + 1;
      end if;
    end loop;
    REQUESTS.INCREASES := 0;
  end PROCESS_INCREASE_REQUESTS;

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

  procedure PROCESS_DECREASE_REQUESTS is
  begin
    for I in 1 .. REQUESTS.DECREASES loop
      if UNPERFORMED_INDENTS = 0 then
        CURRENT_INDENT := CURRENT_INDENT - SID.INDENTATION_LEVEL;
      else
        UNPERFORMED_INDENTS := UNPERFORMED_INDENTS - 1;
      end if;
    end loop;
    REQUESTS.DECREASES := 0;
  end PROCESS_DECREASE_REQUESTS;

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

  procedure PROCESS_CHANGE_REQUESTS is
  begin
    if REQUESTS.CHANGES > 0 then
      PREVIOUS_INDENT := CURRENT_INDENT;
      if CURRENT_CHANGE_COLUMN < SID.RH_MARGIN then
        CURRENT_INDENT := CURRENT_CHANGE_COLUMN - 1;
      end if;

      -- 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;
  end PROCESS_CHANGE_REQUESTS;

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

  procedure PROCESS_RESUME_REQUESTS is
  begin
    if REQUESTS.RESUMES > 0 then
      CURRENT_INDENT := PREVIOUS_INDENT;
    end if;
    REQUESTS.RESUMES := 0;
  end PROCESS_RESUME_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
    SAVING_EXPANDED_NAME := FALSE;
  end USE_PACKAGE_NAME;

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

  procedure WITH_LIBRARY_UNIT is

  --| Effects
  --|
  --| If the library unit is instrumented and type tracing is on,
  --| then add the name to the "with_list".  Its tracing package
  --| will have to be added to the context clause in the instrumented
  --| source.

    WITHED_PACKAGE : NAME_RECORD;
  begin
    if DO_TYPE_TRACING and then
       BFP.PACKAGE_FILES_EXIST(SAVED_TOKEN.LEXED_TOKEN.TEXT.all,
                               PUBLIC_FILES) then
      STRING_LISTS.ATTACH(WITH_LIST, 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);
    SAVING_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_Outer_Scope and turn off the
  --| "Saving_Expanded_Name" flag.

  begin
    SAVING_EXPANDED_NAME := FALSE;
    SEPARATE_UNIT := TRUE;
    CURRENT_OUTER_SCOPE :=
      (CREATE(SAVED_TOKEN.LEXED_TOKEN.TEXT.all),
       EXPANDED_NAME,
       A_BLOCK,
       CREATE(SAVED_TOKEN.LEXED_TOKEN.TEXT.all),
       FALSE,
       ENTRY_EXIT);
  end SAVE_SEPARATE_NAME;

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

  procedure SAVE_GENERIC_NAME is

  --| Effects
  --|
  --| The current expanded name is the generic unit name.  The
  --| instantiated name is in "Saved_Identifier".  Turn off the
  --| "Saving_Expanded_Name" flag.  Tracing generics is currently
  --| unimplemented.

  begin
    SAVING_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;
      SAVING_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
  --|  an 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;
      CREATE_BREAKPOINT.CREATE_BREAKPOINT(OTHER_BREAKPOINT,
                                          CURRENT_SCOPE.PUTVAR_NAME);
    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
      CREATE_BREAKPOINT.CREATE_BREAKPOINT(OTHER_BREAKPOINT,
                                          CURRENT_SCOPE.PUTVAR_NAME);
      CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
    end if;
  end END_BLOCK_SEQUENCE_OF_STATEMENTS;

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

  procedure END_BLOCK_STATEMENT is

  --|  Effects
  --|
  --|  We are exiting a scope, so if there is an outer scope then pop
  --|  the information about that scope so that it becomes the current
  --|  unit.

  begin
    SCOPE_STACK_PKG.POP(SCOPE_STACK, CURRENT_SCOPE);
    if not SCOPE_STACK_PKG.IS_EMPTY(SCOPE_STACK) then
      CURRENT_OUTER_SCOPE := SCOPE_STACK_PKG.TOP(SCOPE_STACK);
    else
      CURRENT_OUTER_SCOPE :=
         (CREATE(""),
          CREATE(""),
          A_BLOCK,
          CREATE(""),
          FALSE,
          ENTRY_EXIT);
    end if;
    CURRENT_SCOPE_QUALIFIED_NAME := CURRENT_SCOPE.QUALIFIED_NAME;
    CURRENT_NESTING_LEVEL := CURRENT_NESTING_LEVEL - 1;
  end END_BLOCK_STATEMENT;

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

  procedure ADD_BREAKPOINT(TYPE_OF_BREAKPOINT : in ADD_BREAKPOINT_TYPE) is

  --|  Effects
  --|
  --|  This procedure is called before every statement within a begin-end.
  --|  Based on the current trace_level and the type of statement, a
  --|  decision is made whether to output a breakpoint.  If we don't
  --|  know whether or not to output a breakpont yet, then start
  --|  buffering tokens until we know.

  begin
    case TYPE_OF_BREAKPOINT is

      when EVERY_STATEMENT =>

   -- current statement is a simple(non decision point) statement, so
   -- add a breakpoint only if trace level is every statement.

        if CURRENT_SCOPE.SCOPE_TRACE_LEVEL = ALL_STATEMENTS then
          CREATE_BREAKPOINT.CREATE_BREAKPOINT(OTHER_BREAKPOINT,
                                              CURRENT_SCOPE.PUTVAR_NAME);
        end if;
      when DECISION_POINT =>

   -- Current statement is a decision point.  Add a breakpoint if
   -- we are not tracing entry/exit

        if CURRENT_SCOPE.SCOPE_TRACE_LEVEL /= ENTRY_EXIT then
          CREATE_BREAKPOINT.CREATE_BREAKPOINT(OTHER_BREAKPOINT,
                                              CURRENT_SCOPE.PUTVAR_NAME);
        end if;
      when ALWAYS =>

   --  Current statement is a return statement.  Add a breakpoint and
   --  an exiting unit.

        CREATE_BREAKPOINT.CREATE_BREAKPOINT(OTHER_BREAKPOINT,
                                            CURRENT_SCOPE.PUTVAR_NAME);
        CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
      when AMBIGUOUS =>

   --  Type of Current statement is unknown, so if trace level is
   --  decision point start buffering tokens.  If trace level is
   --  every statement add a breakpoint.  If trace level is entry/exit
   --  then do nothing.

        case CURRENT_SCOPE.SCOPE_TRACE_LEVEL is
          when ALL_STATEMENTS =>
            CREATE_BREAKPOINT.CREATE_BREAKPOINT(OTHER_BREAKPOINT,
                                                CURRENT_SCOPE.PUTVAR_NAME);
          when DECISION_POINT =>
            BUFFERING_TOKENS := TRUE;

            --start buffer
            TOKEN_LISTS.DESTROY(BUFFERED_TOKENS);
            BUFFERED_TOKENS := TOKEN_LISTS.CREATE;
            PRINT_COMMENTS(COMMENT_BUFFER);
          when ENTRY_EXIT =>
            null;
        end case;
    end case;
  end ADD_BREAKPOINT;

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

  procedure RESOLVE_BREAKPOINT(RESOLVE_TYPE : in RESOLVE_BREAKPOINT_TYPE) is

  --|  Effects
  --|
  --|  The type of an ambiguous statement is now known.  If it was a decision
  --|  point then add a breakpoint. If it is a block statement, then
  --|  make the block the current scope.  If the block had no name then
  --|  make up a unique name for it.

    CURRENT_BLOCK_NUMBER_STRING : STRING_TYPE;
  begin
    if CURRENT_SCOPE.SCOPE_TRACE_LEVEL = DECISION_POINT then
      if (RESOLVE_TYPE = LOOP_NO_IDENTIFIER) or
         (RESOLVE_TYPE = LOOP_WITH_IDENTIFIER) then
        CREATE_BREAKPOINT.CREATE_BREAKPOINT(OTHER_BREAKPOINT,
                                            CURRENT_SCOPE.PUTVAR_NAME);
      end if;
      PRINT_BUFFERED_TOKENS;
    end if;

 -- The current statement is a block.  Add it to the scope stack.

    if (RESOLVE_TYPE = BLOCK_NO_IDENTIFIER) or
       (RESOLVE_TYPE = BLOCK_WITH_IDENTIFIER) then
      CURRENT_NESTING_LEVEL := CURRENT_NESTING_LEVEL + 1;
      SCOPE_STACK_PKG.PUSH(SCOPE_STACK, CURRENT_SCOPE);
      CURRENT_OUTER_SCOPE := CURRENT_SCOPE;

  -- The block does not have a name, so make one for it.

      if RESOLVE_TYPE = BLOCK_NO_IDENTIFIER then
        CURRENT_BLOCK_NUMBER := CURRENT_BLOCK_NUMBER + 1;
        CURRENT_BLOCK_NUMBER_STRING :=
          CREATE(INTEGER'IMAGE(CURRENT_BLOCK_NUMBER));
        CURRENT_BLOCK_NUMBER_STRING :=
          "_" & SUBSTR(CURRENT_BLOCK_NUMBER_STRING, 2,
                       LENGTH(CURRENT_BLOCK_NUMBER_STRING) - 1);
        CURRENT_SCOPE_SIMPLE_NAME :=
          CREATE(PREFIX & "BLOCK" & VALUE(CURRENT_BLOCK_NUMBER_STRING));
        CURRENT_SCOPE_QUALIFIED_NAME :=
          CURRENT_SCOPE_QUALIFIED_NAME & "." & CURRENT_SCOPE_SIMPLE_NAME;
        CURRENT_SCOPE :=
          (CURRENT_SCOPE_SIMPLE_NAME,
           CURRENT_SCOPE_QUALIFIED_NAME,
           A_BLOCK,
           CURRENT_OUTER_SCOPE.PUTVAR_NAME,
           FALSE,
           CURRENT_TRACE_LEVEL);
        if DO_TYPE_TRACING then
          IDENTIFIER_TOKEN.LEXED_TOKEN.TEXT :=
            new STRING'(PREFIX & "BLOCK" & VALUE(CURRENT_BLOCK_NUMBER_STRING));
          IDENTIFIER_TOKEN.LEXED_TOKEN.SRCPOS_LINE := 0;
          IDENTIFIER_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN := 0;
          TOKEN_STACK_PKG.PUSH(IDENTIFIER_STACK, IDENTIFIER_TOKEN);
          PUT(IDENTIFIER_TOKEN);
          COLON_TOKEN.LEXED_TOKEN.SRCPOS_LINE := 0;
          COLON_TOKEN.LEXED_TOKEN.SRCPOS_COLUMN := 0;
          PUT(COLON_TOKEN);
        else
          PUSH_EMPTY_TOKEN;
        end if;
      else   -- block with identifier
        CURRENT_SCOPE_QUALIFIED_NAME :=
          CURRENT_SCOPE_QUALIFIED_NAME & "." & CURRENT_SCOPE_SIMPLE_NAME;
        CURRENT_SCOPE :=
          (CURRENT_SCOPE_SIMPLE_NAME,
           CURRENT_SCOPE_QUALIFIED_NAME,
           A_BLOCK,
           CURRENT_OUTER_SCOPE.PUTVAR_NAME,
           FALSE,
           CURRENT_TRACE_LEVEL);
      end if;
    end if;
  end RESOLVE_BREAKPOINT;

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

  procedure START_LOOP is

  --|  Effects
  --|
  --|  If trace level is not entry/exit then add a breakpoint that
  --|  identifies this statement as a loop.

  begin
    if CURRENT_SCOPE.SCOPE_TRACE_LEVEL /= ENTRY_EXIT then
      CREATE_BREAKPOINT.CREATE_BREAKPOINT(LOOP_BREAKPOINT,
                                          CURRENT_SCOPE.PUTVAR_NAME);
    end if;
  end START_LOOP;

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

  procedure START_DELAY_EXPRESSION is

  --| Effects
  --|
  --| Convert the delay expresstion into a function call to
  --| "Starting_Delay" which is a function that informs the profiler
  --| that the currently executing unit is about to delay the
  --| given amount of time.

  begin
    PO.PUT(SID.INSTRUMENTED_FILE,
           "Starting_Delay (" &
           VALUE(CREATE_BREAKPOINT.GET_PROGRAM_UNIT) &
           ",");
  end START_DELAY_EXPRESSION;

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

  procedure END_DELAY_EXPRESSION is

  --| Effects
  --|
  --| Finish the function call to "Starting_Delay".

  begin
    PO.PUT(SID.INSTRUMENTED_FILE, ")");
  end END_DELAY_EXPRESSION;

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

  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);
      PO.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
        PO.PUT(SID.INSTRUMENTED_FILE, "begin");
      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 reraising the exception will allow the
  --|  users 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
        CREATE_BREAKPOINT.CREATE_BREAKPOINT(OTHER_BREAKPOINT,
                                            CURRENT_SCOPE.PUTVAR_NAME);
        CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
        PO.PUT_LINE(SID.INSTRUMENTED_FILE, "exception");
        ADD_OTHERS_HANDLER;
        PO.SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
        PO.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 reraise 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
        PO.SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
        PO.PUT(SID.INSTRUMENTED_FILE, "  when others =>");
        CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
        PO.PUT(SID.INSTRUMENTED_FILE, "raise;");
      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
        PO.PUT(SID.INSTRUMENTED_FILE, "exception");
        PO.PUT_LINE(SID.INSTRUMENTED_FILE, "  when others =>");
        CREATE_BREAKPOINT.CREATE_EXITING_UNIT;
        PO.PUT(SID.INSTRUMENTED_FILE, "raise;");
      end if;
    end if;
  end ADD_EXCEPTION_HANDLER;

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

  procedure END_COMPILATION_UNIT is

  --| Effects
  --|
  --| Print any buffered tokens, and reset buffering and lists
  --| in case more compilation units follow.

  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;

    if BUFFERING_COLON_DECLARATIONS then
      PRINT_COLON_DECLARATIONS_BUFFER;
    end if;

    PROCESS_DECREASE_REQUESTS;

    STRING_LISTS.DESTROY(WITH_LIST);

    -- 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.
    BFP.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;
    OUTPUT_SOURCE := TRUE;
    BUFFERING_TOKENS := TRUE;
    TOKEN_LISTS.DESTROY(BUFFERED_TOKENS);
    BUFFERED_TOKENS := TOKEN_LISTS.CREATE;
  end END_COMPILATION_UNIT;

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

  procedure INCREMENT_SCOPE(TYPE_OF_SCOPE : in SCOPE_TYPE) is

  --|Effects
  --|
  --|We have entered a new unit, so we must set up to process it.
  --|First determine the type of unit.  Next call set_scope_records
  --|to push any enclosing unit on the stack and to set up the current
  --|unit. If we need instrumenting instructions(doing type tracing or
  --|statement trace mode is mixed) then get the user input. Determine
  --|if this is a nested unit or a compilation unit and inform the
  --|create_breakpoint package.

    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;

    SET_SCOPE_RECORDS (TYPE_OF_SCOPE);

    if DO_TYPE_TRACING then
      STRING_STACK_PKG.PUSH(VARS_TO_TRACE_STACK, VARS_TO_TRACE);
      VARS_TO_TRACE := STRING_LISTS.CREATE;
    end if;

    if DO_TYPE_TRACING or (CURRENT_TRACE_MODE = MIXED) then
      GET_UNIT_INSTRUCTIONS(GET_UNIT_NAME (TYPE_OF_SCOPE),
                            TYPE_OF_SCOPE = PACKAGE_SPECIFICATION,
                            CURRENT_TRACE_LEVEL,
                            VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                            VARS_TO_TRACE);
    end if;

    CURRENT_SCOPE.SCOPE_TRACE_LEVEL := CURRENT_TRACE_LEVEL;

    if TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then

      -- Delete any old type tracing files. New ones will be made if
      -- type tracing is on.
      BFP.DELETE_PACKAGE_FILES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME), ALL_FILES);

      if CURRENT_NESTING_LEVEL = 0 then
        -- ask user if he wants to recompile this package spec --
        OUTPUT_SOURCE := ASK_USER_ABOUT_PACKAGE;
      end if;

      if DO_TYPE_TRACING then
        INITIALIZE_TRACE_PACKAGES;
      end if;
    end if;     -- type of scope = package spec

    if CURRENT_NESTING_LEVEL = 0 then
      CREATE_SUBUNIT := (TYPE_OF_SCOPE = SUBPROGRAM_BODY);
      if TYPE_OF_SCOPE = SUBPROGRAM_BODY or TYPE_OF_SCOPE = PACKAGE_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
      -- Current_Nesting_Level /= 0
      CREATE_BREAKPOINT.START_PROGRAM_UNIT(CURRENT_SCOPE_QUALIFIED_NAME,
                                           TYPE_OF_UNIT);
    end if;

    CURRENT_NESTING_LEVEL := CURRENT_NESTING_LEVEL + 1;
    SAVING_EXPANDED_NAME := FALSE;
    PRINT_BUFFERED_TOKENS;

    if BUFFERING_COLON_DECLARATIONS then
      PRINT_COLON_DECLARATIONS_BUFFER;
    end if;

    SEPARATE_UNIT := FALSE;
    SCOPE_STACK_PKG.PUSH(SCOPE_STACK, CURRENT_OUTER_SCOPE);
  end INCREMENT_SCOPE;

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

  procedure DECREMENT_SCOPE is

  --|Effects
  --|
  --|We are exiting a unit.  Close trace packages if we are type tracing
  --|a package spec. Pop the enclosing unit's list of user requested
  --|variables to trace. Inform the create_breakpoint package that
  --|we are exiting the current unit.  Pop the information about
  --|the outer scope(if any) and set up the scope descriptors for
  --|current unit and current outer unit.

    USER_LIST_ITER      : STRING_LISTS.LISTITER;
    NEXT_USER_LIST_NAME : STRING_TYPE;
  begin
    if DO_TYPE_TRACING then
      if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
        CLOSE_TRACE_PACKAGES;
      end if;

      -- see if all requested variables were found
      if not STRING_LISTS.ISEMPTY (VARS_TO_TRACE) then
        USER_LIST_ITER := STRING_LISTS.MAKELISTITER(VARS_TO_TRACE);
        STRING_LISTS.NEXT(USER_LIST_ITER, NEXT_USER_LIST_NAME);
        if MATCH_S(UPPER(NEXT_USER_LIST_NAME),"*ALL") /= 0 then
          FLUSH(NEXT_USER_LIST_NAME);
        else
          -- if there are any names left in the user_list,
          -- issue an error message.
          loop
            TEXT_IO.PUT_LINE(VALUE(NEXT_USER_LIST_NAME) & " not found");
            FLUSH(NEXT_USER_LIST_NAME);
            exit when not STRING_LISTS.MORE(USER_LIST_ITER);
            STRING_LISTS.NEXT(USER_LIST_ITER, NEXT_USER_LIST_NAME);
          end loop;
        end if; -- next_name /= *ALL
      end if; -- vars_to_trace not empty

      STRING_STACK_PKG.POP(VARS_TO_TRACE_STACK, VARS_TO_TRACE);
    end if;  -- if do_type_tracing

    if CURRENT_SCOPE.TYPE_OF_SCOPE /= PACKAGE_SPECIFICATION or
      CURRENT_NESTING_LEVEL = 1 then
      CREATE_BREAKPOINT.END_PROGRAM_UNIT;
    end if;

    SCOPE_STACK_PKG.POP(SCOPE_STACK, CURRENT_SCOPE);
    CURRENT_NESTING_LEVEL := CURRENT_NESTING_LEVEL - 1;
    if CURRENT_NESTING_LEVEL /= 0 then
      CURRENT_OUTER_SCOPE := SCOPE_STACK_PKG.TOP(SCOPE_STACK);
      CURRENT_SCOPE_QUALIFIED_NAME := CURRENT_SCOPE.QUALIFIED_NAME;
      -- Push_Identifer always resets Current_Scope_Simple_Name
    end if;
    TOKEN_LISTS.DESTROY(TOKEN_BUFFER);
  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. If type tracing is on then
  --|stack the outer scope's tracing information, re-initialize
  --|everything for the current scope, and generate the putvar procedure
  --|declaration.

    TEMP_SCOPE : PD.PARSESTACKELEMENT;
  begin
    if (CURRENT_NESTING_LEVEL = 1) and (CREATE_SUBUNIT = TRUE) then
      PO.SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
      PO.PUT(SID.INSTRUMENTED_FILE,
        "procedure "
        & CT.CONVERT_PERIODS_TO_UNDERSCORES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME))
        & "_Call_Unit_Information;");
    end if;

    if CURRENT_SCOPE.TYPE_OF_SCOPE /= A_BLOCK then
      PO.SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
      PO.PUT(SID.INSTRUMENTED_FILE, PREFIX & "Task_Number: natural := 1;");
    else
      TEMP_SCOPE := TOKEN_STACK_PKG.TOP(IDENTIFIER_STACK);
      CURRENT_SCOPE.PUTVAR_NAME := CREATE(TEMP_SCOPE.LEXED_TOKEN.TEXT.all);
    end if;

    -- Set up type tracing; the current declarative part is for
    -- a body or a block.
    if DO_TYPE_TRACING then
      LIST_STACK_PKG.PUSH(VISIBLE_LIST_STACK, VISIBLE_LIST);
      STRING_STACK_PKG.PUSH(PACKAGE_LIST_STACK, PACKAGE_LIST);
      VISIBLE_LIST := NAME_LISTS.CREATE;
      PACKAGE_LIST := STRING_LISTS.CREATE;

      -- add procedure declaration for "putvars"
      WRITE_SPEC_LINE("");
      WRITE_SPEC_LINE("Procedure " &
                       VALUE(CURRENT_SCOPE.SCOPE_NAME) & "_" &
                       PREFIX & "Putvars;");

      if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY then
        BFP.COPY_PACKAGE_FILES(PRIVATE_SPEC,
                               VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                               SID.INSTRUMENTED_FILE);
      end if;

      if not NAME_LISTS.ISEMPTY(PARAM_LIST) then
        NAME_LISTS.ATTACH(VISIBLE_LIST, NAME_LISTS.COPY(PARAM_LIST));
        NAME_LISTS.DESTROY(PARAM_LIST);
      end if;

      BFP.START_NEW_SECTION;
    end if;
  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.  If
  --|we are doing type tracing 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 th tracing procedures.
  --|3) Copy the procedure bodies from the buffer file that were saved
  --|until the end of the later declarative part. 4) If there were
  --|any user requested variables to trace that weren't found then
  --|issue an error message.

    ITER        : STRING_LISTS.LISTITER;
    NEXT_OBJECT : STRING_TYPE;
  begin
    if (CURRENT_NESTING_LEVEL = 1) and (CREATE_SUBUNIT = TRUE) then
      PO.SPACE_LINE(SID.INSTRUMENTED_FILE, 1);
      PO.PUT(SID.INSTRUMENTED_FILE,
       "procedure "
        & CT.CONVERT_PERIODS_TO_UNDERSCORES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME))
        & "_Call_Unit_Information is separate;");
    end if;

    -- Finish the type tracing for this declarative part; the
    -- "begin ... end" part follows next.
    if DO_TYPE_TRACING then
      GENERATE_PUTVARS;
      if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY then
        BFP.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);
        BFP.COPY_PACKAGE_FILES(PUBLIC_BODY,
                               VALUE(CURRENT_SCOPE.QUALIFIED_NAME &
                                     "." & NEXT_OBJECT),
                               SID.INSTRUMENTED_FILE);
        FLUSH(NEXT_OBJECT);
      end loop;
      STRING_LISTS.DESTROY(PACKAGE_LIST);

      BFP.SAVE_BUFFER_FILE(SID.INSTRUMENTED_FILE);
      BFP.RELEASE_SECTION;
      LIST_STACK_PKG.POP(VISIBLE_LIST_STACK, VISIBLE_LIST);
      STRING_STACK_PKG.POP(PACKAGE_LIST_STACK, PACKAGE_LIST);
    end if;
  end END_DECLARATIVE_PART;

  -----------------------------------------------------------------
  procedure ADD_IDENTIFIER_TO_LIST is

  --| Effects
  --|
  --| If type tracing is on, add the current identifier to "current_list".
  --| The current identifier's name is in Saved_Token.

    CURRENT_NAME : NAME_RECORD;

  begin
    if DO_TYPE_TRACING then
      CURRENT_NAME.OBJECT_NAME :=
        MAKE_PERSISTENT(SAVED_TOKEN.LEXED_TOKEN.TEXT.all);
      -- The mode will be set later...
      NAME_LISTS.ATTACH(CURRENT_LIST, CURRENT_NAME);
    end if;
  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;
  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

    -- Note: anonymous array processing currently discards the
    -- current_list
    if DO_TYPE_TRACING then
      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);
            NEXT_OBJECT.OBJECT_MODE := CURRENT_MODE;
            case LIST_TYPE is
              when DISCRIMINANT_LIST =>
                -- TBD do tracevar things to handle discriminants --
                FLUSH(EXPANDED_NAME);

              when RECORD_FIELD_LIST =>
                -- TBD do tracevar things for record fields --
                null;

              when OBJECT_LIST =>
                NEXT_OBJECT.OBJECT_NAME :=
                  CURRENT_SCOPE.QUALIFIED_NAME & "." & NEXT_OBJECT.OBJECT_NAME;
                NAME_LISTS.ATTACH(VISIBLE_LIST, NEXT_OBJECT);

              when PARAMETER_LIST =>
                if CURRENT_NESTING_LEVEL = 0 then
                  NEXT_OBJECT.OBJECT_NAME :=
                     CURRENT_SCOPE_SIMPLE_NAME & "." & NEXT_OBJECT.OBJECT_NAME;
                else
                  NEXT_OBJECT.OBJECT_NAME :=
                     CURRENT_SCOPE.QUALIFIED_NAME & "." &
                     CURRENT_SCOPE_SIMPLE_NAME & "." &
                     NEXT_OBJECT.OBJECT_NAME;
                end if;
                NAME_LISTS.ATTACH(PARAM_LIST, NEXT_OBJECT);

              when others =>
                null;
            end case;
          end loop;

        when others =>
          null;
      end case;

      NAME_LISTS.DESTROY(CURRENT_LIST);
    end if;
    CURRENT_MODE := NONE;
  end PROCESS_IDENTIFIER_LIST;

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

  procedure SAVE_TYPE_IDENTIFIER is

  --| Effects
  --|
  --| The current saved_token is a type identifier.  If type tracing
  --| is on, save the type identifier for use in generating the
  --| "tracevar" procedures.

  begin
    if DO_TYPE_TRACING then
      FLUSH(CURRENT_TYPE_IDENTIFIER);
      CURRENT_TYPE_IDENTIFIER :=
        CURRENT_SCOPE.QUALIFIED_NAME & "." &
        CREATE(SAVED_TOKEN.LEXED_TOKEN.TEXT.all);
    end if;
  end SAVE_TYPE_IDENTIFIER;

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

  procedure START_TRACE_PROCEDURE(TYPE_KIND : in TYPE_CLASS) is

  --| Effects
  --|
  --| Generate the body of the tracing procedure for the current
  --| type declaration.

  begin
    if DO_TYPE_TRACING then
      GENERATE_TRACEVAR_SPEC := TRUE;

      if TYPE_KIND = TASK_TYPE then
        CURRENT_TYPE_IDENTIFIER :=
          CURRENT_SCOPE.QUALIFIED_NAME & "." &
          CREATE(SAVED_TOKEN.LEXED_TOKEN.TEXT.all);
      end if;

      -- write out the constant part of the header
      for I in 1 .. TRACEVAR_HEADER'LAST - 1 loop
        WRITE_BODY_LINE(VALUE(TRACEVAR_HEADER(I)));
      end loop;

      -- write out the last line, filling in the type name
      -- for "current_value"
      WRITE_BODY_LINE(VALUE(TRACEVAR_HEADER(TRACEVAR_HEADER'LAST)) &
                      " " & VALUE(CURRENT_TYPE_IDENTIFIER) & ") is");

      -- beware that records and arrays will need local vars --
      WRITE_BODY_LINE("begin");

      case TYPE_KIND is

        when ENUMERATION_TYPE =>
          WRITE_BODY_LINE("   RTM.Put_Value");
          WRITE_BODY_LINE("      (Current_Unit, Variable_Name, " &
                          VALUE(CURRENT_TYPE_IDENTIFIER) &
                          "'image (Current_Value));");

        when INTEGER_TYPE =>
          WRITE_BODY_LINE("   RTM.Put_Value");
          WRITE_BODY_LINE("      (Current_Unit, Variable_Name, " &
                          "Integer(Current_Value));");

        when FLOAT_TYPE | FIXED_TYPE =>
          WRITE_BODY_LINE("   RTM.Put_Value");
          WRITE_BODY_LINE("      (Current_Unit, Variable_Name, " &
                          "Float(Current_Value));");

        when DERIVED_TYPE =>
          -- expanded name is the parent type name --
          WRITE_BODY_LINE("   Source_Instrumenter_Added_Tracevar");
          WRITE_BODY_LINE("      (Current_Unit, Variable_Name, " &
                          VALUE(EXPANDED_NAME) &
                          "(Current_Value));");
          FLUSH(EXPANDED_NAME);

        when others =>
          WRITE_BODY_LINE("   RTM.Put_Value");
          WRITE_BODY_LINE("      (Current_Unit, Variable_Name, ");
          WRITE_BODY_LINE("      ""Values of type " &
                          VALUE(CURRENT_TYPE_IDENTIFIER) &
                          " cannot be displayed"");");
      end case;

      WRITE_BODY_LINE("exception");
      WRITE_BODY_LINE("   when others => null;");
      WRITE_BODY_LINE("end;");
    end if;
  end START_TRACE_PROCEDURE;

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

  procedure END_TYPE_DECLARATION is

  --| Effects
  --|
  --| Generate a procedure declaration for the current tracevar
  --| procedure.

  begin
    if DO_TYPE_TRACING then
      if GENERATE_TRACEVAR_SPEC then
        WRITE_SPEC_LINE("");

        -- write out the constant part of the header
        for I in 1 .. TRACEVAR_HEADER'LAST - 1 loop
          WRITE_SPEC_LINE(VALUE(TRACEVAR_HEADER(I)));
        end loop;

        -- write out the last line, filling in the type name
        -- for "current_value"
        WRITE_SPEC_LINE(VALUE(TRACEVAR_HEADER(TRACEVAR_HEADER'LAST)) &
                        " " &
                        VALUE(CURRENT_TYPE_IDENTIFIER) & ");");
      end if;
      GENERATE_TRACEVAR_SPEC := FALSE;
      FLUSH(CURRENT_TYPE_IDENTIFIER);
    end if;
    TOKEN_LISTS.DESTROY(TOKEN_BUFFER);
  end END_TYPE_DECLARATION;

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

  procedure START_ANONYMOUS_ARRAY_DEFINITION is

  --| Effects
  --|
  --| For now, the current identifier list is destroyed.  When
  --| implemented, this procedure will generate a type name for the
  --| anonymous array definition so that a tracevar procedure can be
  --| written for the type.

  begin
    if DO_TYPE_TRACING then
      NAME_LISTS.DESTROY(CURRENT_LIST);  -- temporary
    end if;

  -- stop buffering colon decls
  -- attach current token_to_buffer to buffer
  -- set current_type_identifier to a name we create (foo) and
  --   create a new token_to_buffer for it
  -- write "type foo is" to output files
  -- call start_trace (array type) to generate tracevar proc
  end START_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 "Saving_Expanded_Name" flag.

  begin
    SAVING_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.  If type tracing is on, 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
    if DO_TYPE_TRACING then
      LIST_STACK_PKG.PUSH(VISIBLE_LIST_STACK, VISIBLE_LIST);
      VISIBLE_LIST := NAME_LISTS.CREATE;
      CURRENT_SCOPE.IN_PRIVATE_PART := TRUE;
      WRITE_SPEC_LINE("Procedure " &
                      VALUE(CURRENT_SCOPE.SCOPE_NAME) &
                      "priv_" & PREFIX & "Putvars;");
    end if;
  end START_PRIVATE_PART;

  --------------------------------------------------------------
  --     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);
      INITIALIZE_DESCRIPTOR(CURRENT_BUFFERED_TOKEN);
    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;
      CURRENT_CHANGE_COLUMN := CURRENT_TOKEN.CURRENT_CHANGE_COLUMN;
    end loop;
    TOKEN_LISTS.DESTROY(BUFFERED_TOKENS);
    BUFFERING_TOKENS := FALSE;
  end PRINT_BUFFERED_TOKENS;

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

  function MATCH_NAMES(USER_NAME, SI_NAME : in STRING) return BOOLEAN is

  --| Effects
  --|
  --| USER_NAME is the name of the variable the user requested to
  --| trace.  SI_NAME is the name of a variable found in the
  --| program.  See if they match, not counting indexed and
  --| selected components.

    CH : CHARACTER;
  begin
    if USER_NAME = SI_NAME then
      return TRUE;
    end if;

    if USER_NAME'LENGTH > SI_NAME'LENGTH and then
       USER_NAME(1 .. SI_NAME'LENGTH) = SI_NAME then
      CH := USER_NAME (SI_NAME'LENGTH + 1);
      return (CH = '.' or CH = ' ' or CH = '(' );
    end if;
    return FALSE;
  end MATCH_NAMES;

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

  procedure CHECK_LISTS is

  --| Effects
  --|
  --| Compare the list of variables the user wants to trace
  --| (VARS_TO_TRACE) with the list of visible variables
  --| found by the instrumenter (VISIBLE_LIST). If there is a
  --| match, then change the visible list's version of the name
  --| to what the user requested, to allow for selected components.

  --| At the end, the VISIBLE_LIST will be a new list which has the
  --| revised variable names.

    USER_LIST_ITER      : STRING_LISTS.LISTITER;
    NEXT_USER_LIST_NAME : STRING_TYPE;
    VIS_LIST_ITER       : NAME_LISTS.LISTITER;
    NEXT_VIS_LIST_NAME  : NAME_RECORD;
    TEMP_LIST           : NAME_LISTS.LIST := NAME_LISTS.CREATE;
  begin

    if not STRING_LISTS.ISEMPTY (VARS_TO_TRACE) then
      USER_LIST_ITER := STRING_LISTS.MAKELISTITER(VARS_TO_TRACE);
      STRING_LISTS.NEXT(USER_LIST_ITER, NEXT_USER_LIST_NAME);

      if STRING_PKG.MATCH_S (UPPER(NEXT_USER_LIST_NAME),"*ALL") /= 0 then
        return;
      end if;

      -- loop through the list of user requested vars to trace
      loop
         -- see if the var is in the visible list
        VIS_LIST_ITER := NAME_LISTS.MAKELISTITER(VISIBLE_LIST);

        while NAME_LISTS.MORE(VIS_LIST_ITER) loop
          NAME_LISTS.NEXT(VIS_LIST_ITER, NEXT_VIS_LIST_NAME);
          if MATCH_NAMES(VALUE (UPPER (NEXT_USER_LIST_NAME)),
                         VALUE (UPPER (NEXT_VIS_LIST_NAME.OBJECT_NAME)))
          then  -- save this name, and delete it from user_list
            NEXT_VIS_LIST_NAME.OBJECT_NAME :=
               MAKE_PERSISTENT(NEXT_USER_LIST_NAME);
            NAME_LISTS.ATTACH(TEMP_LIST, NEXT_VIS_LIST_NAME);
            STRING_LISTS.DELETEITEM(VARS_TO_TRACE, NEXT_USER_LIST_NAME);
            exit;
          end if; -- names match
        end loop; -- while more in vis_list

        exit when not STRING_LISTS.MORE(USER_LIST_ITER);
        STRING_LISTS.NEXT(USER_LIST_ITER, NEXT_USER_LIST_NAME);
      end loop; -- while more in users lilst

    end if; -- not is empty (user's list)

    -- save the temp list as the new visible list
    DISCARD_LIST (VISIBLE_LIST);
    NAME_LISTS.ATTACH (VISIBLE_LIST, NAME_LISTS.COPY(TEMP_LIST));
    NAME_LISTS.DESTROY(TEMP_LIST);

  end CHECK_LISTS;

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

  function GET_UNIT_NAME(TYPE_OF_SCOPE : in SCOPE_TYPE) return STRING is

  --| Effects
  --|
  --|  This function searches through the buffered tokens and forms a
  --|  string representation of the current unit specification.  The
  --|  function will add spaces where neccesary but will not add and
  --|  carriage control.

  --  Define an access to a string to hold the unit specification as it
  --  is constructed

    type UNIT_DESCRIPTOR is access STRING;
    UNIT_NAME       : UNIT_DESCRIPTOR;
    BUFFER_ITERATOR : TOKEN_LISTS.LISTITER;  -- Iterator to walk the lists
    CURRENT_TOKEN   : TOKEN_DESCRIPTOR;
                                   -- Holder for token currently being processed

  begin

    case TYPE_OF_SCOPE is
      when PACKAGE_SPECIFICATION =>
        UNIT_NAME := new STRING'("package ");
      when PACKAGE_BODY =>
        UNIT_NAME := new STRING'("package body ");
      when TASK_BODY =>
        UNIT_NAME := new STRING'("task body ");
      when SUBPROGRAM_BODY =>
        if SUBPROGRAM_UNIT_TYPE = PROCEDURE_TYPE then
          UNIT_NAME := new STRING'("procedure ");
        else
          UNIT_NAME := new STRING'("function ");
        end if;
      when others =>
        UNIT_NAME := new STRING'("");
    end case;

    UNIT_NAME := new STRING'(UNIT_NAME.all & VALUE(CURRENT_SCOPE_SIMPLE_NAME));

    if not TOKEN_LISTS.ISEMPTY(TOKEN_BUFFER) then
      UNIT_NAME := new STRING'(UNIT_NAME.all & '(');

      --  process second buffer. This buffer will contain all of the parameter
      --  specifications(if any).  Add the tokens to the list, and put spaces
      --  where appropriate
      BUFFER_ITERATOR := TOKEN_LISTS.MAKELISTITER(TOKEN_BUFFER);
      while TOKEN_LISTS.MORE(BUFFER_ITERATOR) loop
        TOKEN_LISTS.NEXT(BUFFER_ITERATOR, CURRENT_TOKEN);
        exit when CURRENT_TOKEN.TOKEN.GRAM_SYM_VAL = PT.RETURNTOKENVALUE;
        if CURRENT_TOKEN.TOKEN.GRAM_SYM_VAL /= PT.COLON_TOKENVALUE and
           CURRENT_TOKEN.TOKEN.GRAM_SYM_VAL /= PT.RIGHTPAREN_TOKENVALUE then
          UNIT_NAME := new STRING'(UNIT_NAME.all & ' ' &
                                   TOKEN_TEXT(CURRENT_TOKEN.TOKEN));
        else
          UNIT_NAME := new STRING'(UNIT_NAME.all &
                                   TOKEN_TEXT(CURRENT_TOKEN.TOKEN));
        end if;
      end loop;
    end if;
    if TYPE_OF_SCOPE = SUBPROGRAM_BODY and
       SUBPROGRAM_UNIT_TYPE = FUNCTION_TYPE then
      UNIT_NAME := new STRING'(UNIT_NAME.all & " return " &
                               VALUE(EXPANDED_NAME));
    end if;
    if Current_Nesting_Level > 0 and not BUFFERING_COLON_DECLARATIONS then
      TOKEN_LISTS.DESTROY(TOKEN_BUFFER);
    end if;
    return UNIT_NAME.all;   --  return the string
  end GET_UNIT_NAME;

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

  procedure WRITE_BODY_LINE(LINE : in STRING) is

  --| Effects
  --|
  --| The line is part of a procedure body. Write it to the
  --| appropriate buffer file.

  begin
    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
      if CURRENT_SCOPE.IN_PRIVATE_PART then
        BFP.WRITELN_TO_BUFFER(PRIVATE_BODY_FILE, LINE);
      else
        BFP.WRITELN_TO_BUFFER(PUBLIC_BODY_FILE, LINE);
      end if;
    else
      BFP.WRITELN_TO_BUFFER(BUFFER_FILE, LINE);
    end if;
  end WRITE_BODY_LINE;

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

  procedure WRITE_SPEC_LINE(LINE : in STRING) is

  --| Effects
  --|
  --| The current line is a declaration or part of a package spec.
  --| If the current unit is a package specification, write the line
  --| to the appropriate package tracing file.  Otherwise write it
  --| directly to the instrumented source file.

  begin
    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
      if CURRENT_SCOPE.IN_PRIVATE_PART then
        BFP.WRITELN_TO_BUFFER(PRIVATE_SPEC_FILE, LINE);
      else
        BFP.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE, LINE);
      end if;
    else
      PO.PUT_LINE(SID.INSTRUMENTED_FILE, LINE);
    end if;
  end WRITE_SPEC_LINE;

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

  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.  This is used to generate "Putvar" calls to
  --| those units.

    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 := BFP.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 GENERATE_TRACEVAR_CALL(VARNAME : in STRING) is

  --| Effects
  --|
  --| Write the text for a call to Source_Instrumenter_Added_Tracevar
  --| to the appropriate buffer file.

  begin
    WRITE_BODY_LINE("   begin");
    WRITE_BODY_LINE("      Source_Instrumenter_Added_Tracevar ");
    WRITE_BODY_LINE("        (" &
                    VALUE(CREATE_BREAKPOINT.GET_PROGRAM_UNIT) &
                    ",");
    WRITE_BODY_LINE("          " & """" & VARNAME & """, ");
    WRITE_BODY_LINE("          " & VARNAME & ");");
    WRITE_BODY_LINE("   exception");
    WRITE_BODY_LINE("      when others => null;");
    WRITE_BODY_LINE("   end;");
  end GENERATE_TRACEVAR_CALL;

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

  procedure GENERATE_PUTVARS is

  --| Effects
  --|
  --| Generate the procedure "putvars" for the current scope.
  --| "Putvars" first calls "Tracevar" for the variables being
  --| traced in this scope, and then calls the "putvars" for
  --| enclosing scopes.
  --| It is only called if Do_Type_Tracing is True.

    NAME_LIST_ITERATOR   : NAME_LISTS.LISTITER;
    NEXT_VARIABLE        : NAME_RECORD;
    STRING_LIST_ITERATOR : STRING_LISTS.LISTITER;
    NEXT_NAME            : STRING_TYPE;
    WROTE_SOMETHING      : BOOLEAN := FALSE;

  begin

    -- write the procedure spec --
    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then
      if CURRENT_SCOPE.IN_PRIVATE_PART then
        WRITE_BODY_LINE("Procedure " &
                         VALUE(CURRENT_SCOPE.SCOPE_NAME) &
                         "priv_" & PREFIX & "Putvars is");
      else
        WRITE_BODY_LINE("Procedure " &
                         VALUE(CURRENT_SCOPE.SCOPE_NAME) &
                         "spec_" & PREFIX & "Putvars is");
        if CURRENT_NESTING_LEVEL = 1 then
          WRITE_BODY_LINE("   TBX7_Task_Number: Natural := 1;");
        end if;
      end if;
    else
      WRITE_BODY_LINE("Procedure " &
                      VALUE(CURRENT_SCOPE.SCOPE_NAME) &
                      "_" & PREFIX & "Putvars is");
    end if;

    WRITE_BODY_LINE("begin");

    -- first, call tracevar for the variables being traced in this scope
    -- and then destroy the list.

    CHECK_LISTS;
    NAME_LIST_ITERATOR := NAME_LISTS.MAKELISTITER(VISIBLE_LIST);
    while NAME_LISTS.MORE(NAME_LIST_ITERATOR) loop
      NAME_LISTS.NEXT(NAME_LIST_ITERATOR, NEXT_VARIABLE);
      if NEXT_VARIABLE.OBJECT_MODE = READ_ONLY or
         NEXT_VARIABLE.OBJECT_MODE = READ_WRITE then
        GENERATE_TRACEVAR_CALL(VALUE(NEXT_VARIABLE.OBJECT_NAME));
        WROTE_SOMETHING := TRUE;
      end if;
      FLUSH(NEXT_VARIABLE.OBJECT_NAME);
    end loop;
    NAME_LISTS.DESTROY(VISIBLE_LIST);

    -- If the current unit is a package body, and if its spec was
    -- instrumented for type tracing, then trace any variables
    -- from the spec (public and private).
    if CURRENT_SCOPE.TYPE_OF_SCOPE = PACKAGE_BODY then

      -- trace the variables from the private part
      if BFP.PACKAGE_FILES_EXIST(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
        PRIVATE_FILES) then
        WRITE_BODY_LINE("   " &
                        VALUE(CURRENT_SCOPE.SCOPE_NAME) &
                        "priv_" & PREFIX & "Putvars;");
      end if; -- private files exist

      -- trace the variables from the public part
      if BFP.PACKAGE_FILES_EXIST(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                                 PUBLIC_FILES) then
        WRITE_BODY_LINE("   " &
                        "Trace_Public_" &
                        VALUE(CURRENT_SCOPE.SCOPE_NAME) & "." &
                        VALUE(CURRENT_SCOPE.SCOPE_NAME) &
                        "spec_" & PREFIX & "Putvars;");
        WROTE_SOMETHING := TRUE;
      end if; -- public_files exist
    end if; -- current scope = package body

    if CURRENT_SCOPE.TYPE_OF_SCOPE /= PACKAGE_SPECIFICATION then

      -- Call putvars for package specs declared in this scope.
      -- Package specs nested in other package specs are handled by
      -- the package tracing files.  The Package_List will still be
      -- needed in "End_Declarative_Part" so leave it intact.
      STRING_LIST_ITERATOR := STRING_LISTS.MAKELISTITER(PACKAGE_LIST);
      while STRING_LISTS.MORE(STRING_LIST_ITERATOR) loop
        STRING_LISTS.NEXT(STRING_LIST_ITERATOR, NEXT_NAME);
        WRITE_BODY_LINE("   " &
                        VALUE(CURRENT_SCOPE.QUALIFIED_NAME) &
                        ".Trace_Public_" & VALUE(NEXT_NAME) & "." &
                        VALUE(NEXT_NAME) &
                        "spec_" & PREFIX & "Putvars;");
        WROTE_SOMETHING := TRUE;
      end loop;

      -- if this is the outer scope, then call putvars for packages
      -- named in the context_clause
      if CURRENT_NESTING_LEVEL = 1 then
        STRING_LIST_ITERATOR := STRING_LISTS.MAKELISTITER(WITH_LIST);
        while STRING_LISTS.MORE(STRING_LIST_ITERATOR) loop
          STRING_LISTS.NEXT(STRING_LIST_ITERATOR, NEXT_NAME);
          WRITE_BODY_LINE("   Trace_Public_" &
                          VALUE(NEXT_NAME) & "." &
                          VALUE(NEXT_NAME) & "spec_" & PREFIX & "Putvars;");
          FLUSH(NEXT_NAME);
          WROTE_SOMETHING := TRUE;
        end loop;
        STRING_LISTS.DESTROY(WITH_LIST);
      end if;

      -- call putvars for the outer scope
      if not IS_EMPTY(CURRENT_OUTER_SCOPE.SCOPE_NAME) then
        WRITE_BODY_LINE("   " &
                        VALUE(CURRENT_OUTER_SCOPE.PUTVAR_NAME) & "_" &
                        PREFIX & "Putvars;");
        WROTE_SOMETHING := TRUE;
      end if;
    end if;

    -- current_scope /= package_spec
    if not WROTE_SOMETHING then
      WRITE_BODY_LINE("   null;");
    end if;

    WRITE_BODY_LINE("end;");
  end GENERATE_PUTVARS;

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

  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.  The user ought not to recompile a package
  --| specification if the body is not available for recompilation.

    ANSWER : STRING(1 .. 80);
    INDEX  : INTEGER;
  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));
    TEXT_IO.PUT_LINE("Do you want this package specification included in ");
    TEXT_IO.PUT_LINE("the instrumented source?  Recompiling it will require ");
    TEXT_IO.PUT_LINE("recompiling its body and all dependent units.");

    loop
      TEXT_IO.PUT("Y/N ");
      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 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 field
  --| 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);
      end loop;
      NAME_LISTS.DESTROY(WHICH_LIST);
    end if;
  end DISCARD_LIST;

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

  procedure SET_SCOPE_RECORDS(TYPE_OF_SCOPE : in SCOPE_TYPE) is

  --| Effects
  --|
  --| This is called by Increment_Scope to set the
  --| Current_Scope and Current_Outer_Scope variables.

  begin
    if CURRENT_NESTING_LEVEL = 0 then
      if not SEPARATE_UNIT then
        CURRENT_SCOPE_QUALIFIED_NAME := CURRENT_SCOPE_SIMPLE_NAME;
        CURRENT_OUTER_SCOPE :=
           (CREATE(""),
            CREATE(""),
            A_BLOCK,
            CREATE(""),
            FALSE,
            ENTRY_EXIT);
      else
        CURRENT_SCOPE_QUALIFIED_NAME :=
          EXPANDED_NAME & "." & CURRENT_SCOPE_SIMPLE_NAME;
          -- Current_Outer_Scope was set up in Save_Separate_Name
      end if;
    else  -- Current_Nesting_Level /= 0
      CURRENT_SCOPE_QUALIFIED_NAME :=
        CURRENT_SCOPE.QUALIFIED_NAME & "." & CURRENT_SCOPE_SIMPLE_NAME;
      CURRENT_OUTER_SCOPE := CURRENT_SCOPE;
    end if;

    CURRENT_SCOPE :=
       (CURRENT_SCOPE_SIMPLE_NAME,
        CURRENT_SCOPE_QUALIFIED_NAME,
        TYPE_OF_SCOPE,
        CREATE(""),
        FALSE,
        CURRENT_TRACE_LEVEL);

    if DO_TYPE_TRACING then
      CURRENT_SCOPE.PUTVAR_NAME := CURRENT_SCOPE_SIMPLE_NAME;
    end if;
  end SET_SCOPE_RECORDS;

  ---------------------------------------------------------------
  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
      PO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with Run_Time_Monitor, Type_Definitions, String_Pkg;");
      PO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "use Run_Time_Monitor, Type_Definitions, String_Pkg;");
      if DO_TYPE_TRACING then
        PO.PUT_LINE(SID.INSTRUMENTED_FILE,
          "with Trace_Predefined_Types; use Trace_Predefined_Types;");
        RETRIEVE_SPEC_WITH_LIST;
      end if; -- not separate and type tracing
    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
       DO_TYPE_TRACING and then
       BFP.PACKAGE_FILES_EXIST(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                               PUBLIC_FILES) then
      PO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with Trace_Public_" & VALUE(CURRENT_SCOPE_SIMPLE_NAME) & "; " &
        "use Trace_Public_" & 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);
      PO.PUT_LINE(SID.INSTRUMENTED_FILE,
        "with Trace_Public_" & VALUE(NEXT_OBJECT) & "; " &
        "use Trace_Public_" & 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;

  begin

    -- with and use the package being traced
    BFP.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE,
      "with " & VALUE(CURRENT_SCOPE_SIMPLE_NAME) & "; " &
      "use " & VALUE(CURRENT_SCOPE_SIMPLE_NAME) & ";");

    -- with and use the support packages
    BFP.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE,
      "with Run_Time_Monitor, Type_Definitions," &
      " String_Pkg, Trace_Predefined_Types;");
    BFP.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE,
      "use  Run_Time_Monitor, Type_Definitions," &
      " String_Pkg, Trace_Predefined_Types;");

    -- with and use the 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);
      BFP.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE,
        "with Trace_Public_" & VALUE(NEXT_OBJECT) & "; " &
        "use Trace_Public_" & 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 and type tracing
  --| is on.

  begin
    if CURRENT_OUTER_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then

      -- close the private files for the outer package
      -- and open new ones for the current package.
      BFP.CLOSE_PACKAGE_FILES(PRIVATE_FILES);
      BFP.CREATE_PACKAGE_FILES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
        PRIVATE_FILES);
    else
      BFP.CREATE_PACKAGE_FILES(VALUE(CURRENT_SCOPE.QUALIFIED_NAME), ALL_FILES);

      if CURRENT_NESTING_LEVEL = 0 then
        if not STRING_LISTS.ISEMPTY(WITH_LIST) then
          BFP.SAVE_SPEC_WITH_LIST(VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                                  WITH_LIST);
        end if;
        ADD_WITHS_TO_TRACE_PACKAGES;
      end if; -- Current_Nesting_Level = 0

      -- Start the public trace packages
      BFP.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE,
        "package Trace_Public_" & VALUE(CURRENT_SCOPE_SIMPLE_NAME) & " is");
      BFP.WRITELN_TO_BUFFER(PUBLIC_BODY_FILE,
        "package body Trace_Public_" &
         VALUE(CURRENT_SCOPE_SIMPLE_NAME) & " is ");

      BFP.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE,
        "Procedure " &
         VALUE(CURRENT_SCOPE_SIMPLE_NAME) & "spec_" & PREFIX & "Putvars;");

      -- start new visible variable list
      LIST_STACK_PKG.PUSH(VISIBLE_LIST_STACK, VISIBLE_LIST);
      VISIBLE_LIST := NAME_LISTS.CREATE;
    end if; -- if current_outer_scope = package_spec
  end INITIALIZE_TRACE_PACKAGES;

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

  procedure CLOSE_TRACE_PACKAGES is

  --| Effects
  --|
  --| This procedure is called by Decrement_Scope when type
  --| tracing is true and the current unit is a package
  --| specification.  Finish the tracing information packaages.

  begin

    -- Finish the private tracing packages
    if CURRENT_SCOPE.IN_PRIVATE_PART then
      GENERATE_PUTVARS; -- for variables declared in the private part
      LIST_STACK_PKG.POP(VISIBLE_LIST_STACK, VISIBLE_LIST);

    else  -- there was no private part
      CURRENT_SCOPE.IN_PRIVATE_PART := TRUE;
      BFP.WRITELN_TO_BUFFER(PRIVATE_SPEC_FILE,
        "Procedure " & VALUE(CURRENT_SCOPE.SCOPE_NAME) &
        "priv_" & PREFIX & "Putvars;");
      BFP.WRITELN_TO_BUFFER(PRIVATE_BODY_FILE,
        "Procedure " & VALUE(CURRENT_SCOPE.SCOPE_NAME) &
        "priv_" & PREFIX & "Putvars is");
      BFP.WRITELN_TO_BUFFER(PRIVATE_BODY_FILE, "begin");
      BFP.WRITELN_TO_BUFFER(PRIVATE_BODY_FILE, "   null;");
      BFP.WRITELN_TO_BUFFER(PRIVATE_BODY_FILE, "end;");
    end if;
    CURRENT_SCOPE.IN_PRIVATE_PART := FALSE;

    -- finish the public tracing packages
    if CURRENT_OUTER_SCOPE.TYPE_OF_SCOPE = PACKAGE_SPECIFICATION then

      -- reopen private files for outer scope and continue
      BFP.CLOSE_PACKAGE_FILES(PRIVATE_FILES);
      BFP.REOPEN_PRIVATE_FILES(VALUE(CURRENT_OUTER_SCOPE.QUALIFIED_NAME));
    else
      GENERATE_PUTVARS;
      LIST_STACK_PKG.POP(VISIBLE_LIST_STACK, VISIBLE_LIST);

      -- End the public trace packages
      BFP.WRITELN_TO_BUFFER(PUBLIC_SPEC_FILE,
        "end Trace_Public_" & VALUE(CURRENT_SCOPE.SCOPE_NAME) & ";");
      BFP.WRITELN_TO_BUFFER(PUBLIC_BODY_FILE,
        "end Trace_Public_" & VALUE(CURRENT_SCOPE.SCOPE_NAME) & ";");
      BFP.CLOSE_PACKAGE_FILES(ALL_FILES);

      BFP.COPY_PACKAGE_FILES(PUBLIC_SPEC,
                             VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                             SID.INSTRUMENTED_FILE);

      if CURRENT_NESTING_LEVEL = 1 then
        BFP.COPY_PACKAGE_FILES(PUBLIC_BODY,
                               VALUE(CURRENT_SCOPE.QUALIFIED_NAME),
                               SID.INSTRUMENTED_FILE);
      else
        PO.PUT_LINE(SID.INSTRUMENTED_FILE,
          "use Trace_Public_" & 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; -- if outer_scope = package_spec
  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_Utilities;
separate (Lex)
function GetNextNonCommentToken return PD.ParseStackElement is

    package SIU renames Source_Instrumenter_Utilities;

begin
    SIU.Comment_Buffer := SIU.Comment_Lists.Create;
    loop
        CST := GetNextSourceToken;
        exit when (CST.gram_sym_val = PT.EOF_TokenValue) or
            (CST.gram_sym_val /= PT.Comment_TokenValue);
        SIU.Comment_Lists.Attach(SIU.Comment_Buffer, CST);
    end loop;
    return CST;    -- return the token that is not a comment
end GetNextNonCommentToken;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--applyact.sub
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

 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_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;

 -------------------------------------------------------------------
 -- number_declaration ::= identifier_list : CONSTANT := expression ;

  when 21 =>

         Set_Identifier_Mode (Read_Only);
         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 =>

         -- temporary until array processing done --
         -- beware generic array type definitions --
         Start_Trace_Procedure (Array_Type);

 -------------------------------------------------------------------
 -- type_definition ::= record_type_definition ;

  when 34 =>

         Decrease_Indent;

         -- temporary until record processing done --
         Start_Trace_Procedure (Record_Type);

 -------------------------------------------------------------------
 -- type_definition ::= access_type_definition ;

  when 35 =>


         -- temporary:  beware generic access type definitions --
         Start_Trace_Procedure (Access_Type);

 -------------------------------------------------------------------
 -- type_mark ::= type_name|subtype_name

  when 40 =>

         End_Typemark;

 -------------------------------------------------------------------
 -- derived_type_definition ::= NEW start_expanded_name subtype_indication

  when 45 =>

         Start_Trace_Procedure (Derived_Type);

 -------------------------------------------------------------------
 -- enumeration_type_definition ::= ( enumeration_literal_specification )

  when 48 =>

         Start_Trace_Procedure (Enumeration_Type);

 -------------------------------------------------------------------
 -- integer_type_definition ::= range_constraint

  when 52 =>

         Start_Trace_Procedure (Integer_Type);

 -------------------------------------------------------------------
 -- real_type_definition ::= floating_point_constraint

  when 53 =>

         Start_Trace_Procedure (Float_Type);

 -------------------------------------------------------------------
 -- real_type_definition ::= fixed_point_constraint

  when 54 =>

         Start_Trace_Procedure (Fixed_Type);

 -------------------------------------------------------------------
 -- component_list ::= {pragma_decl} {component_declaration}
 --     component_declaration

  when 70

 -------------------------------------------------------------------
 -- component_list ::= {pragma_decl} {component_declaration}' variant_part

  | 71 =>

          Decrease_Indent;

 -------------------------------------------------------------------
 -- component_list ::= null_statement {pragma_decl}

  when 72 =>

         -- buffering started at record_terminal so must print out
         Print_Colon_Declarations_Buffer;
         Decrease_Indent;

 -------------------------------------------------------------------
 -- component_declaration ::= identifier_list : subtype_indication
 --     [:=expression] ;

  when 73 =>

         New_Line;
         Process_Identifier_List (Record_Field_List);

 -------------------------------------------------------------------
 -- discriminant_specification ::= identifier_list : start_expanded_name
 --     type_mark

  when 74 =>

         Process_Identifier_List (Discriminant_List);

 -------------------------------------------------------------------
 -- variant_part ::= CASE__identifier__IS {pragma_variant}__variant__{variant}
 --     END

  when 75 =>

         New_Line;

 -------------------------------------------------------------------
 -- declarative_part ::= start_bdi {basic_declarative_item}

  when 85

 -------------------------------------------------------------------
 -- declarative_part ::= start_bdi {basic_declarative_item} body

  | 86 =>

         Decrease_Indent;
         End_Declarative_Part;

 -------------------------------------------------------------------
 -- start_bdi ::= empty

  when 87 =>

         Start_Declarative_Part;

 -------------------------------------------------------------------
 -- basic_declarative_item ::= basic_declaration

  when 88

 -------------------------------------------------------------------
 -- basic_declarative_item ::= representation_clause

  | 89

 -------------------------------------------------------------------
 -- basic_declarative_item ::= use_clause

  | 90

 -------------------------------------------------------------------
 -- later_declarative_item ::= subprogram_declaration

  | 92

 -------------------------------------------------------------------
 -- later_declarative_item ::= package_declaration

  | 93

 -------------------------------------------------------------------
 -- later_declarative_item ::= task_specification

  | 94

 -------------------------------------------------------------------
 -- later_declarative_item ::= generic_specification

  | 95

 -------------------------------------------------------------------
 -- later_declarative_item ::= use_clause

  | 96

 -------------------------------------------------------------------
 -- later_declarative_item ::= generic_instantiation

  | 97

 -------------------------------------------------------------------
 -- body ::= proper_body

  | 98

 -------------------------------------------------------------------
 -- body ::= body_stub

  | 99 =>

         New_Line;

 -------------------------------------------------------------------
 -- proper_body ::= subprogram_body

  when 100

 -------------------------------------------------------------------
 -- proper_body ::= package_body

  | 101

 -------------------------------------------------------------------
 -- proper_body ::= task_body

  | 102 =>

         Switch_Comment_Context;

 -------------------------------------------------------------------
 -- binary_adding_operator ::= +

  when 156

 -------------------------------------------------------------------
 -- binary_adding_operator ::= -

  | 157 =>

         Put_Space;

 -------------------------------------------------------------------
 -- sequence_of_statements ::= {pragma_stm} statement {statement}

  when 174 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- simple_statement ::= break_decision_point exit_statement

  when 182

 -------------------------------------------------------------------
 -- simple_statement ::= break_always return_statement

  | 183

 -------------------------------------------------------------------
 -- simple_statement ::= break_every_statement goto_statement

  | 184

 -------------------------------------------------------------------
 -- simple_statement ::= break_every_statement abort_statement

  | 186

 -------------------------------------------------------------------
 -- simple_statement ::= break_every_statement raise_statement

  | 187

 -------------------------------------------------------------------
 -- compound_statement ::= break_decision_point if_statement

  | 188

 -------------------------------------------------------------------
 -- compound_statement ::= break_decision_point case_statement

  | 189

 -------------------------------------------------------------------
 -- compound_statement ::= break_decision_point select_statement

  | 191

 -------------------------------------------------------------------
 -- ambiguous_statement ::= break_ambiguous assignment_statement

  | 192

 -------------------------------------------------------------------
 -- ambiguous_statement ::= break_ambiguous code_statement

  | 194

 -------------------------------------------------------------------
 -- ambiguous_statement ::= break_ambiguous loop_statement

  | 195

 -------------------------------------------------------------------
 -- ambiguous_statement ::= break_ambiguous block_statement

  | 196 =>

         New_Line;

 -------------------------------------------------------------------
 -- break_every_statement ::= empty

  when 197 =>

         Add_Breakpoint (Every_Statement);

 -------------------------------------------------------------------
 -- break_decision_point ::= empty

  when 198 =>

         Add_Breakpoint (Decision_Point);

 -------------------------------------------------------------------
 -- break_always ::= empty

  when 199 =>

         Add_Breakpoint (Always);

 -------------------------------------------------------------------
 -- break_ambiguous ::= empty

  when 200 =>

         Add_Breakpoint (Ambiguous);

 -------------------------------------------------------------------
 -- resolve_simple ::= empty

  when 201 =>

         Resolve_Breakpoint (Simple_Statement);

 -------------------------------------------------------------------
 -- null_statement ::= NULL ;

  when 203 =>

         New_Line;

 -------------------------------------------------------------------
 -- sequence_of_statements__end_block_statements ::= sequence_of_statements

  when 217 =>

         End_Block_Sequence_of_Statements;

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

 -- block_statement ::= [block_identifier:] declare_terminal
 -- declarative_part__begin_end_block [identifier] ;

   when 218

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

 -- block_statement ::= [block_identifier:] begin_end_block [identifier] ;

      | 219 =>

         End_Block_Statement;

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

 -- subprogram_declaration ::= subprogram_specification ;

  when 227 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- subprogram_specification ::= PROCEDURE start_identifier

  when 228

 -------------------------------------------------------------------
 -- subprogram_specification ::= PROCEDURE start_identifier left_paren

  | 229 =>

         Subprogram_Type ("procedure");

 -------------------------------------------------------------------
 -- subprogram_specification ::= FUNCTION designator RETURN start_expanded_name

  when 230

 -------------------------------------------------------------------
 -- subprogram_specification ::= FUNCTION designator left_paren right_paren

  | 231 =>

         Subprogram_Type ("function");

 -------------------------------------------------------------------
 -- designator ::= identifier

  when 232

 -------------------------------------------------------------------
 -- designator ::= string_literal

  | 233 =>

         Push_Identifier;

 -------------------------------------------------------------------
 -- parameter_specification ::= identifier_list mode type_mark [:=expression]

  when 234 =>

         Process_Identifier_List (Parameter_List);

 -------------------------------------------------------------------
 -- mode ::= : OUT

  when 236 =>

         Set_Identifier_Mode (Write_Only);

 -------------------------------------------------------------------
 -- generic_parameter_mode ::= :

  when 237 =>

         Insert_In_Token;
         Set_Identifier_Mode (Read_Only);

 -------------------------------------------------------------------
 -- generic_parameter_mode ::= : IN

  when 238 =>

         null;
         Set_Identifier_Mode (Read_Only);

 -------------------------------------------------------------------
 -- generic_parameter_mode ::= : IN OUT

  when 239 =>

         Set_Identifier_Mode (Read_Write);

 -------------------------------------------------------------------
 -- subprogram_body ::= subprogram_specification__IS [end_designator] ;

  when 240 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- call_statement ::= name resolve_simple ;

  when 241 =>

         New_Line;

 -------------------------------------------------------------------
 -- package_declaration ::= package_specification ;

  when 242 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- package_body ::= PACKAGE__BODY__start_identifier__IS
 --     declarative_part__no_begin

  when 245

 -------------------------------------------------------------------
 -- package_body ::= PACKAGE__BODY__start_identifier__IS [identifier] ;

  | 246 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- declarative_part__no_begin ::= declarative_part

  when 247 =>

         Add_Package_Body_Begin;

 -------------------------------------------------------------------
 -- private_type_declaration ::= TYPE type_identifier IS LIMITED PRIVATE ;

  when 248 =>

         Start_Trace_Procedure (Limited_Private_Type);

 -------------------------------------------------------------------
 -- private_type_declaration ::= TYPE type_identifier left_paren right_paren IS

  when 249 =>

         Start_Trace_Procedure (Limited_Private_Type);

 -------------------------------------------------------------------
 -- private_type_declaration ::= TYPE type_identifier IS PRIVATE ;

  when 250 =>

         Start_Trace_Procedure (Private_Type);

 -------------------------------------------------------------------
 -- private_type_declaration ::= TYPE type_identifier left_paren right_paren IS

  when 251 =>

         Start_Trace_Procedure (Private_Type);

 -------------------------------------------------------------------
 -- package_name ::= start_expanded_name expanded_name

  when 253 =>

         Use_Package_Name;

 -------------------------------------------------------------------
 -- renaming_colon_declaration ::= identifier_list : type_mark RENAMES name ;

  when 254

 -------------------------------------------------------------------
 -- renaming_colon_declaration ::= identifier_list : EXCEPTION RENAMES ;

  | 255 =>

         Process_Identifier_List (Renaming_List);

 -------------------------------------------------------------------
 -- renaming_declaration ::= PACKAGE start_identifier RENAMES expanded_name ;

  when 256

 -------------------------------------------------------------------
 -- renaming_declaration ::= subprogram_specification RENAMES name ;

  | 257

 -------------------------------------------------------------------
 -- task_specification ::= TASK start_identifier ;

  | 258 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- task_specification ::= TASK TYPE start_identifier ;

  when 259 =>

         Pop_Identifier;
         Start_Trace_Procedure (Task_Type);
         End_Type_Declaration;

 -------------------------------------------------------------------
  when 261 =>
         End_Type_Declaration;

 -------------------------------------------------------------------
 -- task_body ::= TASK__BODY__start_identifier__IS [identifier] ;

  when 262 =>

         Decrement_Scope;

 -------------------------------------------------------------------
 -- entry_declaration ::= ENTRY identifier [(discrete_range)][formal_part] ;

  when 263 =>

         New_Line;

 -------------------------------------------------------------------
 -- accept_statement ::= ACCEPT start_identifier [(expression)][formal_part] ;

  when 264 =>

         Pop_Identifier;
         New_Line;

 -------------------------------------------------------------------
 -- accept_statement ::=
 --     ACCEPT__start_identifier__[(expression)][formal_part]__DO

  when 265

 -------------------------------------------------------------------
 -- delay_statement ::= DELAY__start_delay_expression ;

  | 266 =>

         New_Line;

 -------------------------------------------------------------------
 -- DELAY__start_delay_expression ::= DELAY

  when 267 =>

         Start_Delay_Expression;

 -------------------------------------------------------------------
 -- simple_expression__end_delay_expression ::= simple_expression

  when 268 =>

         End_Delay_Expression;

 -------------------------------------------------------------------
 -- select_alternative ::= {pragma_stm}

  when 273

 -------------------------------------------------------------------
 -- select_alternative ::= {pragma_stm} selective_wait_alternative

  | 274 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- TERMINATE__; ::= TERMINATE ;

  when 281 =>

         New_Line;

 -------------------------------------------------------------------
 -- accept_statement__decision_point ::= accept_statement

  when 284

 -------------------------------------------------------------------
 -- delay_statement__decision_point ::= delay_statement

  | 285

 -------------------------------------------------------------------
 -- call_statement__decision_point ::= call_statement

  | 286 =>

         Add_Breakpoint (Decision_Point);

 -------------------------------------------------------------------
 -- compilation_unit ::= pragma_header ( general_component_associations ) ;

  when 290

 -------------------------------------------------------------------
 -- compilation_unit ::= pragma_header ;

  | 291 =>

         New_Line;

 -------------------------------------------------------------------
 -- compilation_unit ::= context_clause library_or_secondary_unit

  when 292 =>

         End_Compilation_Unit;

 -------------------------------------------------------------------
 -- library_or_secondary_unit ::= subprogram_body

  when 297

 -------------------------------------------------------------------
 -- library_or_secondary_unit ::= package_body

  | 298 =>

         Switch_Comment_Context;

 -------------------------------------------------------------------
 -- library_unit_name ::= identifier

  when 302 =>

         With_Library_Unit;

 -------------------------------------------------------------------
 -- body_stub ::= subprogram_specification IS SEPARATE ;

  when 303

 -------------------------------------------------------------------
 -- body_stub ::= PACKAGE BODY start_identifier IS SEPARATE ;

  | 304

 -------------------------------------------------------------------
 -- body_stub ::= TASK BODY start_identifier IS SEPARATE ;

  | 305 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- exception_declaration ::= identifier_list : EXCEPTION ;

  when 307 =>

         Process_Identifier_List (Exception_List);

 -------------------------------------------------------------------
 -- non_others_handler ::= WHEN__exception_choice__{|exception_choice}__=>

  when 310

 -------------------------------------------------------------------
 -- others_handler ::= WHEN__exception_OTHERS__=> sequence_of_statements

  | 311 =>

         End_Exception_Sequence_of_Statements;

 -------------------------------------------------------------------
 -- generic_specification ::= generic_formal_part subprogram_specification ;

  when 315 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- generic_specification ::= generic_formal_part package_specification ;

  when 316 =>

          Decrement_Scope;

 -------------------------------------------------------------------
 -- generic_formal_part ::= generic_terminal {generic_parameter_declaration}

  when 317 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- generic_parameter_declaration ::= identifier_list generic_parameter_mode ;

  when 318 =>

        New_Line;
        Process_Identifier_List (Generic_Object_List);

 -------------------------------------------------------------------
 -- generic_parameter_declaration ::= TYPE identifier IS generic_type_definition
 --     ;

  when 319

 -------------------------------------------------------------------
 -- generic_parameter_declaration ::= TYPE identifier left_paren right_paren IS

  | 320 =>

         New_Line;

 -------------------------------------------------------------------
 -- generic_parameter_declaration ::= WITH subprogram_specification ;

  when 321 =>

         New_Line;
         Pop_Identifier;

 -------------------------------------------------------------------
 -- generic_instantiation ::= PACKAGE start_identifier IS__NEW__expanded_name ;

  when 330

 -------------------------------------------------------------------
 -- generic_instantiation ::= PACKAGE start_identifier IS__NEW__expanded_name (
 --     )

  | 331

 -------------------------------------------------------------------
 -- generic_instantiation ::= FUNCTION designator IS__NEW__expanded_name ;

  | 332

 -------------------------------------------------------------------
 -- generic_instantiation ::= FUNCTION designator IS__NEW__expanded_name ( ) ;

  | 333

 -------------------------------------------------------------------
 -- generic_instantiation ::= subprogram_specification IS__NEW__expanded_name ;

  | 334

 -------------------------------------------------------------------
 -- generic_instantiation ::= subprogram_specification IS__NEW__expanded_name (
 --     )

  | 335 =>

         Decrease_Indent;
         Pop_Identifier;

 -------------------------------------------------------------------
 -- IS__NEW__expanded_name ::= generic_instantiation_IS NEW start_expanded_name

  when 336 =>

         Save_Generic_Name;

 -------------------------------------------------------------------
 -- generic_instantiation_IS ::= IS

  when 337 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- representation_clause ::= record_representation_clause

  when 345 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- component_clause ::= name AT simple_expression range_constraint ;

  when 350 =>

         New_Line;

 -------------------------------------------------------------------
 -- alignment_clause ::= AT MOD simple_expression ;

  when 351 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- [loop_identifier:] ::= empty

  when 440 =>

         Push_Empty_Token;
         Resolve_Breakpoint (Loop_No_Identifier);

 -------------------------------------------------------------------
 -- [loop_identifier:] ::= identifier :

  when 441 =>

         Push_Identifier;
         Resolve_Breakpoint (Loop_With_Identifier);

 -------------------------------------------------------------------
 -- [identifier] ::= empty

  when 442 =>

         Pop_Identifier(To_Output);

 -------------------------------------------------------------------
 -- [identifier] ::= identifier

  when 443 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- [block_identifier:] ::= empty

  when 444 =>

         Resolve_Breakpoint (Block_No_Identifier);

 -------------------------------------------------------------------
 -- [block_identifier:] ::= identifier :

  when 445 =>

         Push_Identifier;
         Resolve_Breakpoint (Block_With_Identifier);

 -------------------------------------------------------------------
 -- [exception_handler_part] ::= empty

  when 446 =>

         Add_Exception_Handler;

 -------------------------------------------------------------------
 -- {pragma_alt}__exception_handler ::= {pragma_alt} exception_handler

  when 448 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- [others_handler] ::= empty

  when 451 =>

         Add_Others_Handler;

 -------------------------------------------------------------------
 -- [end_designator] ::= empty

  when 455 =>

         Pop_Identifier(To_Output);

 -------------------------------------------------------------------
 -- [end_designator] ::= identifier

  when 456

 -------------------------------------------------------------------
 -- [end_designator] ::= string_literal

  | 457 =>

         Pop_Identifier;

 -------------------------------------------------------------------
 -- {with_clause{use_clause}} ::= {with_clause{use_clause}} with_clause

  when 481 =>

         New_Line;

 -------------------------------------------------------------------
   when 485 =>
         With_Library_Unit;

 -------------------------------------------------------------------
 -- record_terminal ::= RECORD

  when 499 =>

         New_Line;
         Increase_Indent;
         Start_Buffering_Colon_Declarations;
         -- Generate ("start of record type tracevar");

 -------------------------------------------------------------------
 -- closing_{pragma_decl} ::= {pragma_decl}

  when 500

 -------------------------------------------------------------------
 -- {component_declaration}' ::= {component_declaration}

  | 501 =>

         Print_Colon_Declarations_Buffer;

 -------------------------------------------------------------------
 -- start_of_record_type ::= EMPTY

  when 502

 -------------------------------------------------------------------
 -- repspec_record_terminal ::= RECORD

  | 503

 -------------------------------------------------------------------
 -- CASE__identifier__IS ::= CASE__identifier IS

  | 504

 -------------------------------------------------------------------
 -- WHEN__choice__{|choice}__=> ::= WHEN choice {|choice} =>

  | 505

 -------------------------------------------------------------------
 -- WHEN__OTHERS__=> ::= WHEN OTHERS =>

  | 506

 -------------------------------------------------------------------
 -- CASE__expression__IS ::= CASE expression IS

  | 507 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- generic_terminal ::= GENERIC

  when 508 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- CASE__identifier ::= CASE identifier

  when 509 =>

         null;
         -- Generate ("case var.identifier for record variant");

 -------------------------------------------------------------------
 -- WHEN__variant_choice__{|variant_choice}__=> ::= WHEN__choice__{|choice}__=>

  when 510

 -------------------------------------------------------------------
 -- WHEN__variant_OTHERS__=> ::= WHEN__OTHERS__=>

  | 511 =>

         Start_Buffering_Colon_Declarations;

 -------------------------------------------------------------------
 -- WHEN__case_choice__{|choice}__=> ::= WHEN__choice__{|choice}__=>

  when 512

 -------------------------------------------------------------------
 -- WHEN__case_OTHERS__=> ::= WHEN__OTHERS__=>

  | 513 =>

         Add_Breakpoint (Decision_Point);

 -------------------------------------------------------------------
 -- {pragma_alt}__case_statement_alternative__{case_statement_alternative} ::=

  when 514 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- loop_terminal ::= LOOP

  when 515 =>

         New_Line;
         Increase_Indent;
         Start_Loop;

 -------------------------------------------------------------------
 -- begin_terminal ::= BEGIN

  when 516 =>

         Switch_Comment_Context;
         New_Line;
         Increase_Indent;
         Start_Begin_End_Block;

 -------------------------------------------------------------------
 -- {pragma_variant}__variant__{variant} ::= {pragma_variant} variant {variant}

  when 517 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- declare_terminal ::= DECLARE

  when 518 =>

         Switch_Comment_Context;
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- PACKAGE__start_identifier__IS ::= PACKAGE start_identifier IS

  when 519 =>

         Increment_Scope (Package_Specification);
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- start_identifier ::= identifier

  when 520 =>

         Push_Identifier;

 -------------------------------------------------------------------
 -- {basic_declarative_item}' ::= {basic_declarative_item}

  when 521

 -------------------------------------------------------------------
 -- {entry_declaration}__{representation_clause} ::= {entry_declaration}

  | 522 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- private_terminal ::= PRIVATE

  when 523 =>

         New_Line;
         Increase_Indent;
         Start_Private_Part;

 -------------------------------------------------------------------
 -- PACKAGE__BODY__start_identifier__IS ::= PACKAGE BODY start_identifier IS

  when 524 =>

         Increment_Scope (Package_Body);
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- TASK__start_identifier__IS ::= TASK start_identifier IS

  when 525 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- TASK__TYPE__start_identifier__IS ::= TASK TYPE start_identifier IS

  when 526 =>

         New_Line;
         Increase_Indent;
         Start_Trace_Procedure (Task_Type);

 -------------------------------------------------------------------
 -- TASK__BODY__start_identifier__IS ::= TASK BODY start_identifier IS

  when 527 =>

         Increment_Scope (Task_Body);
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- ACCEPT__start_identifier__[(expression)][formal_part]__DO ::= ACCEPT DO

  when 528

 -------------------------------------------------------------------
 -- select_terminal ::= SELECT

  | 529 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- call_statement__[sequence_of_statements] ::= call_statement__decision_point

  when 530 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- delay_alternative_in_timed_entry ::= delay_alternative

  when 532

 -------------------------------------------------------------------
 -- WHEN__condition__=>__selective_wait_alternative ::= WHEN__condition__=>

  | 533 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- WHEN__condition__=> ::= WHEN condition =>

  when 534

 -------------------------------------------------------------------
 -- exception_terminal ::= EXCEPTION

  | 535 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- WHEN__exception_choice__{|exception_choice}__=> ::= WHEN exception_choice =>

  when 536

 -------------------------------------------------------------------
 -- WHEN__exception_OTHERS__=> ::= WHEN OTHERS =>

  | 537 =>

         New_Line;
         Increase_Indent;
         Start_Exception_Branch;

 -------------------------------------------------------------------
 -- subprogram_specification__IS ::= subprogram_specification IS

  when 538 =>

         Increment_Scope (Subprogram_Body);
         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- {component_clause}' ::= {component_clause}

  when 539 =>

         Decrease_Indent;

 -------------------------------------------------------------------
 -- SEPARATE__(__expanded_name__) ::= SEPARATE__(__expanded_name )

  when 540 =>

         New_Line;

 -------------------------------------------------------------------
 -- SEPARATE__(__expanded_name ::= SEPARATE ( start_expanded_name expanded_name

  when 541 =>

         Save_Separate_Name;

 -------------------------------------------------------------------
 -- start_expanded_name ::= empty

  when 542 =>

         Start_Saving_Expanded_Name;

 -------------------------------------------------------------------
 -- {basic_colon_declaration} ::= start_{basic_colon_declaration} {pragma_decl}

  when 543 =>

         Print_Colon_Declarations_Buffer;

 -------------------------------------------------------------------
 -- start_{basic_colon_declaration} ::= EMPTY

  when 544 =>

         Start_Buffering_Colon_Declarations;

 -------------------------------------------------------------------
 -- condition__THEN ::= condition THEN

  when 549

 -------------------------------------------------------------------
 -- ELSIF__condition__THEN ::= ELSIF condition THEN

  | 550

 -------------------------------------------------------------------
 -- else_terminal ::= ELSE

  | 551 =>

         New_Line;
         Increase_Indent;
         Add_Breakpoint (Decision_Point);

 -------------------------------------------------------------------
 -- or_terminal ::= OR

  when 552 =>

         New_Line;
         Increase_Indent;

 -------------------------------------------------------------------
 -- discriminant__; ::= ;

  when 553

 -------------------------------------------------------------------
 -- parameter__; ::= ;

  | 554 =>

         New_Line;

 -------------------------------------------------------------------
 -- left_paren ::= (

  when 555 =>

         Change_Indent;
         Start_Buffering_Colon_Declarations;

 -------------------------------------------------------------------
 -- right_paren ::= )

  when 556 =>

         Print_Colon_Declarations_Buffer;
         Resume_Normal_Indentation;

     when others =>
         null;
     end case;
 end Apply_Actions;

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--si.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

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 Host_Dependencies;
with Simple_Paginated_Output;
with TEXT_IO;
with User_Interface;

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;
    package HD  renames Host_Dependencies;
    package PO  renames Simple_Paginated_Output;

                         -- Objects --

    Return_Value : PD.ParseStackElement;
    Input_File   : TEXT_IO.FILE_TYPE;

begin
    TEXT_IO.OPEN(FILE => Input_File,
                 MODE => TEXT_IO.IN_FILE,
                 NAME => Source_File);


      PO.Create_Paginated_File(File_Handle => SID.Listing_File,
                               File_Name => Listing_File,
                               Header_Size => 6);
      PO.Set_Header(File_Handle => SID.Listing_File, Header_Line => 1,
          Header_Text => "Source Instrumenter Output on ~d at " &
          "~t                    ~p");
      PO.Set_Header(File_Handle => SID.Listing_File, Header_Line => 2,
          Header_Text => "Source File: " & Source_File);
      PO.Set_Header(File_Handle => SID.Listing_File, Header_Line => 4,
          Header_Text => "Bkpt");
      PO.Set_Header(File_Handle => SID.Listing_File, Header_Line => 5,
          header_Text => "Number  Source Text");
      PO.Set_Header(File_Handle => SID.Listing_File, Header_Line => 6,
          Header_Text => "------  -----------");
      PO.Create_Paginated_File(File_Handle => SID.Instrumented_File,
                               File_Name => Instrumented_File,
                               Header_Size => 0,
                               Page_Size => 0);

    User_Interface.Get_Instrumenting_instructions(SIU.Current_Trace_Mode,
          SIU.Do_Type_tracing);
    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);
    PO.Close_Paginated_File(SID.Listing_File);
    PO.Close_Paginated_File(SID.Instrumented_File);
    TEXT_IO.CLOSE(Input_File);
    TEXT_IO.SET_INPUT(TEXT_IO.STANDARD_INPUT);

exception
    when TEXT_IO.NAME_ERROR =>
        TEXT_IO.PUT_LINE(ITEM => "Error opening file " & Source_File &
            " for input.");
    when PD.Parser_Error =>
        TEXT_IO.NEW_LINE;
        TEXT_IO.PUT_LINE(ITEM => "Syntax Error in Source: Line: " &
            HD.Source_Line'Image(PD.CurToken.lexed_token.srcpos_line) &
            " Column: " & HD.Source_Column'Image(
            PD.CurToken.lexed_token.srcpos_column));
    when PO.File_Error =>
        TEXT_IO.PUT_LINE(ITEM => "Error opening file " &
            " for output.");

    -- Handle others in driver.
    when others =>
        raise;
end Source_Instrument;

---------------------------------------------------------------------
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--COMPLIST.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS;

------------------------------
package COMPILATION_UNIT_LISTS is
------------------------------

  use TYPE_DEFINITIONS;

  UNDEFINED_COMPILATION_UNIT : exception;
  UNDEFINED_PROGRAM_UNIT     : exception;


  ---------------------------------
  procedure ADD_COMPILATION_UNIT(--| Insert Compilation Unit into the list
    COMPILATION_UNIT_NAME : in ADA_NAME;
    NUMBER_OF_BREAKPOINTS : in BREAKPOINT_NUMBER_RANGE);

  -----------------------------
  procedure ADD_PROGRAM_UNIT(--| Insert Program Unit into the list
    UNIT_ID           : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    PROGRAM_UNIT_NAME : in ADA_NAME);

  -----------------------------------
  procedure GET_NUMBER_OF_BREAKPOINTS(--| Get the number of breakpoints
                                      --| in the compilation unit
    COMPILATION_UNIT_NAME : in  ADA_NAME;
    NUMBER_OF_BREAKPOINTS : out BREAKPOINT_NUMBER_RANGE);

  -------------------------------
  procedure GET_PROGRAM_UNIT_NAME(--| Get the program unit name for the
                                  --| Specified program unit
    UNIT_ID           : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    PROGRAM_UNIT_NAME : out ADA_NAME);

  -------------------
  procedure DUMP_LIST; --| Debug procedure to dump the list


end COMPILATION_UNIT_LISTS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--COMPLIST.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS, TEXT_IO, STRING_PKG;

-----------------------------------
package body COMPILATION_UNIT_LISTS is
-----------------------------------

  use TYPE_DEFINITIONS, TEXT_IO, STRING_PKG;

  package INT_IO is
    new INTEGER_IO(INTEGER);
  use INT_IO;


  type PROGRAM_UNIT_LIST;

  type NEXT_PROGRAM_UNITS is access PROGRAM_UNIT_LIST;

  type PROGRAM_UNIT_LIST is
    record
      NAME   : ADA_NAME;                   --| the name of this PU
      NUMBER : PROGRAM_UNIT_NUMBER_RANGE;  --| assigned by source instrumenter
      NEXT   : NEXT_PROGRAM_UNITS;         --| pointer to next PU for this CU
    end record;


  type COMPILATION_UNIT_LIST;

  type NEXT_COMPILATION_UNITS is access COMPILATION_UNIT_LIST;

  type COMPILATION_UNIT_LIST is
    record
      NAME                  : ADA_NAME;               --| the name of this CU
      NUMBER_OF_BREAKPOINTS : BREAKPOINT_NUMBER_RANGE;--| the no of breakpoints
      NEXT                  : NEXT_COMPILATION_UNITS; --| pointer to next CU
      PROGRAM_UNIT_LIST     : NEXT_PROGRAM_UNITS;     --| the PU's for this CU
    end record;


  CURRENT_COMPILATION_UNIT : NEXT_COMPILATION_UNITS := null;
  LAST_COMPILATION_UNIT    : NEXT_COMPILATION_UNITS := null;
  ROOT                     : NEXT_COMPILATION_UNITS := null;
  CURRENT_PROGRAM_UNIT     : NEXT_PROGRAM_UNITS := null;
  LAST_PROGRAM_UNIT        : NEXT_PROGRAM_UNITS := null;

  DEBUG                    : BOOLEAN := FALSE;
                             -- if DEBUG statements are removed, Text_IO
                             -- is not needed.


  ------------------------------
  procedure SET_COMPILATION_UNIT(--| Set list pointer to current Comp Unit
    COMPILATION_UNIT_NAME : in ADA_NAME

    ) is

  begin

    CURRENT_COMPILATION_UNIT := ROOT;

    if DEBUG then
      PUT("In Set_Compilation_Unit ");
      PUT("Find ");
      PUT_LINE(VALUE(COMPILATION_UNIT_NAME));
    end if;

    loop
      if CURRENT_COMPILATION_UNIT = null then
        -- The Compilation Unit is not in the list. Exit with
        -- Current_Compilation_Unit positioned at the null node
        -- so it can be allocated, if necessary.
        if DEBUG then
          PUT_LINE("** No Match **");
        end if;
        exit;
      elsif EQUAL(CURRENT_COMPILATION_UNIT.NAME, COMPILATION_UNIT_NAME) then
        -- Found a match.
        if DEBUG then
          PUT_LINE("** CU Matched **");
        end if;
        exit;
      else
        if DEBUG then
          PUT("** CU Cell Used by ");
          PUT_LINE(VALUE(CURRENT_COMPILATION_UNIT.NAME));
        end if;
        LAST_COMPILATION_UNIT := CURRENT_COMPILATION_UNIT;
        CURRENT_COMPILATION_UNIT := CURRENT_COMPILATION_UNIT.NEXT;
      end if;
    end loop;

  end SET_COMPILATION_UNIT;


  ------------------------------
  procedure ADD_COMPILATION_UNIT(--| ADD Compilation Unit to the list
    COMPILATION_UNIT_NAME : in ADA_NAME;
    NUMBER_OF_BREAKPOINTS : in BREAKPOINT_NUMBER_RANGE

    ) is

  begin

    -- Position the list pointer to the node containing the compilation
    -- unit name specified in Unit_ID. If it is not already in the list,
    -- leave the list pointer on a null node.
    SET_COMPILATION_UNIT(COMPILATION_UNIT_NAME);

    if CURRENT_COMPILATION_UNIT = null then

      --  Add the new compilation unit to the list.
      if DEBUG then
        PUT_LINE("** Add CU **");
      end if;

      if ROOT = null then   -- the list is empty
        ROOT := new COMPILATION_UNIT_LIST;
        CURRENT_COMPILATION_UNIT := ROOT;
      else
        CURRENT_COMPILATION_UNIT   := new COMPILATION_UNIT_LIST;
        LAST_COMPILATION_UNIT.NEXT := CURRENT_COMPILATION_UNIT;
      end if;

      CURRENT_COMPILATION_UNIT.NAME := MAKE_PERSISTENT(COMPILATION_UNIT_NAME);
      CURRENT_COMPILATION_UNIT.NEXT := null;
      CURRENT_COMPILATION_UNIT.PROGRAM_UNIT_LIST := null;
      CURRENT_COMPILATION_UNIT.NUMBER_OF_BREAKPOINTS := NUMBER_OF_BREAKPOINTS;
      if DEBUG then
        PUT_LINE("** CU Added **");
      end if;

    end if;

  end ADD_COMPILATION_UNIT;


  -----------------------------------
  procedure GET_NUMBER_OF_BREAKPOINTS(--| Get the number of breakpoints
                                      --| in the compilation unit

    COMPILATION_UNIT_NAME : in  ADA_NAME;
    NUMBER_OF_BREAKPOINTS : out BREAKPOINT_NUMBER_RANGE

    ) is

  begin

    --  Position the list pointer to the node containing the compilation
    --  unit name specified in Unit_ID. If it is not already in the list,
    --  then raise the exception Undefined_Compilation_Unit.

    SET_COMPILATION_UNIT(COMPILATION_UNIT_NAME);

    if CURRENT_COMPILATION_UNIT = null then

      PUT_LINE("Undefined Compilation Unit Error");
      PUT("Unit = ");
      PUT(VALUE(COMPILATION_UNIT_NAME));
      NEW_LINE;

      raise UNDEFINED_COMPILATION_UNIT;

    end if;

    NUMBER_OF_BREAKPOINTS := CURRENT_COMPILATION_UNIT.NUMBER_OF_BREAKPOINTS;

  end GET_NUMBER_OF_BREAKPOINTS;


  --------------------------
  procedure SET_PROGRAM_UNIT(--| Set list pointer to specified program unit
    UNIT_ID : in PROGRAM_UNIT_UNIQUE_IDENTIFIER

    ) is

    COMPILATION_UNIT_NAME : ADA_NAME;

  begin

    -- Position the list pointer to the node containing the compilation
    -- unit name specified in Unit_ID. If it is not already in the list,
    -- then leave the list pointer on a null node.
    if DEBUG then
      PUT("In Set_Program_Unit ");
      PUT("Find ");
      PUT(VALUE(UNIT_ID.ENCLOSING_UNIT_IDENTIFIER));
      PUT(' ');
      PUT(UNIT_ID.PROGRAM_UNIT_NUMBER);
      NEW_LINE;
    end if;
    COMPILATION_UNIT_NAME := UNIT_ID.ENCLOSING_UNIT_IDENTIFIER;
    SET_COMPILATION_UNIT(COMPILATION_UNIT_NAME);

    if CURRENT_COMPILATION_UNIT /= null then

      CURRENT_PROGRAM_UNIT := CURRENT_COMPILATION_UNIT.PROGRAM_UNIT_LIST;

      loop

        if CURRENT_PROGRAM_UNIT = null then
          --  The program unit is not in the list.
          if DEBUG then
            PUT_LINE("** PU Not Matched PU **");
          end if;
          exit;

        elsif CURRENT_PROGRAM_UNIT.NUMBER = UNIT_ID.PROGRAM_UNIT_NUMBER then
          --  Found a match.
          if DEBUG then
            PUT_LINE("** PU Matched **");
          end if;
          exit;

        else
          if DEBUG then
            PUT_LINE("** PU Cell Used **");
          end if;
          LAST_PROGRAM_UNIT := CURRENT_PROGRAM_UNIT;
          CURRENT_PROGRAM_UNIT := CURRENT_PROGRAM_UNIT.NEXT;

        end if;

      end loop;

    end if;

  end SET_PROGRAM_UNIT;


  --------------------------
  procedure ADD_PROGRAM_UNIT(--| Add Program Unit to the list
    UNIT_ID           : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    PROGRAM_UNIT_NAME : in ADA_NAME

    ) is

    COMPILATION_UNIT_NAME : ADA_NAME;

  begin

    -- Position the list pointer to the node containing the compilation
    -- unit name and program unit number specified in Unit_ID.
    SET_PROGRAM_UNIT(UNIT_ID);

    if CURRENT_PROGRAM_UNIT = null then
      --  The program unit is not in the list. Allocate a new node.
      if DEBUG then
        PUT_LINE("** Allocate PU Node **");
      end if;
      CURRENT_PROGRAM_UNIT := new PROGRAM_UNIT_LIST;

      if CURRENT_COMPILATION_UNIT.PROGRAM_UNIT_LIST = null then
        CURRENT_COMPILATION_UNIT.PROGRAM_UNIT_LIST := CURRENT_PROGRAM_UNIT;
        LAST_PROGRAM_UNIT := CURRENT_COMPILATION_UNIT.PROGRAM_UNIT_LIST;
      end if;

      LAST_PROGRAM_UNIT.NEXT      := CURRENT_PROGRAM_UNIT;
      CURRENT_PROGRAM_UNIT.NAME   := MAKE_PERSISTENT(PROGRAM_UNIT_NAME);
      CURRENT_PROGRAM_UNIT.NUMBER := UNIT_ID.PROGRAM_UNIT_NUMBER;
      CURRENT_PROGRAM_UNIT.NEXT   := null;
      if DEBUG then
        PUT_LINE("** PU Added **");
      end if;

    end if;

  end ADD_PROGRAM_UNIT;


  -------------------------------
  procedure GET_PROGRAM_UNIT_NAME(--| Get the program unit name for the
                                  --| Specified program unit
    UNIT_ID           : in  PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    PROGRAM_UNIT_NAME : out ADA_NAME

    ) is

  begin

    --| Position the list pointer to the node containing the compilation
    --| unit name and program unit number specified in Unit_ID.

    SET_PROGRAM_UNIT(UNIT_ID);


    --| If the list pointer is null then this program unit is not in
    --| the list.  That means that this is the main procedure in
    --| the compilation unit or that the unit is undefined.
    if CURRENT_PROGRAM_UNIT = null then

      if UNIT_ID.PROGRAM_UNIT_NUMBER = 0 then

        --| If the program unit number is zero then this is the
        --| main program unit for the compilation unit. It should
        --| have the same name as the compilation unit
        PROGRAM_UNIT_NAME := UNIT_ID.ENCLOSING_UNIT_IDENTIFIER;

      else

        --| The unit is undefined. Nothing else can be done but
        --| raise an exception. Before raising the exception
        --| display the compilation unit name and unit number
        --| of the offender
        PUT_LINE("Undefined Program Unit Error");
        PUT("Unit = ");
        PUT(VALUE(UNIT_ID.ENCLOSING_UNIT_IDENTIFIER));
        PUT("   Program Unit = ");
        PUT(UNIT_ID.PROGRAM_UNIT_NUMBER);
        NEW_LINE;

        raise UNDEFINED_PROGRAM_UNIT;

      end if;

    else

      --| The program unit has been found
      PROGRAM_UNIT_NAME := CURRENT_PROGRAM_UNIT.NAME;

    end if;

  end GET_PROGRAM_UNIT_NAME;

  -------------------
  procedure DUMP_LIST is  --| Debug procedure to dump the list

    CU_NUMBER : NATURAL := 0;
    PU_NUMBER : PROGRAM_UNIT_NUMBER_RANGE;

  begin

    CURRENT_COMPILATION_UNIT := ROOT;

    while CURRENT_COMPILATION_UNIT /= null loop
      CU_NUMBER := CU_NUMBER + 1;
      PUT(CU_NUMBER, 0);
      PUT(' ');
      PUT(VALUE(CURRENT_COMPILATION_UNIT.NAME));
      PUT(' ');
      PUT(CURRENT_COMPILATION_UNIT.NUMBER_OF_BREAKPOINTS, 0);
      PUT(' ');
      if CURRENT_COMPILATION_UNIT.NEXT = null then
        PUT("null");
      else
        PUT(CU_NUMBER + 1, 0);
      end if;
      PUT(' ');

      if CURRENT_COMPILATION_UNIT.PROGRAM_UNIT_LIST = null then
        PUT("null");
      else
        PUT(1, 0);
      end if;
      PUT(' ');
      NEW_LINE;

      CURRENT_PROGRAM_UNIT := CURRENT_COMPILATION_UNIT.PROGRAM_UNIT_LIST;

      while CURRENT_PROGRAM_UNIT /= null loop
        PU_NUMBER := CURRENT_PROGRAM_UNIT.NUMBER;
        PUT(PU_NUMBER, 0);
        PUT(' ');
        PUT(VALUE(CURRENT_PROGRAM_UNIT.NAME));
        PUT(' ');
        if CURRENT_PROGRAM_UNIT.NEXT = null then
          PUT("null");
        else
          PUT(PU_NUMBER + 1, 0);
        end if;
        PUT(' ');
        NEW_LINE;
        CURRENT_PROGRAM_UNIT := CURRENT_PROGRAM_UNIT.NEXT;

      end loop;

      NEW_LINE;
      CURRENT_COMPILATION_UNIT := CURRENT_COMPILATION_UNIT.NEXT;

    end loop;

  end DUMP_LIST;

end COMPILATION_UNIT_LISTS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--TIMELIB2.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO, CALENDAR, TIME_LIBRARY_1;

----------------------
package TIME_LIBRARY_2 is
----------------------

--| Overview
--| TimeLib contains procedures and functions for getting, putting,
--| and calculating times, dates, and durations. 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 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/21/85


  type WEEKDAYS is (SUNDAY, MONDAY, TUESDAY, WEDNESDAY, THURSDAY, FRIDAY,
                    SATURDAY);

  ------------------
  procedure GET_TIME_OF_DAY(--| Get the time of day from the file
    FYLE    : in TEXT_IO.FILE_TYPE;     --| The input file
    SECONDS : out CALENDAR.DAY_DURATION --| The time read from fyle
    );

  --| Effects
  --| Gets and returns the time of day from the file.

  --| Requires
  --| Fyle must have been previously opened by the calling program.
  --| The time must have been previously put to fyle in the format
  --| output by Put_Time_of_Day.

  --| N/A:  Raises, Modifies, Errors


  ------------------
  procedure GET_TIME(  --| Get the time from the file
    FYLE : in TEXT_IO.FILE_TYPE;  --| The input file
    DATE : out CALENDAR.TIME      --| The time read from fyle
    );

  --| Effects
  --| Gets and returns the time from the file.

  --| Requires
  --| Fyle must have been previously opened by the calling program.
  --| The time must have been previously put to fyle in the format
  --| output by Put_Time.

  --| N/A:  Raises, Modifies, Errors


  ----------------
  function MAXIMUM(--| Return the MAXIMUM of two Day_Durations

    TIME1, TIME2 : in CALENDAR.DAY_DURATION  --| The two times to be compared

    ) return CALENDAR.DAY_DURATION;

  --| Effects
  --| Compares Time1 to Time2 and returns the MAXIMUM of the two times.

  --| N/A:  Raises, Requires, Modifies, Errors


  ----------------
  function MINIMUM(--| Return the MINIMUM of two Day_Durations

    TIME1, TIME2 : in CALENDAR.DAY_DURATION  --| The two times to be compared

    ) return CALENDAR.DAY_DURATION;

  --| Effects
  --| Compares Time1 to Time2 and returns the MINIMUM of the two times.

  --| N/A:  Raises, Requires, Modifies, Errors


  -------------------
  function WEEKDAY_OF( --| Return the day of week for the specified date

    DATE : in CALENDAR.TIME  --| The date to be converted

    ) return WEEKDAYS;

  --| Effects
  --| Returns the day of week (Sunday..Saturday) for the specified date

  --| N/A:  Raises, Requires, Modifies, Errors


  -------------------
  function WEEKDAY_OF( --| Return the day of week for the specified date

    DATE : in CALENDAR.TIME  --| The date to be converted

    ) return STRING;

  --| Effects
  --| Returns the day of week (Sunday..Saturday) for the specified date

  --| N/A:  Raises, Requires, Modifies, Errors


  -------------------
  procedure TIMING_IS(--| Sets the timing method for times recorded in
                      --| the logfile to Raw or Wall_Clock

    TIME_TYPE : in TIME_LIBRARY_1.TIMING_TYPE
            --| The timing method used to record timing data
    );

  --| Effects
  --| Sets the timing method for GETting times from the logfile to
  --| correspond to the timing method used for recording times in
  --| the logfile by the Run Time Monitor (RTM). Timing methods are
  --| RAW and WALL_CLOCK.

  --| N/A:  Raises, Requires, Modifies, Errors



end TIME_LIBRARY_2;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--TIMELIB2.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO, CALENDAR, TIME_LIBRARY_1;

---------------------------
package body TIME_LIBRARY_2 is
---------------------------

--| Overview
--| TimeLib contains procedures and functions for getting, putting,
--| and calculating times, dates, and durations. 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 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/21/85

  package INT_IO is
    new TEXT_IO.INTEGER_IO(INTEGER);

  package TIME_IO is
    new TEXT_IO.FIXED_IO(CALENDAR.DAY_DURATION);

  TIMING_METHOD : TIME_LIBRARY_1.TIMING_TYPE; --| Methods are Raw and Wall_Clock


  ------------------
  procedure GET_TIME_OF_DAY(--| Get the time of day from the file
    FYLE    : in TEXT_IO.FILE_TYPE;      --| The input file
    SECONDS : out CALENDAR.DAY_DURATION  --| The time read from fyle

      ) is

    --| Effects
    --| Gets and returns the time of day from the file.

    --| Requires
    --| Fyle must have been previously opened by the calling program.
    --| The time must have been previously put to fyle in the format
    --| output by Put_Time_of_Day.

    --| N/A:  Raises, Modifies, Errors


    use TIME_LIBRARY_1;
                      --| For Timing_Type
    use CALENDAR;     --| For "+" of Times and Day_Durations

    subtype HOUR_NUMBER is INTEGER range 0 .. 23;
    subtype MINUTE_NUMBER is INTEGER range 0 .. 59;

    HRS     : HOUR_NUMBER;
    MINS    : MINUTE_NUMBER;
    SECS    : CALENDAR.DAY_DURATION;

    TEMP_CH : CHARACTER;       --  temporary storage for field delimiter

  begin

    if TIMING_METHOD = RAW then
      TIME_IO.GET(FYLE, SECONDS);
    else  -- Timing Method is Wall_Clock
      INT_IO.GET(FYLE, HRS, 2);
      TEXT_IO.GET(FYLE, TEMP_CH);
      INT_IO.GET(FYLE, MINS, 2);
      TEXT_IO.GET(FYLE, TEMP_CH);
      TIME_IO.GET(FYLE, SECS, 5);
      SECONDS := SECS + DAY_DURATION(HRS*3600 + MINS*60);
    end if;

  end GET_TIME_OF_DAY;


  ------------------
  procedure GET_TIME(  --| Get the time from the file
    FYLE : in TEXT_IO.FILE_TYPE; --| The input file
    DATE : out CALENDAR.TIME     --| The time read from fyle

      ) is

    --| Effects
    --| Gets and returns the time from the file.

    --| Requires
    --| Fyle must have been previously opened by the calling program.
    --| The time must have been previously put to fyle in the format
    --| output by Put_Time.

    --| N/A:  Raises, Modifies, Errors


    use TIME_LIBRARY_1;  --| For Timing_Type
    use CALENDAR;        --| For "+" of Times and Day_Durations

    YEAR       : CALENDAR.YEAR_NUMBER; --  range 1901 .. 2099
    MONTH      : CALENDAR.MONTH_NUMBER;--  range    1 ..   12
    DAY        : CALENDAR.DAY_NUMBER;  --  range    1 ..   31
    SECONDS    : CALENDAR.DAY_DURATION;

    TEMP_CH    : CHARACTER;    --  temporary storage for field delimiter

    SHORT_YEAR : INTEGER range 0 .. 99; -- a 2 digit of the year

  begin

    INT_IO.GET(FYLE, MONTH, 2);
    TEXT_IO.GET(FYLE, TEMP_CH);
    INT_IO.GET(FYLE, DAY, 2);
    TEXT_IO.GET(FYLE, TEMP_CH);
    INT_IO.GET(FYLE, SHORT_YEAR, 2);
    TEXT_IO.GET(FYLE, TEMP_CH);

    -- The following assignment will produce an invalid year after 2084
    -- However, it enables the use of 2 digit year numbers in the log
    -- file and will still produce a valid date when the date is written
    -- in one year and read back in another year.
    if SHORT_YEAR < 85 then
      YEAR := SHORT_YEAR + 2000;
    else
      YEAR := SHORT_YEAR + 1900;
    end if;

    GET_TIME_OF_DAY(FYLE, SECONDS);

    DATE := CALENDAR.TIME_OF(YEAR, MONTH, DAY, 0.0) + SECONDS;

  end GET_TIME;


  -----------------
  function MAXIMUM(--| Return the MAXIMUM of two Day_Durations

    TIME1, TIME2 : in CALENDAR.DAY_DURATION  --| The two times to be compared

      ) return CALENDAR.DAY_DURATION is

    --| Effects
    --| Compares Time1 to Time2 and returns the MAXIMUM of the two times.

    --| N/A:  Raises, Requires, Modifies, Errors

    use CALENDAR;

  begin
    if TIME1 > TIME2 then
      return TIME1;
    else
      return TIME2;
    end if;
  end MAXIMUM;


  -----------------
  function MINIMUM(--| Return the MINIMUM of two Day_Durations

    TIME1, TIME2 : in CALENDAR.DAY_DURATION  --| The two times to be compared

      ) return CALENDAR.DAY_DURATION is

    --| Effects
    --| Compares Time1 to Time2 and returns the MINIMUM of the two times.

    --| N/A:  Raises, Requires, Modifies, Errors

    use CALENDAR;

  begin
    if TIME1 > TIME2 then
      return TIME2;
    else
      return TIME1;
    end if;
  end MINIMUM;


  --------------------
  function WEEKDAY_OF( --| Return the day of week for the specified date

    DATE : in CALENDAR.TIME  --| The date to be converted

      ) return WEEKDAYS is

    --| Effects
    --| Returns the day of week (Sunday..Saturday) for the specified date

    --| N/A:  Raises, Requires, Modifies, Errors


    use CALENDAR;

    Y      : INTEGER; -- A temporary variable for the year. A short name
                      -- makes the algorithm more readable.

    OFFSET : constant array(1 .. 12) of INTEGER
                        := (1, 4, 3, 6, 1, 4, 6, 2, 5, 0, 3, 5);

  begin
    if MONTH(DATE) = 1 or MONTH(DATE) = 2 then
      Y := YEAR(DATE) - 1901;
    else
      Y := YEAR(DATE) - 1900;
    end if;
    return WEEKDAYS'VAL((OFFSET(MONTH(DATE)) + Y + Y/4 + DAY(DATE)) mod 7);
  end WEEKDAY_OF;


  --------------------
  function WEEKDAY_OF( --| Return the day of week for the specified date

    DATE : in CALENDAR.TIME  --| The date to be converted

      ) return STRING is

    --| Effects
    --| Returns the day of week (Sunday..Saturday) for the specified date

    --| N/A:  Raises, Requires, Modifies, Errors


  begin

    return WEEKDAYS'IMAGE(WEEKDAY_OF(DATE));

  end WEEKDAY_OF;

  -------------------
  procedure TIMING_IS(--| Sets the timing method for times recorded in
                      --| the logfile to Raw or Wall_Clock

    TIME_TYPE : in TIME_LIBRARY_1.TIMING_TYPE
            --| The timing method used to record timing data in the logfile

      ) is

    --| Effects
    --| Sets the timing method for GETting times from the logfile to
    --| correspond to the timing method used for recording times in
    --| the logfile by the Run Time Monitor (RTM). Timing methods are
    --| RAW and WALL_CLOCK.

    --| N/A:  Raises, Requires, Modifies, Errors


  begin

    TIMING_METHOD := TIME_TYPE;

  end TIMING_IS;

end TIME_LIBRARY_2;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--CLOCKS.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS, CALENDAR;

--------------
package CLOCKS is
--------------

--| Overview
--|
--|     This package contains procedures and functions for managing
--| program unit startng and ending times. In a non-tasking
--| program environment it functions merely as a stack. When a
--| program unit begins execution its starting time is pushed onto
--| the stack. When the unit ends execution its starting time is
--| popped from the stack.
--|
--|      However, in a tasking environment when a program unit
--| ends execution its starting time may not necessarily be the top
--| element on the stack. This is true not only for tasks but also
--| for other program units called by tasks. Therefore, tasks
--| must be handled differently than other program units. There must
--| also be a mechanism for determining whether a program unit
--| that is ending execution was also the last currently active
--| program unit to begin execution.
--|
--|     To accomplish this, two separate dynamic structures are
--| maintained. Tasks are managed in a dynamic array. All other
--| program units are maintained on a stack with a mechanism
--| for fetching the starting times for units other than the
--| last active unit started. However, when this happens, a
--| fault occurs and the calling program is informed via the
--| boolean flag "Clock_Fault".

--| Requires:
--| Prior to use the calling program must create the clock
--| structures via a call to Create_Clocks.

--| N/A: Requires, Modifies, Errors


  use TYPE_DEFINITIONS;

  INACTIVE_PROGRAM_UNIT : exception;
  NO_MORE_UNITS         : exception;
  NO_MORE_TASKS         : exception;
  NO_MORE_CLOCK_FAULTS  : exception;

  type UNIT_START_TIMES is
    record
      UNIT_NUM   : NATURAL;
      START_TIME : CALENDAR.TIME;
      STOP_WATCH : CALENDAR.DAY_DURATION;
      SONS       : NATURAL;
      GRANDSONS  : NATURAL;
    end record;


------------------------ Heap Management --------------------------------

  -----------------------
  procedure CREATE_CLOCKS; --| Create a dynamic Clock structure

    --| Effects
    --| Creates the dynamic program unit clock structures

    --| N/A: Raises, Modifies, Errors

  ------------------------
  procedure DESTROY_CLOCKS; --| Destroy the clock structure

    --| Effects
    --| Destroys the dynamic program unit clock structures

    --| N/A: Raises, Modifies, Errors


----------------------- Constructors ------------------------------------


  --------------------
  procedure START_UNIT(--| Store a unit starting time in the clock structure
    UNIT_ID         : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    UNIT_START_TIME : in UNIT_START_TIMES);

    --| Effects
    --| Saves the starting time of the program unit in a dynamic clock
    --| structure

    --| N/A: Raises, Modifies, Errors

  ----------------------
  procedure RESTART_UNIT(--| Restore a unit starting time to the clock structure

    UNIT_START_TIME : in UNIT_START_TIMES);

    --| Effects
    --| Saves the starting time of the program unit in a dynamic clock
    --| structure

    --| N/A: Raises, Modifies, Errors

  -------------------
  procedure STOP_UNIT(--| Fetch a unit starting time from the clock structure
    UNIT_NUM        : in NATURAL;
    UNIT_ID         : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    UNIT_START_TIME : out UNIT_START_TIMES;
    CLOCK_FAULT     : out BOOLEAN);

    --| Raises: Inactive_Program_Unit

    --| Effects
    --| Retrieves the starting time of the terminating program unit.
    --| If the program unit is not a task and and is not the last
    --| active program unit started the Clock_Fault is returned true.
    --| Otherwise, Clock_Fault is returned false.

    --| Modifies
    --| The Unit_Start_Time for the specified unit is deleted from
    --| the clock structure.

    --| N/A: Errors

  --------------------
  procedure PAUSE_UNIT(--| Remove a unit starting time from the clock
    UNIT_START_TIME : out UNIT_START_TIMES);

    --| Raises: No_More_Units

    --| Effects
    --| Retrieves the starting time of the last currently active
    --| non-task program unit from the clock structure.

    --| Modifies
    --| The Unit_Start_Time for the specified unit is deleted from
    --| the clock structure.

    --| N/A: Errors

  ----------------------
  function DANGLING_UNIT  --| Fetch the unit starting time for a dangling
                          --| unit from the clock structure

    return UNIT_START_TIMES;

    --| Raises: No_More_Units

    --| Effects
    --| Returns the starting time of a "dangling" unit.
    --| A dangling unit is a unit that has been left in the clock
    --| structure after all records have been read from the log file.
    --| Under normal circumstances this should not occur unless
    --| the instrumented program that generated the log file terminated
    --| abnormally.

    --| Modifies
    --| The Unit_Start_Time for the specified unit is deleted from
    --| the clock structure.

    --| N/A: Requires, Errors


  ----------------------
  function DANGLING_TASK  --| Fetch the unit starting time for a dangling
                          --| task from the clock structure

    return UNIT_START_TIMES;

    --| Raises: No_More_Tasks

    --| Effects
    --| Returns the starting time of a "dangling" task.
    --| A dangling task is a task that has been left in the clock
    --| structure after all records have been read from the log file.
    --| Under normal circumstances this should not occur unless
    --| the task was aborted or the instrumented program that
    --| generated the log file terminated abnormally.

    --| Modifies
    --| The Unit_Start_Time for the specified task is deleted from
    --| the clock structure.

    --| N/A: Requires, Errors


  -------------------------
  function NEXT_CLOCK_FAULT  --| Clear and return the unit number of the
                             --| next clock fault
    return NATURAL;

    --| Raises: No_More_Clock_Faults

    --| Effects
    --| Clears one clock fault and returns the unit number of a non-task
    --| program unit that was active when the fault occurred. If no clock
    --| faults are outstanding then the exception No_More_Clock_Faults
    --| is raised.

    --| Requires;
    --| The calling program must check for outstanding clock faults via
    --| the function More_Clock_Faults.

    --| N/A: Modifies, Errors



  ----------------------- Queries --------------------------------------


  ----------------------
  function PREVIOUS_UNIT  --| Return the starting time of the last active
                          --| non task program unit to begin execution
    return UNIT_START_TIMES;

    --| Raises: No_More_Units

    --| Effects
    --| Returns the starting time of the last active non-task
    --| program unit to begin execution. This function is
    --| non-destructive, i.e., the starting time of the unit is
    --| not deleted from the structure.

    --| N/A: Modifies, Errors

  -------------------
  function MORE_UNITS  --| Return true if more non-task program units in clock
    return BOOLEAN;

    --| Effects
    --| Returns true if one or more non-task program units remain in
    --| the clock structure.

    --| N/A: Raises, Modifies, Errors

  -------------------
  function MORE_TASKS  --| Return true if more tasks in  clock
    return BOOLEAN;

    --| Effects
    --| Returns true if one or tasks remain in the clock structure.

    --| N/A: Raises, Modifies, Errors


  --------------------------
  function MORE_CLOCK_FAULTS --| Returns true if clock faults remain uncleared
    return BOOLEAN;

    --| Effects
    --| Checks to see if any clock faults remain uncleared. Returns true if
    --| any clock faults remain, otherwise returns false;

    --| N/A: Raises, Requires, Modifies, Errors


end CLOCKS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--CLOCKS.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS, STACK_PKG, DYNARRAY_PKG, CALENDAR;

-------------------
package body CLOCKS is
-------------------

--| Overview
--|
--|     This package contains procedures and functions for managing
--| program unit startng and ending times. In a non-tasking
--| program environment it functions merely as a stack. When a
--| program unit begins execution its starting time is pushed onto
--| the stack. When the unit ends execution its starting time is
--| popped from the stack.
--|
--|      However, in a tasking environment when a program unit
--| ends execution its starting time may not necessarily be the top
--| element on the stack. This is true not only for tasks but also
--| for other program units called by tasks. Therefore, tasks
--| must be handled differently than other program units. There must
--| also be a mechanism for determining whether a program unit
--| that is ending execution was also the last currently active
--| program unit to begin execution.
--|
--|     To accomplish this, two separate dynamic structures are
--| maintained. Tasks are managed in a dynamic array. All other
--| program units are maintained on a stack with a mechanism
--| for fetching the starting times for units other than the
--| last active unit started. However, when this happens, a
--| fault occurs and the calling program is informed via the
--| boolean flag "Clock_Fault".

--| Requires:
--| Prior to use the calling program must create the clock
--| structures via a call to Create_Clocks.

--| N/A: Requires, Modifies, Errors


  use TYPE_DEFINITIONS;

  package TIME_STACK_PKG is
    new STACK_PKG(UNIT_START_TIMES);

  use TIME_STACK_PKG;

  PRIMARY : TIME_STACK_PKG.STACK;
  FAULTS  : TIME_STACK_PKG.STACK;

  type TASK_START_TIMES is
    record
      UNIT_NUM                    : NATURAL;
      TASK_TYPE_ACTIVATION_NUMBER : TASK_TYPE_ACTIVATION_NUMBER_RANGE;
      START_TIME                  : CALENDAR.TIME;
      STOP_WATCH                  : CALENDAR.DAY_DURATION;
      SONS                        : NATURAL;
      GRANDSONS                   : NATURAL;
    end record;

  package TASK_CLOCKS is
    new DYNARRAY_PKG(TASK_START_TIMES);
  use TASK_CLOCKS;

  TASKS           : TASK_CLOCKS.DARRAY;

  UNIT_START_TIME : UNIT_START_TIMES;
  TASK_START_TIME : TASK_START_TIMES;


------------------------ Local Procedures ------------------------------

  ----------------
  function TASK_OF(--| Fetch the starting time for the specified task
    UNIT_NUM : in POSITIVE;
    UNIT_ID  : in PROGRAM_UNIT_UNIQUE_IDENTIFIER

      ) return UNIT_START_TIMES

    is

  --| Raises: Inactive_Program_Unit

  --| Effects
  --| Searches the task clock array for the Task_Start_Time corresponding
  --| to the the specified task. If found, the entry is removed from the
  --| array, converted into Unit_Start_Times form, and returned to
  --| the calling program. If not found then the exception
  --| Inactive program unit is raised.

  --| Modifies
  --| If found, the Task_Start_Time corresponding to Unit_Num and Unit_ID
  --| is removed from the dask array.

  --| N/A: Requires, Errors


    FOUND : BOOLEAN := FALSE;

  begin
    FOUND := FALSE;
    for TASK_NUMBER in 1 .. LENGTH(TASKS) loop
      TASK_START_TIME := FETCH(TASKS, TASK_NUMBER);
      if TASK_START_TIME.UNIT_NUM = UNIT_NUM
         and TASK_START_TIME.TASK_TYPE_ACTIVATION_NUMBER
           = UNIT_ID.TASK_TYPE_ACTIVATION_NUMBER then
        UNIT_START_TIME := (UNIT_NUM, TASK_START_TIME.START_TIME,
                            TASK_START_TIME.STOP_WATCH, TASK_START_TIME.SONS,
                            TASK_START_TIME.GRANDSONS);
        FOUND := TRUE;
        for NEXT_TASK in TASK_NUMBER + 1 .. LENGTH(TASKS) loop
          STORE(TASKS, NEXT_TASK - 1, FETCH(TASKS, NEXT_TASK));
        end loop;
        REMOVE_HIGH(TASKS);
        exit;
      end if;
    end loop;
    if not FOUND then
      raise INACTIVE_PROGRAM_UNIT;
    else
      return UNIT_START_TIME;
    end if;
  end TASK_OF;


  ------------------------ Heap Management ------------------------------

  -----------------------
  procedure CREATE_CLOCKS  --| Create a dynamic Clock structure

    is

    --| Effects
    --| Creates the dynamic program unit clock structures

    --| N/A: Raises, Modifies, Errors

  begin

    --| Create primary stack for non-task program units and another to
    --| hold units which are active when a clock fault occurs.
    PRIMARY := TIME_STACK_PKG.CREATE;
    FAULTS := TIME_STACK_PKG.CREATE;

    --| Create a dynamic array of unit clocks for tasks
    CREATE(1, 10,       --| Start with elements 1..10
    100,                --| 100% of adds will be at high end of array
    50,                 --| Expand the array by 50% each time necessary
    TASKS);             --| The name of the array is Tasks

  end CREATE_CLOCKS;

  ------------------------
  procedure DESTROY_CLOCKS  --| Destroy the clock structure

    is

    --| Effects
    --| Destroys the dynamic program unit clock structures

    --| N/A: Raises, Modifies, Errors

  begin

    TIME_STACK_PKG.DESTROY(PRIMARY);
    TIME_STACK_PKG.DESTROY(FAULTS);
    TASK_CLOCKS.DESTROY(TASKS);

  end DESTROY_CLOCKS;


  --------------------- Constructors ------------------------------------


  --------------------
  procedure START_UNIT(--| Store a unit starting time in the clock structure

    UNIT_ID         : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;

    UNIT_START_TIME : in UNIT_START_TIMES

      ) is

    --| Effects
    --| Saves the starting time of the program unit in a dynamic clock
    --| structure. Any tasks that are currently active are charged
    --| with a grandson for the purpose accumulating overhead time.

    --| N/A: Raises, Modifies, Errors

  begin

    --| If there are any tasks active then each must be charged with a
    --| a grandson. This will enable each task's execution time to be later
    --| adjusted for the overhead imposed by the Run Time Monitor.
    for TASK_NUMBER in 1 .. LENGTH(TASKS) loop
      TASK_START_TIME := FETCH(TASKS, TASK_NUMBER);
      TASK_START_TIME.GRANDSONS := TASK_START_TIME.GRANDSONS + 1;
      STORE(TASKS, TASK_NUMBER, TASK_START_TIME);
    end loop;

    --| Start the current unit
    case UNIT_ID.UNIT_TYPE is

      when TASK_TYPE =>
        --| Store tasks in the the task array
        TASK_START_TIME := (UNIT_START_TIME.UNIT_NUM,
                            UNIT_ID.TASK_TYPE_ACTIVATION_NUMBER,
                            UNIT_START_TIME.START_TIME,
                            UNIT_START_TIME.STOP_WATCH, UNIT_START_TIME.SONS,
                            UNIT_START_TIME.GRANDSONS);
        ADD_HIGH(TASKS, TASK_START_TIME);

      when others =>
        --| All non-tasks go on the unit stack
        PUSH(PRIMARY, UNIT_START_TIME);

    end case;

  end START_UNIT;

  ----------------------
  procedure RESTART_UNIT(--| Restore a unit starting time to the clock

    UNIT_START_TIME : in UNIT_START_TIMES

      ) is

    --| Effects
    --| Saves the starting time of the program unit in a dynamic clock
    --| structure

    --| N/A: Raises, Modifies, Errors

  begin

    PUSH(PRIMARY, UNIT_START_TIME);

  end RESTART_UNIT;

  -------------------
  procedure STOP_UNIT(--| Fetch a unit starting time from the clock structure

    UNIT_NUM        : in NATURAL;

    UNIT_ID         : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;

    UNIT_START_TIME : out UNIT_START_TIMES;

    CLOCK_FAULT     : out BOOLEAN

      ) is

    --| Raises: Inactive_Program_Unit

    --| Effects
    --| Retrieves the starting time of the terminating program unit.
    --| If the program unit is not a task and and is not the last
    --| active program unit started the Clock_Fault is returned true.
    --| Otherwise, Clock_Fault is returned false.

    --| Modifies
    --| The Unit_Start_Time for the specified unit is deleted from
    --| the clock structure.

    --| N/A: Errors

    NEXT_TIME : UNIT_START_TIMES;

    FOUND     : BOOLEAN := FALSE;

  begin

    CLOCK_FAULT := FALSE;

    case UNIT_ID.UNIT_TYPE is

      when TASK_TYPE =>
        UNIT_START_TIME := TASK_OF(UNIT_NUM, UNIT_ID);

      when others =>
        while not IS_EMPTY(PRIMARY) loop
          POP(PRIMARY, NEXT_TIME);
          if NEXT_TIME.UNIT_NUM = UNIT_NUM then
            FOUND := TRUE;
            UNIT_START_TIME := NEXT_TIME;
            exit;
          else
            PUSH(FAULTS, NEXT_TIME);
          end if;
        end loop;

        if not IS_EMPTY(FAULTS) then
          CLOCK_FAULT := TRUE;
        end if;

        if not FOUND then
          raise INACTIVE_PROGRAM_UNIT;
        end if;

    end case;

  end STOP_UNIT;

  --------------------
  procedure PAUSE_UNIT(--| Fetch a unit starting time from the clock structure

    UNIT_START_TIME : out UNIT_START_TIMES

      ) is

    --| Raises: No_More_Units

    --| Effects
    --| Retrieves the starting time of the last currently active
    --| non-task program unit from the clock structure.

    --| Modifies
    --| The Unit_Start_Time for the specified unit is deleted from
    --| the clock structure.

    --| N/A: Errors

  begin

    POP(PRIMARY, UNIT_START_TIME);

  end PAUSE_UNIT;

  ----------------------
  function DANGLING_UNIT  --| Fetch the unit starting time for a dangling
                          --| unit from the clock structure
    return UNIT_START_TIMES

      is

      --| Raises: No_More_Units

      --| Effects
      --| Returns the starting time of a "dangling" unit.
      --| A dangling unit is a unit that has been left in the clock
      --| structure after all records have been read from the log file.
      --| Under normal circumstances this should not occur unless
      --| the instrumented program that generated the log file terminated
      --| abnormally.

      --| Modifies
      --| The Unit_Start_Time for the specified unit is deleted from
      --| the clock structure.

      --| N/A: Requires, Errors

  begin

    POP(PRIMARY, UNIT_START_TIME);
    return UNIT_START_TIME;

  end DANGLING_UNIT;



  ----------------------
  function DANGLING_TASK  --| Fetch the unit starting time for a dangling
                          --| task from the clock structure
    return UNIT_START_TIMES

    is

    --| Raises: No_More_Tasks

    --| Effects
    --| Returns the starting time of a "dangling" task.
    --| A dangling task is a task that has been left in the clock
    --| structure after all records have been read from the log file.
    --| Under normal circumstances this should not occur unless
    --| the task was aborted or the instrumented program that
    --| generated the log file terminated abnormally.

    --| Modifies
    --| The Unit_Start_Time for the specified task is deleted from
    --| the clock structure.

    --| N/A: Requires, Errors

  begin
    TASK_START_TIME := FETCH(TASKS, LENGTH(TASKS));
    UNIT_START_TIME := (TASK_START_TIME.UNIT_NUM, TASK_START_TIME.START_TIME,
                        TASK_START_TIME.STOP_WATCH, TASK_START_TIME.SONS,
                        TASK_START_TIME.GRANDSONS);
    REMOVE_HIGH(TASKS);
    return UNIT_START_TIME;
  end DANGLING_TASK;


  -------------------------
  function NEXT_CLOCK_FAULT  --| Clear and return the unit number of the
                             --| next clock fault
    return NATURAL

    is

    --| Raises: No_More_Clock_Faults

    --| Effects
    --| Clears one clock fault and returns the unit number of a non-task
    --| program unit that was active when the fault occurred. If no clock
    --| faults are outstanding then the exception No_More_Clock_Faults
    --| is raised.

    --| Requires;
    --| The calling program must check for outstanding clock faults via
    --| the function More_Clock_Faults.

    --| N/A: Modifies, Errors

  begin
    if not IS_EMPTY(FAULTS) then
      POP(FAULTS, UNIT_START_TIME);
      PUSH(PRIMARY, UNIT_START_TIME);
      return UNIT_START_TIME.UNIT_NUM;
    else
      raise NO_MORE_CLOCK_FAULTS;
    end if;
  end NEXT_CLOCK_FAULT;


------------------------- Queries --------------------------------------

  ----------------------
  function PREVIOUS_UNIT  --| Return the starting time of the last active
                          --| non-task program unit to begin execution
    return UNIT_START_TIMES

    is

    --| Raises: No_More_Units

    --| Effects
    --| Returns the starting time of the last active non-task
    --| program unit to begin execution. This function is
    --| non-destructive, i.e., the starting time of the unit is
    --| not deleted from the structure.

    --| N/A: Modifies, Errors

  begin
    return TOP(PRIMARY);
  end PREVIOUS_UNIT;

  -------------------
  function MORE_UNITS  --| Return true if more non-task program units in clock
    return BOOLEAN

    is

    --| Effects
    --| Returns true if one or more non-task program units remain in
    --| the clock structure.

    --| N/A: Raises, Modifies, Errors

  begin
    return not IS_EMPTY(PRIMARY);
  end MORE_UNITS;

  -------------------
  function MORE_TASKS  --| Return true if more tasks in  clock
    return BOOLEAN

    is

    --| Effects
    --| Returns true if one or tasks remain in the clock structure.

    --| N/A: Raises, Modifies, Errors

  begin
    return LENGTH(TASKS) > 0;
  end MORE_TASKS;



  --------------------------
  function MORE_CLOCK_FAULTS  --| Returns true if clock faults remain uncleared
    return BOOLEAN

    is

    --| Effects
    --| Checks to see if any clock faults remain uncleared. Returns true if
    --| any clock faults remain, otherwise returns false;

    --| N/A: Raises, Requires, Modifies, Errors

  begin
    return not IS_EMPTY(FAULTS);
  end MORE_CLOCK_FAULTS;

end CLOCKS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--READLOG.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS, IMPLEMENTATION_DEPENDENCIES, CALENDAR;
----------------
package READ_LOG is
----------------

--| Overview
--| Read_Log is an input package used by the report generators for
--| the Ada Testing and Evaluation Tools. It performs all input from the
--| Execution Log File (ELF) that is used to dynamically record
--| information about programs written in the Ada language. The
--| ELF is used for output by the Run Time Monitor (RTM) to record
--| runtime information about the execution of the Ada program being
--| tested. It is used as input by various report generators which
--| summarize the information and present it in a meaningful format.
--| All output to the ELF by the Run Time Monitor is performed by the
--| package Write_Log.

--| N/A: Errors, Raises, Modifies, Requires

--  Version         : 3.1
--  Author          : Jeff England
--  Initial Release : 02/27/85
--  Last Modified   : 05/14/85

  use TYPE_DEFINITIONS,          --| Global type declarations common to
                                 --| all of the Ada Testing and Analysis
                                 --| Tools

  IMPLEMENTATION_DEPENDENCIES,   --| Ada compiler dependencies

  CALENDAR;    --| Logfile_Input uses the standard Ada package Calendar
               --| to provide the standard interface to the system clock.


  LOGFILE_ACCESS_ERROR   : exception; --| Attempt to access unopened logfile
  LOGFILE_SEQUENCE_ERROR : exception; --| Attempt to access in wrong order
  INVALID_LOGFILE_FORMAT : exception; --| Invalid or no configuration data
  END_OF_LOGFILE         : exception; --| Unchecked end of file reached
  UNDEFINED_UNIT         : exception; --| No unit name defined for unit id


  ------------------
  procedure OPEN_LOG( --| Opens the ELF for input by the report generators.

    LOGFILE_NAME : in FILENAME;  --| The name of the log file to be created

    PROGRAM_NAME : out ADA_NAME; --| The name of the main program unit

    TEST_IDENT   : out TEST_IDENTIFIER; --| A unique ID assigned by the tester

    TEST_DATE    : out TIME      --| The date and time of the test

      );

    --| Raises: Invalid_Log_File_Format, Logfile_Access_Error

    --| Effects
    --| This procedure opens the ELF for input by the report generators.
    --| If the file is successfully opened, it returns test configuration
    --| data recorded in the ELF by the RTM during execution of the Ada
    --| program under test. If the file is already open then the exception
    --| Logfile_Access_Error is raised. If the file is not successfully
    --| opened due to an IO error, then the standard Text_IO exceptions are
    --| allowed to pass unhandled back to the calling program. If the ELF is
    --| is determined to contain invalid or missing configuration data,
    --| then the exception Invalid_Log_File_Format is raised.

    --| Requires
    --| The ELF must contain test configuration data in the format
    --| created by the RTM via a call to the procedure Create_Log.

    --| N/A:  Modifies, Errors


  ----------------------
  procedure GET_NEXT_KEY(--| Gets the next log file key from the ELF

    KEY : in out LOGFILE_KEYS  --| Defines the type of data that is
                               --| contained in the current ELF record
      );

    --| Effects
    --| This procedure reads the next log file key (Key) from the ELF and
    --| returns it to the calling program.

    --| Requires
    --| The ELF must have been previously opened for input by the
    --| calling program via a call to the procedure Open_Log.

    --| N/A:  Raises, Modifies, Errors


  ------------------------------
  procedure FLUSH_LOGFILE_RECORD(--| Flush the current Logfile record

    KEY : in LOGFILE_KEYS  --| The current logfile key

      );

    --| Effects
    --| If Key is equal to the current log file key then the remainder of the
    --| current logfile record is flushed and the logfile is positioned at
    --| the beginning of the next logfile record.

    --| Requires
    --| The ELF must have been previously opened for input by the
    --| calling program via a call to the procedure Open_Log.
    --| The Logfile key for the current record must have already been
    --| read. The Key passed by the calling program must match the
    --| key for the current logfile record.

    --| N/A:  Raises, Modifies, Errors


  -----------------------
  procedure GET_UNIT_ID(--| Gets unit ID for current unit from the ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER
    --| A unique ID assigned by the Source Instrumenter

      );

    --| Effects
    --| Gets and returns the program unit id (Unit_Identifier) from the ELF

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be in UNIT_START..UNIT_STOP.

    --| N/A:  Raises, Modifies, Errors


  -----------------------
  procedure GET_UNIT_TIME(--| Gets the unit ID and start/stop time from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    LOGGED_TIME     : out CALENDAR.DAY_DURATION
    --| The time that the unit was entered or exited

      );

    --| Effects
    --| Gets and returns the program unit id (Unit_Identifier) and logged
    --| time (Log_Time)  from the ELF.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be in UNIT_START..UNIT_STOP.

    --| N/A:  Raises, Modifies, Errors

  ------------------------
  procedure GET_BREAKPOINT( --| Gets current breakpoint from the ELF

    UNIT_IDENTIFIER    : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    CURRENT_BREAKPOINT : out BREAKPOINT_NUMBER_RANGE
    --| The breakpoint number assigned by the Source Instrumenter

      );

    --| Effects
    --| Gets the program unit, and current breakpoint number from the
    --| Execution Log File.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be in BEGIN_IF..OTHER_BREAKPOINT.

    --| N/A:  Raises, Modifies, Errors


  -------------------
  function CALL_PARAMETERS  --| Gets AutoPath procedure call parameter list

  return USER_INPUT_STRING; --| The user specified input parameter list

    --| Raises:  Logfile_Access_Error, Logfile_Sequence_Error,
    --|          End_of_Log_File

    --| Effects
    --| Gets the AutoPath procedure call parameter list from the logfile
    --| for a single execution of the target Ada program.
    --| If the logfile is not open then the exception Logfile_Access_Error
    --| is raised.
    --| If an End of File (EOF) in the ELF is encountered, the exception
    --| End_of_Log_File is raised.
    --| If the current logfile key is not AUTOPATH_CALL
    --| then the exception Logfile_Sequence_Error is raised.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be AUTOPATH_CALL.

    --| N/A:  Modifies, Errors


  -------------------
  procedure GET_VALUE(--| Gets value of INTEGER variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME; --| The unqualified variable name

    VALUE           : out INTEGER   --| The current value of variable

      );

    --| Effects
    --| Gets integer values from the execution log file.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be INTEGER_VARIABLE.

    --| N/A:  Raises, Modifies, Errors


  -------------------
  procedure GET_VALUE(--| Gets value of LONG_INTEGER variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME;     --| The unqualified variable name

    VALUE           : out LONG_INTEGER  --| The current value of variable

      );

    --| Effects
    --| Gets long_integer values from the execution log file.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be LONG_INTEGER_VARIABLE.

    --| N/A:  Raises, Modifies, Errors


  -------------------
  procedure GET_VALUE(--| Gets value of FLOAT variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME;  --| The unqualified variable name

    VALUE           : out FLOAT      --| The current value of variable

      );

    --| Effects
    --| Gets floating point values from the execution log file.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be FLOAT_VARIABLE.

    --| N/A:  Raises, Modifies, Errors


  -------------------
  procedure GET_VALUE(--| Gets value of LONG_FLOAT variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME;   --| The unqualified variable name
    VALUE           : out LONG_FLOAT  --| The current value of variable

      );

    --| Effects
    --| Gets long_float values from the execution log file.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be LONG_FLOAT_VARIABLE.

    --| N/A:  Raises, Modifies, Errors


  -------------------
  procedure GET_VALUE(--| Gets value of STRING variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME;        --| The unqualified variable name

    STRING_VALUE    : out STRING_VARIABLES --| The current value of variable

      );

    --| Effects
    --| Gets string values from the execution log file.
    --| This procedure used to get the value of
    --|        strings
    --|        characters
    --|        enumerated data types (including booleans)

    --| Requires
    --| The current log file key (i.e., the previously read key)
    --| must be STRING_VARIABLE.

    --| N/A:  Raises, Modifies, Errors


  -------------------
  function END_OF_LOG  --| Checks for End Of file in the ELF
    return BOOLEAN;    --| True if EOF is reached else false

    --| Raises:  Logfile_Access_Error

    --| Effects
    --| This function checks for End Of File in the ELF and returns true
    --| if an EOF has been reached.
    --| If the logfile is not open then the exception Logfile_Access_Error
    --| is raised.
    --| Text_IO exceptions that may be raised are allowed to pass, unhandled,
    --| back to the calling program.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.

    --| N/A:  Modifies, Errors


  ------------------------
  procedure FIND_UNIT_NAME( --| Finds the name of a program unit

    UNIT_IDENTIFIER : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    UNIT_NAME       : out ADA_NAME  --| The name of program unit

      );

    --| Raises: Undefined_Program_Unit

    --| Effects
    --| Finds the program unit unit name (Unit_Name) corresponding to the
    --| program unit ID. If no UNIT_DEF record has been previously
    --| encountered in the ELF to associate a program unit name with
    --| the specified unit ID then the Undefined_Program_Unit exception
    --| is raised.

    --| Requires
    --| A program unit name (Unit_Name) must have been previously recorded
    --| in the ELF and assosiated with the specified unit id (Unit_Identifier)
    --| by the program that originally generated the log file via a call
    --| to the procedure Define_Comp_Unit.

    --| N/A:  Modifies, Errors


  ------------------------------
  function NUMBER_OF_BREAKPOINTS(--| Finds the number of breakpoints
                                 --| in a compilation unit

    COMPILATION_UNIT_NAME : in ADA_NAME --| The name of the compilation unit

      ) return BREAKPOINT_NUMBER_RANGE;

    --| Raises: Undefined_Program_Unit

    --| Effects
    --| Gets and returns the total number of breakpoints in the
    --| specified compilation unit. If the compilation unit has
    --| not been previously defined in the logfile then the
    --| exception Undefined_Program_Unit is raised.

    --| Requires
    --| The compilation unit name must have been previously
    --| returned to the calling program in a Unit ID by the
    --| the procedure Get_Unit_ID.

    --| N/A:  Modifies, Errors


  --------------------
  function TIMING_DATA --| Returns true if the logfile contains timing data

    return BOOLEAN;

    --| Raises: Logfile_Access_Error

    --| Effects
    --| Returns true if the logfile contains timing data. Otherwise
    --| returns false. This function provides a mechanism for the
    --| calling program to determine whether or not timing data
    --| has been recorded in the logfile prior to calling other
    --| Read_Log procedures that read times from the logfile.
    --| If the logfile is not open then the exception
    --| Logfile_Access_Error is raised.

    --| Requires
    --| The target Ada program must have been executed with
    --| Tool_Name = Profile_Tool in order for timing data to have
    --| been recorded in the log file and the current log file
    --| key must be Timing_Overhead. The log file must have been
    --| previously opened by the calling program via a call to Open_Log.

    --| N/A:  Modifies, Errors


  -----------------------------
  function ACCUMULATED_OVERHEAD --| Returns the Accumulated timing overhead
                                --| calculated during test program execution

    return CALENDAR.DAY_DURATION;

    --| Raises: Logfile_Access_Error

    --| Effects
    --| Gets and returns the total accumulated timing overhead
    --| calculated during execution of the target Ada program.
    --| If the logfile is not open or the current logfile key is
    --| not then the exception Logfile_Access_Error is raised.

    --| Requires
    --| The target Ada program must have been executed with
    --| Tool_Name = Profile_Tool in order for timing data to have
    --| been recorded in the log file and the current log file
    --| key must be Timing_Overhead.

    --| N/A:  Modifies, Errors


  -------------------
  procedure CLOSE_LOG; --| Closes the execution log file

    --| Raises:  Logfile_Access_Error

    --| Effects
    --| Closes the execution log file.
    --| If the logfile is not open then the exception Logfile_Access_Error
    --| is raised.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.

    --| N/A:  Modifies, Errors

end READ_LOG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--READLOG.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS, COMPILATION_UNIT_LISTS, CALENDAR, TEXT_IO,
     TIME_LIBRARY_1, TIME_LIBRARY_2, STRING_PKG, IMPLEMENTATION_DEPENDENCIES;
---------------------
package body READ_LOG is
---------------------

--| Overview
--| Read_Log is an input package used by the report generators for
--| the Ada Testing and Evaluation Tools. It performs all input from the
--| Execution Log File (ELF) that is used to dynamically record
--| information about programs written in the Ada language. The
--| ELF is used for output by the Run Time Monitor (RTM) to record
--| runtime information about the execution of the Ada program being
--| tested. It is used as input by various report generators which
--| summarize the information and present it in a meaningful format.
--| All output to the ELF by the Run Time Monitor is performed by the
--| package Write_Log.

--| N/A: Errors, Raises, Modifies, Requires

--  Version         : 3.1
--  Author          : Jeff England
--  Initial Release : 02/27/85
--  Last Modified   : 05/14/85

  use TYPE_DEFINITIONS,        --| Global type declarations common to all
                               --| of the Ada Testing and Analysis Tools.

  IMPLEMENTATION_DEPENDENCIES, --| Ada compiler dependencies

  TEXT_IO;                     --| The logfile is in text format

  package INT_IO              is new INTEGER_IO(INTEGER);
  package NEW_LONG_INTEGER_IO is new INTEGER_IO(LONG_INTEGER);
  package NEW_FLOAT_IO        is new FLOAT_IO(FLOAT);
  package NEW_LONG_FLOAT_IO   is new FLOAT_IO(LONG_FLOAT);

  use INT_IO;

  type LOGFILE_STATES    is (OPENED,  CLOSED);
  type LOGFILE_POSITIONS is (LOG_KEY, LOG_DATA);

  LOGFILE         : TEXT_IO.FILE_TYPE;

  TOOL_NAME       : TOOL_NAMES;       --| Name of the tool
  TIMING          : BOOLEAN := FALSE; --| Timing option is used by Profile
  LOGFILE_IS_OPEN : BOOLEAN := FALSE; --| Goes true when logfile is opened

  TIMING_METHOD   : TIME_LIBRARY_1.TIMING_TYPE; --| method of recording times
  CURRENT_KEY     : LOGFILE_KEYS := PROGRAM;    --| The current logfile key

  NUMBER_OF_COMPILATION_UNITS : NATURAL := 0;

  NEXT_LOGFILE_ITEM : LOGFILE_POSITIONS := LOG_KEY;
  MAX_LINE_LENGTH   : constant INTEGER  := 255; --| Max length of logfile entry
  TEMP_STRING       : STRING(1 .. MAX_LINE_LENGTH);

  ----------------------------
  procedure DUMP_LOGFILE_STATE is

  begin

    PUT("Key      = ");
    PUT(LOGFILE_KEYS'POS(CURRENT_KEY));
    NEW_LINE;
    PUT("Position = ");
    PUT(LOGFILE_POSITIONS'POS(NEXT_LOGFILE_ITEM));
    NEW_LINE;

  end DUMP_LOGFILE_STATE;


  ------------------------
  procedure VERIFY_LOGFILE(--| Verify the current state of the logfile
    DESIRED_STATE    : in LOGFILE_STATES;
    DESIRED_POSITION : in LOGFILE_POSITIONS := NEXT_LOGFILE_ITEM;
    FIRST_KEY        : in LOGFILE_KEYS := LOGFILE_KEYS'FIRST;
    LAST_KEY         : in LOGFILE_KEYS := LOGFILE_KEYS'LAST

      ) is

    --| Raises: Logfile_Access_Error, Logfile_Sequence_Error, End_of_Logfile

    --| Effects
    --| This is an internal procedure that checks the current status of the
    --| logfile for the following error conditions:
    --|
    --| Logfile State:    If the desired state is open and the logfile is
    --|                   closed then the exception Logfile_Access_Error
    --|                   is raised.
    --|
    --| Logfile Position: If the desired position does not match the current
    --|                   position then the exception Logfile_Sequence_Error
    --|                   is raised.
    --|
    --| Logfile Key:      If the current logfile key is not in the desired
    --|                   range then the exception Logfile_Sequence_Error
    --|                   is raised.
    --|
    --| End_of_File:      If the logfile is open and is currently positioned
    --|                   at the end of file then the exception
    --|                   End_of_Logfile is raised.


    --| N/A: Requires, Modifies, Errors

  begin

    --| Check Logfile state
    if DESIRED_STATE = OPENED and not LOGFILE_IS_OPEN then
      PUT_LINE("Logfile Access Error: Logfile not open");
      DUMP_LOGFILE_STATE;
      raise LOGFILE_ACCESS_ERROR;
    end if;

    if DESIRED_STATE = CLOSED and LOGFILE_IS_OPEN then
      PUT_LINE("Logfile Access Error: Logfile already open");
      DUMP_LOGFILE_STATE;
      raise LOGFILE_ACCESS_ERROR;
    end if;

    --| Check Logfile position
    if DESIRED_POSITION /= NEXT_LOGFILE_ITEM then
      PUT_LINE("Logfile Sequence Error - Position");
      DUMP_LOGFILE_STATE;
      raise LOGFILE_SEQUENCE_ERROR;
    end if;

    --| Check for valid Logfile key
    if CURRENT_KEY not  in FIRST_KEY .. LAST_KEY then
      PUT_LINE("Logfile Sequence Error - Key");
      DUMP_LOGFILE_STATE;
      raise LOGFILE_SEQUENCE_ERROR;
    end if;

    --| Test for unchecked End Of File
    if LOGFILE_IS_OPEN then
      if END_OF_FILE(LOGFILE) then
        PUT_LINE("Error - Unchecked EOF");
        DUMP_LOGFILE_STATE;
        raise END_OF_LOGFILE;
      end if;
    end if;

  end VERIFY_LOGFILE;


  ------------------------------
  procedure FLUSH_LOGFILE_RECORD(--| Flush the current Logfile record

    KEY : in LOGFILE_KEYS  --| The current logfile key

      ) is

    --| Effects
    --| If Key is equal to the current log file key then the remainder of the
    --| current logfile record is flushed and the logfile is positioned at
    --| the beginning of the next logfile record.

    --| Requires
    --| The ELF must have been previously opened for input by the
    --| calling program via a call to the procedure Open_Log.
    --| The Logfile key for the current record must have already been
    --| read. The Key passed by the calling program must match the
    --| key for the current logfile record.

    --| N/A:  Raises, Modifies, Errors

  begin

    --| Flush the current logfile record and reset the
    --| current logfile position to Log_Key.

    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end FLUSH_LOGFILE_RECORD;


  -----------------
  function NEXT_KEY return LOGFILE_KEYS is

    KEY_NUMBER : NATURAL;
    SPACE      : CHARACTER;

  begin

    GET(LOGFILE, KEY_NUMBER);                    --| Get the logfile key
    GET(LOGFILE, SPACE);                         --| Discard next delimiter
    NEXT_LOGFILE_ITEM := LOG_DATA;               --| Set new logfile position
    CURRENT_KEY := LOGFILE_KEYS'VAL(KEY_NUMBER); --| Convert key to a value

    return CURRENT_KEY;

  end NEXT_KEY;


  ------------------------
  procedure GET_ADA_NAME(  --| Get the next token from Logfile

    NAME : out ADA_NAME  --| The token is returned as a string type

    ) is

    use STRING_PKG;

    TOKEN : STRING(1 .. MAX_LINE_LENGTH);

  begin

    for NEXT_CHARACTER in 1 .. MAX_LINE_LENGTH loop

      GET(LOGFILE, TOKEN(NEXT_CHARACTER));

      if TOKEN(NEXT_CHARACTER) = ' ' then
        NAME := MAKE_PERSISTENT(UPPER(TOKEN(1 .. NEXT_CHARACTER - 1)));
        exit;
      end if;

    end loop;

  end GET_ADA_NAME;


  -----------------------------
  procedure GET_UNIT_IDENTIFIER(--| Gets unit ID for current unit from the ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER
    --| A unique ID assigned by the Source Instrumenter

      ) is

    --| Effects
    --| This is an internal procedure that gets and returns the
    --| program unit identifier from the ELF

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log. Tests for logfile open,
    --| logfile position, correct logfile key, and NOT end of logfile
    --| must have already been made.

    --| N/A:  Raises, Modifies, Errors

    COMPILATION_UNIT : ADA_NAME;
    SPACE            : CHARACTER;      --| spaces are field delimiters
    TEMP_STRING      : STRING(1 .. 3);
    UNIT_TYPE        : CHARACTER;

  begin

    GET_ADA_NAME(UNIT_IDENTIFIER.ENCLOSING_UNIT_IDENTIFIER);
    GET(LOGFILE, UNIT_IDENTIFIER.PROGRAM_UNIT_NUMBER);
    UNIT_IDENTIFIER.TASK_TYPE_ACTIVATION_NUMBER := 0;
    GET(LOGFILE, TEMP_STRING);
    UNIT_TYPE := TEMP_STRING(2);

    case UNIT_TYPE is
      when 'P' =>
        UNIT_IDENTIFIER.UNIT_TYPE := PROCEDURE_TYPE;
      when 'F' =>
        UNIT_IDENTIFIER.UNIT_TYPE := FUNCTION_TYPE;
      when 'G' =>
        UNIT_IDENTIFIER.UNIT_TYPE := GENERIC_TYPE;
      when 'K' =>
        UNIT_IDENTIFIER.UNIT_TYPE := PACKAGE_TYPE;
      when 'T' =>
        UNIT_IDENTIFIER.UNIT_TYPE := TASK_TYPE;
        GET(LOGFILE, UNIT_IDENTIFIER.TASK_TYPE_ACTIVATION_NUMBER);
        GET(LOGFILE, SPACE);                   -- delimiter
      when others =>
        null;
    end case;

  end GET_UNIT_IDENTIFIER;



  -----------------------
  procedure GET_UNIT_ID(--| Gets unit ID for current unit from the ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER
    --| A unique ID assigned by the Source Instrumenter

      ) is

    --| Effects
    --| Gets and returns the program unit id (Unit_ID) from the ELF

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be in UNIT_START..UNIT_STOP.

    --| N/A:  Raises, Modifies, Errors

  begin

    GET_UNIT_IDENTIFIER(UNIT_IDENTIFIER);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end GET_UNIT_ID;



  ---------------------------------
  procedure DEFINE_COMPILATION_UNIT is --| Defines a new compilation unit

    use COMPILATION_UNIT_LISTS; --| List management package for
                                --| compilation units and program units.

    COMPILATION_UNIT      : ADA_NAME;
    NUMBER_OF_BREAKPOINTS : BREAKPOINT_NUMBER_RANGE;

  begin

    GET_ADA_NAME(COMPILATION_UNIT);         -- get the name of the unit
    GET(LOGFILE, NUMBER_OF_BREAKPOINTS);    -- and the number of breakpoints
                                            -- add them to the unit list
    ADD_COMPILATION_UNIT(COMPILATION_UNIT, NUMBER_OF_BREAKPOINTS);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;           -- set the new logfile position

  end DEFINE_COMPILATION_UNIT;


  -----------------------------
  procedure DEFINE_PROGRAM_UNIT is --| Defines a new program unit

    use COMPILATION_UNIT_LISTS; --| List management package for
                                --| compilation units and program units.
    use STRING_PKG;             --| A string handling package for String_Type's

    UNIT_ID   : PROGRAM_UNIT_UNIQUE_IDENTIFIER;
              --| Assigned by Source Instrumenter

    UNIT_NAME : ADA_NAME;       --| The name of the program unit
    LAST      : NATURAL;        --| Index to last character read

  begin

    GET_UNIT_IDENTIFIER(UNIT_ID);             -- get the program unit ID
    GET_LINE(LOGFILE, TEMP_STRING, LAST);     -- get the name of the unit

    STRING_PKG.FLUSH(UNIT_NAME);
    UNIT_NAME := MAKE_PERSISTENT(UPPER(TEMP_STRING(1 .. LAST)));
    ADD_PROGRAM_UNIT(UNIT_ID, UNIT_NAME);     -- Add this unit to the unit list
    NEXT_LOGFILE_ITEM := LOG_KEY;             -- set new position for logfile

  end DEFINE_PROGRAM_UNIT;


  ------------------
  procedure OPEN_LOG( --| Opens the ELF for input by the report generators.

    LOGFILE_NAME : in FILENAME;         --| Name of the log file to be created

    PROGRAM_NAME : out ADA_NAME;        --| The name of the main program unit

    TEST_IDENT   : out TEST_IDENTIFIER; --| A unique ID assigned by the tester

    TEST_DATE    : out CALENDAR.TIME    --| The date and time of the test

      ) is

    --| Raises: Invalid_Log_File_Format, Logfile_Access_Error

    --| Effects
    --| This procedure opens the ELF for input by the report generators.
    --| If the file is successfully opened, it returns test configuration
    --| data recorded in the ELF by the RTM during execution of the Ada
    --| program under test. If the file is already open then the exception
    --| Logfile_Access_Error is raised. If the file is not successfully
    --| opened due to an IO error, then the standard Text_IO exceptions are
    --| allowed to pass unhandled back to the calling program. If the ELF is
    --| is determined to contain invalid or missing configuration data,
    --| then the exception Invalid_Log_File_Format is raised.

    --| Requires
    --| The ELF must contain test configuration data in the format
    --| created by the RTM via a call to the procedure Create_Log.

    --| N/A:  Modifies, Errors

    use TIME_LIBRARY_1; --| for Timing_Type
    use TIME_LIBRARY_2; --| for Timing_Is Get_Time and Get_Time_of_Day
    use STRING_PKG;     --| for Mark, Release, Create, Substr, Make_Persistent

    KEY           : LOGFILE_KEYS;
    LAST          : NATURAL;

    PROGRAM_KEY   : BOOLEAN := FALSE; -- a test configuration key
    TOOL_KEY      : BOOLEAN := FALSE; -- a test configuration key
    TEST_TIME_KEY : BOOLEAN := FALSE; -- a test configuration key
    TEST_ID_KEY   : BOOLEAN := FALSE; -- a test configuration key

    TIME_TYPE     : CHARACTER; -- a temp variable for the timing method used
    DELIMITER     : CHARACTER; -- a temp variable for logfile field delimiters

  begin

    --| Verify that the logfile is not already open. If it is
    --| already open then raise the exception Logfile_Access_Error.

    VERIFY_LOGFILE(CLOSED);

    --| If no exception has been raised the open the logfile
    --| for input.

    OPEN(LOGFILE, IN_FILE, VALUE(LOGFILE_NAME));
    LOGFILE_IS_OPEN := TRUE;        -- logfile is open for business

    ------------------
    CONFIGURATION_DATA : while not END_OF_FILE(LOGFILE) loop

      case NEXT_KEY is

        when PROGRAM =>
          GET_LINE(LOGFILE, TEMP_STRING, LAST);
          PROGRAM_NAME := MAKE_PERSISTENT(UPPER(TEMP_STRING(1 .. LAST)));
          PROGRAM_KEY := TRUE;

        when TOOL =>
          GET_LINE(LOGFILE, TEMP_STRING, LAST);
          TOOL_KEY := TRUE;
          if TEMP_STRING(1 .. LAST) = "PROFILE_TOOL" then
            TIMING := TRUE;
          end if;

        when TEST_TIME =>
          GET(LOGFILE, TIME_TYPE);
          case TIME_TYPE is
            when 'W' =>
              TIMING_IS(WALL_CLOCK);
            when 'R' =>
              TIMING_IS(RAW);
            when others =>
              raise INVALID_LOGFILE_FORMAT;
          end case;
          GET(LOGFILE, DELIMITER);       -- a field delimiter
          GET_TIME(LOGFILE, TEST_DATE);
          SKIP_LINE(LOGFILE);
          TEST_TIME_KEY := TRUE;

        when TEST_ID =>
          GET_LINE(LOGFILE, TEMP_STRING, LAST);
          TEST_IDENT := MAKE_PERSISTENT(TEMP_STRING(1 .. LAST));
          TEST_ID_KEY := TRUE;

        when COMPILATION_UNIT_DEFINITION =>
          DEFINE_COMPILATION_UNIT;

        when PROGRAM_UNIT_DEFINITION =>
          DEFINE_PROGRAM_UNIT;

        when others =>
          FLUSH_LOGFILE_RECORD(CURRENT_KEY);

      end case;

      exit CONFIGURATION_DATA when  -- all config keys have been read
      PROGRAM_KEY and TOOL_KEY and TEST_TIME_KEY and TEST_ID_KEY;

    end loop CONFIGURATION_DATA;

    NEXT_LOGFILE_ITEM := LOG_KEY;

    --| We have reached the end of the logfile. Verify that all configuration
    --| data has been found. If not, raise an exception.
    if not (PROGRAM_KEY and TOOL_KEY and TEST_TIME_KEY and TEST_ID_KEY) then
      raise INVALID_LOGFILE_FORMAT;
    end if;

    RESET(LOGFILE);  --| The logfile must be reset in the event runtime
                     --| execution data has been interleaved with
                     --| Configuration data due to tasking or WITH'ing
                     --| of instrumented packages.

  end OPEN_LOG;


  ----------------------
  procedure GET_NEXT_KEY(--| Gets the next log file key from the ELF

    KEY : in out LOGFILE_KEYS  --| Defines the type of data that is
                               --| contained in the current ELF record

      ) is

    --| Effects
    --| This procedure reads the next log file key (Key) from the ELF and
    --| returns it to the calling program.

    --| Requires
    --| The ELF must have been previously opened for input by the
    --| calling program via a call to the procedure Open_Log.

    --| N/A:  Raises, Modifies, Errors

  begin

    KEY := NEXT_KEY;  --  Get the next logfile key;

    case KEY is

      when PROGRAM .. TEST_ID =>
        --| This is a Configuration key. It was read when the log file
        --| was opened. Ignore it.
        FLUSH_LOGFILE_RECORD(KEY);
        GET_NEXT_KEY(KEY);

      when COMPILATION_UNIT_DEFINITION =>
        --| This key defines a new compilation unit. It should have
        --| already been read when the log file was opened. Just in
        --| case try to add it to the compilation unit list. If it's
        --| already there then a little time will be lost but it's
        --| better to be safe than sorry.
        DEFINE_COMPILATION_UNIT;
        GET_NEXT_KEY(KEY);

      when PROGRAM_UNIT_DEFINITION =>
        --| This key defines a new program unit. It should have
        --| already been read when the log file was opened. Just in
        --| case try to add it to the program unit list for this
        --| compilation unit. If it's already there then a little
        --| time will be lost but it's better to be safe than sorry.
        DEFINE_PROGRAM_UNIT;
        GET_NEXT_KEY(KEY);

      when others =>  --| No other keys require special processing
        null;

    end case;

  end GET_NEXT_KEY;


  -----------------------
  procedure GET_UNIT_TIME(--| Gets the unit ID and start/stop time from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    LOGGED_TIME     : out CALENDAR.DAY_DURATION --| The time that the unit
                                                --| was entered or exited
      ) is

    --| Effects
    --| Gets and returns the program unit id (Unit_Identifier) and logged
    --| time (Log_Time)  from the ELF.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be in UNIT_START..UNIT_STOP.

    --| N/A:  Raises, Modifies, Errors


  begin

    GET_UNIT_IDENTIFIER(UNIT_IDENTIFIER);
    TIME_LIBRARY_2.GET_TIME_OF_DAY(LOGFILE, LOGGED_TIME);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end GET_UNIT_TIME;


  ------------------------
  procedure GET_BREAKPOINT( --| Gets current breakpoint from the ELF

    UNIT_IDENTIFIER    : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    CURRENT_BREAKPOINT : out BREAKPOINT_NUMBER_RANGE
    --| The breakpoint number assigned by the Source Instrumenter

      ) is

    --| Effects
    --| Gets the program unit, and current breakpoint number from the
    --| Execution Log File.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be in LOOP_BREAKPOINT..OTHER_BREAKPOINT.

    --| N/A:  Raises, Modifies, Errors

  begin

    GET_UNIT_IDENTIFIER(UNIT_IDENTIFIER);
    GET(LOGFILE, CURRENT_BREAKPOINT);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end GET_BREAKPOINT;



  ------------------------
  function CALL_PARAMETERS  --| Gets AutoPath procedure call parameter list

    return USER_INPUT_STRING  --| The user specified parameter list

        is

    --| Raises:  Logfile_Access_Error, Logfile_Sequence_Error,
    --|          End_of_Log_File

    --| Effects
    --| Gets the AutoPath procedure call parameter list from the logfile
    --| for a single execution of the target Ada program.
    --| If the logfile is not open then the exception Logfile_Access_Error
    --| is raised.
    --| If an End of File (EOF) in the ELF is encountered, the exception
    --| End_of_Log_File is raised.
    --| If the current logfile key is not AUTOPATH_CALL
    --| then the exception Logfile_Sequence_Error is raised.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be AUTOPATH_CALL.

    --| N/A:  Modifies, Errors

    use STRING_PKG; --| for handling of String_Type's

    PARAMETER_LIST : USER_INPUT_STRING;
    LAST           : NATURAL;           --| The length of the parameter list

  begin

    --| Verify that the logfile is currently open, that the current
    --| logfile position is Log_Data, and that the current logfile
    --| key is AutoPath_Call. If any of these conditions
    --| is false then raise the appropriate exception.

    VERIFY_LOGFILE(OPENED, LOG_DATA, AUTOPATH_CALL, AUTOPATH_CALL);

    GET_LINE(LOGFILE, TEMP_STRING, LAST);
    STRING_PKG.FLUSH(PARAMETER_LIST);
    PARAMETER_LIST := MAKE_PERSISTENT(UPPER(TEMP_STRING(1 .. LAST)));
    NEXT_LOGFILE_ITEM := LOG_KEY;

    return PARAMETER_LIST;

  end CALL_PARAMETERS;

  -------------------
  procedure GET_VALUE(--| Gets value of INTEGER variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME; --| The unqualified variable name

    VALUE           : out INTEGER   --| The current value of variable

      ) is

    --| Effects
    --| Gets integer values from the execution log file.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be INTEGER_VARIABLE.

    --| N/A:  Raises, Modifies, Errors

  begin

    GET_UNIT_IDENTIFIER(UNIT_IDENTIFIER);
    GET_ADA_NAME(VARIABLE_NAME);
    GET(LOGFILE, VALUE);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end GET_VALUE;


  -------------------
  procedure GET_VALUE(--| Gets value of LONG_INTEGER variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME;    --| The unqualified variable name

    VALUE           : out LONG_INTEGER --| The current value of variable

      ) is

    --| Effects
    --| Gets long_integer values from the execution log file.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be LONG_INTEGER_VARIABLE.

    --| N/A:  Raises, Modifies, Errors

    use NEW_LONG_INTEGER_IO;

  begin

    GET_UNIT_IDENTIFIER(UNIT_IDENTIFIER);
    GET_ADA_NAME(VARIABLE_NAME);
    GET(LOGFILE, VALUE);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end GET_VALUE;



  -------------------
  procedure GET_VALUE(--| Gets value of FLOAT variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME; --| The unqualified variable name

    VALUE           : out FLOAT     --| The current value of variable

      ) is

    --| Effects
    --| Gets floating point values from the execution log file.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be FLOAT_VARIABLE.

    --| N/A:  Raises, Modifies, Errors

    use NEW_FLOAT_IO;

  begin

    GET_UNIT_IDENTIFIER(UNIT_IDENTIFIER);
    GET_ADA_NAME(VARIABLE_NAME);
    GET(LOGFILE, VALUE);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end GET_VALUE;



  -------------------
  procedure GET_VALUE(--| Gets value of LONG_FLOAT variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME;   --| The unqualified variable name

    VALUE           : out LONG_FLOAT  --| The current value of variable

      ) is

    --| Effects
    --| Gets long_float values from the execution log file.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.
    --| The current log file key (i.e., the previously read key)
    --| must be LONG_FLOAT_VARIABLE.

    --| N/A:  Raises, Modifies, Errors

    use NEW_LONG_FLOAT_IO;

  begin

    GET_UNIT_IDENTIFIER(UNIT_IDENTIFIER);
    GET_ADA_NAME(VARIABLE_NAME);
    GET(LOGFILE, VALUE);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end GET_VALUE;



  -------------------
  procedure GET_VALUE(--| Gets value of STRING variable from ELF

    UNIT_IDENTIFIER : out PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    VARIABLE_NAME   : out ADA_NAME;        --| The unqualified variable name

    STRING_VALUE    : out STRING_VARIABLES --| current value of variable

      ) is

    --| Effects
    --| Gets string values from the execution log file.
    --| This procedure used to get the value of
    --|        strings
    --|        characters
    --|        enumerated data types (including booleans)

    --| Requires
    --| The current log file key (i.e., the previously read key)
    --| must be STRING_VARIABLE.

    --| N/A:  Raises, Modifies, Errors

    use STRING_PKG; --| for handling of String_Type's

    LAST : NATURAL;  --| The length of the string variable's value

  begin

    GET_UNIT_IDENTIFIER(UNIT_IDENTIFIER);
    GET_ADA_NAME(VARIABLE_NAME);
    GET_LINE(LOGFILE, TEMP_STRING, LAST);
    STRING_VALUE := MAKE_PERSISTENT(TEMP_STRING(1 .. LAST));
    NEXT_LOGFILE_ITEM := LOG_KEY;

  end GET_VALUE;



  -------------------
  function END_OF_LOG  --| Checks for End Of file in the ELF
    return BOOLEAN     --| True if EOF is reached else false

        is

    --| Raises:  Logfile_Access_Error

    --| Effects
    --| This function checks for End Of File in the ELF and returns true
    --| if an EOF has been reached.
    --| If the logfile is not open then the exception Logfile_Access_Error
    --| is raised.
    --| Text_IO exceptions that may be raised are allowed to pass, unhandled,
    --| back to the calling program.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.

    --| N/A:  Modifies, Errors


  begin
    if not LOGFILE_IS_OPEN then
      PUT_LINE("In End_of_Log");
      PUT_LINE("Logfile Access Error: Logfile not open");
      DUMP_LOGFILE_STATE;
      raise LOGFILE_ACCESS_ERROR;
    else
      return END_OF_FILE(LOGFILE);
    end if;
  end END_OF_LOG;



  ------------------------
  procedure FIND_UNIT_NAME( --| Finds the name of a program unit

    UNIT_IDENTIFIER : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
    --| A unique ID assigned by the Source Instrumenter

    UNIT_NAME       : out ADA_NAME  --| The name of program unit

      ) is

    --| Raises: Undefined_Program_Unit

    --| Effects
    --| Finds the program unit unit name (Unit_Name) corresponding to the
    --| program unit ID. If no UNIT_DEF record has been previously
    --| encountered in the ELF to associate a program unit name with
    --| the specified unit ID then the Undefined_Program_Unit exception
    --| is raised.

    --| Requires
    --| A program unit name (Unit_Name) must have been previously recorded
    --| in the ELF and assosiated with the specified unit id (Unit_Identifier)
    --| by the program that originally generated the log file via a call
    --| to the procedure Define_Comp_Unit.

    --| N/A:  Modifies, Errors

    use COMPILATION_UNIT_LISTS; --| List management package for
                                --| compilation units and program units.
  begin

    GET_PROGRAM_UNIT_NAME(UNIT_IDENTIFIER, UNIT_NAME);

  end FIND_UNIT_NAME;



  ------------------------------
  function NUMBER_OF_BREAKPOINTS(--| Finds the number of breakpoints
                                 --| in a compilation unit

    COMPILATION_UNIT_NAME : in ADA_NAME --| The name of the compilation unit

      ) return BREAKPOINT_NUMBER_RANGE is

    --| Raises: Undefined_Program_Unit

    --| Effects
    --| Gets and returns the total number of breakpoints in the
    --| specified compilation unit. If the compilation unit has
    --| not been previously defined in the logfile then the
    --| exception Undefined_Program_Unit is raised.

    --| Requires
    --| The compilation unit name must have been previously
    --| returned to the calling program in a Unit ID by the
    --| the procedure Get_Unit_ID.

    --| N/A:  Modifies, Errors

    use COMPILATION_UNIT_LISTS;  --| List management package for
                                 --| compilation units and program units.

    TOTAL_BREAKPOINTS : BREAKPOINT_NUMBER_RANGE;

  begin

    GET_NUMBER_OF_BREAKPOINTS(COMPILATION_UNIT_NAME, TOTAL_BREAKPOINTS);
    return TOTAL_BREAKPOINTS;

  end NUMBER_OF_BREAKPOINTS;


  --------------------
  function TIMING_DATA  --| Returns true if the logfile contains timing data

    return BOOLEAN

    is

    --| Raises: Logfile_Access_Error

    --| Effects
    --| Returns true if the logfile contains timing data. Otherwise
    --| returns false. This function provides a mechanism for the
    --| calling program to determine whether or not timing data
    --| has been recorded in the logfile prior to calling other
    --| Read_Log procedures that read times from the logfile.
    --| If the logfile is not open then the exception
    --| Logfile_Access_Error is raised.

    --| Requires
    --| The target Ada program must have been executed with
    --| Tool_Name = Profile_Tool in order for timing data to have
    --| been recorded in the log file and the current log file
    --| key must be Timing_Overhead. The log file must have been
    --| previously opened by the calling program via a call to Open_Log.

    --| N/A:  Modifies, Errors


  begin

    return TIMING;

  end TIMING_DATA;


  -----------------------------
  function ACCUMULATED_OVERHEAD --| Returns the Accumulated timing overhead
                                --| calculated during test program execution

    return CALENDAR.DAY_DURATION

    is

    --| Raises: Logfile_Access_Error

    --| Effects
    --| Gets and returns the total accumulated timing overhead
    --| calculated during execution of the target Ada program.
    --| If the logfile is not open or the current logfile key is
    --| not then the exception Logfile_Access_Error is raised.

    --| Requires
    --| The target Ada program must have been executed with
    --| Tool_Name = Profile_Tool in order for timing data to have
    --| been recorded in the log file and the current log file
    --| key must be Timing_Overhead.

    --| N/A:  Modifies, Errors

    LOGGED_TIME : CALENDAR.DAY_DURATION;

  begin

    --| Verify that the logfile is currently open, that the current
    --| logfile position is Log_Data, and that the current logfile
    --| key is in Unit_Start..Unit_Stop. If any of these conditions
    --| is false then raise the appropriate exception.

    VERIFY_LOGFILE(OPENED, LOG_DATA, TIMING_OVERHEAD, TIMING_OVERHEAD);

    TIME_LIBRARY_2.GET_TIME_OF_DAY(LOGFILE, LOGGED_TIME);
    SKIP_LINE(LOGFILE);
    NEXT_LOGFILE_ITEM := LOG_KEY;
    return LOGGED_TIME;

  end ACCUMULATED_OVERHEAD;

  -------------------
  procedure CLOSE_LOG is --| Closes the execution log file

    --| Raises:  Logfile_Access_Error

    --| Effects
    --| Closes the execution log file.
    --| If the logfile is not open then the exception Logfile_Access_Error
    --| is raised.

    --| Requires
    --| The log file must have been previously opened by the calling
    --| program via a call to Open_Log.

    --| N/A:  Modifies, Errors

  begin
    if LOGFILE_IS_OPEN then
      CLOSE(LOGFILE);
      LOGFILE_IS_OPEN := FALSE;
    else
      PUT_LINE("In Close_Log");
      PUT_LINE("Logfile_Access_Error: Logfile already closed");
      raise LOGFILE_ACCESS_ERROR;
    end if;
  end CLOSE_LOG;


end READ_LOG;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--REPLIB.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS, SIMPLE_PAGINATED_OUTPUT, STRING_PKG, CALENDAR;

----------------------
package REPORT_LIBRARY is --| Ada Test and Evaluation Tools Report Library
----------------------

--| Overview
--| NOSC_Report_Library is a library of procedures common to all of the
--| NOSC Ada Test and Evaluation Tool Set (ATETS) report generators.

--| N/A: Raises, Requires, Modifies, Errors

  use TYPE_DEFINITIONS;        --| Global type declarations for all ATETS tools

  use SIMPLE_PAGINATED_OUTPUT; --| Output writer uses Text_IO;


  MINIMUM_CPL : constant INTEGER :=  40;
  MAXIMUM_CPL : constant INTEGER := 132;
  MINIMUM_LPP : constant INTEGER :=  24;
  MAXIMUM_LPP : constant INTEGER :=  66;

  subtype CHARACTERS_PER_LINE is INTEGER range MINIMUM_CPL .. MAXIMUM_CPL;
  subtype LINES_PER_PAGE      is INTEGER range MINIMUM_LPP .. MAXIMUM_LPP;

  type OPTIONS is    --| Report formatting options
    record
      CPL          : CHARACTERS_PER_LINE;
      PAGE_SIZE    : LINES_PER_PAGE;
      TOOL_NAME    : TOOL_NAMES;
      TOOL_VERSION : STRING(1 .. 20);
    end record;

  subtype HEADER_TEXT is STRING_PKG.STRING_TYPE;


  --------------------------
  procedure OPEN_REPORT_FILE(--| Open the report file and set up formatting

    REPORT           : in out PAGINATED_FILE_HANDLE;
                   --| A "handle" for the report file

    REPORT_FILE_NAME : in FILENAME; --| The name of the report file

    FORMAT_OPTIONS   : in OPTIONS   --| Report formatting options

      );

    --| Effects
    --| This procedure opens the report file for output and sets up the
    --| report formatting options. If the report file already exists then
    --| it is overwritten. A "handle" for the report file is returned to
    --| the calling program. All output to the report file is performed via
    --| the package Pagenated_Output. Report formatting  options for the
    --| output writer are set up according to the parameters specified in
    --| Format_Options. Although no exceptions are raised by this procedure,
    --| any Text_IO or Pagenated_Output exceptions that may be raised are
    --| allowed to pass, unhandled, back to the calling program.

    --| N/A:  Raises, Requires, Modifies, Errors


  -----------------------------------------
  procedure PRINT_TEST_CONFIGURATION_REPORT(
  --| Print log file test configuration data to report file

    REPORT        : in out PAGINATED_FILE_HANDLE;--| Output report file handle

    PROGRAM_NAME  : in ADA_NAME;       --| Name of program under test

    LOG_FILE_NAME : in FILENAME;       --| Name of the log file

    TEST_DATE     : in CALENDAR.TIME;  --| Date the log file was created

    TEST_IDENT    : in TEST_IDENTIFIER --| Test id specified by the user

      );

    --| Effects
    --| This procedure prints configuration information obtained from
    --| the command line parameters and the Execution Log File  on the
    --| first page of the report file. All output to the report file
    --| is performed via the package Pagenated_Output. No logfile is specified
    --| as access to the logfile is not visible to the calling program.
    --| The following information is printed on the configuration page
    --| of the report file:
    --|
    --|     Program Name:  name of program under test
    --|     Test Date:     date of log file generation
    --|     Test Time:     time of log file generation
    --|     Report Date:   date of report generation
    --|     Report Time:   time of report generation
    --|     Logfile:       log file name

    --| N/A:  Raises, Requires, Modifies, Errors


  -------------------------------------
  procedure PUT_TEST_CONFIGURATION_DATA(
  --| Put log file test configuration data to current output

    PROGRAM_NAME : in ADA_NAME;        --| The name of the program under test
    TEST_DATE    : in CALENDAR.TIME;   --| Date the log file was created
    TEST_IDENT   : in TEST_IDENTIFIER  --| Test id specified by the user

      );

    --| Effects
    --| This procedure puts test configuration information obtained from
    --| the Execution Log File  to current output. The following information
    --| is output:
    --|
    --|     Program Under Test:  name of program under test
    --|     Test Date:           date of log file generation
    --|     Test Time:           time of log file generation
    --|     Test ID:             the test ID obtained from the log file
    --|

    --| N/A:  Raises, Requires, Modifies, Errors


  --------------
  function QUERY(--| Put a Yes or No question and get a response

    QUESTION : in STRING  --| A query to be answered Y or N

      ) return BOOLEAN;   --| True if answered Y, False if answered N

    --| Effects
    --| The user is then prompted with Question. The user's response is then
    --| tested for Y or N. Only the first character input is tested and
    --| case is not significant. If Y is input then Response is returned
    --| true. In N is input then Response is  returned false. If Neither
    --| Y nor N then the user is prompted again with Query.

    --| N/A:  Raises, Requires, Modifies, Errors


  ------------------
  function STRING_OF(--| Convert an integer to a string of length 1..Width

    INT   : in INTEGER;      --| The Integer to be converted

    WIDTH : in NATURAL := 0  --| The width of the string to be returned

      ) return STRING;

    --| Effects
    --| Converts the integer Int to a string of length Width. If Width = 0
    --| then the length of the string is equal to the number of digits in
    --| INT. If Width is greater than the number of digits in Int then the
    --| integer is right justified in the string and padded with blanks.


  ----------------
  function REPLACE(--| Replace characters in S1 at position Pos with S2

    S1  : in STRING_PKG.STRING_TYPE;
      --| String_Type with characters to be replaced

    S2  : in STRING_PKG.STRING_TYPE;
      --| String_Type to be inserted into copy of S2

    POS : in NATURAL
      --| Position in S1 at which S2 is to be inserted

      ) return STRING_PKG.STRING_TYPE;

    --| Effects
    --| Returns  Substr( S1, 1, Pos-1 ) & S2 &
    --|              Substr( S1, Pos+Length(S2), Length(S1)-Pos-Len(S2) )

    --| N/A:  Raises, Requires, Modifies, Errors


  ----------------
  function REPLACE(--| Replace characters in S1 at position Pos with S2

    S1  : in STRING_PKG.STRING_TYPE;
      --| String_Type with characters to be replaced

    S2  : in STRING;
      --| String to be inserted into copy of S2

    POS : in NATURAL
      --| Position in S1 at which S2 is to be inserted

      ) return STRING_PKG.STRING_TYPE;

    --| Effects
    --| Returns  Substr( S1, 1, Pos-1 ) & S2 &
    --|              Substr( S1, Pos+Length(S2), Length(S1)-Pos-Len(S2) )

    --| N/A:  Raises, Requires, Modifies, Errors


  ---------------
  function CENTER( --| Center text on header line

    TEXT : in STRING;              --| The text to be centered

    CPL  : in CHARACTERS_PER_LINE  --| Length of header text, in characters,
                                   --| to be created

      ) return HEADER_TEXT;

    --| Effects
    --| Returns a Header_Text line of length CPL with the input Text string
    --| centered on the line.

    --| N/A:  Raises, Requires, Modifies, Errors


end REPORT_LIBRARY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--REPLIB.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS, STRING_PKG, SIMPLE_PAGINATED_OUTPUT, TEXT_IO;
with CALENDAR, TIME_LIBRARY_1, TIME_LIBRARY_2;

---------------------------
package body REPORT_LIBRARY is  --| Ada Test and Evaluation Tools Report Lib
---------------------------

--| Overview
--| NOSC_Report_Library is a library of procedures common to all of the
--| NOSC Ada Test and Evaluation Tool Set (ATETS) report generators.

--| N/A: Raises, Requires, Modifies, Errors


  use TYPE_DEFINITIONS;        --| Global type declarations common to all
                               --| Ada Testing and Analysis Tools

  use SIMPLE_PAGINATED_OUTPUT; --| Output writer uses Text_IO;

  use STRING_PKG;              --| String handling package for String_Types;


  REPORT_OPTIONS : OPTIONS;    --| Report formatting options;

  HEADER         : VARIABLE_STRING_ARRAY(1 .. 7);


  ------------------
  function STRING_OF(--| Convert an integer to a string of length 1..Width

    INT   : in INTEGER;      --| The Integer to be converted

    WIDTH : in NATURAL := 0  --| The width of the string to be returned

      ) return STRING is

    --| Effects
    --| Converts the integer Int to a string of length Width. If Width = 0
    --| then the length of the string is equal to the number of digits in
    --| INT. If Width is greater than the number of digits in Int then the
    --| integer is right justified in the string and padded with blanks.

    package INT_IO is new TEXT_IO.INTEGER_IO(INTEGER);

    STR   : STRING(1 .. 20);
    INDEX : NATURAL;

  begin

    INT_IO.PUT(STR, INT);

    if WIDTH > STR'LAST then
      INDEX := STR'FIRST;

    elsif WIDTH = 0 then
      for I in reverse STR'range loop
        exit when STR(I) = ' ';
        INDEX := I;
      end loop;

    else
      INDEX := STR'LAST - WIDTH + 1;

    end if;

    return STR(INDEX .. STR'LAST);

  end STRING_OF;


  ----------------
  function REPLACE(--| Replace characters in S1 at position Pos with S2

    S1  : in STRING_TYPE;
      --| String_Type with characters to be replaced

    S2  : in STRING_TYPE;
      --| String_Type to be inserted into copy of S2

    POS : in NATURAL
      --| Position in S1 at which S2 is to be inserted

      ) return STRING_TYPE is

    --| Effects
    --| Returns  Substr( S1, 1, Pos-1 ) & S2 &
    --|          Substr( S1, Pos+Length(S2), Length(S1)-Pos-Len(S2) )

    --| N/A:  Raises, Requires, Modifies, Errors

  begin
    return INSERT(SPLICE(S1, POS, LENGTH(S2)), S2, POS);
  end REPLACE;


  ----------------
  function REPLACE(--| Replace characters in S1 at position Pos with S2

    S1  : in STRING_TYPE;
      --| String_Type with characters to be replaced
    S2  : in STRING;
      --| String to be inserted into copy of S2
    POS : in NATURAL
      --| Position in S1 at which S2 is to be inserted

      ) return STRING_TYPE is

    --| Effects
    --| Returns  Substr( S1, 1, Pos-1 ) & S2 &
    --|              Substr( S1, Pos+Length(S2), Length(S1)-Pos-Len(S2) )

    --| N/A:  Raises, Requires, Modifies, Errors

  begin
    return INSERT(SPLICE(S1, POS, LENGTH(CREATE(S2))), S2, POS);
  end REPLACE;


  ---------------
  function CENTER( --| Center text on header line

    TEXT : in STRING;              --| The text to be centered

    CPL  : in CHARACTERS_PER_LINE  --| Length of header text, in characters,
                                   --| to be created

      ) return HEADER_TEXT is

    --| Effects
    --| Returns a Header_Text line of length CPL with the input Text string
    --| centered on the line.

    --| N/A:  Raises, Requires, Modifies, Errors

    HEADER_LINE : HEADER_TEXT;

  begin

    HEADER_LINE := MAKE_PERSISTENT(TEXT);

    for I in 1 .. ((CPL - LENGTH(HEADER_LINE))/2) loop
      HEADER_LINE := INSERT(HEADER_LINE, " ", 1);
    end loop;

    return HEADER_LINE;

  end CENTER;


  --------------------------
  procedure OPEN_REPORT_FILE(--| Open the report file and set up formatting

    REPORT           : in out PAGINATED_FILE_HANDLE;
                   --| A "handle" for the report file

    REPORT_FILE_NAME : in FILENAME; --| The name of the report file

    FORMAT_OPTIONS   : in OPTIONS   --| Report formatting options

      ) is

    --| Effects
    --| This procedure opens the report file for output and sets up the
    --| report formatting options. If the report file already exists then
    --| it is overwritten. A "handle" for the report file is returned to
    --| the calling program. All output to the report file is performed via
    --| the package Pagenated_Output. Report formatting  options for the
    --| output writer are set up according to the parameters specified in
    --| Format_Options. Although no exceptions are raised by this procedure,
    --| any Text_IO or Pagenated_Output exceptions that may be raised are
    --| allowed to pass, unhandled, back to the calling program.

    --| N/A:  Raises, Requires, Modifies, Errors

    HEADER_SIZE : constant INTEGER := 7;
    FOOTER_SIZE : constant INTEGER := 3;

  begin

    --| Create the report file.
    CREATE_PAGINATED_FILE(VALUE(REPORT_FILE_NAME), REPORT,
                          FORMAT_OPTIONS.PAGE_SIZE, HEADER_SIZE);

    --| Save the report formatting options for later
    REPORT_OPTIONS := FORMAT_OPTIONS;

  end OPEN_REPORT_FILE;


  -----------------------------------------
  procedure PRINT_TEST_CONFIGURATION_REPORT(
  --| Print test configuration data to report file

    REPORT        : in out PAGINATED_FILE_HANDLE; --| Output report file handle

    PROGRAM_NAME  : in ADA_NAME;       --| The name of the program under test

    LOG_FILE_NAME : in FILENAME;       --| Name of the log file

    TEST_DATE     : in CALENDAR.TIME;  --| Date the log file was created

    TEST_IDENT    : in TEST_IDENTIFIER --| Test id specified by the user

      ) is

    --| Effects
    --| This procedure prints configuration information obtained from
    --| the command line parameters and the Execution Log File  on the
    --| first page of the report file. All output to the report file
    --| is performed via the package Pagenated_Output. No logfile is specified
    --| as access to the logfile is not visible to the calling program.
    --| The following information is printed on the configuration page
    --| of the report file:
    --|
    --|     Program Name:  name of program under test
    --|     Test Date:     date of log file generation
    --|     Test Time:     time of log file generation
    --|     Report Date:   date of report generation
    --|     Report Time:   time of report generation
    --|     Logfile:       log file name
    --|     Test ID:       the test ID obtained from the log file

    --| N/A:  Raises, Requires, Modifies, Errors

    use CALENDAR, TIME_LIBRARY_1, TIME_LIBRARY_2;

    DASHES : constant STRING(1 .. MAXIMUM_CPL) := (1 .. MAXIMUM_CPL => '-');
    BLANKS : constant STRING(1 .. MAXIMUM_CPL) := (1 .. MAXIMUM_CPL => ' ');

    PATH_TITLE     : constant STRING := "Ada Path Analyzer";
    AUTOPATH_TITLE : constant STRING := "Ada Automatic Path Analyzer";
    PROFILE_TITLE  : constant STRING := "Ada Performance Analyzer";
    SMART_TITLE    : constant STRING := "Ada Self Metric Analysis " &
                                        "and Reporting Tool";

    REPORT_TITLE   : constant STRING := " - Test Configuration Report";
    TEST_TIME      : STRING(1 .. 11);    -- the time of the test


  begin

    --| Create 7 header lines. Lines 1 and 5 are initially created
    --| with a length of 132 characters. Line 1 includes the day of the
    --| week and escape sequences for Paginated_Output to print the
    --| calendar date (~c), the time (~t), and the page number (~p).

    STRING_PKG.MARK;

    HEADER(1) := MAKE_PERSISTENT(BLANKS);
    HEADER(1) := REPLACE(HEADER(1), WEEKDAY_OF(CLOCK), 85);
    HEADER(1) := REPLACE(HEADER(1), "~d    ~t    Page:  ~p", 98);
    HEADER(2) := MAKE_PERSISTENT(" ");
    HEADER(3) := MAKE_PERSISTENT(" ");

    --| Center the name of the tool and the report title on line 4
    case REPORT_OPTIONS.TOOL_NAME is

      when PATH_TOOL =>
        HEADER(4) := CENTER(PATH_TITLE & REPORT_TITLE, REPORT_OPTIONS.CPL);
      when AUTOPATH_TOOL =>
        HEADER(4) := CENTER(AUTOPATH_TITLE & REPORT_TITLE, REPORT_OPTIONS.CPL);
      when PROFILE_TOOL =>
        HEADER(4) := CENTER(PROFILE_TITLE & REPORT_TITLE, REPORT_OPTIONS.CPL);
      when SMART_TOOL =>
        HEADER(4) := CENTER(SMART_TITLE & REPORT_TITLE, REPORT_OPTIONS.CPL);
      when others =>
        null;

    end case;

    HEADER(5) := MAKE_PERSISTENT(DASHES);
    HEADER(6) := MAKE_PERSISTENT(" ");
    HEADER(7) := MAKE_PERSISTENT(" ");

    --| Set header lines 1 & 5 to the number of Character per line (CPL)
    --| specified in Report_Options
    HEADER(1) := SUBSTR(HEADER(1), MAXIMUM_CPL - REPORT_OPTIONS.CPL + 1,
                        REPORT_OPTIONS.CPL - 14);  -- ~d and ~t add 14 chars

    HEADER(5) := SUBSTR(HEADER(5), MAXIMUM_CPL - REPORT_OPTIONS.CPL + 1,
                        REPORT_OPTIONS.CPL);

    --| Insert the tool version number into the first header line
    HEADER(1) := REPLACE(HEADER(1), REPORT_OPTIONS.TOOL_VERSION, 1);


    --| Print the report
    TEST_TIME := WALL_CLOCK_OF(SECONDS(TEST_DATE));

    SET_HEADER(REPORT, HEADER);   --| Set up the new header

    PUT      (REPORT, "       Program Under Test:      ");
    PUT_LINE (REPORT, VALUE(PROGRAM_NAME));
    SKIP_LINE(REPORT, 1);
    PUT      (REPORT, "       Test Date:               ");
    PUT_LINE (REPORT, DATE_OF(TEST_DATE));
    SKIP_LINE(REPORT, 1);
    PUT      (REPORT, "       Test Day:                ");
    PUT_LINE (REPORT, WEEKDAY_OF(TEST_DATE));
    SKIP_LINE(REPORT, 1);
    PUT      (REPORT, "       Test Time:               ");
    PUT_LINE (REPORT, TEST_TIME(1 .. 8));
    SKIP_LINE(REPORT, 1);
    PUT      (REPORT, "       Log File:                ");
    PUT_LINE (REPORT, VALUE(LOG_FILE_NAME));
    SKIP_LINE(REPORT, 1);
    PUT      (REPORT, "       Test ID:                 ");
    PUT_LINE (REPORT, VALUE(TEST_IDENT));

    STRING_PKG.RELEASE;

  end PRINT_TEST_CONFIGURATION_REPORT;


  -------------------------------------
  procedure PUT_TEST_CONFIGURATION_DATA(
  --| Put log file test configuration data to current output

    PROGRAM_NAME : in ADA_NAME;        --| The name of the program under test

    TEST_DATE    : in CALENDAR.TIME;   --| Date the log file was created

    TEST_IDENT   : in TEST_IDENTIFIER  --| Test id specified by the user

      ) is

    --| Effects
    --| This procedure puts test configuration information obtained from
    --| the Execution Log File  to current output. The following information
    --| is output:
    --|
    --|     Program Under Test:  name of program under test
    --|     Test Date:           date of log file generation
    --|     Test Time:           time of log file generation
    --|     Test ID:             the test ID obtained from the log file
    --|

    --| N/A:  Raises, Requires, Modifies, Errors

    use CALENDAR, TIME_LIBRARY_1;

    TEST_TIME : STRING(1 .. 11); --| the time of the test

  begin

    TEST_TIME := WALL_CLOCK_OF(SECONDS(TEST_DATE));

    TEXT_IO.NEW_LINE;
    TEXT_IO.PUT     ("Program Under Test:        ");
    TEXT_IO.PUT_LINE(VALUE(PROGRAM_NAME));
    TEXT_IO.PUT     ("Test Date:                 ");
    TEXT_IO.PUT_LINE(DATE_OF(TEST_DATE));
    TEXT_IO.PUT     ("Test Time:                 ");
    TEXT_IO.PUT_LINE(TEST_TIME(1 .. 8));
    TEXT_IO.PUT     ("Test ID:                   ");
    TEXT_IO.PUT_LINE(VALUE(TEST_IDENT));
    TEXT_IO.NEW_LINE;

  end PUT_TEST_CONFIGURATION_DATA;


  --------------
  function QUERY(--| Put a Yes or No question and get a response

    QUESTION : in STRING  --| A query to be answered Y or N

      ) return BOOLEAN is

    --| Effects
    --| The user is then prompted with Question. The user's response is then
    --| tested for Y or N. Only the first character input is tested and
    --| case is not significant. If Y is input then Response is returned
    --| true. In N is input then Response is  returned false. If Neither
    --| Y nor N then the user is prompted again with Query.

    --| N/A:  Raises, Requires, Modifies, Errors

    ANSWER : STRING(1 .. 80); --| temporary string for user's answer

    LAST   : NATURAL;         --| temporary variable used by Text_IO to
                              --| return the index of the last character
                              --| input by the user

  begin

    loop
      TEXT_IO.PUT(QUESTION);
      TEXT_IO.GET_LINE(ANSWER, LAST);
      TEXT_IO.NEW_LINE;
      TEXT_IO.NEW_LINE;

      if LAST > 0 then
        case ANSWER(1) is
          when 'Y' | 'y' => return TRUE;
          when 'N' | 'n' => return FALSE;
          when others    => null;
        end case;
      end if;
    end loop;

  end QUERY;

end REPORT_LIBRARY;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--BREAK.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TYPE_DEFINITIONS; use TYPE_DEFINITIONS;
with STRING_PKG; use STRING_PKG;
with DYNAMIC_ARRAY_PKG; use DYNAMIC_ARRAY_PKG;
package BREAKPOINT is

--| overview
--| Breakpoint is a package containing all of the common procedures to be
--| used by the report writer for the path analyzer. This package is used
--| to keep a running record of breakpoints encountered via an execution
--| count for each breakpoint in a given unit. This information is utilized
--| by the report writer for the path analyzer.

--| raises
--| No user defined exceptions are raised during package initialization.

--| effects
--| package initialization has no effect on outside and/or "withing" units.

--| n/a  requires,errors,tuning,notes




  type BREAKPOINT_INFORMATION;
  type TABLE_ACCESS is access BREAKPOINT_INFORMATION;

  type BREAKPOINT_INFORMATION is
    record
      UNIT_NAME       : ADA_NAME;
      EXECUTION_COUNT : DARRAY;
    end record;



  procedure INITIALIZE_BREAKPOINTS( --| add entry to table
                                   UNIT_NAME             : in ADA_NAME;
                                           --| name of library unit
                                   NUMBER_OF_BREAKPOINTS : in
                                     BREAKPOINT_NUMBER_RANGE
                                   --| number of brkpts in library unit
                                   );
  --| overview
  --| Adds an entry to the table for the current library unit, in which to
  --| store the execution count data.

  --| effects
  --| The table is searched for the current library unit,
  --| if it is not found, an entry is added for each breakpoint in the
  --| current library unit.
  --| The total execution count for each breakpoint is initialized to 0.

  --| modifies
  --| The internal Breakpoint_Information Data structure is modified if
  --| the current unit is not found.


  --| n/a
  --| errors, raises, requires

  procedure BREAK( --| called at each breakpoint
                  UNIT_NAME         : in ADA_NAME;  --| procedure name
                  BREAKPOINT_NUMBER : in BREAKPOINT_NUMBER_RANGE
                  --| breakpoint number
                  );
  --| overview
  --| Increments the execution count for the current breakpoint.

  --| effects
  --| Break increments the execution count for Breakpoint_Number in
  --| the unit Unit_Name.

  --| requires
  --| Initialize_Breakpoints must be called for the Unit_Name prior
  --| to calling Break.

  --| modifies
  --| The Execution_Count is modified for the given Breakpoint_Number


  --| errors
  --| The unit name can't be found in the table

  --| raises Unit_Name_Not_Found

  --| n/a tuning,notes


  procedure DUMP( --| dump totals to logfile

                 BREAKPOINT_TABLE_ACCESS : in out TABLE_ACCESS;
                 --|unit name, breakpoints and counts
                 MORE_UNITS_AVAILABLE    : out BOOLEAN
                 --|false if all units have been dumped
                 );

  --| overview
  --| Dump is called to list execution count totals.
  --| Dump should be be used by any tool that requires total execution
  --| counts for each breakpoint. Each invocation of Dump will return
  --| information for only one compilation unit. When all compilation unit
  --| information has been dumped, more_Units_Available will assume a false
  --| value.

  --| effects
  --| A unit name and breakpoint Execution_Count data is returned to the
  --| calling unit. The internal storage space for that Unit_Information is
  --| then released. This does not affect the data returned to the user of
  --| this procedure. Upon encountering the last piece of Unit_Information,
  --| the boolean More_Units_Available is set to false. If a calling program
  --| invokes this procedure after the boolean More_Units_Available is set to
  --| false, the exeception No_Units_Available will be raised.

  --| modifies
  --| Breakpoint_Table_Access, More_Units_Available, Internal Unit_Information
  --| storage.

  --| errors
  --| If a calling program invokes the procedure after the boolean
  --| More_Units_Available has been set to false, an exception will
  --| be raised (No_Units_Available).

  --| raises No_Units_Available


  --| n/a
  --| tuning,notes,requires


  UNIT_NAME_NOT_FOUND : exception;  --|raised when break is called with an
  --|uninitialized unit name.

  NO_UNITS_AVAILABLE  : exception;  --|raised when dump is called and no
  --|breakpoint information is available.

end BREAKPOINT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--BREAK.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
package body BREAKPOINT is
--|overview
--|Three procedures are provided to initialize, update , and recall
--|breakpoint information for a given unit. A dynamic data structure
--|consisting of a linked list is utilized as well as the dynamic array
--|and dynamic string data structures provided via library packages.

--|effects
--|package initialization has no effect on outside and/or "withing" units.

--|raises
--|No user defined exceptions are raised during package initialization.

--|n/a requires,errors,tuning,notes.




  type BREAKPOINT_TABLE;
  type NEXT_POINTER is access BREAKPOINT_TABLE;

  type BREAKPOINT_TABLE is
    record
      TABLE_UNIT_NAME : ADA_NAME;
      NEXT_TABLE      : NEXT_POINTER;
      EXECUTION_COUNT : DARRAY;

    end record;

  TOP_POINTER : NEXT_POINTER;  --| global pointer for top of list

  procedure INITIALIZE_BREAKPOINTS( --| add entry to table
                                   UNIT_NAME             : in ADA_NAME;
                                           --| name of library unit
                                   NUMBER_OF_BREAKPOINTS : in
                                     BREAKPOINT_NUMBER_RANGE
                                   --| number of brkpts in library unit
                                   ) is

  --|effects
  --|The table is searched for the current library unit, if it is not found
  --|an entry is added for each breakpoint in the current library unit. The
  --|total execution count for each breakpoint is initialized to 0.

  --|modifies
  --|The internal Breakpoint_Information data structure is modified if the
  --|current unit is not found.

  --|n/a errors,requires,raises



    LOCAL_BREAKPOINT_ARRAY : ARRAY_TYPE(1 .. NUMBER_OF_BREAKPOINTS) := (others
      => 0);  --| local breakpoint table used
    --| to initialize counts to zero

    POINT_TO               : NEXT_POINTER := TOP_POINTER;
                                           --| local pointer for table access,
    --| initially is null
  begin
    while POINT_TO /= null and then not EQUAL(POINT_TO.TABLE_UNIT_NAME,
      UNIT_NAME) loop

      -- search for library unit in table
      POINT_TO := POINT_TO.NEXT_TABLE;
    end loop;
    if POINT_TO = null then

      -- library unit not found so add it

      -- use dynamic array funcs convert array of proper length, initialized
      -- to zero counts to a darray.
      POINT_TO := new BREAKPOINT_TABLE;
      POINT_TO.TABLE_UNIT_NAME := UNIT_NAME;
      POINT_TO.NEXT_TABLE := TOP_POINTER;
      ARRAY_TO_DARRAY(A => LOCAL_BREAKPOINT_ARRAY, PREDICT =>
        NUMBER_OF_BREAKPOINTS, D => POINT_TO.EXECUTION_COUNT);
      TOP_POINTER := POINT_TO;
    end if;
  end INITIALIZE_BREAKPOINTS;

  procedure BREAK( --| called at each breakpoint
                  UNIT_NAME         : in ADA_NAME;  --| procedure name
                  BREAKPOINT_NUMBER : in BREAKPOINT_NUMBER_RANGE
                  --| breakpoint number
                  ) is

  --|effects
  --|Break increments the execution count for Breakpoint_Number in the
  --|current Unit_Name.

  --|requires
  --|Initialize_Breakpoints must be called for the Unit_Name prior
  --|to calling Break.

  --|modifies
  --|The Execution_Count is modified for the given Breakpoint_Number.

  --|errors
  --|The Unit_Name can't be found in the table.

  --|raises
  --|Unit_Name_Not_Found

  --|n/a tuning,notes



    POINTER_TO : NEXT_POINTER := TOP_POINTER;
                                             --| local pointer for table access
    COUNT      : COUNT_RANGE;

  begin
    while POINTER_TO /= null and then not EQUAL(POINTER_TO.TABLE_UNIT_NAME,
      UNIT_NAME) loop

      -- search for unit name in table
      POINTER_TO := POINTER_TO.NEXT_TABLE;
    end loop;
    if POINTER_TO /= null then

      -- unit name found
      -- increment the execution count
      COUNT := FETCH(D => POINTER_TO.EXECUTION_COUNT, I => BREAKPOINT_NUMBER);
      COUNT := COUNT + 1;
      STORE(D => POINTER_TO.EXECUTION_COUNT, I => BREAKPOINT_NUMBER, E => COUNT)
        ;
    else

      -- unit name not found in table
      -- error condition
      raise UNIT_NAME_NOT_FOUND;
    end if;
  end BREAK;

  procedure DUMP( --| dump totals to logfile

                 BREAKPOINT_TABLE_ACCESS : in out TABLE_ACCESS;
                 --|unit name, breakpoints and counts
                 MORE_UNITS_AVAILABLE    : out BOOLEAN
                 --|false if all units have been dumped
                 ) is

  --|effects
  --|A unit name and breakpoint Execution_Count data is returned to the
  --|calling unit. The internal storage space for that Unit_Information is
  --|then released. This does not affect the data returned to the user of
  --|this procedure. Upon encountering the last piece of Unit_Information,
  --|the boolean More_Units_Available is set to false. If a calling program
  --|invokes this procedure after the boolean More_Units_Available is set to
  --|false, the exeception No_Units_Available will be raised.

  --|modifies
  --|Breakpoint_Table_Access, More_Units_Available, Internal Unit_Information
  --|storage.

  --|errors
  --|If a calling program invokes the procedure after the boolean
  --|More_Units_Available has been set to false, an exception will
  --|be raised (No_Units_Available).

  --|raises No_Units_Available

  --|n/a
  --|tuning,notes,requires







    POINTS_TO : NEXT_POINTER := TOP_POINTER;  --| local pointer for table access

  begin
    if POINTS_TO /= null then
      BREAKPOINT_TABLE_ACCESS := new BREAKPOINT_INFORMATION'(POINTS_TO.
        TABLE_UNIT_NAME, COPY(POINTS_TO.EXECUTION_COUNT));
      TOP_POINTER := POINTS_TO.NEXT_TABLE;
      if TOP_POINTER /= null then
        MORE_UNITS_AVAILABLE := TRUE;
      else
        MORE_UNITS_AVAILABLE := FALSE;
      end if;
      DESTROY(POINTS_TO.EXECUTION_COUNT);
    else
      MORE_UNITS_AVAILABLE := FALSE;

      --| Error condition encountered, no breakpoint information available
      raise NO_UNITS_AVAILABLE;
    end if;
  end DUMP;


end BREAKPOINT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--AVERAGE.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
with IMPLEMENTATION_DEPENDENCIES;
with TYPE_DEFINITIONS; use TYPE_DEFINITIONS; use TEXT_IO; use
  IMPLEMENTATION_DEPENDENCIES;
--
--
package AVERAGE is
--:Overview
--:average is a package for calculating the average value from arbitrary
--:number of elements.  to avoid the overflow condition, an incremental
--:average algorithm is used:
--:            previous_average             current_value
--: new_ave= -------------------- * (n-1) + --------------
--:                   n                           n
--: where n = current number of element read

--:N/A:errors, raises, modifies, requires

--version          : 0.0
--author           : Alex Wei
--initial release  : 05/13/85

  procedure AVERAGER(--:calculates the integer average value
                     NEW_AVERAGE    : out INTEGER;
                                  --: the calculated average number
                     COUNT          : in POSITIVE;
                                  --: the current number of element
                     CURRENT_VALUE  : in INTEGER;
                                  --: the current element
                     PREVIOUS_VALUE : in INTEGER);
                                  --: the previous average number
--:raises:
--:effects
--:calaulates the average value for an arbitrary number of integers

--:requires

--:N/A: modifies, errors

--:
  procedure AVERAGER(  --:calculates the long_integer average value
                     NEW_AVERAGE    : out LONG_INTEGER;
                                  --: the calculated average number
                     COUNT          : in POSITIVE;
                                  --: the current number of element
                     CURRENT_VALUE  : in LONG_INTEGER;
                                  --: the current element
                     PREVIOUS_VALUE : in LONG_INTEGER);
                                  --: the previous average number
--:raises:
--:effects
--:calaulates the average value for an arbitrary number of long_integers

--:requires

--:N/A: modifies, errors

  procedure AVERAGER(--:calculates the float average value
                     NEW_AVERAGE    : out FLOAT;
                                  --: the calculated average number
                     COUNT          : in POSITIVE;
                                  --: the current number of element
                     CURRENT_VALUE  : in FLOAT;
                                  --: the current element
                     PREVIOUS_VALUE : in FLOAT);
                                  --: the previous average number
--:raises:
--:effects
--:calaulates the average value for an arbitrary number of float elements

--:requires

--:N/A: modifies, errors

  procedure AVERAGER(--:calculates the long_float average value
                     NEW_AVERAGE    : out LONG_FLOAT;
                                  --: the calculated average number
                     COUNT          : in POSITIVE;
                                  --: the current number of element
                     CURRENT_VALUE  : in LONG_FLOAT;
                                  --: the current element
                     PREVIOUS_VALUE : in LONG_FLOAT);
                                  --: the previous average number
--:raises:
--:effects
--:calaulates the average value for an arbitrary number of long_float elements

--:requires

--:N/A: modifies, errors

--procedure averager( --:calculates the fixed_point average value
--                  new_average:  out fixed_point;
--                                --: the calculated average number
--                  count      :  in  positive;
--                                --: the current number of element
--              current_value  :  in  fixed_point;
--                                --: the current element
--             previous_value  :  in  fixed_point);
                                  --: the previous average number
--:raises:
--:effects
--:calaulates the average value for an arbitrary number of fixed_points

--:requires

--:N/A: modifies, errors

end AVERAGE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--AVERAGE.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

package body AVERAGE is

  use TEXT_IO;
  use IMPLEMENTATION_DEPENDENCIES;
  use TYPE_DEFINITIONS;
  procedure AVERAGER(NEW_AVERAGE    : out INTEGER;
                     COUNT          : in POSITIVE;
                     CURRENT_VALUE  : in INTEGER;
                     PREVIOUS_VALUE : in INTEGER) is

    TEMPORARY_VALUE : FLOAT := 0.0;

  begin
    if COUNT > 1 then
      TEMPORARY_VALUE := (FLOAT(PREVIOUS_VALUE)*FLOAT(COUNT - 1)) + FLOAT(
        CURRENT_VALUE);
      NEW_AVERAGE := INTEGER(TEMPORARY_VALUE/FLOAT(COUNT));
    elsif COUNT = 1 then
      NEW_AVERAGE := CURRENT_VALUE;
    end if;
  end AVERAGER;
--

  procedure AVERAGER(NEW_AVERAGE    : out LONG_INTEGER;
                     COUNT          : in POSITIVE;
                     CURRENT_VALUE  : in LONG_INTEGER;
                     PREVIOUS_VALUE : in LONG_INTEGER) is

    TEMPORARY_VALUE : FLOAT := 0.0;

  begin
    if COUNT > 1 then
      TEMPORARY_VALUE := (FLOAT(PREVIOUS_VALUE)*FLOAT(COUNT - 1)) + FLOAT(
        CURRENT_VALUE);
      NEW_AVERAGE := LONG_INTEGER(TEMPORARY_VALUE/FLOAT(COUNT));
    elsif COUNT = 1 then
      NEW_AVERAGE := CURRENT_VALUE;
    end if;
  end AVERAGER;


  procedure AVERAGER(NEW_AVERAGE    : out FLOAT;
                     COUNT          : in POSITIVE;
                     CURRENT_VALUE  : in FLOAT;
                     PREVIOUS_VALUE : in FLOAT) is

    TEMPORARY_VALUE : FLOAT := 0.0;

  begin
    if COUNT > 1 then
      TEMPORARY_VALUE := (PREVIOUS_VALUE*(FLOAT(COUNT) - 1.0)) + CURRENT_VALUE;
      NEW_AVERAGE := TEMPORARY_VALUE/FLOAT(COUNT);
    elsif COUNT = 1 then
      NEW_AVERAGE := CURRENT_VALUE;
    end if;
  end AVERAGER;


  procedure AVERAGER(NEW_AVERAGE    : out LONG_FLOAT;
                     COUNT          : in POSITIVE;
                     CURRENT_VALUE  : in LONG_FLOAT;
                     PREVIOUS_VALUE : in LONG_FLOAT) is

    TEMPORARY_VALUE : LONG_FLOAT := 0.0;

  begin
    if COUNT > 1 then
      TEMPORARY_VALUE := (PREVIOUS_VALUE*(LONG_FLOAT(COUNT) - 1.0)) +
        CURRENT_VALUE;
      NEW_AVERAGE := TEMPORARY_VALUE/LONG_FLOAT(COUNT);
    elsif COUNT = 1 then
      NEW_AVERAGE := CURRENT_VALUE;
    end if;
  end AVERAGER;

--procedure averager(new_average:  out fixed_point;
--                  count      :  in  positive;
--              current_value  :  in  fixed_point;
--             previous_value  :  in  fixed_point) is
--
--temporary_value:  fixed_point;

--begin
--if count > 1  then
--temporary_value:= previous_value  * (fixed_point(count) - 1.0 );
--temporary_value:= temporary_value + current_value;
--new_average:= temporary_value / fixed_point(count);
--elsif count = 1 then
--new_average:= current_value;
--end if;
--end averager;

end AVERAGE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--VARHAND.SPC
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
with DYNARRAY_PKG;
with TYPE_DEFINITIONS, IMPLEMENTATION_DEPENDENCIES;
with STRING_PKG;

package VARHAND is

--| overview
--| VARiableHANDler is a package to handle the initialization, assignment,
--| and other operations of variable record arrays.  it also defines all
--| variable related types.

--| n/a: errors, raises, modifies, requires

--version:             0.0
--author:              Alexis Wei
--initial release:     05/14/85

  use TYPE_DEFINITIONS, IMPLEMENTATION_DEPENDENCIES;

  subtype VARIABLE_KIND is LOGFILE_KEYS range INTEGER_VARIABLE ..
    FIXED_POINT_VARIABLE;

  type VARIABLE_RECORD(WHICHKIND : VARIABLE_KIND) is
    record
      PROGRAMID     : PROGRAM_UNIT_UNIQUE_IDENTIFIER;
      VARIABLENAME  : FILENAME;
      UNITNAME      : FILENAME;
      VARIABLECOUNT : POSITIVE;
      case WHICHKIND is
        when INTEGER_VARIABLE =>
          CURRENT_V : INTEGER;
          MAX_V     : INTEGER;
          MIN_V     : INTEGER;
          AVERAGE_V : INTEGER;

        when FLOAT_VARIABLE =>
          CURRENT_FV : FLOAT;
          MAX_FV     : FLOAT;
          MIN_FV     : FLOAT;
          AVERAGE_FV : FLOAT;

        when LONG_INTEGER_VARIABLE =>
          CURRENT_LIV : LONG_INTEGER;
          MAX_LIV     : LONG_INTEGER;
          MIN_LIV     : LONG_INTEGER;
          AVERAGE_LIV : LONG_INTEGER;


        when LONG_FLOAT_VARIABLE =>
          CURRENT_LFV : LONG_FLOAT;
          MAX_LFV     : LONG_FLOAT;
          MIN_LFV     : LONG_FLOAT;
          AVERAGE_LFV : LONG_FLOAT;

-- when fixed_point_variable =>
-- current_fpv:       fixed_point;
-- max_fpv:           fixed_point;
-- min_fpv:           fixed_point;
-- average_fpv:       fixed_point;

        when others =>
          null;
      end case;
    end record;

  type LOOP_RECORD is
    record
      PROGRAMID  : PROGRAM_UNIT_UNIQUE_IDENTIFIER;
      BRKPT_NO   : BREAKPOINT_NUMBER_RANGE;
      BRKPTCOUNT : POSITIVE;
      UNITNAME   : FILENAME;
    end record;

  subtype IVRECORD is VARIABLE_RECORD(INTEGER_VARIABLE);
  subtype LIVRECORD is VARIABLE_RECORD(LONG_INTEGER_VARIABLE);
  subtype FVRECORD is VARIABLE_RECORD(FLOAT_VARIABLE);
  subtype LFVRECORD is VARIABLE_RECORD(LONG_FLOAT_VARIABLE);

  package IVDARRAY_PKG is
    new DYNARRAY_PKG(IVRECORD);
  use IVDARRAY_PKG;
  package LIVDARRAY_PKG is
    new DYNARRAY_PKG(LIVRECORD);
  use LIVDARRAY_PKG;
  package FVDARRAY_PKG is
    new DYNARRAY_PKG(FVRECORD);
  use FVDARRAY_PKG;
  package LFVDARRAY_PKG is
    new DYNARRAY_PKG(LFVRECORD);
  use LFVDARRAY_PKG;


  procedure INITARRAY( --| to initialize the 1st element of variable array
                      IVARRAY  : in out IVRECORD;
                      IDARRAY  : in out IVDARRAY_PKG.DARRAY;
                      PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                      VNAME    : in FILENAME;
                      UNITNAME : in FILENAME;
                      VALUE    : in INTEGER;
                      KUNT     : in NATURAL);


  procedure INITARRAY( --| to initialize the 1st element of variable array
                      LIVARRAY : in out LIVRECORD;
                      LIDARRAY : in out LIVDARRAY_PKG.DARRAY;
                      PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                      VNAME    : in FILENAME;
                      UNITNAME : in FILENAME;
                      VALUE    : in LONG_INTEGER;
                      KUNT     : in NATURAL);


  procedure INITARRAY( --| to initialize the 1st element of variable array
                      FVARRAY  : in out FVRECORD;
                      FDARRAY  : in out FVDARRAY_PKG.DARRAY;
                      PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                      VNAME    : in FILENAME;
                      UNITNAME : in FILENAME;
                      VALUE    : in FLOAT;
                      KUNT     : in NATURAL);


  procedure INITARRAY( --| to initialize the 1st element of variable array
                      LFVARRAY : in out LFVRECORD;
                      LFDARRAY : in out LFVDARRAY_PKG.DARRAY;
                      PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                      VNAME    : in FILENAME;
                      UNITNAME : in FILENAME;
                      VALUE    : in LONG_FLOAT;
                      KUNT     : in NATURAL);


--procedure initarray (--| to initialize the 1st element of variable array
--                     fparray:            in out fpvrecord;
--                     fpdarray:           in out fpvdarray_pkg.darray;
--                     pid:                in program_unit_unique_identifier;
--                     vname:              in filename;
--                     unitname:           in filename;
--                     value:              in fixed_point;
--                     kunt:               in natural);

  procedure FIND_VARIABLE(--| check to see if the variable read is an
                          --| existing variable, it also return the
                          --| array index if found
                          PID     : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                          IDARRAY : in out IVDARRAY_PKG.DARRAY;
                          IVARRAY : in out IVRECORD;
                          VNAME   : in FILENAME;
                          KUNT    : in NATURAL;
                          IDX     : out NATURAL;
                          FOUND   : out BOOLEAN);

  procedure FIND_VARIABLE(--| check to see if the variable read is an
                          --| existing variable, it also return the
                          --| array index if found
                          PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                          LIDARRAY : in out LIVDARRAY_PKG.DARRAY;
                          LIVARRAY : in out LIVRECORD;
                          VNAME    : in FILENAME;
                          KUNT     : in NATURAL;
                          IDX      : out NATURAL;
                          FOUND    : out BOOLEAN);

  procedure FIND_VARIABLE(--| check to see if the variable read is an
                          --| existing variable, it also return the
                          --| array index if found
                          PID     : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                          FDARRAY : in out FVDARRAY_PKG.DARRAY;
                          FVARRAY : in out FVRECORD;
                          VNAME   : in FILENAME;
                          KUNT    : in NATURAL;
                          IDX     : out NATURAL;
                          FOUND   : out BOOLEAN);

  procedure FIND_VARIABLE(--| check to see if the variable read is an
                          --| existing variable, it also return the
                          --| array index if found
                          PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                          LFDARRAY : in out LFVDARRAY_PKG.DARRAY;
                          LFVARRAY : in out LFVRECORD;
                          VNAME    : in FILENAME;
                          KUNT     : in NATURAL;
                          IDX      : out NATURAL;
                          FOUND    : out BOOLEAN);

--procedure find_variable(--| check to see if the variable read is an --janus
--                        --| existing variable, it also return the   --janus
--                        --| array index if found                    --janus
--                        pid:             in     program_unit_unique_identifier;
--                        fpdarray:        in out fpdarray_pkg.darray;
--                        fparray:         in out variable_record(fixed_point_variable);
--                        vname:           in filename;
--                        kunt:            in natural;
--                        idx:             out natural;
--                        found:           out boolean);


  procedure FIND_MAXMIN(IVARRAY : in out IVRECORD;
                        IDARRAY : in out IVDARRAY_PKG.DARRAY;
                        IDX     : in NATURAL;
                        VALUE   : in INTEGER);


  procedure FIND_MAXMIN(LIVARRAY : in out LIVRECORD;
                        LIDARRAY : in out LIVDARRAY_PKG.DARRAY;
                        IDX      : in NATURAL;
                        VALUE    : in LONG_INTEGER);


  procedure FIND_MAXMIN(FVARRAY : in out FVRECORD;
                        FDARRAY : in out FVDARRAY_PKG.DARRAY;
                        IDX     : in NATURAL;
                        VALUE   : in FLOAT);



  procedure FIND_MAXMIN(LFVARRAY : in out LFVRECORD;
                        LFDARRAY : in out LFVDARRAY_PKG.DARRAY;
                        IDX      : in NATURAL;
                        VALUE    : in LONG_FLOAT);


--procedure find_maxmin(
--                        fpvarray:        in out variable_record(fixed_point_variable);
--                        fpdarray:        in out fpvdarray_pkg.darray;
--                        idx:             in natural;
--                        value:           in fixed_point);


function LAST_VALUE( --| Return the last value of the string variable
  UNIT_ID       : PROGRAM_UNIT_UNIQUE_IDENTIFIER;
  VARIABLE_NAME : ADA_NAME;
  CURRENT_VALUE : STRING_VARIABLES
  ) return string;

--| Effects
--| Searches the String_Variable_Array for the last value of
--| the specified string variable. If it is the first occurrence
--| of the string variable then it is added to the array and
--| a null String_Type is returned. Otherwise the last value
--| stored in the array for the string variable is returned.
--| If the current value of the string variable is different
--| than the previous value then the array is updated with the
--| new current value.

--| Modifies
--| If it is the first occurrence of the string value of the string
--| variable of if the current value is different than the previous
--| value then the String_Array is updated

--| N/A: Raises, Requires, Errors


  function LONG_INTEGER_TO_STR(
    LINT  : LONG_INTEGER;
    WIDTH : NATURAL := 0
    ) return STRING;

  function FLOAT_TO_STR(
    FLO   : FLOAT;
    WIDTH : NATURAL := 0
    ) return STRING;

  function LONG_FLOAT_TO_STR(
    LFLO  : LONG_FLOAT;
    WIDTH : NATURAL := 0
    ) return STRING;

end VARHAND;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--VARHAND.BDY
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::





package body VARHAND is

--| overview
--| VARiableHANDler is a package to handle the initialization, assignment,
--| and other operations of variable record arrays.  it also defines all
--| variable related types.

--| n/a: errors, raises, modifies, requires

--version:             0.0
--author:              Alexis Wei
--initial release:     05/14/85

  use IMPLEMENTATION_DEPENDENCIES;
  use TYPE_DEFINITIONS;
  use TEXT_IO;
  use STRING_PKG;
  use IVDARRAY_PKG;
  use LIVDARRAY_PKG;
  use FVDARRAY_PKG;
  use LFVDARRAY_PKG;

  package FLO_IO is
    new FLOAT_IO(FLOAT);
  package LFLO_IO is
    new FLOAT_IO(LONG_FLOAT);
  package INT_IO is
    new TEXT_IO.INTEGER_IO(INTEGER);
  package LINT_IO is
    new TEXT_IO.INTEGER_IO(LONG_INTEGER);


  type STRING_VARIABLE_ARRAY_ELEMENTS is
    record
      UNIT_ID       : PROGRAM_UNIT_UNIQUE_IDENTIFIER;
      VARIABLE_NAME : ADA_NAME;
      VALUE         : STRING_VARIABLES;
    end record;

  package STRING_VARIABLE_ARRAY_PKG is
    new DYNARRAY_PKG(STRING_VARIABLE_ARRAY_ELEMENTS);

  STRING_VARIABLE_ARRAY : STRING_VARIABLE_ARRAY_PKG.DARRAY;

  FIRST_STRING_VARIABLE : boolean := TRUE;

  procedure INITARRAY(IVARRAY  : in out IVRECORD;
                      IDARRAY  : in out IVDARRAY_PKG.DARRAY;
                      PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                      VNAME    : in FILENAME;
                      UNITNAME : in FILENAME;
                      VALUE    : in INTEGER;
                      KUNT     : in NATURAL) is

  begin
    IVARRAY.PROGRAMID     := PID;
    IVARRAY.VARIABLENAME  := VNAME;
    IVARRAY.UNITNAME      := UNITNAME;
    IVARRAY.CURRENT_V     := VALUE;
    IVARRAY.VARIABLECOUNT := 1;
    IVARRAY.MAX_V         := VALUE;
    IVARRAY.MIN_V         := VALUE;
    IVARRAY.AVERAGE_V     := VALUE;
    ADD_HIGH(IDARRAY, IVARRAY);
  end INITARRAY;




  procedure INITARRAY(LIVARRAY : in out LIVRECORD;
                      LIDARRAY : in out LIVDARRAY_PKG.DARRAY;
                      PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                      VNAME    : in FILENAME;
                      UNITNAME : in FILENAME;
                      VALUE    : in LONG_INTEGER;
                      KUNT     : in NATURAL) is


  begin
    LIVARRAY.PROGRAMID     := PID;
    LIVARRAY.VARIABLENAME  := VNAME;
    LIVARRAY.UNITNAME      := UNITNAME;
    LIVARRAY.CURRENT_LIV   := VALUE;
    LIVARRAY.VARIABLECOUNT := 1;
    LIVARRAY.MAX_LIV       := VALUE;
    LIVARRAY.MIN_LIV       := VALUE;
    LIVARRAY.AVERAGE_LIV   := VALUE;
    ADD_HIGH(LIDARRAY, LIVARRAY);
  end INITARRAY;


  procedure INITARRAY(FVARRAY  : in out FVRECORD;
                      FDARRAY  : in out FVDARRAY_PKG.DARRAY;
                      PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                      VNAME    : in FILENAME;
                      UNITNAME : in FILENAME;
                      VALUE    : in FLOAT;
                      KUNT     : in NATURAL) is


  begin
    FVARRAY.PROGRAMID     := PID;
    FVARRAY.VARIABLENAME  := VNAME;
    FVARRAY.UNITNAME      := UNITNAME;
    FVARRAY.CURRENT_FV    := VALUE;
    FVARRAY.VARIABLECOUNT := 1;
    FVARRAY.MAX_FV        := VALUE;
    FVARRAY.MIN_FV        := VALUE;
    FVARRAY.AVERAGE_FV    := VALUE;
    ADD_HIGH(FDARRAY, FVARRAY);
  end INITARRAY;


  procedure INITARRAY(LFVARRAY : in out LFVRECORD;
                      LFDARRAY : in out LFVDARRAY_PKG.DARRAY;
                      PID      : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                      VNAME    : in FILENAME;
                      UNITNAME : in FILENAME;
                      VALUE    : in LONG_FLOAT;
                      KUNT     : in NATURAL) is


  begin
    LFVARRAY.PROGRAMID     := PID;
    LFVARRAY.VARIABLENAME  := VNAME;
    LFVARRAY.UNITNAME      := UNITNAME;
    LFVARRAY.CURRENT_LFV   := VALUE;
    LFVARRAY.VARIABLECOUNT := 1;
    LFVARRAY.MAX_LFV       := VALUE;
    LFVARRAY.MIN_LFV       := VALUE;
    LFVARRAY.AVERAGE_LFV   := VALUE;
    ADD_HIGH(LFDARRAY, LFVARRAY);
  end INITARRAY;


--procedure initarray (fparray:            in out fpvrecord;
--                     fpdarray:           in out fpvdarray_pkg.darray;
--                     pid:                in program_unit_unique_identifier;
--                     vname:              in filename;
--                     unitname:           in filename;
--                     value:              in fixed_point;
--                     kunt:               in natural) is
--
--
--begin
-- fparray.programid := pid;
-- fparray.variablename := vname;
-- fparray.unitname := unitname;
-- fparray.current_fpv := value;
-- fparray.variablecount := 1;
-- fparray.max_fpv := value;
-- fparray.min_fpv := value;
-- fparray.average_fpv := value;
-- add_high (fpdarray, fparray);
--end initarray;


  procedure FIND_VARIABLE(PID     : in PROGRAM_UNIT_UNIQUE_IDENTIFIER;
                          IDARRAY : in out IVDARRAY_PKG.DARRAY;
                          IVARRAY : in out IVRECORD;
                          VNAME   : in FILENAME;
                          KUNT    : in NATURAL;
                          IDX     : out NATURAL;
                          FOUND   : out BOOLEAN) is


  begin
    FOUND := FALSE;
    IDX   := 0;
    SEARCH_LOOP : for I in INTEGER range 1 .. KUNT loop
      IVARRAY := FETCH(IDARRAY, I);
      if (IVARRAY.PROGRAMID.PROGRAM_UNIT_NUMBER = PID.PROGRAM_UNIT_NUMBER) and
        EQUAL(IVARRAY.VARIABLENAME, VN