# $Id$

#
# Note: for these commands to work, you must set $env to point
# to the thread structure for a live thread, e.g.:
#
#     (gdb) set $env = _jc_vms_list.lh_first->threads.alive_list.lh_first
#
# You can use "setenv" to try to do this automatically, or "setenv2"
# to do it manually (the "env" is usually obvious in stack traces).
#

define setenv
  if _jc_vms_list.lh_first == 0
    printf "sorry, the vm is not initialized yet\n"
  else
    set $env = _jc_vms_list.lh_first->threads.alive_list.lh_first
    set $vm = $env->vm
    print $vm
    print $env
  end
end

document setenv
  Attempt to automatically set the $env and $vm variables.
end

define setenv2
  set $env = (_jc_env *)$arg0
  set $vm = $env->vm
  print $vm
  print $env
end

document setenv
  Set $env from the supplied argument, and derive $vm too.
end

define print_java_stack_frame
  set $method = (_jc_method *)$arg0
  if $method == (void *)0
    set $addr = (_jc_method *)$arg1
    printf "  %p not found\n", $addr
  else
    if $method->class == 0
      printf "  function `%s' (method %p)\n", $method->name, $method
    else
      set $class = $method->class
      printf "  %s.%s(", $class->name, $method->name
      if $class->u.nonarray.source_file == 0
	printf "Unknown"
      else
	printf "%s", $class->u.nonarray.source_file
      end
      set $jline = 0
      set $i = 0
      set $found = 0
      set $pctr = (int)$arg1
      while !$found && $i < $method->code.num_linemaps
	if $pctr >= $method->code.linemaps[$i].index && ($i == $method->code.num_linemaps - 1 || $pctr < $method->code.linemaps[$i + 1].index)
	  set $jline = $method->code.linemaps[$i].line
	  set $found = 1
	end
	set $i = $i + 1
      end
      if $jline != 0
	printf ":%d", $jline
      end
      printf ")"
      printf " ((_jc_method *)%p)\n", $method
    end
  end
end

define pstack
  set $jstack = $env->java_stack
  while $jstack != 0
    set $jip = $jstack->pc != 0 ? $jstack->pc - $jstack->method->code.insns : -1
    print_java_stack_frame $jstack->method $jip
    set $jstack = $jstack->next
  end
end

document pstack
  Print Java stack for the current thread. The $env variable must be
  set consistently with the currently selected thread.
end

define follow_bp
  set $bp = $ebp
  set $p = (void *)0xffffffff
  while $bp != 0
    printf "bp = %p pc = %p\n", $bp, $p
    set $p = ((void **)$bp)[1]
    set $bp = ((void **)$bp)[0]
  end
end

document follow_bp
  Follow chain of base pointers (i386 only).
end

define pthrowable
  set $obj = (_jc_object *)$arg0
  printf "%s", $obj->type->name
  set $string = (_jc_object *)((char *)$obj + $env->vm->boot.fields.Throwable.detailMessage->offset)
  if $string != 0x0
    printf "detail@%p", $string
    printf ": "
    pstring $string
  else
    printf "\n"
  end
end

document pthrowable
  Display an exception object.
  The first parameter is the address of a java.lang.Throwable object.
end

define pstring
  set $obj = (_jc_object *)$arg0
  set $type = (_jc_type *)$env->vm->boot.types.String
  set $value = *(_jc_char_array **)((char *)$obj + $type->u.nonarray.fields[4]->offset)
  set $offset = *(jint *)((char *)$obj + $type->u.nonarray.fields[7]->offset)
  set $count = *(jint *)((char *)$obj + $type->u.nonarray.fields[6]->offset)
  set $i = $offset
  printf "\""
  while $i < $offset + $count
    printf "%c", (char)($value->elems[$i])
    set $i = $i + 1
  end
  printf "\"\n"
end

document pstring
  Print the contents of a Java string object.
  The first parameter is the address of a java.lang.String object.
end

define ptype
  set $type = (_jc_type *)$arg0
  printf "%s\n", $type->name
  if ($type->flags & 0x0040)
    printf "  LOADED\n"
  end
  if ($type->flags & 0x0400)
    printf "  RESOLVED\n"
  end
  if ($type->flags & 0x0800)
    printf "  INITIALIZED\n"
  end
end

document ptype
  Print basic info about a type.
end

define pobj
  printf "%p is a %s\n", (void *)$arg0, ((_jc_object *)$arg0)->type->name
end

document pobj
  Print the type of an object.
end

define pmethod
  set $accnames = { "public", "privat", "prtctd", "static", "finall", "synchr", "voltle", "trnsnt", "native", "intrfc", "abstrt", "strict" }
  set $method = (_jc_method *)$arg0
  set $i = 0
  while $i < 12
    if (($method->access_flags & (1 << $i)) != 0)
      printf "%s ", $accnames[$i]
    end
    set $i = $i + 1
  end
  printf "%s.%s%s\n", $method->class->name, $method->name, $method->signature
  printf "      type=%s\n", ($method->access_flags & 0x0100) ? (($method->access_flags & 0x1000) ? "JCNI native" : "JNI native") : "interpreted"
  printf "  function=%p\n", $method->function
  if ($method->access_flags & 0x0100)
    printf "nativefunc=%p\n", $method->function
  end
end

document pmethod
  Print information about a method.
end

define heap_block
  set $page_size = 4096
  set $mem = (char *)$arg0
  set $heap = &$env->vm->heap
  set $heap_start = (char *)$heap->pages
  set $heap_end = $heap_start + ($page_size * $heap->num_pages)
  printf "Address %p:\n", $mem
  if $mem < $heap_start || $mem >= $heap_end
    printf "Address does not lie within the heap (%p - %p)\n", $heap_start, $heap_end
  else
    set $page_num = ($mem - $heap_start) / $page_size
    printf "\tPage number:\t%d\n", $page_num
    set $ppw = (sizeof(_jc_word) * 8) / 2
    set $type = ($heap->page_bits[$page_num / $ppw] >> (($page_num % $ppw) * 2)) & 0x03
    printf "\tPage type:\t"
    if $type == 0
      printf "FREE\n"
    else
      if $type == 2
	printf "LARGE\n"
      else
	if $type == 1
	  printf "SMALL\n"
	  set $i = 0
	  set $found = 0
	  while $i < $heap->num_sizes && !$found
	    set $size = &$heap->sizes[$i]
	    set $page = $size->pages
	    set $pnum = ((char *)$page - $heap_start) / $page_size
	    while $page != 0 && $pnum != $page_num
	      set $page = $page->u.next
	      set $pnum = ((char *)$page - $heap_start) / $page_size
	    end
	    if $page != 0
	      set $found = 1
	    else
	      set $i = $i + 1
	    end
	  end
	  if $found
	    printf "\tSize index:\t%d\n", $i
	    printf "\tBlock size:\t%d\n", $size->size
	    printf "\tOffset:\t\t%d\n", $size->offset
	    printf "\tBlock index:\t%d\n", ((char *)$mem - ((char *)$page + $size->offset)) / $size->size
	    printf "\tBlock offset:\t%d\n", ((char *)$mem - ((char *)$page + $size->offset)) % $size->size
	  else
	    printf "\t*** page not found in any small page list ***\n"
	  end
	else
	  printf "FINALIZABLE\n"
	end
      end
    end
  end
end

document heap_block
  Print info about the heap block that contains a memory address.
  The first parameter is the memory address in the heap.
end

define show_pages
  set $page_size = 4096
  set $heap = &$env->vm->heap
  set $heap_start = (char *)$heap->pages
  set $heap_end = $heap_start + ($page_size * $heap->num_pages)
  printf "Small heap pages:\n"
  set $i = 0
  while $i < $heap->num_sizes
    printf "  Block size index [%d]\n", $i
    set $size = &$heap->sizes[$i]
    printf "    Size of each block:\t\t%d bytes\n", $size->size
    printf "    Number of blocks:\t\t%d\n", $size->num_blocks
    printf "    Offset to first block:\t%d bytes\n", $size->offset
    printf "    Length of live_bits[]:\t%d words\n", $size->num_bit_words
    printf "    Pages:\n"
    set $page = $size->pages
    while $page != 0
      set $pnum = ((char *)$page - $heap_start) / $page_size
      printf "    %4d  %p\t", $pnum, $page
      set $j = 0
      while $j < $size->num_bit_words
	printf " %08x", ((_jc_small_page *)$page)->live_bits[$j]
	set $j = $j + 1
	if $j % 6 == 0 && $j < $size->num_bit_words
	  printf "\n\t\t\t"
	end
      end
      printf "\n"
      set $page = $page->u.next
    end
    set $i = $i + 1
  end
end

document show_pages
  Show heap pages.
end