program DisasmSevenPerCard

! Disassemble diagnostic programs distributed in seven-fields-per-card format.

  use CommandLine_m, only: CommandLine
  use DumpCore_m, only: DumpCore
  use Get_Addr_m, only: Get_Addr
  use Undump_m, only: Undump

  implicit NONE

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

  integer :: EndAddr=-1  ! In columns 2-4 of card with / in 1
  integer :: I           ! Loop inductor
  character(100) :: Line ! of input or output
  integer :: N1, N2      ! Addresses in fields of input
  logical :: ShowAddr    ! Show addresses in 6:10; set by -a option
  logical :: ShowMem     ! Show memory contents; set by -m option
  integer :: X           ! Index register in address field; not used here

  ! Analyze command line
  call commandLine ( showAddr, showMem )

  core = ''
  wm = ''

  ! Create a JOB card if the first card has A in column 80
  read ( *, '(a)', end=9 ) line
  if ( line(80:80) == 'A' ) &
    & write ( *, '(15x,"JOB  ", a, t75,a)' ) line(49:72), line(73:77)

  do
    read ( *, '(a)', end=9 ) line
    if ( line(1:1) == 'L' ) then
      call get_addr ( line(2:4), n1, x )
      call get_addr ( line(5:7), n2, x )
      core(n2-n1+33:n2) = line(33:n1)
      wm(n2-n1+33:n2-n1+33) = '1'
      do i = 8, 22, 7
        if ( line(i:i) == ',' ) then ! Set word mark
          call get_addr ( line(i+1:i+3), n1, x )
          call get_addr ( line(i+4:i+6), n2, x )
          wm(n1:n1) = '1'
          wm(n2:n2) = '1'
        else if ( line(i:i) == ')' ) then ! Clear word mark
          call get_addr ( line(i+1:i+3), n1, x )
          call get_addr ( line(i+4:i+6), n2, x )
          wm(n1:n1) = ' '
          wm(n2:n2) = ' '
        else
          exit
        end if
      end do
    else if ( line(1:1) == '/' ) then
      call get_addr ( line(2:4), endAddr, x )
      exit
    end if
  end do
9 continue

  ! Dump core, just to make sure we got it right
  if ( showMem ) call DumpCore ( Core, WM )
  call undump ( Core, WM, showAddr, endAddr )

end program DisasmSevenPerCard
