module Tables_m

  ! Create tables representing a page

  use Declaration_Types ! Everything: Label, Spec, Field, S_*, F_*
  use Error_Handler, only: Error_Intro, Simple, Warning
  use Output_m, only: Blanks, NewLine, Output
  use Parser_Tables, only: N_Asterisk, N_Dot, N_Identifier, N_Label, N_Minus, &
    & N_Plus, N_Spec, N_Tilde
  use String_Table, only: Display_String, Get_String, String_Length
  use Toggles, only: Con, Levels, Toggle
  use Trace, only: Trace_Begin, Trace_End
  use Tree, only: Decorate, Decoration, Node_Id, NSons, Source_Ref, Subtree, &
    & Sub_Rosa

  implicit NONE

  type :: Base_t
    integer :: Lab_Ix        ! String index of label, zero if unlabeled
    integer :: Tree          ! Index of Spec tree node
    integer :: Page_Pos = 0  ! 1000*line + column
  end type Base_t

  type, extends(base_t) :: Block_t
    character(2) :: Label    ! Page coordinates
    character :: Signals(16) ! 1-8 inputs, 9-16 outputs, from Mode= field
  end type Block_t

  type, extends(base_t) :: Comment_t
    integer :: N_Text        ! nsons(text=... field vertex)
  end type Comment_t

  type, extends(base_t) :: Dot_t
    character :: Sign = ' '  ! blank, +, or -
    character :: Signal = ' ' ! Determined by From= field of line with To = this dot
    integer, allocatable :: From(:) ! Indices of Line_t elements
  end type Dot_t

  type, extends(base_t) :: Edge_t
    integer :: I_O_Tree = 0  ! If the edge is specified on Input or Output spec
    character :: Tag = ''
    character(8) :: Text
  end type Edge_t

  type, extends(base_t) :: EC_t
    character :: Tag
    character(8) :: Date
    character(7) :: Number  
  end type EC_t

  type, extends(base_t) :: Input_t
    character(3) :: Label    ! Page coordinates
    integer :: NText         ! Number of text fields -- 1 or 2
    character :: Sign        ! + or -
    character :: Signal
    character(15) :: Text(2)
    logical :: Tag = .false. ! Input has a tagged edge connector
  end type Input_t

  type, extends(base_t) :: Line_t
    integer :: From, To      ! Tree indices of <field> vertices
    character :: Sign        !  + or -
    character :: Signal
    integer :: Edge = 0      ! Tree index of edge=... <field> vertex
  end type Line_t

  type, extends(base_t) :: Multi_t
  end type Multi_t

  type, extends(base_t) :: Output_t
    character(3) :: Label    ! Page coordinates
    integer :: NText         ! Number of text fields -- 1 or 2
    character :: Sign        !  + or -
    character :: Signal
    character(15) :: Text(2)
    logical :: Tag = .false. ! Output has a tagged edge connector
  end type Output_t

  type, extends(base_t) :: Page_t
  end type Page_t

  type(block_t),   allocatable :: Blocks(:),   Temp_Blocks(:)
  type(comment_t), allocatable :: Comments(:), Temp_Comments(:)
  type(dot_t),     allocatable :: Dots(:),     Temp_Dots(:)
  type(ec_t),      allocatable :: ECs(:),      Temp_ECs(:)
  type(edge_t),    allocatable :: Edges(:),    Temp_Edges(:)
  type(input_t),   allocatable :: Inputs(:),   Temp_Inputs(:)
  type(line_t),    allocatable :: Lines(:),    Temp_Lines(:)
  type(multi_t),   allocatable :: Multis(:),   Temp_Multis(:)
  type(output_t),  allocatable :: Outputs(:),  Temp_Outputs(:)
  type(page_t),    allocatable :: Pages(:),    Temp_Pages(:)
  integer :: Last_Page = 0

  ! Index of the last of each kind of object for each page. There's only
  ! one Page_t for each page, so it's not needed here.
  type :: Ends_t
    integer :: Last_Block = 0
    integer :: Last_Comment = 0
    integer :: Last_Dot = 0
    integer :: Last_Edge = 0
    integer :: Last_EC = 0
    integer :: Last_Input = 0
    integer :: Last_Line = 0
    integer :: Last_Multi = 0
    integer :: Last_Output = 0
  end type Ends_t

  type(ends_t), allocatable :: Ends(:)

  integer :: Taken(2:6,9,16) ! (col,row,pin) Index of Line from/to logic block

!---------------------------- RCS Module Info ------------------------------
  character (len=*), private, parameter :: ModuleName= &
       "$RCSfile: parser.f90,v $"
  private :: not_used_here 
!---------------------------------------------------------------------------

contains

  ! Entable is invoked after Type_Checker has verified that all
  ! spec identifiers, field identifiers, and field values are valid.
  ! Invoked with Son1 indexing a Page tree node, so each page is
  ! processed individually.

  subroutine Entable ( Root, Son1, Error, Warn )
    integer, intent(in) :: Root    ! of the abstract syntax tree.
    integer, intent(inout) :: Son1 ! First son of root to process. Processing
                                   ! is done one page at a time. Set to zero
                                   ! when the end of the abstract syntax tree
                                   ! is reached.
    logical, intent(out) :: Error  ! "An error occurred"
    logical, intent(out) :: Warn   ! "A warning occurred"

    integer :: GGSon      ! Son of gson
    integer :: GSon       ! Son of son
    integer :: I, J, K, L ! Loop inductor or temp
    integer :: Lab_Ix     ! String index of label, zero if unlabeled
    integer :: Key        ! Spec: Son of root if no label, else grandson of root
    integer :: Nums(4)    ! Numbers deduced from fields
    logical :: SawPage    ! Saw a "page" spec.
    integer :: Son        ! Son of Root
    character(8) :: Text  ! Of a field
    logical :: Wrong      ! Something went wrong in checking

    if ( toggle(con) ) call trace_begin ( 'Entable', text=' for ', node=root )

    ! Set up the tables, if not yet set up, i.e., on the first call

    error = .false.
    warn = .false.
    if ( last_page == 0 ) allocate ( ends(0:100), blocks(100), comments(100), &
      & dots(100), ECs(100), edges(100), inputs(100), lines(100), multis(100), &
      & outputs(100), pages(100) )
    last_page = last_page + 1

    sawPage = .false.
    taken = 0 ! No lines from/to logic block pins yet.
    do i = son1, nsons(root)
      son = subtree(i,root)
      key = son
      lab_ix = 0
      if ( node_id(son) == n_label ) then
        lab_ix = sub_rosa(subtree(1,son))
        key = subtree(2,son)
      end if
      if ( toggle(con) ) call trace_begin ( 'Entable.1', text=' for ', node=key )
      if ( i == son1 .and. decoration(key) /= s_page ) then
        call error_intro ( simple, source_ref(key) )
        call output ( 'First specification must be a Page specification.', &
          & advance='yes' )
        error = .true.
      end if
      select case ( decoration(key) )
      case ( s_block ) ! ---------------------------     Block     -----
        if ( ends(last_page)%last_block >= size(blocks) ) then
          allocate ( temp_blocks(2*size(blocks)) )
          temp_blocks(1:size(blocks)) = blocks
          call move_alloc ( temp_blocks, blocks )
        end if
        ends(last_page)%last_block = ends(last_page)%last_block + 1
        blocks(ends(last_page)%last_block)%tree = key
        blocks(ends(last_page)%last_block)%lab_ix = lab_ix
        call decorate ( subtree(1,key), ends(last_page)%last_block )
        ! Block is required to have a label
        call get_str ( sub_rosa(subtree(1,son)), text(1:2) )
        blocks(ends(last_page)%last_block)%label = text
        blocks(ends(last_page)%last_block)%page_pos = &
          & 1000 * ( 3 + 18 * min( iachar(text(2:2)) - iachar('A'), 8 ) ) + &
          & 22 + 17 * ( iachar(text(1:1)) - iachar('2') )
        do j = 2, nsons(key)
          gson = subtree(j,key) ! A <field> vertex, decorated with f_...
          if ( decoration(gson) == f_mode ) then ! Copy the signals
            ggson = subtree(2,gson) ! Either Identifier or Dot node
            associate ( s => blocks(ends(last_page)%last_block)%signals )
              if ( node_id(ggson) == n_dot ) then
                call get_str ( sub_rosa(subtree(1,ggson)), text(1:2) )
                call get_str ( sub_rosa(subtree(2,ggson)), text(3:4) )
              else
                call get_str ( sub_rosa(ggson), text(1:4) )
              end if
              text(1:2) = adjustl(text(1:2))
              text(3:4) = adjustl(text(3:4))
              if ( text(2:2) == '' ) text(2:2) = text(1:1)
              if ( text(4:4) == '' ) text(4:4) = text(3:3)
              s(1:4) = repeat(text(1:1),3)
              s(5:8) = repeat(text(2:2),3)
              s(9:12) = repeat(text(3:3),3)
              s(13:16) = repeat(text(4:4),3)
            end associate
          end if
        end do
      case ( s_comment ) ! -----------------------     Comment     -----
        if ( ends(last_page)%last_comment >= size(comments) ) then
          allocate ( temp_comments(2*size(comments)) )
          temp_comments(1:size(comments)) = comments
          call move_alloc ( temp_comments, comments )
        end if
        ends(last_page)%last_comment = ends(last_page)%last_comment + 1
        comments(ends(last_page)%last_comment)%tree = key
        comments(ends(last_page)%last_comment)%lab_ix = lab_ix
        comments(ends(last_page)%last_comment)%n_text = nsons(subtree(2,key)) - 1
        if ( sum(comments(ends(last_page-1)%last_comment+1: &
                               ends(last_page)%last_comment)%n_text) > 14 ) then
          call error_intro ( simple, source_ref(key) )
          call output ( 'Maximum of 14 comments exceeded.', advance='yes' )
          error = .true.
        end if
      case ( s_dot ) ! -------------------------------     Dot     -----
        if ( ends(last_page)%last_dot >= size(dots) ) then
          allocate ( temp_dots(2*size(dots)) )
          temp_dots(1:size(dots)) = dots
          call move_alloc ( temp_dots, dots )
        end if
        ends(last_page)%last_dot = ends(last_page)%last_dot + 1
        dots(ends(last_page)%last_dot)%tree = key
        dots(ends(last_page)%last_dot)%lab_ix = lab_ix
        call decorate ( subtree(1,key), ends(last_page)%last_dot )
        gson = subtree(2,key) ! <field> At =... vertex
        ggson = subtree(2,gson) ! <dot> vertex
        call get_str ( sub_rosa(subtree(1,ggson)), text(1:2) )
        call get_str ( sub_rosa(subtree(2,ggson)), text(3:4) )
        call get_str ( sub_rosa(subtree(3,ggson)), text(5:6) )
        nums(1) = iachar(text(1:1)) - iachar('1')        ! Coord column 1..6
        nums(2) = min(iachar(text(2:2)) - iachar('A'),8) ! Coord row 0..8
        read ( text(3:4), * ) nums(3)                    ! Horizontal in block
        read ( text(5:6), * ) nums(4)                    ! Vertical in block
        dots(ends(last_page)%last_dot)%page_pos = &
          & 1000 * ( 2 + 18 * nums(2) + nums(4) ) + &
          & 14 + 17 * nums(1) + nums(3)
      case ( s_EC ) ! --------------------------------     EC     ------
        if ( ends(last_page)%last_EC >= size(ECs) ) then
          allocate ( temp_ECs(2*size(ECs)) )
          temp_ECs(1:size(ECs)) = ECs
          call move_alloc ( temp_ECs, ECs )
        end if
        ends(last_page)%last_EC = ends(last_page)%last_EC + 1
        ECs(ends(last_page)%last_EC)%tree = key
        ECs(ends(last_page)%last_EC)%lab_ix = lab_ix
        call decorate ( subtree(1,key), ends(last_page)%last_ec )
        do j = 2, nsons(key) ! name=value fields
          gson = subtree(j,key)
          ggson = subtree(2,gson)
          select case ( decoration(gson) )
          case ( f_date )
            call get_str( sub_rosa(ggson), &
                        & ECs(ends(last_page)%last_EC)%date )
          case ( f_number )
            if ( node_id(ggson) == n_dot ) then
              call get_str ( sub_rosa(subtree(1,ggson)), &
                           & ECs(ends(last_page)%last_EC)%number )
              call get_str ( sub_rosa(subtree(2,ggson)), &
                           & ECs(ends(last_page)%last_EC)%number(7:7) )
            else
              call get_str ( sub_rosa(ggson), &
                           & ECs(ends(last_page)%last_EC)%number )
            end if
          case ( f_tag )
            call get_str ( sub_rosa(subtree(2,gson)), &
                         & ECs(ends(last_page)%last_EC)%tag )
          end select
        end do
        if ( ends(last_page)%last_EC - ends(last_page-1)%last_EC > 14*4 ) then
          call error_intro ( simple, source_ref(key) )
          call output ( 'Maximum of 56 engineering change notes exceeded.', advance='yes' )
        end if
      case ( s_edge ) ! -----------------------------     Edge     -----
        if ( ends(last_page)%last_edge >= size(edges) ) then
          allocate ( temp_edges(2*size(edges)) )
          temp_edges(1:size(edges)) = edges
          call move_alloc ( temp_edges, edges )
        end if
        ends(last_page)%last_edge = ends(last_page)%last_edge + 1
        edges(ends(last_page)%last_edge)%tree = key
        edges(ends(last_page)%last_edge)%lab_ix = lab_ix
        call decorate ( subtree(1,key), ends(last_page)%last_edge )
        call get_str ( sub_rosa(subtree(2,subtree(2,key))), &
                     & edges(ends(last_page)%last_edge)%text )
        if ( ends(last_page)%last_edge - ends(last_page-1)%last_edge > 108 ) then
          call error_intro ( simple, source_ref(gson) )
          call output ( 'More than 108 edge connectors.', advance='yes' )
          error = .true.
        end if
      case ( s_input) ! ----------------------------     Input     -----
        if ( ends(last_page)%last_input >= size(inputs) ) then
          allocate ( temp_inputs(2*size(inputs)) )
          temp_inputs(1:size(inputs)) = inputs
          call move_alloc ( temp_inputs, inputs )
        end if
        ends(last_page)%last_input = ends(last_page)%last_input + 1
        inputs(ends(last_page)%last_input)%tree = key
        inputs(ends(last_page)%last_input)%lab_ix = lab_ix
        call decorate ( subtree(1,key), ends(last_page)%last_input ) ! 'Input'
        call get_str ( sub_rosa(subtree(1,son)), text(1:3) ) ! Label
        inputs(ends(last_page)%last_input)%label = text
        nums(1) = min(iachar(text(2:2)) - iachar('A'),8)
        nums(2) = iachar(text(3:3)) - iachar('1')
        inputs(ends(last_page)%last_input)%page_pos = &
          & 1000 * ( 18 * nums(1) + 3 * nums(2) + 3 ) + 1
        inputs(ends(last_page)%last_input)%sign = '+'
        do k = 2, nsons(key)
          gson = subtree(k,key)
          select case ( decoration(gson) )
          case ( f_edge ) ! connector.tag
            call add_edge ( key, gson, error )
            inputs(ends(last_page)%last_input)%tag = .true.
          case ( f_level )
            ggson = subtree(2,gson)
            if ( node_id(ggson) == n_minus ) &
              & inputs(ends(last_page)%last_input)%sign = '-'
            call get_str ( sub_rosa(subtree(1,ggson)), &
              & inputs(ends(last_page)%last_input)%signal )
          case ( f_text )
            ggson = subtree(2,gson)
            if ( node_id(ggson) == n_dot ) then
              inputs(ends(last_page)%last_input)%nText = nsons(ggson)
              do l = 1, nsons(ggson)
                call get_str ( sub_rosa(subtree(l,ggson)), &
                  & inputs(ends(last_page)%last_input)%text(l) )
              end do
            else
              inputs(ends(last_page)%last_input)%nText = nsons(gson) - 1
              do l = 2, nsons(gson)
                call get_str ( sub_rosa(subtree(l,gson)), &
                  & inputs(ends(last_page)%last_input)%text(l-1) )
              end do
            end if
          end select
        end do
      case ( s_line ) ! -----------------------------     Line     -----
        if ( ends(last_page)%last_line >= size(lines) ) then
          allocate ( temp_lines(2*size(lines)) )
          temp_lines(1:size(lines)) = lines
          call move_alloc ( temp_lines, lines )
        end if
        ends(last_page)%last_line = ends(last_page)%last_line + 1
        lines(ends(last_page)%last_line)%tree = key
        lines(ends(last_page)%last_line)%lab_ix = lab_ix
        call decorate ( subtree(1,key), ends(last_page)%last_line )
        do k = 2, nsons(key)
          select case ( decoration(subtree(k,key)) )
          case ( f_from )
            lines(ends(last_page)%last_line)%from = subtree(k,key)
          case ( f_to )
            lines(ends(last_page)%last_line)%to = subtree(k,key)
          end select
        end do
      case ( s_multi ) ! ---------------------------     Multi     -----
        if ( ends(last_page)%last_multi >= size(multis) ) then
          allocate ( temp_multis(2*size(multis)) )
          temp_multis(1:size(multis)) = multis
          call move_alloc ( temp_multis, multis )
        end if
        ends(last_page)%last_multi = ends(last_page)%last_multi + 1
        multis(ends(last_page)%last_multi)%tree = key
        multis(ends(last_page)%last_multi)%lab_ix = lab_ix
        call decorate ( subtree(1,key), ends(last_page)%last_multi )
      case ( s_output ) ! --------------------------     Output     -----
        if ( ends(last_page)%last_output >= size(outputs) ) then
          allocate ( temp_outputs(2*size(outputs)) )
          temp_outputs(1:size(outputs)) = outputs
          call move_alloc ( temp_outputs, outputs )
        end if
        ends(last_page)%last_output = ends(last_page)%last_output + 1
        outputs(ends(last_page)%last_output)%tree = key
        outputs(ends(last_page)%last_output)%lab_ix = lab_ix
        call decorate ( subtree(1,key), ends(last_page)%last_output ) ! 'Output'
        call get_str ( sub_rosa(subtree(1,son)), text(1:3) ) ! Label
        outputs(ends(last_page)%last_output)%label = text
        nums(1) = min(iachar(text(2:2)) - iachar('A'),8)
        nums(2) = iachar(text(3:3)) - iachar('1')
        outputs(ends(last_page)%last_output)%page_pos = &
          & 1000 * ( 18 * nums(1) + 3 * nums(2) + 3 ) + 107
        outputs(ends(last_page)%last_output)%sign = '+'
        do k = 2, nsons(key)
          gson = subtree(k,key)
          select case ( decoration(gson) )
          case ( f_edge ) ! connector.tag
            call add_edge ( key, gson, error )
            outputs(ends(last_page)%last_output)%tag = .true.
          case ( f_level )
            ggson = subtree(2,gson)
            if ( node_id(ggson) == n_minus ) &
              & outputs(ends(last_page)%last_output)%sign = '-'
              call get_str ( sub_rosa(subtree(1,ggson)), &
                & outputs(ends(last_page)%last_output)%signal )
          case ( f_text )
            ggson = subtree(2,gson)
            if ( node_id(ggson) == n_dot ) then
              outputs(ends(last_page)%last_output)%nText = nsons(ggson)
              do l = 1, nsons(ggson)
                call get_str ( sub_rosa(subtree(l,ggson)), &
                  & outputs(ends(last_page)%last_output)%text(l) )
              end do
            else
              outputs(ends(last_page)%last_output)%nText = nsons(gson) - 1
              do l = 2, nsons(gson)
                call get_str ( sub_rosa(subtree(l,gson)), &
                  & outputs(ends(last_page)%last_output)%text(l-1) )
              end do
            end if
          end select
        end do
      case ( s_page ) ! -----------------------------     Page     -----
        if ( last_page >= size(pages) ) then
          allocate ( temp_pages(2*size(pages)) )
          temp_pages(1:size(pages)) = pages
          call move_alloc ( temp_pages, pages )
        end if
        if ( sawPage ) then
          son1 = i
          exit
        end if
        sawPage = .true.
        pages(last_page)%tree = key
        pages(last_page)%lab_ix = lab_ix
        call decorate ( subtree(1,key), last_page )
      end select
      if ( toggle(con) ) call trace_end ( 'Entable.1', text=' for ', node=son )
    end do
    if ( i > nsons(root) ) son1 = 0

    if ( .not. sawpage ) then
      call output ('*** Error *** No page specification', advance='yes' )
      error = .true.
    end if

    call fill_dot ( wrong )
    error = error .or. wrong

    call check_signals ( wrong, warn )
    error = error .or. wrong

    if ( toggle(con) ) call trace_end ( 'Entable', text=' for ', node=root )

  end subroutine Entable

  subroutine Add_Edge ( Key, Field, Error )
    ! Check for same tag, different text, or duplicates.
    ! If new and OK, add the edge from Input or Output to Edges.
    ! Duplicate text is OK if it's not tagged.
    integer, intent(in) :: Key   ! Tree vertex of the Input or Output Spec vertex
    integer, intent(in) :: Field ! Tree vertex of the edge=... <field> vertex
    logical, intent(inout) :: Error
    integer :: I
    character :: Tag
    character(8) :: Text

    call get_str ( sub_rosa(subtree(1,subtree(2,field))), text )
    call get_str ( sub_rosa(subtree(2,subtree(2,field))), tag )
    do i = ends(last_page-1)%last_edge+1, ends(last_page)%last_edge
      if ( edges(i)%tag /= ' ' .and. tag /= ' ' .and. edges(i)%tag == tag ) then
        if ( edges(i)%text == text ) then ! Don't duplicate it
          call error_intro ( warning, source_ref(field) )
          call output ( source_ref(edges(i)%i_o_tree)/256, &
            & before='Edge connector duplicates one at line ', advance='yes' )
          return
        end if
        call error_intro ( simple, source_ref(field) )
        call output ( 'Edge connector with the same tag and different text', advance='yes' )
        call blanks ( len('*** Error *** ') )
        call output ( source_ref(edges(i)%i_o_tree)/256, before='as at line ', &
          & advance='yes' )
      end if
    end do

    if ( ends(last_page)%last_edge >= size(edges) ) then
      allocate ( temp_edges(2*size(edges)) )
      temp_edges(1:size(edges)) = edges
      call move_alloc ( temp_edges, edges )
    end if
    ends(last_page)%last_edge = ends(last_page)%last_edge + 1
    edges(ends(last_page)%last_edge)%I_O_tree = key
    edges(ends(last_page)%last_edge)%text = text
    edges(ends(last_page)%last_edge)%tag = tag
    call decorate ( subtree(1,field), ends(last_page)%last_edge ) ! 'Edge'
    if ( ends(last_page)%last_edge - ends(last_page-1)%last_edge > 108 ) then
      call error_intro ( simple, source_ref(field) )
      call output ( 'More than 108 edge connectors.', advance='yes' )
      error = .true.
    end if
  end subroutine Add_Edge

  subroutine Check_Signals ( Wrong, Warn )
    ! Check that all lines that are not incident on Dot vertices have
    ! consistent signals at the From and To ends
    logical, intent(out) :: Wrong   ! "An error occurred"
    logical, intent(inout) :: Warn  ! "A warning occurred"
    integer :: From       ! Index of from=... node in Line spec
    integer :: From_Ix    ! in data structure
    integer :: From_Label ! String index
    integer :: From_What  ! 1 = block, 2 = dot, 3 = input
    integer :: GSon       ! Son of son
    integer :: GGson      ! Son of gson
    integer :: I, J       ! Subscript, loop inductor, temp
    integer :: Pin(2)     ! of from or to block
    character :: Sign(2), Signal(2)
    integer :: To         ! Index of To=... node in line spec
    integer :: To_Ix      ! in data structure
    integer :: To_Label   ! String index
    integer :: To_What    ! 1 = block, 2 = dot, 4 = output
    logical :: Trouble
    character(*), parameter :: What(*) = ['block ', 'dot   ', 'input ', 'output' ]
    enum, bind(c)
      enumerator :: W_Block=1, W_Dot, W_Input, W_Output
    end enum
    wrong = .false.
    do i = ends(last_page-1)%last_line+1, ends(last_page)%last_line
      from = lines(i)%from   ! Tree index of from=... node in Line spec
      gson = subtree(2,from) ! First value
      if ( any(node_id(gson) == [ n_asterisk, n_tilde ]) ) gson=subtree(1,gson)
      if ( node_id(gson) == n_dot .and. nsons(gson) >= 3 ) then ! Spec node for Block.pin.label
        from_ix = decoration(subtree(1,decoration(subtree(1,gson)))) ! Blocks index
        call block_stuff ( gson, from_ix, 1, from_label )
        from_what = w_block
      else
        if ( node_id(gson) == n_dot ) then ! to = Label.route
          ggson = decoration(subtree(1,gson)) ! Spec node
        else ! to = Label
          ggson = decoration(gson) ! Spec node
        end if
        from_ix = decoration(subtree(1,ggson)) ! Inputs or Dots index
        if ( decoration(ggson) == s_dot ) then ! Dots index
          if ( signal(1) == ' ' ) then
            call error_intro ( warning, source_ref(dots(from_ix)%tree) )
            call output ( 'Signal not yet assigned; maybe no line incident here.', &
                        & advance='yes' )
            warn = .true.
          end if
          from_label = dots(from_ix)%lab_ix
          sign(1) = dots(from_ix)%sign
          signal(1) = dots(from_ix)%signal
          from_what = w_dot
        else ! Inputs index
          from_label = inputs(from_ix)%lab_ix
          sign(1) = inputs(from_ix)%sign
          signal(1) = inputs(from_ix)%signal
          from_what = w_input
        end if
      end if
      lines(i)%sign = sign(1)
      lines(i)%signal = signal(1)
      to = lines(i)%to     ! Tree index of To=... node in line spec
      if ( from_what /= w_dot .and. nsons(to) > 2 ) then
        call error_intro ( simple, source_ref(lines(i)%to) )
        call output ( 'To can be an array only if From is a Dot.', advance='yes' )
        wrong = .true.
      end if
      do j = 2, nsons(to)
        gson = subtree(j,to) ! Value field
        if ( any(node_id(gson) == [ n_asterisk, n_tilde]) ) &
          & gson = subtree(1,gson)
        if ( node_id(gson) == n_dot .and. nsons(gson) >= 3 ) then ! Spec node for Block.pin.label
          to_ix = decoration(subtree(1,decoration(subtree(1,gson)))) ! Blocks index
          call block_stuff ( gson, to_ix, 2, to_label )
          to_what = w_block
        else
          if ( node_id(gson) == n_dot ) then ! to = Label.route
            ggson = decoration(subtree(1,gson)) ! Spec node
          else ! to = Label
            ggson = decoration(gson) ! Spec node
          end if
          to_ix = decoration(subtree(1,ggson)) ! Outputs or Dots index
          if ( decoration(ggson) == s_dot ) then ! Dots index
            to_label = dots(to_ix)%lab_ix
            sign(2) = dots(to_ix)%sign
            signal(2) = dots(to_ix)%signal
            to_what = w_dot
          else ! Outputs index
            to_label = outputs(to_ix)%lab_ix
            sign(2) = outputs(to_ix)%sign
            signal(2) = outputs(to_ix)%signal
            to_what = w_output
          end if
        end if
        if ( signal(1) == ' ' .or. signal(2) == ' ' ) then
          call error_intro ( warning, source_ref(lines(i)%tree) )
          call output ( 'Signal not assigned at From; maybe no incident line.', &
                      & advance='yes' )
          warn = .true.
        else
          trouble = signal(1) /= signal(2)
          if ( sign(1) /= ' ' .and. sign(2) /= ' ' ) &
            trouble = trouble .or. sign(1) /= sign(2)
          if ( trouble ) then
            call error_intro ( warning, source_ref(lines(i)%tree) )
            call output ('Signals ' )
            call output ( trim(sign(1)) )
            call output ( signal(1))
            call output ( ' at ' )
            call output ( trim(what(from_what)) )
            call output ( from_ix, before=' ' )
            if ( from_label /= 0 ) call display_string ( from_label, before=' ' )
            if ( from_what == w_block ) call output ( pin(1), before='.' )
            call output ( ' and ', advance='yes' )
            call blanks ( len('*** Warning *** ') )
            call output ( trim(sign(2)) )
            call output ( signal(2))
            call output ( ' at ' )
            call output ( trim(what(to_what)) )
            call output ( to_ix, before=' ' )
            if ( to_label /= 0 ) call display_string ( to_label, before=' ' )
            if ( to_what == w_block ) call output ( pin(2), before='.' )
            call output ( i, before=' for Line ' )
            call output ( ' are not consistent.', advance='yes' )
            call output ( from_ix, 2, after=': ' )
            select case ( from_what )
            case ( w_block )
              call dump_block ( blocks(from_ix), details=0 )
            case ( w_dot )
              call dump_dot ( dots(from_ix), details=0 )
            case ( w_input )
              call dump_input ( inputs(from_ix), details=0 )
            end select
            call output ( to_ix, 2, after=': ' )
            select case ( to_what )
            case ( w_block )
              call dump_block ( blocks(to_ix), details=0 )
            case ( w_dot )
              call dump_dot ( dots(to_ix), details=0 )
            case ( w_output )
              call dump_output ( outputs(to_ix), details=0 )
            end select
            warn = .true.
          end if
        end if
      end do
    end do
  contains
    subroutine Block_Stuff ( Node, Ix, FromTo, Lab )
      integer, intent(in) :: Node     ! Index of Coord.Pin.Label in From/To node
      integer, intent(in) :: Ix       ! Index in Blocks array
      integer, intent(in) :: FromTo   ! 1 => From, 2 => To
      integer, intent(out) :: Lab     ! String index from Blocks(ix)%lab_ix
      integer :: Col        ! Logic block column index 2..6
      integer :: K          ! Loop inductor
      integer :: Row        ! Logic block row index A-HJ => 1..9
      character(2) :: Text
      lab = blocks(ix)%lab_ix
      call get_str ( lab, text ) ! Logic block label = page coordinate
      row = min ( iachar(text(2:2)) - ichar('A') + 1, 9 )
      read ( text(1:1), * ) col
      call get_str ( sub_rosa(subtree(2,node)), text )
      read ( text, * ) pin(fromTo) ! Pin number of block
      sign(fromTo) = ''
      signal(fromTo) = blocks(ix)%signals(pin(fromTo))
      if ( taken(col,row,pin(fromTo)) /= 0 ) then
        call error_intro ( warning, source_ref(lines(i)%tree) )
        call output ( 'Another line is already connected to ' )
        do k = 1, 3
          call display_string ( sub_rosa(subtree(k,gson)) )
          if ( k /= 3 ) call output ( '.' )
        end do
        call newLine
        call dump_line ( lines(taken(col,row,pin(fromTo))) )
      else
        taken(col,row,pin(fromTo)) = i
      end if
    end subroutine Block_Stuff
  end subroutine Check_Signals

  subroutine Dump_Tables ( Page_Number )
    integer, intent(in) :: Page_Number
    integer :: I
    call output ( page_number, before='Page number ', advance='yes' )
    call dump_page ( pages(page_number) )
    do i = ends(page_number-1)%last_block+1, ends(page_number)%last_block
      call output ( i, places=3, after=': ' )
      call dump_block ( blocks(i) )
    end do
    do i = ends(page_number-1)%last_comment+1, ends(page_number)%last_comment
      call output ( i, places=3, after=': ' )
      call dump_comment ( comments(i) )
    end do
    do i = ends(page_number-1)%last_dot+1, ends(page_number)%last_dot
      call output ( i, places=3, after=': ' )
      call dump_dot ( dots(i) )
    end do
    do i = ends(page_number-1)%last_EC+1, ends(page_number)%last_EC
      call output ( i, places=3, after=': ' )
      call dump_EC ( ECs(i) )
    end do
    do i = ends(page_number-1)%last_edge+1, ends(page_number)%last_edge
      call output ( i, places=3, after=': ' )
      call dump_edge ( edges(i) )
    end do
    do i = ends(page_number-1)%last_input+1, ends(page_number)%last_input
      call output ( i, places=3, after=': ' )
      call dump_input ( inputs(i) )
    end do
    do i = ends(page_number-1)%last_line+1, ends(page_number)%last_line
      call output ( i, places=3, after=': ' )
      call dump_line ( lines(i) )
    end do
    do i = ends(page_number-1)%last_multi+1, ends(page_number)%last_multi
      call output ( i, places=3, after=': ' )
      call dump_multi ( multis(i) )
    end do
    do i = ends(page_number-1)%last_output+1, ends(page_number)%last_output
      call output ( i, places=3, after=': ' )
      call dump_output ( outputs(i) )
    end do
  end subroutine Dump_Tables

  subroutine Dump_Block ( The_Block, Details )
    type(block_t), intent(in) :: The_Block
    integer, intent(in), optional :: Details
    integer :: I
    integer :: MyDetail
    myDetail = 1
    if ( present(details) ) myDetail = details
    call output ( 'Block' )
    if ( myDetail > 0 ) call output ( the_block%tree, before=' node ' )
    if ( the_block%lab_ix /= 0 ) call display_string ( the_block%lab_ix, before=' ' )
    call dump_where ( the_block%tree, advance='no' )
    call output ( ' signals ' )
    do i = 1, 16
      call output ( the_block%signals(i:i) )
    end do
    if ( myDetail > 0 ) call dump_pos ( the_block%page_pos )
    call newLine
  end subroutine Dump_Block

  subroutine Dump_Comment ( Comment )
    type(comment_t), intent(in) :: Comment
    call output ( comment%tree, before='Comment node ' )
    call dump_where ( comment%tree )
    call output ( comment%n_text, before=' N_Text ', advance='yes' )
  end subroutine Dump_Comment

  subroutine Dump_Dot ( Dot, Details )
    type(dot_t), intent(in) :: Dot
    integer, intent(in), optional :: Details
    integer :: F, I
    integer :: MyDetail
    myDetail = 1
    if ( present(details) ) myDetail = details
    call output ( 'Dot' )
    if ( myDetail > 0 ) call output ( dot%tree, before=' node ' )
    if ( dot%lab_ix /= 0 ) call display_string ( dot%lab_ix, before=' ' )
    call dump_where ( dot%tree )
    if ( dot%signal /= '' ) then
      call output ( ' signal ' )
      call output ( trim(dot%sign) )
      call output ( trim(dot%signal) )
    end if
    if ( allocated(dot%from) ) then
      call output ( ' from line' )
      if ( size(dot%from) > 1 ) call output ( 's' )
      do i = 1, size(dot%from)
        f = dot%from(i)   ! Index in Lines
        call output ( f, before=' ' )
        call output ( '(' )
        call output ( lines(f)%signal )
        call output ( ')' )
      end do
    end if
    if ( myDetail > 0 ) call dump_pos ( dot%page_pos )
    call newLine
  end subroutine Dump_Dot

  subroutine Dump_EC ( EC )
    type(EC_t), intent(in) :: EC
    call output ( EC%tree, before='EC node ' )
    if ( EC%lab_ix /= 0 ) call display_string ( EC%lab_ix, before=' ' )
    call dump_where ( EC%tree )
    call dump_pos ( EC%page_pos )
    call output ( ' tag ' )
    call output ( ec%tag )
    call output ( ' date ' )
    call output ( ec%date )
    call output ( ' number ' )
    call output ( trim(ec%number), advance='yes' )
  end subroutine Dump_EC

  subroutine Dump_Edge ( Edge )
    type(Edge_t), intent(in) :: Edge
    integer :: I_O_ix ! Inputs or outputs index
    if ( edge%i_o_tree == 0 ) then
      call output ( edge%tree, before='Edge node ' )
      if ( edge%lab_ix /= 0 ) call display_string ( edge%lab_ix, before=' ' )
      call dump_where ( edge%tree )
      call dump_pos ( edge%page_pos )
    else
      call output ( edge%i_o_tree, before='Edge I/O  ' )
      i_o_ix = decoration(subtree(1,edge%i_o_tree)) ! Inputs or outputs index
      if ( decoration(edge%i_o_tree) == s_input ) then
        if ( inputs(i_o_ix)%lab_ix /= 0 ) &
          & call display_string ( inputs(i_o_ix)%lab_ix, before=' ' )
      else
        if ( outputs(i_o_ix)%lab_ix /= 0 ) &
          & call display_string ( outputs(i_o_ix)%lab_ix, before=' ' )
      end if
      call dump_where ( edge%i_o_tree )
    end if
    call output ( ' edge ' )
    call output ( edge%text )
    if ( edge%tag /= '' ) then
      call output ( ' tag ' )
      call output ( edge%tag )
    end if
    call newLine
  end subroutine Dump_Edge

  subroutine Dump_Input ( Input, Details )
    type(input_t), intent(in) :: Input
    integer, intent(in), optional :: Details
    integer :: MyDetail
    myDetail = 1
    if ( present(details) ) myDetail = details
    call output ( 'Input' )
    if ( myDetail > 0 ) call output ( input%tree, before=' node ' )
    if ( input%lab_ix /= 0 ) call display_string ( input%lab_ix, before=' ' )
    call dump_where ( input%tree )
    call dump_pos ( input%page_pos )
    call output ( ' signal ' )
    call output ( input%sign )
    call output ( input%signal )
    call output ( ' "' )
    call output ( trim(input%text(1)) )
    call output ( '"' )
    if ( input%nText == 2 ) then
      call output ( ' "' )
      call output ( trim(input%text(2)) )
      call output ( '"' )
    end if
    call newLine
  end subroutine Dump_Input

  subroutine Dump_Line ( Line )
    type(line_t), intent(in) :: Line
    integer :: I
    call output ( line%tree, before='Line node ' )
    if ( line%lab_ix /= 0 ) call display_string ( line%lab_ix, before=' ' )
    call dump_where ( line%tree )
    call output ( ' Signal ' )
    call output ( trim(line%sign) )
    call output ( line%signal )
    call output ( ' from=' )
    call dump_ref ( subtree(2,line%from) )
    call output ( ' to=' )
    do i = 2, nsons(line%to)
      if ( i /= 2 ) call output (',' )
      call dump_ref ( subtree(i,line%to), &
                    & advance=merge('yes','no ',i==nsons(line%to)) )
    end do
  end subroutine Dump_Line

  subroutine Dump_Multi ( Multi )
    type(multi_t), intent(in) :: Multi
    call output ( multi%tree, before='Multi node ' )
    if ( multi%lab_ix /= 0 ) call display_string ( multi%lab_ix, before=' ' )
    call dump_where ( multi%tree )
    call dump_pos ( multi%page_pos, advance='yes' )
  end subroutine Dump_Multi

  subroutine Dump_Output ( The_Output, Details )
    type(output_t), intent(in) :: The_Output
    integer, intent(in), optional :: Details
    integer :: MyDetail
    myDetail = 1
    if ( present(details) ) myDetail = details
    call output ( 'Output' )
    if ( myDetail > 0 ) call output ( the_output%tree, before=' node ' )
    if ( the_output%lab_ix /= 0 ) call display_string ( the_output%lab_ix, before=' ' )
    call dump_where ( the_output%tree )
    call dump_pos ( the_output%page_pos )
    call output ( ' signal ' )
    call output ( the_output%sign )
    call output ( the_output%signal )
    call output ( ' "' )
    call output ( trim(the_output%text(1)) )
    call output ( '"' )
    if ( the_output%nText == 2 ) then
      call output ( ' "' )
      call output ( trim(the_output%text(2)) )
      call output ( '"' )
    end if
    call newLine
  end subroutine Dump_Output

  subroutine Dump_Page ( Page )
    type(page_t), intent(in) :: Page
    call output ( page%tree, before='Page node ' )
    if ( page%lab_ix /= 0 ) call display_string ( page%lab_ix, before=' ' )
    call dump_where ( page%tree, advance='yes' )
  end subroutine Dump_Page

  subroutine Dump_Pos ( Where, Advance )
    integer, intent(in) :: Where ! 1000 * line on page + column
    character(*), intent(in), optional :: Advance
    call output ( where/1000, before=' page (' )
    call output ( mod(where,1000), before=',', after=')', advance=advance )
  end subroutine Dump_Pos

  subroutine Dump_Ref ( Ref, Advance )
    integer, intent(in) :: Ref ! Tree index of label or <dot label pin>
    character(*), intent(in), optional :: Advance
    integer :: D    ! Decoration of a label = its spec node
    integer :: What ! Ref, or son of Ref if ref is asterisk or tilde
    what = ref
    if ( any(node_id(what) == [ n_asterisk, n_tilde ]) ) what = subtree(1,what)
    if ( node_id(what) == n_dot ) then
      call display_string ( sub_rosa(subtree(1,what)) )
      d = decoration(subtree(1,what))
      call display_string ( sub_rosa(subtree(2,what)), before='.' )
    else
      call display_string ( sub_rosa(what) )
      d = decoration(what)
    end if
    call output ( decoration(subtree(1,d)), before='(' ) ! Index in blocks etc
    call output ( ')', advance=advance )
  end subroutine Dump_Ref

  subroutine Dump_Where ( Tree, Advance )
    integer, intent(in) :: Tree
    character(*), intent(in), optional :: Advance
    integer :: Where ! 256*line + column
    where = source_ref(tree)
    call output ( where/256, before=' line ' )
    call output ( mod(where,256), before=' column ', advance=advance )
  end subroutine Dump_Where

  subroutine Fill_Dot ( Wrong )
    ! Go through the Line_t elements for this page and fill the From component
    ! of Dot_t elements. Then go through the Dot elements and set the Sign and
    ! Signal components.
    logical, intent(out) :: Wrong   ! "An error occurred"
    logical :: Change     ! The Signal component of a Dots element was changed
    integer :: From       ! Index of from=... node in Line spec
    integer :: GSon       ! Son of son
    integer :: GGson      ! Son of gson
    integer :: I, J, K, N ! Subscript, loop inductor, temp
    integer :: NFrom      ! Size(dots(k)%from) + 1
    character :: Sign, Signal ! To be set in Dots(i)
    character(2) :: Text  ! ofa two-character field
    integer :: To         ! Index of To=... node in line spec
    integer, allocatable :: Temp_Int(:)
    wrong = .false.
    ! First go through the lines
    do i = ends(last_page-1)%last_line+1, ends(last_page)%last_line
      from = lines(i)%from ! Tree index of from=... node in Line spec
      to = lines(i)%to     ! Tree index of To=... node in line spec
      do j = 2, nsons(to)
        gson = subtree(j,to)
        if ( node_id(gson) /= n_dot .or. nsons(gson) < 3 ) then ! Not a reference to a Block
          if ( node_id(gson) == n_dot ) then ! Label.Route
            ggson = decoration(subtree(1,gson)) ! Spec node for Dot?
          else
            ggson = decoration(gson) ! Spec node for Dot?
          end if
          if ( decoration(ggson) == s_dot ) then
            ! Fill the "from" field of Dot(.) if "To" lands on a Dot node
            k = decoration(subtree(1,ggson)) ! Index of Dots element
            if ( .not. allocated(dots(k)%from) ) then
              allocate ( dots(k)%from(1) )
              nFrom = 1
            else
              nFrom = size(dots(k)%from) + 1
              allocate ( temp_int(nFrom) )
              temp_int(1:nFrom-1) = dots(k)%from
              call move_alloc ( temp_int, dots(k)%from )
            end if
            dots(k)%from(nFrom) = i
          end if
        end if
      end do ! j
    end do ! i
    ! Now go through the dots
    change = .true.
    do while ( change )
      change = .false.
      do i = ends(last_page-1)%last_dot+1, ends(last_page)%last_dot
        if ( allocated(dots(i)%from) ) then
          do j = 1, size(dots(i)%from)
            from = lines(dots(i)%from(j))%from ! Index of from= node in Line spec
            k = subtree(2,from)
            if ( any(node_id(k) == [ n_asterisk, n_tilde ]) ) k = subtree(1,k)
            if ( node_id(k) == n_dot ) then
              call get_str ( sub_rosa(subtree(2,k)), text )
              read ( text, * ) n   ! pin number
              from = subtree(1,k)  ! Tree index of Block spec
              k = decoration(subtree(1,decoration(from))) ! Index of Blocks element
              sign = ''
              signal = blocks(k)%signals(n)
            else
              from = decoration(k)   ! Tree index of Input or Dot spec
              k = decoration(subtree(1,from)) ! Index of Inputs or Dots spec
              if ( decoration(from) == s_input ) then
                sign = inputs(k)%sign
                signal = inputs(k)%signal
              else
                sign = dots(k)%sign
                signal = dots(k)%signal
              end if
            end if
            if ( dots(i)%signal == '' .and. signal /= '' ) then
              dots(i)%sign = sign
              dots(i)%signal = signal
              change = .true.
            else if ( dots(i)%signal /= signal .or. &
                    & dots(i)%sign /= '' .and. dots(i)%sign /= sign ) then
              if ( dots(i)%signal == ' ' ) then
                call error_intro ( warning, source_ref(dots(i)%tree) )
                call output ( 'Signal not yet assigned; maybe no line incident here.', &
                            & advance='yes' )
              else
                k = source_ref(lines(dots(i)%from(j))%from)
                call error_intro ( simple, source_ref(dots(i)%tree) )
                call output ( i, before='For "Dot" ' )
                call output ( ', "From" signal ' )
                call output ( signal )
                call output ( ' at line ' )
                call output ( k/256 )
                call output ( mod(k,256), before=' column ', advance='yes' )
                call blanks ( len('*** Error *** ') )
                call output ( 'is inconsistent with previous signal ' )
                call output ( dots(i)%signal )
                call output ( '.', advance='yes' )
                wrong = .true.
              end if
            end if
          end do ! j
        end if
      end do ! i
    end do ! while ( change )
  end subroutine Fill_Dot

  subroutine Get_Str ( String, Text )
    ! Wrapper for Get_String, to set Strip and Cap always .true.
    integer, intent(in) :: String
    character(*), intent(inout) :: Text
    call get_string ( string, text, cap=.true., strip=.true. )
  end subroutine Get_Str

!--------------------------- end bloc --------------------------------------
  logical function not_used_here()
  character (len=*), parameter :: IdParm = &
       "$Id: parser.f90,v 1.4 2022/02/10 18:57:13 vsnyder Exp $"
  character (len=len(idParm)) :: Id = idParm
    not_used_here = (id(1:1) == ModuleName(1:1))
    print *, Id ! .mod files sometimes change if PRINT is added
  end function not_used_here
!---------------------------------------------------------------------------

end module Tables_m

! $Log: parser.f90,v $
