gdbinit

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