module MACRO_PASS_M

  use INPUT_M, only: INUNIT, READ_LINE
  use IO_UNITS, only: MACRO_FILE => MACROS, U_MACROS, U_SCR2
  use MACHINE, only: IO_ERROR
  use OP_CODES_M, only: OP_CODES

  implicit NONE
  private

  public :: MACRO_PASS

contains

  subroutine MACRO_PASS

  ! Process the input file, expanding macros, and including INCLD and
  ! CALL macros.

    integer, parameter :: MAX_MACROS = 99
    character(5) :: CMD
    logical :: FOUND_MACRO ( max_macros )
    integer :: I, J
    integer :: IOSTAT
    character(len=80) :: LINE_IN, LINE_MAC
    character(len=5) :: MACROS(max_macros)   ! CALL and INCLD held until END
    integer :: N_MACROS

    n_macros = 0
  o:do
      call read_line ( line_in, iostat )
      if ( iostat < 0 ) exit  ! End of file
      if ( iostat > 0 ) then  ! Error
        call io_error ( "While reading input", inunit, macro_file )
        stop
      end if

      if ( line_in(5:5) == '*' .or. line_in(16:18) == ' ' ) then
        write ( u_scr2, 100 ) ' ', line_in
100     format ( a5, a )
      else
        do i = 1, size(op_codes,1)-1
          if ( line_in(16:20) == op_codes(i)%op ) then
            if ( line_in(16:20) == 'END  ' .or. line_in(16:20) == 'EX   ' .or. &
              &  line_in(16:20) == 'LTORG' ) call include_closed_macros
            write ( u_scr2, 100 ) ' ', trim(line_in)
            cycle o
          end if
        end do
        select case ( line_in(16:20) )
        case ( 'CALL ' )
          write ( u_scr2, 100 ) 'MACRO', trim(line_in)
          cmd = 'B'
          i = 21
          do
            call get_arg
            if ( line_in(i:j-1) == '' ) exit
            if ( cmd == 'B' ) call add_macro ( line_in(i:j-1) )
            write ( u_scr2, 200 ) 'GEN  ', cmd, line_in(i:j-1)
200         format ( a5, 15x, a5, a )
            if ( line_in(j:j) /= ',' ) exit
            i = j + 1
            cmd = 'DCW'
          end do
        case ( 'INCLD' )
          write ( u_scr2, 100 ) 'MACRO', trim(line_in)
          do i = 21, 25
            if ( line_in(i:i) == ' ' ) exit
          end do
          call add_macro ( line_in(21:i) )
        case default
        end select
      end if
    end do o

  contains
    subroutine ADD_MACRO ( NAME )
      ! Add name of macro to be included at END or EX or LTORG
      character(len=*), intent(in) :: NAME
      do i = 1, n_macros
        if ( macros(i) == name ) return
      end do
      n_macros = n_macros + 1
      if ( n_macros > max_macros ) then
        write ( u_scr2, '(a5,a)' ) 'ERROR', '* TOO MANY MACROS'
      else
        macros(n_macros) = name
      end if
    end subroutine ADD_MACRO

    subroutine GET_ARG
      ! Get an argument for a macro.  Start at I, and go until the end
      ! of the argument -- a comma or blank not inside of @...@.
      if ( line_in(i:i) == '@' ) then
        j = 72
        do
          if ( line_in(j:j) == '@' ) then
            j = j + 1
            exit
          end if
          j = j - 1
        end do
      else
        j = i
        do
          if ( line_in(j:j) == ',' .or. line_in(j:j) == ' ' ) exit
          j = j + 1
        end do
      end if
    end subroutine GET_ARG

    subroutine INCLUDE_CLOSED_MACROS
    ! Include macros requested by CALL or INCLD.
      logical :: COPYING
      copying = .false.
      found_macro = .false.
      rewind ( u_macros )
    m:do
        read ( u_macros, '(a)', iostat=iostat ) line_mac
        if ( iostat < 0 ) exit  ! End of file
        if ( iostat > 0 ) then  ! Error
          call io_error ( "While reading macros", inunit, macro_file )
          stop
        end if
        if ( line_mac(16:20) == 'HEADR' ) then
          do i = 1, n_macros
            if ( line_mac(6:11) == macros(i) ) then
              if ( found_macro(i) ) then
                write ( u_scr2, 100 ) 'ERROR', &
                  & '* DUPLICATE MACRO ON MACRO FILE: ' // trim(macros(i))
100             format ( a5, a )
              else
                copying = .true.
                found_macro(i) = .true.
                cycle m
              end if
            end if
          end do
          copying = .false.
        else if ( copying ) then
          write ( u_scr2, 100 ) 'GEN  ', line_mac
        end if
      end do m
      do i = 1, n_macros
        if ( .not. found_macro(i) ) then
          write ( u_scr2, 100 ) 'ERROR', '* MACRO NOT FOUND: ' // trim(macros(i))
        end if
      end do
    end subroutine INCLUDE_CLOSED_MACROS      
  end subroutine MACRO_PASS

end module MACRO_PASS_M