module DisAsmAutocoder_m

! Disassemble object decks in Autocoder format.

  implicit NONE
  private

  public DisAsmAutocoder

contains

  subroutine DisAsmAutocoder ( ShowAddr, ShowMem, Line, Title )

    use DumpCore_m, only: DumpCore, Undef
    use Get_Addr_m, only: Get_Addr
    use Undump_m, only: Undump

    logical, intent(in) :: ShowAddr ! Show addresses in 6:10; set by -a option
    logical, intent(in) :: ShowMem  ! Show memory contents; set by -m option
    character(100), intent(inout) :: Line ! of input or output
    character(55), intent(in) :: Title    ! to put on JOB card

    character(16000) :: Core, Wm ! Simulated 1401 memory

    logical :: Any         ! Any stuff in memory?
    integer :: EndAddr     ! In columns 41-43 of card with / in 40
    integer :: ExAddr      ! In columns 69-71 of card with B in 68
    integer :: I           ! Loop inductor
    integer :: N1, N2      ! Addresses in fields of input

    line(21:75) = title
    write ( *, '(t16,"JOB",a/t16,"CTL  6611")' ) trim('  '//line(21:80))

    do
      any = .false.
      do i = 1, 16000
        core(i:i) = undef
      end do
      wm = ''
      endAddr = -1
      exAddr = -1

      do
        read ( *, '(a)', end=9 ) line
        if ( line(40:40) == 'L' .or. line(40:40) == 'M' ) then
          if ( index(line(41:67),'###') /= 0 ) cycle
          call get_addr ( line(41:43), n1 )
          call get_addr ( line(44:46), n2 )
          if ( line(40:40) == 'L' ) then
            core(n2-n1+1:n2) = line(1:n1)
            wm(n2-n1+1:n2-n1+1) = '1'
          else
            do i = n1, 1, -1
              core(n2:n2) = line(i:i)
              if ( wm(n2:n2) == '1' ) exit
              n2 = n2 - 1
            end do
          end if
          any = .true.
          do i = 47, 67, 7
            if ( line(i:i) == ',' ) then ! Set word mark
              call get_addr ( line(i+1:i+3), n1 )
              call get_addr ( line(i+4:i+6), n2 )
              if ( n1 /= 40 ) wm(n1:n1) = '1'
              if ( n2 /= 40 ) wm(n2:n2) = '1'
            else if ( line(i:i) == ')' ) then ! Clear word mark
              call get_addr ( line(i+1:i+3), n1 )
              call get_addr ( line(i+4:i+6), n2 )
              wm(n1:n1) = ' '
              wm(n2:n2) = ' '
            else
              exit
            end if
          end do
          if ( line(68:68) == 'B' ) then ! EX card
            call get_addr ( line(69:71), exAddr )
            exit
          end if
        else if ( line(40:40) == '/' .and. line(1:39) == '' ) then
          call get_addr ( line(41:43), endAddr )
          core(1:80) = ''
          wm(1:80) = ''
          exit
        end if
      end do
      if ( showMem ) call DumpCore ( Core, WM )
      call undump ( Core, WM, showAddr, endAddr, exAddr )
    end do
  9 continue

    if ( any ) then
      if ( showMem ) call DumpCore ( Core, WM )
      call undump ( Core, WM, showAddr, endAddr, exAddr )
    end if

  end subroutine DisAsmAutocoder

end module DisAsmAutocoder_m
