module Paper_Tape

  ! Read and write paper tape

  ! Format:
  ! I instruction
  ! D data
  ! N neither

  implicit NONE

  private

  public :: Read_Paper_Tape, Write_Paper_Tape

contains

  subroutine Read_Paper_Tape ( Channel, Word, Single_FP, Error )
    use Memory
    integer, intent(in) :: Channel, Word
    logical, intent(in) :: Single_FP
    logical, intent(out) :: Error

    character(255) :: File
    integer :: I, IOSTAT
    character(18) :: Text

    do
      print '(a,i0)', 'Enter file name for input to channel ', channel
      read ( *, '(a)', iostat=iostat ) file
      if ( iostat /= 0 ) then
        print '(a)', 'Error reading file name'
      else
        open ( 10, file=trim(file), status='old', iostat=iostat )
        if ( iostat == 0 ) cycle
        print '(3a)', 'Error opening ', trim(file), ' for paper-tape input'
      end if
    end do

    instructions(channel,0:word-1) = instruction_t(0,0,0,0)
    if ( single_fp ) then
      single(channel,0:word-1) = 0.0
    else
      double(channel,0:word/2) = 0.0
    end if

    i = 0
    do while ( i < word )
      read ( 10, '(a)', end=9 ) text
      select case ( text(1:1) )
      case ( 'I' ) ! Instruction
        call read_instruction ( adjustl(text(2:)), instructions(channel,i), &
          & error )
        if ( error ) exit
        what(channel,i) = w_instr
        i = i + 1
      case ( 'D' ) ! Data
        if ( single_fp ) then
          read ( text(2:), *, iostat=iostat ) single(channel,i)
          what(channel,i) = w_data
          i = i + 1
        else
          i = i + mod(i,2)
          read ( text(2:), *, iostat=iostat ) double(channel,i/2)
          what(channel,i:i+1) = w_data
          i = i + 2
        end if
        error = iostat /= 0
        if ( error ) then
          print '(a,i0)', 'Invalid data read for ', 100*channel+i
          exit
        end if
      case default
        what(channel,i) = w_none
        i = i + 1
      end select
    end do
9   close ( 10 )
    if ( error ) print '(2a)', 'While reading from ', trim(file)
  end subroutine Read_Paper_Tape

  subroutine Write_Paper_Tape ( Channel, Word, Single_FP )
    use Memory
    integer, intent(in) :: Channel, Word
    logical, intent(in) :: Single_FP

    character(255) :: File
    integer :: I, IOSTAT
    character(18) :: Text

    do
      print '(a,i0)', 'Enter file name for output from channel ', channel
      read ( *, '(a)', iostat=iostat ) file
      if ( iostat /= 0 ) then
        print '(a)', 'Error reading file name'
      else
        open ( 10, file=trim(file), iostat=iostat )
        if ( iostat == 0 ) cycle
        print '(3a)', 'Error opening ', trim(file), ' for paper-tape output'
      end if
    end do

    i = 0
    do while ( i < word )
      select case ( what(channel,i) )
      case ( w_instr )
        call format_instruction ( instructions(channel,i), text )
        write ( 10, '(2a)' ) 'I', trim(adjustl(text))
        i = i + 1
      case ( w_data )
        if ( single_fp ) then
          write ( file, * ) single(channel,i)
          write ( 10, '(2a)' ) 'D ', trim(file)
          i = i + 1
        else
          write ( file, * ) double(channel,i/2)
          write ( 10, '(2a)' ) 'D ', trim(file)
          i = i + 2
        end if
      case ( w_none )
        write ( 10, '(a)' ) 'N'
      end select
    end do
    close ( 10 )
  end subroutine Write_Paper_Tape

end module Paper_Tape
