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

mk-gdbinit.ss updates

Browse Source 
Cleaned up pso output in gdb

svn: r11590
This commit is contained in:
Kevin Tew 2008-09-09 15:52:20 +00:00
parent 7068de8f67
commit 04500805cc
1 changed files with 270 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

163
src/mzscheme/mk-gdbinit.ss
View File

@ -18,6 +18,7 @@
(define template #<<EOS
define pso
psox $arg0 0
printf "\n"
end
document pso
Print Scheme Object
@ -31,6 +32,19 @@ define indent
end
end
define psonn
set $O = ((Scheme_Object*) ($arg0))
if (((int)$arg0) & 0x1)
set $OT = <<scheme_integer_type>>
else
set $OT = $O->type
end
printf "Scheme_Object %p type=%d", $O, $OT
end
document psonn
print scheme object summary no newline
end
define psox
set $O = ((Scheme_Object*) ($arg0))
indent $arg1
@ -39,15 +53,14 @@ define psox
else
set $OT = $O->type
end
printf "Scheme_Object %p type=%d\n", $O, $OT
printf "Scheme_Object %p type=%d ", $O, $OT
psoq $O $arg1
end
define psoq
indent $arg1
if (((int)$arg0) & 0x1)
if (((int)$arg0) & 0x1)
printf "scheme_integer_type %d", (((int)$arg0) >> 1)
else
else
set $O = ((Scheme_Object*) ($arg0))
set $OT = $O->type
if ( $OT == <<scheme_toplevel_type>> )
@ -61,6 +74,25 @@ else
printf "scheme_syntax_type index=%d\n", $index
psox $object $arg1+1
end
if ( $OT == <<scheme_application_type>> )
set $AP = ((Scheme_App_Rec*) ($O))
set $size = $AP->num_args
printf "scheme_application_type - args %i\n", $size
set $RATOR = $AP->args[0]
indent $arg1
printf "rator="
psox $RATOR $arg1+1
set $cnt = 1
while ( $cnt < $size )
indent $arg1
printf "rand%i = ", ($cnt - 1)
psonn $AP->args[$cnt]
printf "\n"
set $cnt++
end
set $OT = 0
end
if ( $OT == <<scheme_application2_type>> )
printf "scheme_application2_type\n"
set $AP = ((Scheme_App2_Rec*) ($O))
@ -70,45 +102,120 @@ else
printf "rator="
psox $RATOR $arg1+1
indent $arg1
printf "rand="
printf "rand1="
psox $RAND $arg1+1
end
if ( $OT == <<scheme_application3_type>> )
printf "scheme_application3_type\n"
set $AP = ((Scheme_App3_Rec*) ($O))
set $RATOR = $AP->rator
set $RAND1 = $AP->rand1
set $RAND2 = $AP->rand2
indent $arg1
printf "rator="
psox $RATOR $arg1+1
indent $arg1
printf "rand1="
psox $RAND1 $arg1+1
indent $arg1
printf "rand2="
psox $RAND2 $arg1+1
end
if ( $OT == <<scheme_unclosed_procedure_type>> )
set $unclosure = ((Scheme_Closure_Data *) $O)
#set $name = $code->name
set $param_num = $unclosure->num_params
printf "scheme_unclosed_procedure_type - num_params %i\n", $param_num
psox $unclosure->code $arg1+1
set $OT = <<scheme_unclosed_procedure_type>>
end
if ( $OT == <<scheme_sequence_type>> )
printf "scheme_sequence\n"
set $seq = ((Scheme_Sequence *) $O)
p *$seq
set $size = $seq->count
printf "scheme_sequence - size %i\n", $size
set $cnt = 0
while ( $cnt < $size )
p $cnt
p $seq->array[$cnt]
psox $seq->array[$cnt] $arg1+1
indent $arg1
printf "%i - ", $cnt
psonn $seq->array[$cnt]
printf "\n"
#psox $seq->array[$cnt] $arg1+2
set $cnt++
end
$OT = 0
set $OT = 0
end
if ( $OT == <<scheme_branch_type>>)
set $breq = ((Scheme_Branch_Rec *) $O)
printf "scheme_branch_type\n"
indent $arg1
printf "test - "
psonn $breq->test
printf "\n"
indent $arg1
printf "trueb - "
psonn $breq->tbranch
printf "\n"
indent $arg1
printf "falseb - "
psonn $breq->fbranch
printf "\n"
end
if ( $OT == <<scheme_variable_type>> )
printf "scheme_variable_type\n"
set $bucket = ((Scheme_Bucket *) $O)
psonn $bucket->val
end
if ( $OT == <<scheme_prim_type>> )
printf "scheme_prim_type\n"
set $pproc = ((Scheme_Primitive_Proc *) $O)
p *$pproc
end
if ( $OT == <<scheme_let_one_type>> )
printf "scheme_let_one_type\n"
set $letone = ((Scheme_Let_One *) $O)
indent $arg1+1
printf "value %p\n", $letone->value
indent $arg1+1
printf "body %p\n", $letone->body
end
if ( $OT == <<scheme_closure_type>> )
printf "scheme_closure_type\n"
set $closure = ((Scheme_Closure *) $O)
p *$closure
set $code = $closure->code
printf "scheme_closure_type code1\n"
p *$code
set $name = $code->name
p *$name
#psox $name $arg+1
printf "scheme_closure_type code2\n"
psox $code->code $arg+1
$OT = <<scheme_closure_type>>
psox $code $arg1+1
set $OT = <<scheme_closure_type>>
end
if ( $OT == <<scheme_case_closure_type>> )
set $cclosure = ((Scheme_Case_Lambda *) $O)
set $size = $cclosure->count
printf "scheme_case_closure_type - size %i\n", $size
indent $arg1+1
printf "name - "
set $name = $cclosure->name
psox $name $arg1+1
printf "\n"
set $scc_cnt = 0
while ( $scc_cnt < $size )
indent $arg1+1
printf "%i - ", $scc_cnt
psox $cclosure->array[$scc_cnt] $arg1+1
set $scc_cnt++
end
set $OT = <<scheme_case_closure_type>>
end
if ( $OT == <<scheme_structure_type>>)
printf "scheme_structure_type\n"
end
if ( $OT == <<scheme_char_string_type>>)
printf "scheme_char_string_type "
set $scharp = ((Scheme_Simple_Object *)$O)->u.byte_str_val.string_val
while ( *$scharp != 0 )
printf "%c", *$scharp
set $scharp = $scharp + 4
end
end
if ( $OT == <<scheme_unix_path_type>>)
printf "scheme_unix_path_type "
p (char *)((Scheme_Simple_Object *)$O)->u.byte_str_val.string_val
@ -137,8 +244,11 @@ else
printf "scheme_vector_type size=%d\n", $size
set $cnt = 0
while ( $cnt < $size )
p $cnt
psox $vector->els[$cnt] $arg1+1
indent $arg1
printf "%i - ", $cnt
psonn $vector->els[$cnt]
printf "\n"
#psox $vector->els[$cnt] $arg1+2
set $cnt++
end
end
@ -180,7 +290,7 @@ else
if ( $OT == <<scheme_stx_type>> )
printf "scheme_stx_type\n"
set $stx = ((Scheme_Stx*) $O)
p *$stx
#p *$stx
indent $arg1
printf "content="
psox $stx->val $arg1+1
@ -200,13 +310,14 @@ else
printf "scheme_module_type\n"
set $module = ((Scheme_Module*)$O)
psox $module->modname $arg1+1
set $OT = 0
end
if ( $OT == <<scheme_resolved_module_path_type>>)
set $OO = (((Scheme_Small_Object *)$arg0)->u.ptr_val)
printf "scheme_resolved_module_path_type %s %p", (char *)((Scheme_Symbol*) $OO)->s, $OO
psox $OO $arg1+1
set $OT = 0
end
end
end
printf "\n"
end
document psoq
print scheme object quiet