#
# This file contains various macros useful for Kaffe debugging.  Most
# of the macros in this file were either written by or originated from
# Patrick Tullmann <tullmann@cs.utah.edu>
#
# To use it, you need to use gdb's "source" command to source it.  This can
# be done explicitly, or from your ~/.gdbinit file.
# Remember that to debug kaffe, you invoke it like so (csh version):
#
#	setenv KAFFE_DEBUG gdb
#	kaffe ...
# 
# There's no guarantee that all of these macros work; if you notice 
# problems, fixes are always welcome.  Most of the macros are dependent
# on the structure of internal variables and types in the VM.
#
# Here's what should definitely work:	pstr, jlstring, pclass, pmeth, intbt,
# livethreads, livethreadsbt, rr, findNativeMethod, btThread, pobject,
# pobjecttype, vmdebug_state, vmdebug_list, vmdebug_setopt
#

# X-debugging is your friend.  (See FAQ/FAQ.xdebugging) Just startup
# the VM with `-Xxdebug' and then run this gdb macro
# whenever you want a full backtrace:
define xdb
    shell awk -- '// { print $0; } /\$xdb\$\.java\",132,0,0,0x/ { last_line = $0; } END { split(last_line, stabargs, /,/); printf(".stabs \"$xdb$.java\",100,0,0,%s\n", stabargs[5]); }' xdb.as | as -o xdb.o
    add-symbol-file xdb.o 0
end
document xdb
    Load xdebugging symbol information from xdb.as
end


# Kaffe ignores SIGPIPE, so we should too (on systems that have SIGPIPE)
#handle SIGPIPE nostop noprint

define pStr
  p (char*)(($arg0).value)
end

document pStr
  Print a kaffe utf8 string correctly.  Assumes its all actually ascii chars.
end


define pName
  pStr (($arg0).name)
end

document pName
  Print the name field of arg0 as a kaffe utf8 string.
end

define pObjCName
  pName ($arg0)->dtable->class
end

document pObjCName
  Print the class name of the given object.
end

define jthreadInfo
  set $jth = ($arg0)
  set $jlth = (Hjava_lang_Thread*)($jth->localData.jlThread)
  printf "jthread:"
    p $jth
  printf "  .status="
    pjthreadStatus $jth
  printf ";  .flags=%x\n", $jth.flags
  printf "java.lang.Thread:"
    p $jlth
  printf "  .PrivateInfo=%x", $jlth.PrivateInfo
  printf ";  .name="
    jlthreadName $jlth
  printf "\n"
end
document jthreadInfo
  Print the useful info on a thread, given a jthread pointer.
end

define pSlotInt
  p/x ($arg0)->v.tint
end

# arg0 == class, arg1 == entry
define pCPool
  echo Tag: 
  output/x ($arg0)->constants.tags[$arg1]
  echo ; Data:  
  output/x ($arg0)->constants.data[$arg1]
  echo \n
end

document pCPool
pCPool <class> <entry>:
   Print constant pool entry <entry> for class <class>
end

define pmeth
    printf "%s.%s;%s: %p %p idx=%d\n", \
	($arg0).class.name.data, ($arg0).name.data, \
	($arg0).parsed_sig.signature.data, ($arg0).c.ncode.ncode_start, \
	($arg0).c.ncode.ncode_end, ($arg0).idx
end
document pmeth
    Print full name of a method <meth>
end

define pmethods
  set $meths = ($arg0).methods
  set $nMeths = ($arg0).methods
  set $i = 0
  while $i < (($arg0).nmethods)
    pmeth $nMeths[$i]
    set $i = $i + 1
  end
end
document pmethods
  Print (the names of) all of the methods assocated with the given shared class object.
end

define pfields
  set $fields = ($arg0).fields
  set $i = 0
  while $i < (($arg0).nfields)
    printf "[%d] %s", $i, (char*)(($fields[$i]).name.data)

    ## Print the type 
    if $fields[$i].accflags & 0x8000
      # field is unresolved
      printf " (unresolved %s)", (char*)(((Utf8Const*)($fields[$i].type)).data)
    else
      # field is resolved
      printf " (%s)", $fields[$i].type.name.data
    end

    ## Print the location
    if $fields[$i].accflags & 0x8
      # static
      printf " @ %p (static)\n", $fields[$i].info.addr
    else
      printf " @ +%d\n", $fields[$i].info.boffset
    end

    set $i = $i + 1
  end
end
document pfields
  Print the names and locations of the fields associated with the given perspace class.
end

define pclass
   set $class = $arg0
   printf "%s", $class.name.data
   set $i = $class.total_interface_len
   if $i > 0
       printf "\n  implements "
       while --$i >= 0
	  printf "%s, ", $class.interfaces[$i].name.data
       end
   end

   printf "\n  extends "
   while $class.superclass != 0
       set $class = $class.superclass
       printf "%s, ", $class.name.data
   end
   printf "\nwas loaded by loader 0x%x\n", ($arg0).loader
   printf "state %d\n", $class.state
end
document pclass
Given a class object, print its superclasses and interfaces
end

define intbt
    set $i = $arg0
    while $i < $arg1
	frame $i++
	pmeth meth
    end
end
document intbt
    Show a backtrace for the interpreter from between <B> and (not including) <E>
end

define gcmem2block_old
  p/x *((gc_block*)((uintp)($arg0) & -gc_pgsize))
end

define gcmem2block 
  p/x ((gc_block *)gc_block_base)[(((uintp) ($arg0)) - gc_heap_base)/gc_pgsize]
end
document gcmem2block
  print the gc_block for a given pointer.
end

define gcblock 
  p/x ((gc_block *) gc_block_base)[$arg0]
end
document gcblock
    display a gc_block structure by index
end

define pcolor
  if ($arg0) == 0
    printf "GC_COLOUR_FREE "
  end
  if $arg0 == 1
    printf "GC_COLOUR_FIXED "
  end
  if $arg0 == 8
    printf "GC_COLOUR_WHITE "
  end
  if $arg0 == 9
    printf "GC_COLOUR_GREY "
  end
  if $arg0 == 10
    printf "GC_COLOUR_BLACK "
  end
end

define pfinalstate
  if $arg0 == 0
    printf "GC_STATE_NORMAL "
  end
  if $arg0 == 0x10
    printf "GC_STATE_NEEDFINALIZE "
  end
  if $arg0 == 0x20
    printf "GC_STATE_INFINALIZE "
  end
end

define gcstate
  set $ptr = (uint8*)($arg0)
  set $gcBlock = &(((gc_block *)gc_block_base)[(((uintp) ($ptr)) - gc_heap_base)/gc_pgsize])

  if $gcBlock->size <= 0
    printf "WARNING: block size is <= 0 (%d)\n", $gcBlock->size
  else
    set $gcPtr = (((gc_unit*)($ptr)) - 1) 
    set $idx = ((($ptr) - ($gcBlock->data)) / ($gcBlock->size))
    printf "Magic: %#x\n", $gcBlock->magic
    printf "$gcBlock: %p:: blockSize: %d; index: %d\n", $gcBlock, $gcBlock->size, $idx

    if ($gcBlock->funcs[$idx] != 0)
      set $func = gcFunctions[$gcBlock->funcs[$idx]]
      printf "Func: "
      p $func
    else
      printf "Func: NULL\n"
    end

    printf "gcPtr.cnext = %p; gcPtr.cprev = %p\n", $gcPtr.cnext, $gcPtr.cprev

    set $dataPtr = ((void*)&($gcBlock->data[$idx * $gcBlock->size]))
    # no space around &
    pcolor (($gcBlock->state[$idx])&0x0F)
    pfinalstate (($gcBlock->state[$idx])&0xF0)
    printf "\nADDRS: $gcPtr: %p; $dataPtr: %p; supplied: %p\n", $gcPtr, $dataPtr, $ptr

  end
end
document gcstate
  print the GC state associated with a given pointer.
end

define curth
  jthreadInfo currentJThread
end
document curth
 print out info about the current thread in kaffe.
end

define livethreads
  __livethreads 0
end

define livethreadsbt
  __livethreads 1
end

define __livethreads
  set $doBt = $arg0

  printf "Live threads in the system: (jth-current = %p)\n\n", currentJThread
  set $liveQ = liveThreads

  while $liveQ != 0

    set $th = ((jthread *)$liveQ->element)
    jthreadInfo $th
    if $doBt
       btThread $th
    end

    printf "---- ---- ---- ----\n\n"
    set $liveQ = $liveQ.next
  end
  printf "\n"
end
document livethreads
 Print info on all of the live threads in the system.
end

define alarmthreads
  printf "Threads on the alarm queue."
  set $th = alarmList
  while $th != 0
    jthreadInfo $th
    set $th = $th.nextalarm
  end
  printf "\n"
end
document alarmthreads
 Print info on all of the threads on the alarm queue.
end

define threadInfo
  set $jlth = (Hjava_lang_Thread*)($arg0)
  set $jth = (jthread*)($jlth.PrivateInfo)
  if $jth == 0
     printf "Thread at %p not yet initialized (PrivateInfo == 0)\n", $jlth
     printf "  State = %d; Name = ", $jlth.state
     jlstring $jlth.name
  else
    if $jth->localData.jlThread != $jlth
       printf "threadInfo: ERROR $jth->localData.jlThread (%p) != $jlth (%p)\n", $jth->localData.jlThread, $jlth
    else
       jthreadInfo $jth
    end
  end
end
document threadInfo
  Print the information in an Hjava_lang_Thread struct.
end


define pjthreadStatus
  set $stat = ($arg0).status
  if $stat == 0
    printf "SUSPENDED"
  else
    if $stat == 1
      printf "RUNNING"
    else
      if $stat == 2
        printf "DEAD"
      else
        printf "UNKNOWN(%x)", $stat
      end
    end
  end
end
document pjthreadStatus
  Print a string describing the status field of the given thread
end

define jlthread
  p ((Hjava_lang_Thread*)(($arg0)->localData.jlThread))
end
document jlthread
  Print the java-lang-Thread associated with the given JTHREAD ptr.
end

define jlthreadName
  set $chararr = ($arg0).name
  set $strcount = $chararr.length

  if $strcount < 1
    printf "(String is zero length)\n"
  else
    set $i = 0
    while $i < $strcount
     printf "%c", ($chararr.data.body)[$i]
     set $i = $i + 1
    end
    echo \n
  end
end
document jlthreadName
  print the name of the given java.lang.Thread object
end

define printDebugBuffer
  set $i = 0
  set $end = bufferBegin
  set $i = bufferBegin + 1

  printf "Debug Buffer is %d bytes\n", bufferSz
  #printf "DebugBuffer: beg: %d\n", bufferBegin 

  if ($i == 0) || (bufferSz == 0)
    printf "(No data in buffer)\n"
  else
    printf "%s...\n", debugBuffer + bufferBegin + 1
    printf "%s...\n", debugBuffer
  end
end
document printDebugBuffer
  Print the contents of the debug buffer.
end

define pjchararr
	set $i = 0
	while $i < ($arg0).length
	    printf "%c", ($arg0).data[0].body[$i]
	    set $i = $i + 1
	end
	printf " (len=%d)\n", ($arg0).length
end
document pjchararr
	Print a HArrayOfChar
end

define sunjlString
  set $strcount = ($arg0).count
  set $strstart = ($arg0).offset
  set $chararr = ($arg0).value
  if $strcount < 1
    printf "(String is zero length)\n"
  else
    set $i = 0
    while $i < $strcount
     printf "%c", ($chararr.data.body)[$i + $strstart]
     set $i = $i + 1
    end
    echo \n
  end
end

define jlString
  sunjlString $arg0
end
document jlString
  Print a java/lang/String
end

define rr
  run
end
document rr
  Re-run the last run, and never prompt.
end

# FreeBSD's setjmp:
#	 movl    %edx, 0(%ecx)
#	 movl    %ebx, 4(%ecx)
#	 movl    %esp, 8(%ecx)
#	 movl    %ebp,12(%ecx)
#	 movl    %esi,16(%ecx)
#	 movl    %edi,20(%ecx)
#	 movl    %eax,24(%ecx)
#        fnstcw  28(%ecx)
define restoreThread
echo >
  set $jb = ($arg0).env._jb
echo .
  set $eax = $jb[0]
echo .
  set $ebx = $jb[1]
echo .
  set $esp = $jb[2]
echo .
  set $ebp = $jb[3]
echo .
  set $esi = $jb[4]
echo .
  set $edi = $jb[5]
echo .
  set $eax = $jb[6]
#echo .
  #set $eflags = $jb[7]
echo \ Done.
echo \n
end
document restoreThread
  Restore a thread (given the jthread*) in FreeBSD.
end

define findNativeMethod
  pmeth findMethodFromPC($arg0)
end
document findNativeMethod
  Find the native method objet associated with the given address...
end

define JITwhere
  findNativeMethod $pc
end
document JITwhere
  Find information about the native method of the current PC
end

define restoreThread
  set $th = ((jthread*)$arg0)
  set $jbuf = (int*)($th.env)
  set $eip = $jbuf[0]
  set $esp = $jbuf[2]
  set $ebp = $jbuf[3]
end
document restoreThread
     restore register from a given jthread
end

define btThread
  set $th = ((jthread_t)$arg0)
  set $jbuf = (int*)($th.env)

  #btThreadBSDjmpbuf $jbuf
  btThreadLinuxjmpbuf $jbuf
  #btThreadOSKitUnixjmpbuf $jbuf
end
document btThread
  Print a backtrace for the given JTHREAD
end

define btThreadBSDjmpbuf
  set $jbuf = (int*)($arg0)

  set $saveEIP = $eip
  set $saveESP = $esp
  set $saveEBP = $ebp

  ## jmpbuf[0] = instruction pointer
  ## jmpbuf[2] = stack pointer
  ## jmpbuf[3] = base pointer
  set $eip = $jbuf[0]
  set $esp = $jbuf[2]
  set $ebp = $jbuf[3]

  # printf "btThreadBSDjmpbuf: .esp=%x .ebp=%x\n", $esp, $ebp

  bt

  set $eip = $saveEIP
  set $esp = $saveESP
  set $ebp = $saveEBP
end
document btThreadBSDjmpbuf
  Print a backtrace based on the given BSDish JMPBUF
end


define btThreadLinuxjmpbuf
  set $jbuf = (int*)($arg0)

  set $saveEIP = $eip
  set $saveESP = $esp
  set $saveEBP = $ebp
  set $saveEDI = $edi
  set $saveESI = $esi
  set $saveEBX = $ebx

  ## jmpbuf[0] = %ebx
  ## jmpbuf[1] = %esi
  ## jmpbuf[2] = %edi
  ## jmpbuf[3] = base pointer
  ## jmpbuf[4] = stack pointer
  ## jmpbuf[5] = instruction pointer
  set $eip = $jbuf[5]
  set $esp = $jbuf[4]
  set $ebp = $jbuf[3]
  set $edi = $jbuf[2]
  set $esi = $jbuf[1]
  set $ebx = $jbuf[0]

  # printf "btThreadLinuxjmpbuf: .esp=%x .ebp=%x\n", $esp, $ebp

  bt

  set $eip = $saveEIP
  set $esp = $saveESP
  set $ebp = $saveEBP
  set $edi = $saveEDI
  set $esi = $saveESI
  set $ebx = $saveEBX
end
document btThreadLinuxjmpbuf
  Print a backtrace based on the given Linuxish JMPBUF
end


define btThreadOSKitUnixjmpbuf
  set $jbuf = (pcb_t*)($arg0)

  set $saveEIP = $eip
  set $saveESP = $esp
  set $saveEBP = $ebp

  ## jmpbuf[0] = instruction pointer
  ## jmpbuf[2] = stack pointer
  ## jmpbuf[3] = base pointer
  set $eip = $jbuf.eip
  set $esp = $jbuf.esp
  set $ebp = $jbuf.ebp

  # printf "btThreadOSKitUnixjmpbuf: .esp=%x .ebp=%x\n", $esp, $ebp

  bt

  set $eip = $saveEIP
  set $esp = $saveESP
  set $ebp = $saveEBP
end
document btThreadOSKitUnixjmpbuf
  Print a backtrace based on the given OSKit/UNIX JMPBUF
end


#define plock
#  echo Holder:
#  p/x* ($arg0).holder
#  jlthreadName ((Hjava_lang_Thread*)(($arg0).holder.jlThread))
#  set $waiting = ($arg0).waiting
#  while ($waiting != 0)
#    echo Waiting:
#    p/x* $waiting
#    jlthreadName ((Hjava_lang_Thread*)(($waiting)->jlThread))
#    set $waiting = ($waiting).nextQ
#  end
#end

define dumpclasses
    set $i2 = 0
    while $i2 < 256
	# print $i2
	set $b = classEntryPool[$i2]
	while $b != 0
	   # print /x $b
	   if $b.class == 0
	      print "not loaded"
	   else
	      pclass $b.class
	   end
	   set $b = $b.next
	end
	set $i2 = $i2 + 1
    end
end
document dumpclasses
    find a class from a pool
end

define restorelinux
  set $th = ((struct _jthread*)$arg0)
  set $jbuf = $th.env[0].__jmpbuf
  echo >
  set $eip = $jbuf[5]
  echo .
  set $esp = $jbuf[4]
  echo .
  set $ebp = $jbuf[3]
  echo .
  set $edi = $jbuf[2]
  echo .
  set $esi = $jbuf[1]
  echo .
  set $ebx = $jbuf[0]
  echo .\n
end
document restorelinux
    Restore a thread under Linux, given a jthread pointer
end

define dumpexcchain
    set $th = ((jthread *) $arg0)
    set $jth = (Hjava_lang_Thread *) $th->localData.jlThread
    set $eptr = (struct VmExceptHandler *) $jth.exceptPtr
    while $eptr != 0
	printf "VmExceptionHandler: %p ", $eptr
	if $eptr.meth == 1
	    # VMEXCEPTHANDLER_KAFFEJNI_HANDLER
	    printf "  JNI frame.jni.fp = %p\n", $eptr->frame.jni.fp
	else
	    printf "  %s.%s", ($eptr.meth).class.name.data, ($eptr.meth).name.data
	    printf "  frame.intrp.pc = %p, frame.intrp.syncobj = %p\n", \
		$eptr->intrp.pc, $eptr->syncobj
	end
	set $eptr = $eptr.prev
    end
end
document dumpexcchain
    Dump exception chain for a given jthread
end

define pobject
  set $object  = $arg0
  set $class = (((Hjava_lang_Object*)$object).dtable.class)

  pobjecttype $object $class
end
document pobject
  Given a java object POINTER, lookup the object class and print its state
end

define pobjecttype
  set $SHOWSTATICS = 0

  set $obj  = ((Hjava_lang_Object*)$arg0)
  set $type = ((Hjava_lang_Class*)$arg1)
  set $fields = $type.fields
  set $i = 0
  while $i < ($type.nfields)
    ## Print the type 
    if $fields[$i].accflags & 0x8000
      # field is unresolved
      printf "  (unresolved %s)\n", (char*)(((Utf8Const*)($fields[$i].type)).data)
    else
      # field is resolved


      ## Print the location
      if $fields[$i].accflags & 0x8
       # Static field element
       if $SHOWSTATICS != 0
          printf "  %s %s", $fields[$i].type.name.data, (char*)(($fields[$i]).name.data)
         printf " @ %p (static)\n", $fields[$i].info.addr
       end
      else
        ## Regular, non-static field
        printf "  %s %s", $fields[$i].type.name.data, (char*)(($fields[$i]).name.data)
        set $size = $fields[$i].bsize
       if $size == 1
         printf " = %d\n", *((unsigned char*)(((char*)$obj) + $fields[$i].info.boffset))
       else
         if $size == 2
           printf " = %d\n", *((unsigned short*)(((char*)$obj) + $fields[$i].info.boffset))
         else
           if $size == 4
              if $type.methods == ((Method*)-1)
                # primitive type, show as int
                printf " = %d\n", *((int*)(((char*)$obj) + $fields[$i].info.boffset))
              else
                printf " = %p\n", *((void**)(((char*)$obj) + $fields[$i].info.boffset))
              end
           else
             if $size == 8
               printf " = icky\n"
             else
               printf " = ?? size=%d\n", $size
             end
           end
         end
       end
      end
    end
    set $i = $i + 1
  end
end
document pobjecttype
  Print the state of an object and a class object.
end

define vmdebug_state
  set $df = kaffevmDebugMask

  set $index = 0
  set $flag = debug_opts[$index].mask
  printf "Current vmdebug flags are: "
  ### XXX end-of-list marker is bogus.  I just assume DBG_ANY is last...
  while $flag != (long long)-1
    #printf "\n  (checking %s @ %d) ", debug_opts[$index].name, $index
    set $match = ((long long)$flag) & kaffevmDebugMask
    if ($flag != 0) && ($match == $flag)
      printf "%s, ", debug_opts[$index].name
    end
    set $index = $index + 1
    set $flag = debug_opts[$index].mask
  end
  printf "\n"
end
document vmdebug_state
  Print the Kaffe internal debug flag state
end

define vmdebug_list
  set $index = 0
  set $flag = debug_opts[$index].mask
  ### XXX end-of-list marker is bogus.  I just assume DBG_ANY is last...
  while $flag != (long long)-1
    if $flag != 0
      printf "%s: %s ", debug_opts[$index].name, debug_opts[$index].desc
    end

    set $index = $index + 1
    set $flag = debug_opts[$index].mask
    printf "\n"
  end
end
document vmdebug_list
  List the vmdebug flags (equivalent to -vmdebug list on command line)
end

define vmdebug_setopt
  set $name = ($arg0)
  set $foundit = 0
    
  set $index = 0
  set $flag = debug_opts[$index].mask
  ### XXX end-of-list marker is bogus.  I just assume DBG_ANY is last...
  while ($flag != (long long)-1) && ($foundit == 0)
    set $strchk = strcmp($name, debug_opts[$index].name)
    if $strchk == 0
      set kaffevmDebugMask = kaffevmDebugMask | debug_opts[$index].mask
      set $foundit = 1
    end

    set $index = $index + 1
    set $flag = debug_opts[$index].mask
  end

  if $foundit == 0
    printf "Couldn't find mask %s, no changes made.\n", $name
  end
end
document vmdebug_setopt
  Turn on some bits in the debug mask, based on the STRING given
end

define repeatrun
	set height 0
        set $repeatrun_count = $arg0
        set $repeatrun_i = 0
        while $repeatrun_i < $repeatrun_count
                printf "Iteration %d:\n", $repeatrun_i
                r
                set $repeatrun_i = $repeatrun_i + 1 
        end
        printf "Done with %d iterations.\n", $repeatrun_count
end
document repeatrun
  Invoke run the specified number of times.
end