module common
  implicit none
  character(128):: query
end module

subroutine help
  print '(A)', "  ?             this help"
  print '(A)', "  <filename     load file"
  print '(A)', "  =string       query by string"
  print '(A)', "  /string       query by pattern for key"
  print '(A)', "  %string       query by pattern for value"
  print '(A)', "  12 34 FF FF   query by hexadecimal integer"
  print '(A)', "  @             dump all entries"
  print '(A)', "  :             exit"
  print '(A)', "  other string  query by string"
end subroutine

subroutine status(ihash)
  use n3hash, only: hash_size, hash_klen, hash_vlen
  implicit none
  integer, intent(in):: ihash
  if (ihash < 0) then
    print *, "HASH TABLE NOT LOADED"
    return
  endif
  print *, "TABLE SIZE: ", hash_size(ihash), "ENTRIES"
  print *, "KEY SIZE:   ", hash_klen(ihash), "WORDS"
  print *, "VALUE SIZE: ", hash_vlen(ihash), "WORDS"
end subroutine

subroutine dumpword(word, str)
  implicit none
  integer, intent(in):: word
  character(8), intent(out):: str
  integer:: i, j, oct
  real:: x
  equivalence(i, x)
  select case(iand(255, ishft(word, -23)))
  case (0, 255)
    write(str, "(I8.1)") word
    return
  end select
  do, j = 0, 3
    oct = iand(255, ishft(word, (j * 8)-24))
    select case(oct)
    case(32:126)
      str(j*2+1:j*2+2) = ' ' // achar(oct)
    case default
      goto 900
    end select
  enddo
  return
  900 continue
  i = word
  write(unit=str, fmt="(G8.2)") x
end subroutine

subroutine dump(key, value, args, stat)
  implicit none
  integer, intent(in):: key(*), value(*), args(*)
  integer, intent(out):: stat
  integer:: i, v, ofs
  character(72):: line, plus
  line = ""
  plus = ""
  ofs = 1
  do, i = 1, args(1) + args(2)
    if (i <= args(1)) then
      v = key(i)
    else
      v = value(i - args(1))
    endif
    write(line(ofs:ofs+7), '(Z8.8)') v
    call dumpword(v, plus(ofs:ofs+7))
    if (i == args(1)) line(ofs+8:ofs+8) = ':'
    ofs = ofs + 9
    if (ofs > 72) then
      write(*, '(A/A)') trim(line), trim(plus)
      line = ""
      plus = ""
      ofs = 1
    endif
  enddo
  if (ofs /= 1) then
      write(*, '(A/A)') trim(line), trim(plus)
  endif
  stat = 0
end subroutine

subroutine dump_p(key, value, args, stat)
  use n3bits, only: itoaunpack
  use n3regex, only: fmatch
  use common, only: query
  implicit none
  integer, intent(in):: key(*), value(*), args(*)
  integer, intent(out):: stat
  integer, parameter:: NWORDS = 128
  character(NWORDS * 4):: ckey
  integer:: i, j
  if (args(3) == 1) then
    call itoaunpack(key, min(NWORDS, args(1)), ckey)
    if (fmatch(query, ckey, i, j)) then
      call dump(key, value, args, stat)
    else
      stat = 0
    endif
  else
    call itoaunpack(value, min(NWORDS, args(2)), ckey)
    if (fmatch(query, ckey, i, j)) then
      call dump(key, value, args, stat)
    else
      stat = 0
    endif
  endif
end subroutine

subroutine query_z(ihash, cmd)
  use n3hash, only: hash_get, hash_klen, hash_vlen
  implicit none
  integer, intent(in):: ihash
  character(*), intent(in):: cmd
  integer:: stat, args(2), i, j
  integer, pointer:: key(:), value(:)
  character(len(cmd)):: dup
  if (ihash < 0) then
    print *, "LOAD HASH FIRST"
    return
  endif
  j = 1
  do, i = 1, len(cmd)
    select case(cmd(i:i))
    case(' ')
    case('0':'9', 'A':'F', 'a':'f')
      dup(j:j) = cmd(i:i)
      j = j + 1
    case default
      goto 900
    end select
  enddo
  args(1) = hash_klen(ihash)
  args(2) = hash_vlen(ihash)
  allocate(key(args(1)), value(args(2)), stat=stat)
  if (stat /= 0) then
    write(*, *) 'MEMORY ALLOCATION ERROR'
    return
  endif
  key = 0
  do, i = 1, args(1)
    read(dup(i*8-7:i*8), "(Z8)") key(i)
  enddo
  call hash_get(ihash, key, value, stat)
  if (stat /= 0) then
    write(*, '(A,Z8,A)') 'HEXA SEARCH: RECORD ', key(1), '  NOT FOUND'
  else
    call dump(key, value, args, stat)
  endif
  deallocate(key, value)
  return
  900 continue
  call query_c(ihash, cmd)
end subroutine

subroutine query_c(ihash, cmd)
  use n3hash, only: hash_get, hash_klen, hash_vlen
  use n3bits, only: atoipack
  use n3error, only: trace
  implicit none
  integer, intent(in):: ihash
  character(*), intent(in):: cmd
  integer:: stat, args(2)
  integer, pointer:: key(:), value(:)
  if (ihash < 0) then
    print *, "LOAD HASH FIRST"
    return
  endif
  args(1) = hash_klen(ihash)
  args(2) = hash_vlen(ihash)
  allocate(key(args(1)), value(args(2)), stat=stat)
  if (stat /= 0) then
    write(*, *) 'MEMORY ALLOCATION ERROR'
    return
  endif
  call atoipack(cmd, key, args(1))
  call hash_get(ihash, key, value, stat)
  if (stat /= 0) then
    write(*, *) 'STRING SEARCH: RECORD NOT FOUND'
  else
    call dump(key, value, args, stat)
  endif
  deallocate(key, value, stat=stat)
end subroutine

subroutine query_p(ihash, cmd, flag)
  use n3hash, only: hash_each, hash_klen, hash_vlen
  use common
  implicit none
  integer, intent(in):: ihash, flag
  character(*), intent(in):: cmd
  integer:: stat, args(3)
  external dump_p
  if (ihash < 0) then
    print *, "LOAD HASH FIRST"
    return
  endif
  args(1) = hash_klen(ihash)
  args(2) = hash_vlen(ihash)
  args(3) = flag
  query = cmd
  call hash_each(ihash, dump_p, args, stat)
end subroutine

subroutine dumpall(ihash)
  use n3hash, only: hash_each, hash_klen, hash_vlen
  implicit none
  integer, intent(in):: ihash
  integer:: stat, args(2)
  external dump
  if (ihash < 0) then
    print *, "LOAD HASH FIRST"
    return
  endif
  args(1) = hash_klen(ihash)
  args(2) = hash_vlen(ihash)
  call hash_each(ihash, dump, args, stat)
end subroutine

subroutine load(ihash, filename)
  use n3hash, only: hash_load, hash_dispose
  use n3error, only: trace
  implicit none
  integer, intent(inout):: ihash
  character(*), intent(in):: filename
  integer:: stat, htmp
  call hash_load(adjustl(filename), htmp)
  if (htmp < 0) then
    call trace
    return
  endif
  if (ihash >= 0) then
    call hash_dispose(ihash, stat)
    if (stat < 0) call trace
  endif
  ihash = htmp
end subroutine

program frthash
  use n3hash, only: hash_dispose, hashclass_finalize
  use n3error, only: trace
  implicit none
  character(128):: cmd
  integer:: ihash, stat
  ihash = -HUGE(1)
  do
    write(*, '(A)', advance='NO') '>'
    read(*, '(A)', iostat=stat) cmd
    if (stat /= 0) exit
    if (cmd == "") cycle
    cmd = adjustl(cmd)
    select case(cmd(1:1))
    case ('<')
      call load(ihash, cmd(2: ))
      call status(ihash)
    case ('?')
      call help
    case ('=')
      call query_c(ihash, cmd(2: ))
    case ('/')
      call query_p(ihash, cmd(2: ), 1)
    case ('%')
      call query_p(ihash, cmd(2: ), 2)
    case ('0':'9', 'A':'F', 'a':'f')
      call query_z(ihash, cmd)
    case ('@')
      call dumpall(ihash)
    case (':')
      exit
    case default
      call query_c(ihash, cmd)
    end select
  enddo
  if (ihash >= 0) then
    call hash_dispose(ihash, stat)
    if (stat < 0) call trace
  endif
  if (ihash /= -HUGE(1)) then
    call hashclass_finalize(stat)
    if (stat < 0) call trace
  endif
end program