suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

mz-gdbinit updates

Browse Source
This commit is contained in:
Kevin Tew 2011-05-06 17:30:26 -06:00
parent 85ef1e2153
commit a09a4edcc3
1 changed files with 39 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/racket/mk-gdbinit.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
;; This script generates "mz-gdbinit" to the current directory. ;; This script generates "mz-gdbinit" to the current directory.
;; It's normally run via `make mz-gdbinit', in which case ;; It's normally run via `make mz-gdbinit', in which case
@ -71,13 +71,13 @@ define psoq
set $TL = ((Scheme_Toplevel*) ($O)) set $TL = ((Scheme_Toplevel*) ($O))
printf "scheme_toplevel_type depth=%d position=%d", $TL->depth, $TL->position printf "scheme_toplevel_type depth=%d position=%d", $TL->depth, $TL->position
end end
if ( $OT == <<scheme_syntax_type>> ) # if ( $OT == <<scheme_symbol_type>> )
set $SSO = ((Scheme_Simple_Object*) ($O)) # set $SSO = ((Scheme_Simple_Object*) ($O))
set $index = $SSO->u.ptr_int_val.pint # set $index = $SSO->u.ptr_int_val.pint
set $object = (Scheme_Object *) $SSO->u.ptr_int_val.ptr # set $object = (Scheme_Object *) $SSO->u.ptr_int_val.ptr
printf "scheme_syntax_type index=%d\n", $index # printf "scheme_syntax_type index=%d\n", $index
psox $object $arg1+1 # psox $object $arg1+1
end # end
if ( $OT == <<scheme_application_type>> ) if ( $OT == <<scheme_application_type>> )
set $AP = ((Scheme_App_Rec*) ($O)) set $AP = ((Scheme_App_Rec*) ($O))
set $size = $AP->num_args set $size = $AP->num_args
@ -210,7 +210,34 @@ define psoq
set $OT = <<scheme_case_closure_type>> set $OT = <<scheme_case_closure_type>>
end end
if ( $OT == <<scheme_structure_type>>) if ( $OT == <<scheme_structure_type>>)
printf "scheme_structure_type\n" set $st = ((struct Scheme_Structure *) $O)
set $size = $st->stype->num_slots
printf "scheme_structure_type slots %d\n", $size
set $cnt = 0
while ( $cnt < $size )
indent $arg1
printf "%i - ", $cnt
psonn $st->slots[$cnt]
printf "\n"
#psox $st->slots[$cnt] $arg1+2
set $cnt++
end
end
if ( $OT == <<scheme_serialized_structure_type>>)
set $st = ((struct Scheme_Serialized_Structure *) $O)
set $size = $st->num_slots
printf "scheme_serialized_structure_type slots %d\n", $size
indent $arg1
psonn $st->prefab_key
set $cnt = 0
while ( $cnt < $size )
indent $arg1
printf "%i - ", $cnt
psonn $st->slots[$cnt]
printf "\n"
#psox $st->slots[$cnt] $arg1+2
set $cnt++
end
end end
if ( $OT == <<scheme_char_string_type>>) if ( $OT == <<scheme_char_string_type>>)
printf "scheme_char_string_type " printf "scheme_char_string_type "
@ -231,6 +258,9 @@ define psoq
if ( $OT == <<scheme_symbol_type>> ) if ( $OT == <<scheme_symbol_type>> )
printf "scheme_symbol_type %s", (char *)((Scheme_Symbol*) $O)->s printf "scheme_symbol_type %s", (char *)((Scheme_Symbol*) $O)->s
end end
if ( $OT == <<scheme_serialized_symbol_type>> )
printf "scheme_serialized_symbol_type %s", (char *)((Scheme_Symbol*) $O)->s
end
if ( $OT == <<scheme_null_type>> ) if ( $OT == <<scheme_null_type>> )
printf "scheme_null" printf "scheme_null"
end end