| 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 |