gdbinit

   1 # -*- GDB-Script -*-
   2
   3 handle SIGPWR noprint nostop
   4 handle SIGXCPU noprint nostop
   5
   6 define newline
   7   call (void)scm_newline (scm_current_error_port ())
   8 end
   9
  10 define pp
  11   call (void)scm_call_1 (scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("ice-9 pretty-print"), "pretty-print")), $arg0)
  12 end
  13
  14 define gdisplay
  15   call (void)scm_display ($arg0, scm_current_error_port ())
  16   newline
  17 end
  18
  19 define gwrite
  20   call (void)scm_write ($arg0, scm_current_error_port ())
  21   newline
  22 end
  23
  24 define sputs
  25   call (void)scm_puts ($arg0, scm_current_error_port ())
  26 end
  27
  28 define gslot
  29   print ((SCM**)$arg0)[1][$arg1]
  30 end
  31
  32 define pslot
  33   gslot $arg0 $arg1
  34   gwrite $
  35 end
  36
  37 define lforeach
  38   set $l=$arg0
  39   while $l != 0x404
  40     set $x=scm_car($l)
  41     $arg1 $x
  42     set $l = scm_cdr($l)
  43   end
  44 end
  45
  46 define modsum
  47   modname $arg0
  48   gslot $arg0 1
  49   set $uses=$
  50   output "uses:\n"
  51   lforeach $uses modname
  52 end
  53
  54 define moduses
  55   pslot $arg0 1
  56 end
  57
  58 define modname
  59   pslot $arg0 5
  60 end
  61
  62 define modkind
  63   pslot $arg0 6
  64 end
  65
  66 define car
  67   call scm_car ($arg0)
  68 end
  69
  70 define cdr
  71   call scm_cdr ($arg0)
  72 end
  73
  74 define smobwordtox
  75   set $x=((SCM*)$arg0)[$arg1]
  76 end
  77
  78 define smobdatatox
  79   smobwordtox $arg0 1
  80 end
  81
  82 define program_objcode
  83   smobdatatox $arg0
  84   set $objcode=$x
  85   smobdatatox $objcode
  86   p *(struct scm_objcode*)$x
  87 end
  88
  89 define proglocals
  90   set $i=bp->nlocs
  91   while $i > 0
  92     set $i=$i-1
  93     gwrite fp[bp->nargs+$i]
  94   end
  95 end
  96
  97 define progstack
  98   set $x=sp
  99   while $x > stack_base
 100     gwrite *$x
 101     set $x=$x-1
 102   end
 103 end
 104
 105 define tc16
 106   p ((scm_t_bits)$arg0) & 0xffff
 107 end
 108
 109 define smobdescriptor
 110   p scm_smobs[0xff & (((scm_t_bits)$arg0) >> 8)]
 111 end
 112
 113 define vmstackinit
 114   set $vmsp=sp
 115   set $vmstack_base=stack_base
 116   set $vmfp=fp
 117   set $vmbp=bp
 118   set $vmframe=0
 119 end
 120
 121 define nextframe
 122   set $orig_vmsp=$vmsp
 123   while $vmsp > $vmstack_base
 124     output $orig_vmsp - $vmsp
 125     sputs "\t"
 126     output $vmsp
 127     sputs "\t"
 128     gwrite *$vmsp
 129     set $vmsp=$vmsp-1
 130   end
 131   newline
 132   sputs "Frame "
 133   output $vmframe
 134   newline
 135   sputs "ra:\t"
 136   output $vmsp
 137   sputs "\t"
 138   output (SCM*)*$vmsp
 139   set $vmsp=$vmsp-1
 140   newline
 141   sputs "mvra:\t"
 142   output $vmsp
 143   sputs "\t"
 144   output (SCM*)*$vmsp
 145   set $vmsp=$vmsp-1
 146   newline
 147   sputs "dl:\t"
 148   output $vmsp
 149   sputs "\t"
 150   set $vmdl=(SCM*)(*$vmsp)
 151   output $vmdl
 152   newline
 153   set $vmsp=$vmsp-1
 154   set $vmnlocs=(int)$vmbp->nlocs
 155   while $vmnlocs > 0
 156     sputs "loc #"
 157     output $vmnlocs
 158     sputs ":\t"
 159     output $vmsp
 160     sputs "\t"
 161     gwrite *$vmsp
 162     set $vmsp=$vmsp-1
 163     set $vmnlocs=$vmnlocs-1
 164   end
 165   set $vmnargs=(int)$vmbp->nargs
 166   while $vmnargs > 0
 167     sputs "arg #"
 168     output $vmnargs
 169     sputs ":\t"
 170     output $vmsp
 171     sputs "\t"
 172     gwrite *$vmsp
 173     set $vmsp=$vmsp-1
 174     set $vmnargs=$vmnargs-1
 175   end
 176   sputs "prog:\t"
 177   output $vmsp
 178   sputs "\t"
 179   gwrite *$vmsp
 180   set $vmsp=$vmsp-1
 181   newline
 182   if $vmdl
 183     set $vmfp=$vmdl
 184     set $vmbp=(struct scm_objcode*)((SCM*)(((SCM*)($vmfp[-1]))[1])[1])
 185     set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4
 186     set $vmframe=$vmframe+1
 187     newline
 188   end
 189 end
 190
 191 define vmstack
 192   vmstackinit
 193   while $vmsp > vp->stack_base
 194     nextframe
 195   end
 196 end
 197
 198 define inst
 199   p scm_instruction_table[$arg0]
 200 end
 201
 202 define gbt
 203   call scm_display_backtrace (scm_make_stack(0x404,0x304), scm_current_error_port (), 0x704, 0x704, 0x704)
 204 end