gdbinit

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