aboutsummaryrefslogtreecommitdiffstats
path: root/erts/etc/unix/etp-commands.in
diff options
context:
space:
mode:
Diffstat (limited to 'erts/etc/unix/etp-commands.in')
-rw-r--r--erts/etc/unix/etp-commands.in698
1 files changed, 672 insertions, 26 deletions
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index 54ff7b3e3a..19c92681d0 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2005-2012. All Rights Reserved.
+# Copyright Ericsson AB 2005-2014. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -54,13 +54,23 @@ document etp-help
% etp-mfa, etp-cp,
% etp-msgq, etpf-msgq,
% etp-stacktrace, etp-stackdump, etpf-stackdump, etp-dictdump
-% etp-offheapdump, etpf-offheapdump,
-% etp-print-procs, etp-search-heaps, etp-search-alloc,
+% etp-process-info, etp-process-memory-info
+% etp-port-info, etp-port-state, etp-port-sched-flags
+% etp-heapdump, etp-offheapdump, etpf-offheapdump,
+% etp-search-heaps, etp-search-alloc,
% etp-ets-tables, etp-ets-tabledump
%
% Complex commands that use the Erlang support module.
% etp-overlapped-heaps, etp-chart, etp-chart-start, etp-chart-end
-%
+%
+% System inspection
+% etp-system-info, etp-schedulers, etp-process, etp-ports, etp-lc-dump,
+% etp-migration-info, etp-processes-memory,
+% etp-compile-info, etp-config-h-info
+%
+% Platform specific (when gdb fails you)
+% etp-ppc-stacktrace
+%
% Erlang support module handling commands:
% etp-run
%
@@ -652,7 +662,7 @@ end
define etp-ct-atom-1
# Args: int
#
-# Determines if integer is a atom first character
+# Determines if integer is an atom first character
#
# Non-reentrant
# Returns: $etp_ct_atom
@@ -1055,7 +1065,9 @@ define etp-cp-1
set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2
end
if $etp_cp_p
- set $etp_cp_low = (Eterm**)($etp_cp_p->start + 8)
+ # 12 = MI_FUNCTIONS
+ set $etp_cp_low = (Eterm**)($etp_cp_p->start + 12)
+ # 0 = MI_NUM_FUNCTIONS
set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0]
set $etp_cp_p = 0
while $etp_cp_low < $etp_cp_high
@@ -1278,6 +1290,250 @@ document etpf-stackdump
%---------------------------------------------------------------------------
end
+define etp-heapdump
+# Args: Process*
+#
+# Non-reentrant
+ etp-heapdump-1 ($arg0)->heap ($arg0)->htop
+end
+
+document etp-heapdump
+%---------------------------------------------------------------------------
+% etp-heapdump Process*
+%
+% Take an Process* and print a heapdump for the process heap.
+%---------------------------------------------------------------------------
+end
+
+define etp-heapdump-old
+# Args: Process*
+#
+# Non-reentrant
+ etp-heapdump-1 ($arg0)->old_heap ($arg0)->old_htop
+end
+
+document etp-heapdump
+%---------------------------------------------------------------------------
+% etp-heapdump-old Process*
+%
+% Take an Process* and print a heapdump for the process old heap (gen-heap).
+%---------------------------------------------------------------------------
+end
+
+
+define etp-heapdump-1
+# Args: Eterm* heap, Eterm* htop
+#
+# Non-reentrant
+ set $etp_heapdump_heap = (Eterm*)($arg0)
+ set $etp_heapdump_p = (Eterm*)($arg0)
+ set $etp_heapdump_end = (Eterm*)($arg1)
+ set $etp_heapdump_skips = 0
+ printf "%% heapdump (%u):\n", $etp_heapdump_end-$etp_heapdump_p
+ while $etp_heapdump_p < $etp_heapdump_end
+ set $etp_heapdump_ix = 0
+ printf " %p: ", $etp_heapdump_p
+ while $etp_heapdump_p < $etp_heapdump_end && $etp_heapdump_ix < 8
+ if ($etp_heapdump_skips > 0)
+ printf "| 0x%08x ", ($etp_heapdump_p)
+ set $etp_heapdump_skips--
+ else
+ etp-term-dump $etp_heapdump_p[0]
+ end
+ set $etp_heapdump_p++
+ set $etp_heapdump_ix++
+ end
+ printf "\n"
+ end
+end
+
+
+define etp-term-dump
+# Args: Eterm
+ if (($arg0) & 0x3) == 0
+ etp-term-dump-header ($arg0)
+ else
+ if (($arg0) & 0x3) == 1
+ # Cons pointer
+ set $etp_term_dump_cons_p = ((Eterm*)(($arg0) & ~0x3))
+ if $etp_term_dump_cons_p > $etp_heapdump_heap && $etp_term_dump_cons_p < $etp_heapdump_end
+ printf "| C:0x%08x ", $etp_term_dump_cons_p
+ #printf "| C: --> %5d ", $etp_heapdump_p - $etp_term_dump_cons_p - 1
+ else
+ printf "| C:0x%08x ", $etp_term_dump_cons_p
+ end
+ else
+ if (($arg0) & 0x3) == 2
+ # Box pointer
+ printf "| B:0x%08x ", ($arg0)
+ else
+ if (($arg0) & 0x3) == 3
+ # immediate
+ etp-term-dump-immediate ($arg0)
+ else
+ printf "| U:0x%08x ", ($arg0)
+ end
+ end
+ end
+ end
+end
+
+define etp-term-dump-immediate
+# Args: immediate term
+ if (($arg0) & 0xF) == 0xf
+ # Fixnum
+ etp-ct-printable-1 ((long)((Sint)($arg0)>>4))
+ if $etp_ct_printable
+ if $etp_ct_printable < 0
+ printf "| I: %c (%3ld) ", (long)((Sint)($arg0)>>4), (long)((Sint)($arg0)>>4)
+ else
+ printf "| I: \\%c (%3ld) ", (long)((Sint)($arg0)>>4), (long)((Sint)($arg0)>>4)
+ end
+ else
+ printf "| I:%10ld ", (long)((Sint)($arg0)>>4)
+ end
+ else
+ if (($arg0) & 0xF) == 0x3
+ etp-term-dump-pid ($arg0)
+ else
+ if (($arg0) & 0xF) == 0x7
+ printf "| port:0x%05x ", ($arg0)
+ else
+ # Immediate2 - 0xB
+ if (($arg0) & 0x3f) == 0x0b
+ etp-term-dump-atom ($arg0)
+ else
+ if (($arg0) & 0x3f) == 0x1b
+ printf "| #Catch<%06d> ", ($arg0)>>6
+ else
+ if (($arg0) == $etp_nil)
+ printf "| [] (NIL) "
+ else
+ printf "| I:0x%08x ", ($arg0)
+ end
+ end
+ end
+ end
+ end
+ end
+end
+
+define etp-term-dump-atom
+# Args: atom term
+ set $etp_atom_1_ap = (Atom*)erts_atom_table.seg_table[(Eterm)($arg0)>>16][((Eterm)($arg0)>>6)&0x3FF]
+ set $etp_atom_1_i = ($etp_atom_1_ap)->len
+ set $etp_atom_1_p = ($etp_atom_1_ap)->name
+ set $etp_atom_1_quote = 1
+ set $etp_atom_indent = 13
+
+ if ($etp_atom_1_i < 11)
+ if ($etp_atom_1_i > 0)
+ etp-ct-atom-1 (*$etp_atom_1_p)
+ if $etp_ct_atom
+ set $etp_atom_indent = 13
+ else
+ set $etp_atom_indent = 11
+ end
+ end
+ # perform indentation
+ printf "|"
+ while ($etp_atom_1_i < $etp_atom_indent)
+ printf " "
+ set $etp_atom_1_i++
+ end
+ set $etp_atom_1_i = ($etp_atom_1_ap)->len
+ # Check if atom has to be quoted
+ if ($etp_atom_1_i > 0)
+ etp-ct-atom-1 (*$etp_atom_1_p)
+ if $etp_ct_atom
+ # Atom start character
+ set $etp_atom_1_p++
+ set $etp_atom_1_i--
+ set $etp_atom_1_quote = 0
+ else
+ set $etp_atom_1_i = 0
+ end
+ end
+ while $etp_atom_1_i > 0
+ etp-ct-name-1 (*$etp_atom_1_p)
+ if $etp_ct_name
+ # Name character
+ set $etp_atom_1_p++
+ set $etp_atom_1_i--
+ else
+ set $etp_atom_1_quote = 1
+ set $etp_atom_1_i = 0
+ end
+ end
+ # Print the atom
+ if $etp_atom_1_quote
+ printf "'"
+ end
+ set $etp_atom_1_i = ($etp_atom_1_ap)->len
+ set $etp_atom_1_p = ($etp_atom_1_ap)->name
+ while $etp_atom_1_i > 0
+ etp-char-1 (*$etp_atom_1_p) '\''
+ set $etp_atom_1_p++
+ set $etp_atom_1_i--
+ end
+ if $etp_atom_1_quote
+ printf "'"
+ end
+ printf " "
+ else
+ printf "| A:0x%08x ", ($arg0)
+ end
+end
+
+define etp-term-dump-pid
+# Args: Eterm pid
+#
+# Non-reentrant
+#
+ set $etp_pid_1 = (Eterm)($arg0)
+ if ($etp_pid_1 & 0xF) == 0x3
+ if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_big_endian)
+ set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff)
+ else
+ set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff)
+ end
+ else
+ set $etp_pid_data = (unsigned) (((((Uint32) $etp_pid_1) >> 4) & ~erts_proc.r.o.pix_mask) | ((((Uint32) $etp_pid_1) >> (erts_proc.r.o.pix_cl_shift + 4)) & erts_proc.r.o.pix_cl_mask) | (((((Uint32) $etp_pid_1) >> 4) & erts_proc.r.o.pix_cli_mask) << erts_proc.r.o.pix_cli_shift))
+ end
+ # Internal pid
+ printf "| <0.%04u.%03u> ", $etp_pid_data & 0x7fff, ($etp_pid_data >> 15) & 0x1fff
+ else
+ printf "| #NotPid<%#x> ", ($arg0)
+ end
+end
+
+define etp-term-dump-header
+# Args: Header term
+ if (($arg0) & 0x3f) == 0
+ printf "| H:%4d-tuple ", ($arg0) >> 6
+ else
+ set $etp_heapdump_skips = ($arg0) >> 6
+ if ((($arg0) & 0x3f) == 0x18)
+ printf "| H: float %3d ", ($arg0) >> 6
+ else
+ if ((($arg0) & 0x3f) == 0x28)
+ # sub-binary
+ printf "| H: sub-bin "
+ else
+ if ((($arg0) & 0x3f) == 0x8)
+ # pos-bignum
+ printf "| H:bignum %3u ", ($arg0) >> 6
+ else
+ printf "| header %5d ", ($arg0) >> 6
+ end
+ end
+ end
+ end
+end
+
+
+
define etp-pid2pix-1
# Args: Eterm
#
@@ -1316,49 +1572,102 @@ end
define etp-proc-state-int
# Args: int
#
- if ($arg0 & 0xfffff000)
+ if ($arg0 & 0xff000000)
printf "GARBAGE | "
end
- if ($arg0 & 0x800)
+ if ($arg0 & 0x800000)
+ printf "delayed-sys | "
+ end
+ if ($arg0 & 0x400000)
+ printf "proxy | "
+ set $proxy_process = 1
+ else
+ set $proxy_process = 0
+ end
+ if ($arg0 & 0x200000)
+ printf "running-sys | "
+ end
+ if ($arg0 & 0x100000)
+ printf "active-sys | "
+ end
+ if ($arg0 & 0x80000)
printf "trapping-exit | "
end
- if ($arg0 & 0x400)
+ if ($arg0 & 0x40000)
printf "bound | "
end
- if ($arg0 & 0x200)
+ if ($arg0 & 0x20000)
printf "garbage-collecting | "
end
- if ($arg0 & 0x100)
+ if ($arg0 & 0x10000)
printf "suspended | "
end
- if ($arg0 & 0x80)
+ if ($arg0 & 0x8000)
printf "running | "
end
- if ($arg0 & 0x40)
+ if ($arg0 & 0x4000)
printf "in-run-queue | "
end
- if ($arg0 & 0x20)
+ if ($arg0 & 0x2000)
printf "active | "
end
- if ($arg0 & 0x10)
+ if ($arg0 & 0x1000)
printf "pending-exit | "
end
- if ($arg0 & 0x8)
+ if ($arg0 & 0x800)
printf "exiting | "
end
- if ($arg0 & 0x4)
+ if ($arg0 & 0x400)
printf "free | "
end
- if ($arg0 & 0x3) == 0
- printf "prio-max\n"
+ if ($arg0 & 0x200)
+ printf "in-prq-low | "
+ end
+ if ($arg0 & 0x100)
+ printf "in-prq-normal | "
+ end
+ if ($arg0 & 0x80)
+ printf "in-prq-high | "
+ end
+ if ($arg0 & 0x40)
+ printf "in-prq-max | "
+ end
+ if ($arg0 & 0x30) == 0x0
+ printf "prq-prio-max | "
else
- if ($arg0 & 0x3) == 1
- printf "prio-high\n"
+ if ($arg0 & 0x30) == 0x10
+ printf "prq-prio-high | "
else
- if ($arg0 & 0x3) == 2
- printf "prio-normal\n"
+ if ($arg0 & 0x30) == 0x20
+ printf "prq-prio-normal | "
else
- printf "prio-low\n"
+ printf "prq-prio-low | "
+ end
+ end
+ end
+ if ($arg0 & 0xc) == 0x0
+ printf "usr-prio-max | "
+ else
+ if ($arg0 & 0xc) == 0x4
+ printf "usr-prio-high | "
+ else
+ if ($arg0 & 0xc) == 0x8
+ printf "usr-prio-normal | "
+ else
+ printf "usr-prio-low | "
+ end
+ end
+ end
+ if ($arg0 & 0x3) == 0x0
+ printf "act-prio-max\n"
+ else
+ if ($arg0 & 0x3) == 0x1
+ printf "act-prio-high\n"
+ else
+ if ($arg0 & 0x3) == 0x2
+ printf "act-prio-normal\n"
+ else
+ printf "act-prio-low\n"
end
end
end
@@ -1392,9 +1701,15 @@ define etp-process-info
# Args: Process*
#
printf " Pid: "
- etp-1 $arg0->common.id
+ etp-1 ($arg0)->common.id
printf "\n State: "
etp-proc-state $arg0
+ if $proxy_process != 0
+ printf " Pointer: (Process *) %p\n", $arg0
+ printf " *** PROXY process struct *** refer to: \n"
+ etp-pid2proc-1 $arg0->common.id
+ etp-process-info $proc
+ else
if (*(((Uint32 *) &(((Process *) $arg0)->state))) & 0x4) == 0
if ($arg0->common.u.alive.reg)
printf " Registered name: "
@@ -1432,6 +1747,7 @@ define etp-process-info
printf " Parent: "
etp-1 $arg0->parent
printf "\n Pointer: (Process *) %p\n", $arg0
+ end
end
document etp-process-info
@@ -1463,11 +1779,104 @@ end
document etp-processes
%---------------------------------------------------------------------------
% etp-processes
-%
+%
% Print misc info about all processes
%---------------------------------------------------------------------------
end
+define etp-processes-memory
+ if (!erts_initialized)
+ printf "No processes, since system isn't initialized!\n"
+ else
+ set $proc_ix = 0
+ printf "--- (%ld processes in wheel)\n", erts_proc.r.o.max
+ while $proc_ix < erts_proc.r.o.max
+ set $proc = (Process *) *((UWord *) &erts_proc.r.o.tab[$proc_ix])
+ if ($proc != ((Process *) 0) && $proc != &erts_invalid_process)
+ etp-process-memory-info $proc
+ end
+ set $proc_ix++
+ end
+ printf "---\n",
+ end
+end
+
+document etp-processes-memory
+%---------------------------------------------------------------------------
+% etp-processes-memory
+%
+% Print memory info about all processes
+%---------------------------------------------------------------------------
+end
+
+define etp-process-memory-info
+# Args: Process*
+#
+ if ((*(((Uint32 *) &(((Process *) $arg0)->state)))) & 0x400000)
+ set $proxy_process = 1
+ else
+ set $proxy_process = 0
+ end
+ printf " "
+ etp-1 $arg0->common.id
+ printf ": (Process *) %p ", $arg0
+ if $proxy_process != 0
+ printf "(Process *) %p ", $arg0
+ printf " *** PROXY process struct *** refer to next: \n"
+ etp-pid2proc-1 $arg0->common.id
+ printf " -"
+ etp-process-memory-info $proc
+ else
+ printf " [Heap: %5ld", $arg0->heap_sz
+ if ($arg0->old_heap)
+ printf " | %5ld", $arg0->old_hend - $arg0->old_heap
+ else
+ printf " | none "
+ end
+ printf "] [Mbuf: %5ld", $arg0->mbuf_sz
+ if (etp_smp_compiled)
+ printf " | %3ld (%3ld | %3ld)", ($arg0->msg.len + $arg0->msg_inq.len), $arg0->msg.len, $arg0->msg_inq.len
+ else
+ printf " | %3ld", $arg0->msg.len
+ end
+ printf "] "
+ if ($arg0->i)
+ printf " I: "
+ etp-cp-1 $arg0->i
+ printf " "
+ end
+
+ if ($arg0->current)
+ etp-1 $arg0->current[0]
+ printf ":"
+ etp-1 $arg0->current[1]
+ printf "/%d ", $arg0->current[2]
+ end
+
+ if (*(((Uint32 *) &(((Process *) $arg0)->state))) & 0x4) == 0
+ if ($arg0->common.u.alive.reg)
+ etp-1 $arg0->common.u.alive.reg->name
+ printf " "
+ end
+ end
+
+ if ($arg0->cp)
+ printf " CP: "
+ etp-cp-1 $arg0->cp
+ printf " "
+ end
+ printf "\n"
+ end
+end
+
+document etp-process-memory-info
+%---------------------------------------------------------------------------
+% etp-process-memory-info Process*
+%
+% Print memory info about process
+%---------------------------------------------------------------------------
+end
+
define etp-port-id2pix-1
# Args: Eterm
#
@@ -2736,6 +3145,95 @@ document etp-ets-tabledump
%---------------------------------------------------------------------------
end
+define etp-lc-dump
+# Non-reentrant
+ set $etp_lc_dump_thread = erts_locked_locks
+ while $etp_lc_dump_thread
+ printf "Thread %s\n", $etp_lc_dump_thread->thread_name
+ set $etp_lc_dump_thread_locked = $etp_lc_dump_thread->locked.first
+ while $etp_lc_dump_thread_locked
+ if 0 <= $etp_lc_dump_thread_locked->id && $etp_lc_dump_thread_locked->id < sizeof(erts_lock_order)/sizeof(erts_lc_lock_order_t)
+ printf " %s:", erts_lock_order[$etp_lc_dump_thread_locked->id].name
+ else
+ printf " unkown:"
+ end
+ if ($etp_lc_dump_thread_locked->extra & 0x3) == 0x3
+ etp-1 $etp_lc_dump_thread_locked->extra
+ else
+ printf "%p", $etp_lc_dump_thread_locked->extra
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 0)
+ printf "[spinlock]"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 1)
+ printf "[rw(spin)lock]"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 2)
+ printf "[mutex]"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 3)
+ printf "[rwmutex]"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 4)
+ printf "[proclock]"
+ end
+ printf "(%s:%d)", $etp_lc_dump_thread_locked->file, $etp_lc_dump_thread_locked->line
+ if ($etp_lc_dump_thread_locked->flags & (0x60)) == (1 << 5)
+ printf "(r)"
+ end
+ if ($etp_lc_dump_thread_locked->flags & (0x60)) == ((1 << 5) | (1 << 6))
+ printf "(rw)"
+ end
+ printf "\n"
+ set $etp_lc_dump_thread_locked = $etp_lc_dump_thread_locked->next
+ end
+ set $etp_lc_dump_thread = $etp_lc_dump_thread->next
+ end
+end
+
+document etp-lc-dump
+%---------------------------------------------------------------------------
+% etp-lc-dump
+%
+% Dump all info about locks in the lock checker
+%---------------------------------------------------------------------------
+end
+
+define etp-ppc-stacktrace
+# Args: R1
+# Non-reentrant
+ set $etp_ppc_st_fp = ($arg0)
+ while $etp_ppc_st_fp
+ info symbol ((void**)$etp_ppc_st_fp)[1]
+ set $etp_ppc_st_fp = ((void**)$etp_ppc_st_fp)[0]
+ end
+end
+
+document etp-ppc-stacktrace
+%---------------------------------------------------------------------------
+% etp-ppc-stacktrace R1
+%
+% Dump stacktrace from given $r1 frame pointer
+%---------------------------------------------------------------------------
+end
+
+############################################################################
+# OSE support
+#
+define etp-ose-attach
+ target ose $arg0:21768
+ attach block start_beam start_beam
+end
+
+document etp-ose-attach
+%---------------------------------------------------------------------------
+% etp-ose-attach Host
+%
+% Connect and attach to erlang vm at Host.
+%---------------------------------------------------------------------------
+end
+
+
############################################################################
# Erlang support module handling
#
@@ -2762,6 +3260,154 @@ define etp-thr
end
############################################################################
+# erl_alloc_util (blocks and carriers)
+#
+
+define etp-block-size-1
+#
+# In: (Block_t*) in $arg0
+# Out: Byte size in $etp_blk_sz
+#
+ if ($arg0)->bhdr & 1
+ # Free block
+ set $etp_blk_sz = ($arg0)->bhdr & ~7
+ else
+ # Allocated block
+ if !$etp_MBC_ABLK_SZ_MASK
+ if etp_arch_bits == 64
+ set $etp_MBC_ABLK_OFFSET_SHIFT = (64 - 24)
+ else
+ set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9)
+ end
+ set $etp_MBC_ABLK_SZ_MASK = ((UWord)1 << $etp_MBC_ABLK_OFFSET_SHIFT) - 1 - 7
+ end
+ set $etp_blk_sz = ($arg0)->bhdr & $etp_MBC_ABLK_SZ_MASK
+ end
+end
+
+define etp-block2mbc-1
+#
+# In: (Block_t*) in $arg0
+# Out: (Carrier_t*) in $etp-mbc
+#
+ if (($arg0)->bhdr) & 1
+ # Free block
+ set $etp_mbc = ($arg0)->u.carrier
+ else
+ # Allocated block
+ if !$etp_MBC_ABLK_OFFSET_SHIFT
+ if etp_arch_bits == 64
+ set $etp_MBC_ABLK_OFFSET_SHIFT = (64 - 24)
+ else
+ set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9)
+ end
+ end
+ set $etp_mbc = (Carrier_t*) ((((UWord)($arg0) >> 18) - (($arg0)->bhdr >> $etp_MBC_ABLK_OFFSET_SHIFT)) << 18)
+ end
+end
+
+define etp-block2mbc
+ etp-block2mbc-1 ((Block_t*)$arg0)
+ print $etp_mbc
+end
+
+document etp-block2mbc
+%---------------------------------------------------------------------------
+% Print pointer to multiblock carrier containing the argument (Block_t*)
+%---------------------------------------------------------------------------
+end
+
+define etp-block
+ etp-block-size-1 ((Block_t*)$arg0)
+ if ((Block_t*)$arg0)->bhdr & 1
+ printf "%#lx: FREE sz=%#x\n", ($arg0), $etp_blk_sz
+ else
+ printf "%#lx: ALLOCATED sz=%#x\n", ($arg0), $etp_blk_sz
+ end
+end
+
+document etp-block
+%---------------------------------------------------------------------------
+% Print memory block (Block_t*)
+%---------------------------------------------------------------------------
+end
+
+define etp-carrier-blocks
+ set $etp_crr = (Carrier_t*) $arg0
+ set $etp_alc = (Allctr_t*)($etp_crr->allctr.counter & ~7)
+ set $etp_blk = (Block_t*) ((char*)$etp_crr + $etp_alc->mbc_header_size)
+ set $etp_prev_blk = 0
+ set $etp_error_cnt = 0
+ set $etp_ablk_cnt = 0
+ set $etp_fblk_cnt = 0
+
+ if $argc == 2
+ set $etp_be_silent = $arg1
+ else
+ set $etp_be_silent = 0
+ end
+
+ while 1
+ if !$etp_be_silent
+ etp-block $etp_blk
+ else
+ etp-block-size-1 $etp_blk
+ end
+ etp-block2mbc-1 $etp_blk
+ if $etp_mbc != $etp_crr
+ printf "ERROR: Invalid carrier pointer %#lx in block at %#lx\n", $etp_mbc, $etp_blk
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ if $etp_prev_blk
+ if ($etp_prev_blk->bhdr & 1)
+ # Prev is FREE
+ if ($etp_blk->bhdr & 1)
+ printf "ERROR: Adjacent FREE blocks at %#lx and %#lx\n", $etp_prev_blk, $etp_blk
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ if !($etp_blk->bhdr & 2)
+ printf "ERROR: Missing PREV_FREE_BLK_HDR_FLG (2) in block at %#lx\n", $etp_blk
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ end
+ end
+ if $etp_blk->bhdr & 1
+ set $etp_fblk_cnt = $etp_fblk_cnt + 1
+ else
+ set $etp_ablk_cnt = $etp_ablk_cnt + 1
+ end
+ if $etp_blk->bhdr & 4
+ # Last block
+ loop_break
+ end
+ # All free blocks except the last have a footer
+ if ($etp_blk->bhdr & 1) && ((UWord*)((char*)$etp_blk + $etp_blk_sz))[-1] != $etp_blk_sz
+ printf "ERROR: Invalid footer of free block at %#lx\n", $etp_blk
+ end
+ set $etp_prev_blk = $etp_blk
+ set $etp_blk = (Block_t*) ((char*)$etp_blk + $etp_blk_sz)
+ end
+
+ if ((char*)$etp_blk + $etp_blk_sz) != ((char*)$etp_crr + ($etp_crr->chdr & ~7))
+ printf "ERROR: Last block not at end of carrier\n"
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ printf "Allocated blocks: %u\n", $etp_ablk_cnt
+ printf "Free blocks: %u\n", $etp_fblk_cnt
+ if $etp_error_cnt
+ printf "%u ERRORs reported above\n", $etp-error-cnt
+ end
+end
+
+document etp-carrier-blocks
+%---------------------------------------------------------------------------
+% Check and (maybe) print all memory blocks in carrier
+% Args: (Carrier_t*) [1=be_silent]
+%---------------------------------------------------------------------------
+end
+
+
+############################################################################
# Toolbox parameter handling
#