mk-gdbinit.ss updates
Cleaned up pso output in gdb svn: r11590
This commit is contained in:
Kevin Tew
parent
7068de8f67
commit
04500805cc
|
|
@ -18,6 +18,7 @@
|
||||||
(define template #<<EOS
|
(define template #<<EOS
|
||||||
define pso
|
define pso
|
||||||
psox $arg0 0
|
psox $arg0 0
|
||||||
|
printf "\n"
|
||||||
end
|
end
|
||||||
document pso
|
document pso
|
||||||
Print Scheme Object
|
Print Scheme Object
|
||||||
|
|
@ -31,6 +32,19 @@ define indent
|
||||||
end
|
end
|
||||||
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
|
define psox
|
||||||
set $O = ((Scheme_Object*) ($arg0))
|
set $O = ((Scheme_Object*) ($arg0))
|
||||||
indent $arg1
|
indent $arg1
|
||||||
|
|
@ -39,174 +53,271 @@ define psox
|
||||||
else
|
else
|
||||||
set $OT = $O->type
|
set $OT = $O->type
|
||||||
end
|
end
|
||||||
printf "Scheme_Object %p type=%d\n", $O, $OT
|
printf "Scheme_Object %p type=%d ", $O, $OT
|
||||||
psoq $O $arg1
|
psoq $O $arg1
|
||||||
end
|
end
|
||||||
|
|
||||||
define psoq
|
define psoq
|
||||||
indent $arg1
|
if (((int)$arg0) & 0x1)
|
||||||
if (((int)$arg0) & 0x1)
|
printf "scheme_integer_type %d", (((int)$arg0) >> 1)
|
||||||
printf "scheme_integer_type %d", (((int)$arg0) >> 1)
|
else
|
||||||
else
|
set $O = ((Scheme_Object*) ($arg0))
|
||||||
set $O = ((Scheme_Object*) ($arg0))
|
set $OT = $O->type
|
||||||
set $OT = $O->type
|
if ( $OT == <<scheme_toplevel_type>> )
|
||||||
if ( $OT == <<scheme_toplevel_type>> )
|
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
|
|
||||||
if ( $OT == <<scheme_syntax_type>> )
|
|
||||||
set $SSO = ((Scheme_Simple_Object*) ($O))
|
|
||||||
set $index = $SSO->u.ptr_int_val.pint
|
|
||||||
set $object = (Scheme_Object *) $SSO->u.ptr_int_val.ptr
|
|
||||||
printf "scheme_syntax_type index=%d\n", $index
|
|
||||||
psox $object $arg1+1
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_application2_type>> )
|
|
||||||
printf "scheme_application2_type\n"
|
|
||||||
set $AP = ((Scheme_App2_Rec*) ($O))
|
|
||||||
set $RATOR = $AP->rator
|
|
||||||
set $RAND = $AP->rand
|
|
||||||
indent $arg1
|
|
||||||
printf "rator="
|
|
||||||
psox $RATOR $arg1+1
|
|
||||||
indent $arg1
|
|
||||||
printf "rand="
|
|
||||||
psox $RAND $arg1+1
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_sequence_type>> )
|
|
||||||
printf "scheme_sequence\n"
|
|
||||||
set $seq = ((Scheme_Sequence *) $O)
|
|
||||||
p *$seq
|
|
||||||
set $size = $seq->count
|
|
||||||
set $cnt = 0
|
|
||||||
while ( $cnt < $size )
|
|
||||||
p $cnt
|
|
||||||
p $seq->array[$cnt]
|
|
||||||
psox $seq->array[$cnt] $arg1+1
|
|
||||||
set $cnt++
|
|
||||||
end
|
end
|
||||||
$OT = 0
|
if ( $OT == <<scheme_syntax_type>> )
|
||||||
end
|
set $SSO = ((Scheme_Simple_Object*) ($O))
|
||||||
if ( $OT == <<scheme_prim_type>> )
|
set $index = $SSO->u.ptr_int_val.pint
|
||||||
printf "scheme_prim_type\n"
|
set $object = (Scheme_Object *) $SSO->u.ptr_int_val.ptr
|
||||||
set $pproc = ((Scheme_Primitive_Proc *) $O)
|
printf "scheme_syntax_type index=%d\n", $index
|
||||||
p *$pproc
|
psox $object $arg1+1
|
||||||
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>>
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_structure_type>>)
|
|
||||||
printf "scheme_structure_type\n"
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_unix_path_type>>)
|
|
||||||
printf "scheme_unix_path_type "
|
|
||||||
p (char *)((Scheme_Simple_Object *)$O)->u.byte_str_val.string_val
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_symbol_type>> )
|
|
||||||
printf "scheme_symbol_type %s", (char *)((Scheme_Symbol*) $O)->s
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_null_type>> )
|
|
||||||
printf "scheme_null"
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_pair_type>> )
|
|
||||||
printf "scheme_pair\n"
|
|
||||||
set $SSO = ((Scheme_Simple_Object*) ($O))
|
|
||||||
set $CAR = $SSO->u.pair_val.car
|
|
||||||
set $CDR = $SSO->u.pair_val.cdr
|
|
||||||
indent $arg1
|
|
||||||
printf "car=\n"
|
|
||||||
psox $CAR $arg1+1
|
|
||||||
indent $arg1
|
|
||||||
printf "cdr=\n"
|
|
||||||
psox $CDR $arg1+1
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_vector_type>> )
|
|
||||||
set $vector = ((struct Scheme_Vector *) $O)
|
|
||||||
set $size = $vector->size
|
|
||||||
printf "scheme_vector_type size=%d\n", $size
|
|
||||||
set $cnt = 0
|
|
||||||
while ( $cnt < $size )
|
|
||||||
p $cnt
|
|
||||||
psox $vector->els[$cnt] $arg1+1
|
|
||||||
set $cnt++
|
|
||||||
end
|
end
|
||||||
end
|
if ( $OT == <<scheme_application_type>> )
|
||||||
if ( $OT == <<scheme_true_type>> )
|
set $AP = ((Scheme_App_Rec*) ($O))
|
||||||
printf "scheme_true"
|
set $size = $AP->num_args
|
||||||
end
|
printf "scheme_application_type - args %i\n", $size
|
||||||
if ( $OT == <<scheme_false_type>> )
|
set $RATOR = $AP->args[0]
|
||||||
printf "scheme_false"
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_void_type>> )
|
|
||||||
printf "scheme_void"
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_hash_table_type>> )
|
|
||||||
psht $O $arg1
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_module_index_type>> )
|
|
||||||
printf "scheme_module_index_type\n"
|
|
||||||
set $modidx = ((Scheme_Modidx *) $O)
|
|
||||||
indent $arg1
|
|
||||||
printf "path="
|
|
||||||
psox $modidx->path $arg1+1
|
|
||||||
indent $arg1
|
|
||||||
printf "base="
|
|
||||||
psox $modidx->base $arg1+1
|
|
||||||
indent $arg1
|
|
||||||
printf "resolved="
|
|
||||||
psox $modidx->resolved $arg1+1
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_namespace_type>>)
|
|
||||||
printf "scheme_namespace_type\n"
|
|
||||||
set $env = ((Scheme_Env*)$O)
|
|
||||||
if ($env->module != 0)
|
|
||||||
psox $env->module $arg1+1
|
|
||||||
else
|
|
||||||
indent $arg1
|
indent $arg1
|
||||||
printf "top-level\n"
|
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))
|
||||||
|
set $RATOR = $AP->rator
|
||||||
|
set $RAND = $AP->rand
|
||||||
|
indent $arg1
|
||||||
|
printf "rator="
|
||||||
|
psox $RATOR $arg1+1
|
||||||
|
indent $arg1
|
||||||
|
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>> )
|
||||||
|
set $seq = ((Scheme_Sequence *) $O)
|
||||||
|
set $size = $seq->count
|
||||||
|
printf "scheme_sequence - size %i\n", $size
|
||||||
|
set $cnt = 0
|
||||||
|
while ( $cnt < $size )
|
||||||
|
indent $arg1
|
||||||
|
printf "%i - ", $cnt
|
||||||
|
psonn $seq->array[$cnt]
|
||||||
|
printf "\n"
|
||||||
|
#psox $seq->array[$cnt] $arg1+2
|
||||||
|
set $cnt++
|
||||||
|
end
|
||||||
|
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)
|
||||||
|
set $code = $closure->code
|
||||||
|
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
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_symbol_type>> )
|
||||||
|
printf "scheme_symbol_type %s", (char *)((Scheme_Symbol*) $O)->s
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_null_type>> )
|
||||||
|
printf "scheme_null"
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_pair_type>> )
|
||||||
|
printf "scheme_pair\n"
|
||||||
|
set $SSO = ((Scheme_Simple_Object*) ($O))
|
||||||
|
set $CAR = $SSO->u.pair_val.car
|
||||||
|
set $CDR = $SSO->u.pair_val.cdr
|
||||||
|
indent $arg1
|
||||||
|
printf "car=\n"
|
||||||
|
psox $CAR $arg1+1
|
||||||
|
indent $arg1
|
||||||
|
printf "cdr=\n"
|
||||||
|
psox $CDR $arg1+1
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_vector_type>> )
|
||||||
|
set $vector = ((struct Scheme_Vector *) $O)
|
||||||
|
set $size = $vector->size
|
||||||
|
printf "scheme_vector_type size=%d\n", $size
|
||||||
|
set $cnt = 0
|
||||||
|
while ( $cnt < $size )
|
||||||
|
indent $arg1
|
||||||
|
printf "%i - ", $cnt
|
||||||
|
psonn $vector->els[$cnt]
|
||||||
|
printf "\n"
|
||||||
|
#psox $vector->els[$cnt] $arg1+2
|
||||||
|
set $cnt++
|
||||||
|
end
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_true_type>> )
|
||||||
|
printf "scheme_true"
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_false_type>> )
|
||||||
|
printf "scheme_false"
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_void_type>> )
|
||||||
|
printf "scheme_void"
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_hash_table_type>> )
|
||||||
|
psht $O $arg1
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_module_index_type>> )
|
||||||
|
printf "scheme_module_index_type\n"
|
||||||
|
set $modidx = ((Scheme_Modidx *) $O)
|
||||||
|
indent $arg1
|
||||||
|
printf "path="
|
||||||
|
psox $modidx->path $arg1+1
|
||||||
|
indent $arg1
|
||||||
|
printf "base="
|
||||||
|
psox $modidx->base $arg1+1
|
||||||
|
indent $arg1
|
||||||
|
printf "resolved="
|
||||||
|
psox $modidx->resolved $arg1+1
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_namespace_type>>)
|
||||||
|
printf "scheme_namespace_type\n"
|
||||||
|
set $env = ((Scheme_Env*)$O)
|
||||||
|
if ($env->module != 0)
|
||||||
|
psox $env->module $arg1+1
|
||||||
|
else
|
||||||
|
indent $arg1
|
||||||
|
printf "top-level\n"
|
||||||
|
end
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_stx_type>> )
|
||||||
|
printf "scheme_stx_type\n"
|
||||||
|
set $stx = ((Scheme_Stx*) $O)
|
||||||
|
#p *$stx
|
||||||
|
indent $arg1
|
||||||
|
printf "content="
|
||||||
|
psox $stx->val $arg1+1
|
||||||
|
set $srcloc = $stx->srcloc
|
||||||
|
set $name = ($stx->srcloc->src)
|
||||||
|
set $name = (char *)((Scheme_Simple_Object *)$name)->u.byte_str_val.string_val
|
||||||
|
indent $arg1
|
||||||
|
printf "%s:%i:%i\n", $name, $srcloc->line, $srcloc->col
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_compilation_top_type>>)
|
||||||
|
printf "scheme_compilation_top_type\n"
|
||||||
|
set $top = ((Scheme_Compilation_Top*)$O)
|
||||||
|
p *$top
|
||||||
|
psox $top->code $arg1+1
|
||||||
|
end
|
||||||
|
if ( $OT == <<scheme_module_type>>)
|
||||||
|
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)
|
||||||
|
psox $OO $arg1+1
|
||||||
|
set $OT = 0
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
if ( $OT == <<scheme_stx_type>> )
|
|
||||||
printf "scheme_stx_type\n"
|
|
||||||
set $stx = ((Scheme_Stx*) $O)
|
|
||||||
p *$stx
|
|
||||||
indent $arg1
|
|
||||||
printf "content="
|
|
||||||
psox $stx->val $arg1+1
|
|
||||||
set $srcloc = $stx->srcloc
|
|
||||||
set $name = ($stx->srcloc->src)
|
|
||||||
set $name = (char *)((Scheme_Simple_Object *)$name)->u.byte_str_val.string_val
|
|
||||||
indent $arg1
|
|
||||||
printf "%s:%i:%i\n", $name, $srcloc->line, $srcloc->col
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_compilation_top_type>>)
|
|
||||||
printf "scheme_compilation_top_type\n"
|
|
||||||
set $top = ((Scheme_Compilation_Top*)$O)
|
|
||||||
p *$top
|
|
||||||
psox $top->code $arg1+1
|
|
||||||
end
|
|
||||||
if ( $OT == <<scheme_module_type>>)
|
|
||||||
printf "scheme_module_type\n"
|
|
||||||
set $module = ((Scheme_Module*)$O)
|
|
||||||
psox $module->modname $arg1+1
|
|
||||||
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
|
|
||||||
end
|
|
||||||
end
|
|
||||||
printf "\n"
|
|
||||||
end
|
end
|
||||||
document psoq
|
document psoq
|
||||||
print scheme object quiet
|
print scheme object quiet
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user