program Extdef

! Find external definitions in an Autocoder listing and create EQUs for them.
! External definitions are marked by asterisk in column 1.

  use ISO_Fortran_Env, only: E => Error_Unit

  character(132) :: Arg, IOMsg, Line
  character(132) :: Out  ! Output file name
  integer :: I, IOStat, J
  integer :: N, P    ! Argument number, Phase number
  logical :: Opened  ! Is the output file already opened? 

  opened = .false.
  call get_command_argument ( 1, arg )
  call get_command_argument ( 2, out )
  open ( 10, file=trim(arg), status='old', iostat=iostat, iomsg=iomsg )
  if ( iostat /= 0 ) then
    write ( e, 6 ) 'Unable to open input file "', trim(arg), '"', &
      & 'Status = ', i0, trim(iomsg)
  6 format (3a/a,i0/a)
    stop 1
  end if
  do
    read ( 10, '(a)', end=1 ) line
    if ( line(7:7) /= '*' ) cycle
    if ( line(7:8) == '**' ) cycle  ! Error message at the end
    if ( .not. opened ) then
      if ( out == '' ) then
        ! Assume listing file name is 'phase-[n]n*.lst
        i = 6
        do ! Find the end of the numeric part.
          if ( out(i+1:i+1) < '0' .or. out(i+1:i+1) > '9' ) exit
          i = i + 1
        end do
        read ( out(7:i), *, iostat=iostat, iomsg=iomsg ) p
        if ( iostat /= 0 ) then
          write ( e, 6 ), 'Unable to read phase number from "', trim(out), '"', &
            & 'Status = ', iostat, trim(iomsg)
          close ( 10 )
          stop 1
        end if
        write ( out, '("ext",i2.2)' ) p
      end if
      open ( 11, file=out, iostat=iostat, iomsg=iomsg )
      if ( iostat /= 0 ) then
        write ( e, 6 ) 'Unable to open output file "', trim(arg), '"', &
          & 'Status = ', i0, trim(iomsg)
        stop 1
      end if
      opened = .true.
      write ( 11, '(5x,a,t16,"headr")' ) adjustl(trim(out))
    end if
    do j = 80, 30, -1 ! Find a trailing at sign, if any
      if ( line(j:j) == '@' ) exit
    end do
    do j = j, 80 ! Now find two blanks
      if ( line(j-1:j) == ' ' ) exit
    end do
    do i = 87, 91  ! Trim leading blanks and zeros
      if ( line(i:i) /= '' .and. line(i:i) /= '0' ) exit
    end do
    write ( 11, 2 ) line(15:20), line(i:91), trim(adjustl(line(j+1:80)))
  2 format ( 5x, a6, 4x, 'equ  ', a, t27, a )
  end do
1 continue
  if ( opened ) close ( 11 )
  close ( 10 )

end program Extdef
