module Undump_m

! Undump an IBM 1401 memory dump to Autocoder format

  implicit NONE
  private

  public :: Undump

contains

  subroutine Undump ( Core, WM, ShowAddr, EndAddr, ExAddr )

    use DisAsmOne_m, only: DisAsmOne

    character(16000), intent(in) :: Core, WM
    logical, intent(in) :: ShowAddr ! Put addresses in 1:5 of output
    integer, intent(in), optional :: EndAddr ! To put on END card
    integer, intent(in), optional :: ExAddr  ! To put on EX card

    logical :: Done        ! No more to do
    integer :: L, LP       ! Subscript, loop inductor
    character(100) :: Line ! of output
    integer :: LW          ! Line width from DisAsmOne
    integer :: MyEndAddr, MyExAddr ! Local ones
    integer :: N           ! Next word mark, else highest non-blank
    character :: Nop5      ! D-modifier of NOP if not NoD
    integer :: W           ! Field width


    ! Find first non-blank or first word mark.
    do l = 1, 16000
      if ( core(l:l) /= '' .or. wm(l:l) /= '' ) exit
    end do

    lp = -100
    w = -100
    done = .false.

    do while ( .not. done )

      if ( l /= lp + w ) write ( *, '(15x,"ORG  ",i0)' ) l

      ! Find next WM.  If none, find last non-blank
      do n = l+1, 16000
        if ( wm(n:n) /= '' ) exit
      end do
      done = n > 16000
      if ( done ) n = max(len_trim(core), len_trim(wm)) + 1 ! ran off the end of core

      w = n - l
      if ( n <= l ) exit

      call disAsmOne ( core(l:n-1), line, lw, w, nop5 )
      if ( w <= 50 ) then
        if ( showAddr ) then
          if ( line(16:20) == 'DCW' .or. line(16:20) == 'DSA' ) then
            write ( line(1:5), '(i5)' ) l+w-1
          else
            write ( line(1:5), '(i5)' ) l
          end if
        end if
        write ( *, '(a)' ) trim(line(:lw))
      else ! Long field, break into DCW and DC
        line(16:20) = 'DCW'
        do while ( w > 0 )
          if ( core(l:l+w-1) /= '' ) then
            lw = min(w,50)
            if ( showAddr ) write ( line(1:5), '(i5)' ) l + lw - 1
            line(21:) = '@' // core(l:l+lw-1) // '@'
            write ( *, '(a)' ) trim(line)
            line(18:18) = '' ! Change OP to DC for remainder of field
            l = l + lw
            w = w - lw
          else if ( done ) then
            if ( line(18:18) == '' ) exit ! DC now?
            if ( showAddr ) write ( line(1:5), '(i5)' ) l
            line(21:) = '#1'
            write ( *, '(a)' ) trim(line)
            exit
          else
            l = l + w
            lp = -100 ! Force top of loop to make ORG
            exit
          end if
        end do
      end if

      lp = l
      l = n

    end do

    myEndAddr = -1
    if ( present(endAddr) ) myEndAddr = endAddr
    myExAddr = -1
    if ( present(exAddr) ) myExAddr = exAddr

    if ( myExAddr >= 0 ) write ( *, '(15x,"EX   ",i0)' ) myExAddr

    if ( myEndAddr >= 0 ) then
      write ( *, '(15x,"END  ",i0)' ) myEndAddr
    else if ( .not. present(exAddr) ) then
      write ( *, '(t16,"END")' )
    end if

  end subroutine Undump

end module Undump_m