# -*- GDB-Script -*-
+handle SIGPWR noprint nostop
+handle SIGXCPU noprint nostop
+
define newline
call (void)scm_newline (scm_current_error_port ())
end
smobwordtox $arg0 1
end
-define program
+define program_objcode
smobdatatox $arg0
- p *(struct scm_program*)$x
+ set $objcode=$x
+ smobdatatox $objcode
+ p *(struct scm_objcode*)$x
end
define proglocals
output $vmdl
newline
set $vmsp=$vmsp-1
- sputs "hl:\t"
- output $vmsp
- sputs "\t"
- gwrite *$vmsp
- set $vmsp=$vmsp-1
- sputs "el:\t"
- output $vmsp
- sputs "\t"
- gwrite *$vmsp
- set $vmsp=$vmsp-1
set $vmnlocs=(int)$vmbp->nlocs
while $vmnlocs > 0
sputs "loc #"
gwrite *$vmsp
set $vmsp=$vmsp-1
newline
- if !$vmdl
- loop_break
+ if $vmdl
+ set $vmfp=$vmdl
+ set $vmbp=(struct scm_objcode*)((SCM*)(((SCM*)($vmfp[-1]))[1])[1])
+ set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4
+ set $vmframe=$vmframe+1
+ newline
end
- set $vmfp=$vmdl
- set $vmbp=(struct scm_program*)(((SCM*)($vmfp[-1]))[1])
- set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4
- set $vmframe=$vmframe+1
- newline
end
define vmstack
define inst
p scm_instruction_table[$arg0]
end
+
+define gbt
+ call scm_display_backtrace (scm_make_stack(0x404,0x304), scm_current_error_port (), 0x704, 0x704, 0x704)
+end