1# -*- gdb-script -*-
2#
3# %CopyrightBegin%
4#
5# Copyright Ericsson AB 2005-2020. All Rights Reserved.
6#
7# Licensed under the Apache License, Version 2.0 (the "License");
8# you may not use this file except in compliance with the License.
9# You may obtain a copy of the License at
10#
11#     http://www.apache.org/licenses/LICENSE-2.0
12#
13# Unless required by applicable law or agreed to in writing, software
14# distributed under the License is distributed on an "AS IS" BASIS,
15# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
16# See the License for the specific language governing permissions and
17# limitations under the License.
18#
19# %CopyrightEnd%
20#
21
22############################################################################
23# Help commands
24#
25
26define etp-help
27  help etp-help
28end
29
30document etp-help
31%---------------------------------------------------------------------------
32% etp-help
33%
34% Same as "help etp-help"
35%
36% Emulator Toolbox for Pathologists
37% - GDB command toolbox for analyzing core dumps from the
38% Erlang emulator (BEAM).
39%
40% Should work for 32-bit and 64-bit unix gdb
41%
42% The commands are prefixed with:
43%   etp:  Acronym for erts-term-print
44%   etpf: Acronym for erts-term-print-flat
45%
46% User commands (these have help themselves):
47%
48% Most useful:
49%   etp, etpf
50%
51% Useful for doing step-by-step traversal of lists and tuples after
52% calling the toplevel command etpf:
53%   etpf-cons, etpf-boxed,
54%
55% Special commands for not really terms:
56%   etp-mfa, etp-cp, etp-disasm,
57%   etp-msgq, etpf-msgq,
58%   etp-stacktrace, etp-stacktrace-emu, etp-stackdump, etp-stackdump-emu,
59%   etpf-stackdump, etp-dictdump
60%   etp-process-info, etp-process-memory-info
61%   etp-port-info, etp-port-state, etp-port-sched-flags
62%   etp-heapdump, etp-offheapdump, etpf-offheapdump,
63%   etp-search-heaps, etp-search-alloc,
64%   etp-ets-tables, etp-ets-tabledump
65%
66% Complex commands that use the Erlang support module.
67%   etp-overlapped-heaps, etp-chart, etp-chart-start, etp-chart-end
68%
69% System inspection
70%   etp-system-info, etp-schedulers, etp-process, etp-ports, etp-lc-dump,
71%   etp-migration-info, etp-processes-memory,
72%   etp-compile-info, etp-config-h-info
73%
74% Platform specific (when gdb fails you)
75%   etp-ppc-stacktrace
76%
77% Erlang support module handling commands:
78%   etp-run
79%
80% Parameter handling commands:
81%   etp-show, etp-set-max-depth, etp-set-max-string-length
82%
83% Other commands you may find in this toolbox are suffixed -1, -2, ...
84% and are internal; not for the console user.
85%
86% The Erlang support module requires `erl' and `erlc' in the path.
87% The compiled "erl_commands.beam" file is stored in the current
88% working directory, so it is thereby in the search path of `erl'.
89%
90% These are just helpful commands when analyzing core dumps, but
91% you will not get away without knowing the gory details of the
92% tag bits. Do not forget about the e.g p, p/x, x and x/4x commands.
93%
94% Execution speed of user defined gdb commands is not lightning fast.
95% It may well take half a minute to dump a complex term with the default
96% max depth values on our old Sparc Ultra-10's.
97%
98% To use the Erlang support module, the environment variable ROOTDIR
99% must be set to the toplevel installation directory of Erlang/OTP,
100% so the etp-commands file becomes:
101%     $ROOTDIR/erts/etc/unix/etp-commands
102% Also, erl and erlc must be in the path.
103%---------------------------------------------------------------------------
104end
105
106############################################################################
107# Toplevel commands
108#
109
110define etp
111# Args: Eterm
112#
113# Reentrant
114#
115  etp-1 ((Eterm)($arg0)) 0
116  printf ".\n"
117end
118
119document etp
120%---------------------------------------------------------------------------
121% etp Eterm
122%
123% Takes a toplevel Erlang term and prints the whole deep term
124% very much as in Erlang itself. Up to a max depth. See etp-show.
125%---------------------------------------------------------------------------
126end
127
128define etp-1
129# Args: Eterm, int depth
130#
131# Reentrant
132#
133  if (($arg0) & 0x3) == 1
134    # Cons pointer
135    if $etp_flat
136      printf "<etpf-cons %p>", (($arg0) & etp_ptr_mask)
137    else
138      etp-list-1 ($arg0) ($arg1)
139    end
140  else
141    if (($arg0) & 0x3) == 2
142      if $etp_flat
143        printf "<etpf-boxed %p>", (($arg0) etp_ptr_mask)
144      else
145        etp-boxed-1 ($arg0) ($arg1)
146      end
147    else
148      if (($arg0) & 0x3) == 3
149        etp-immediate-1 ($arg0)
150      else
151        # (($arg0) & 0x3) == 0
152        if (($arg0) == etp_the_non_value)
153          printf "<the-non-value>"
154        else
155          etp-cp-1 ($arg0)
156        end
157      end
158    end
159  end
160end
161
162define etpf
163# Args: Eterm
164#
165# Non-reentrant
166  set $etp_flat = 1
167  etp-1 ((Eterm)($arg0))
168  set $etp_flat = 0
169  printf ".\n"
170end
171
172document etpf
173%---------------------------------------------------------------------------
174% etpf Eterm
175%
176% Takes a toplevel Erlang term and prints it is. If it is a deep term
177% print which command to use to traverse down one level.
178%---------------------------------------------------------------------------
179end
180
181############################################################################
182# Commands for nested terms. Some are recursive.
183#
184
185define etp-list-1
186# Args: Eterm cons_cell, int depth
187#
188# Reentrant
189#
190  if (($arg0) & 0x3) != 0x1
191    printf "#NotCons<%p>", ($arg0)
192  else
193    # Cons pointer
194    if $etp_chart
195      etp-chart-entry-1 ($arg0) ($arg1) 2
196    end
197    etp-list-printable-1 ($arg0) ($arg1)
198    if !$etp_list_printable
199      # Print normal list
200      printf "["
201      etp-list-2 ($arg0) (($arg1)+1)
202    end
203  end
204end
205
206define etp-list-printable-1
207# Args: Eterm list, int depth
208#
209# Non-reentrant
210#
211# Returns: $etp_list_printable
212#
213  if (($arg0) & 0x3) != 0x1
214    printf "#NotCons<%p>", ($arg0)
215  else
216    # Loop to check if it is a printable string
217    set $etp_list_p = ($arg0)
218    set $etp_list_printable = ($etp_list_p != $etp_nil)
219    set $etp_list_i = 0
220    while ($etp_list_p != $etp_nil) && \
221          ($etp_list_i < $etp_max_string_length) && \
222          $etp_list_printable
223      if ($etp_list_p & 0x3) == 0x1
224        # Cons pointer
225        set $etp_list_n = ((Eterm*)($etp_list_p & etp_ptr_mask))[0]
226        if ($etp_list_n & 0xF) == 0xF
227          etp-ct-printable-1 ($etp_list_n>>4)
228          if $etp_ct_printable
229            # Printable
230            set $etp_list_p = ((Eterm*)($etp_list_p & etp_ptr_mask))[1]
231            set $etp_list_i++
232          else
233            set $etp_list_printable = 0
234          end
235        else
236          set $etp_list_printable = 0
237        end
238      else
239        set $etp_list_printable = 0
240      end
241    end
242    #
243    if $etp_list_printable
244  	# Print printable string
245  	printf "\""
246      set $etp_list_p = ($arg0)
247      set $etp_list_i = 0
248      while $etp_list_p != $etp_nil
249        set $etp_list_n = ((Eterm*)($etp_list_p & etp_ptr_mask))[0]
250        etp-char-1 ($etp_list_n>>4) '"'
251        set $etp_list_p = ((Eterm*)($etp_list_p & etp_ptr_mask))[1]
252        set $etp_list_i++
253        if $etp_list_p == $etp_nil
254          printf "\""
255        else
256          if $etp_list_i >= $etp_max_string_length
257            set $etp_list_p = $etp_nil
258            printf "\"++[...]"
259          else
260            if $etp_chart
261              etp-chart-entry-1 ($arg0) (($arg1)+$etp_list_i) 2
262            end
263          end
264        end
265      end
266    end
267  end
268end
269
270define etp-list-2
271# Args: Eterm cons_cell, int depth
272#
273# Reentrant
274#
275  if (($arg0) & 0x3) != 0x1
276    printf "#NotCons<%p>", ($arg0)
277  else
278    # Cons pointer
279    if ($arg1) >= $etp_max_depth
280      printf "...]"
281    else
282      etp-1 (((Eterm*)(($arg0)&etp_ptr_mask))[0]) (($arg1)+1)
283      if ((Eterm*)(($arg0) & etp_ptr_mask))[1] == $etp_nil
284        # Tail is []
285        printf "]"
286      else
287        if $etp_chart
288          etp-chart-entry-1 ($arg0) ($arg1) 2
289        end
290        if (((Eterm*)(($arg0)&etp_ptr_mask))[1]&0x3) == 0x1
291          # Tail is cons cell
292          printf ","
293          etp-list-2 (((Eterm*)(($arg0)&etp_ptr_mask))[1]) (($arg1)+1)
294        else
295          # Tail is other term
296          printf "|"
297          etp-1 (((Eterm*)(($arg0)&etp_ptr_mask))[1]) (($arg1)+1)
298          printf "]"
299        end
300      end
301    end
302  end
303end
304
305define etpf-cons
306# Args: Eterm
307#
308# Reentrant capable
309#
310  if ((Eterm)($arg0) & 0x3) != 0x1
311    printf "#NotCons<%p>", ($arg0)
312  else
313    # Cons pointer
314    set $etp_flat = 1
315    printf "["
316    etp-1 (((Eterm*)((Eterm)($arg0)&etp_ptr_mask))[0])
317    printf "|"
318    etp-1 (((Eterm*)((Eterm)($arg0)&etp_ptr_mask))[1])
319    printf "]\n"
320    set $etp_flat = 0
321  end
322end
323
324document etpf-cons
325%---------------------------------------------------------------------------
326% etpf-cons Eterm
327%
328% Takes a Cons ptr and prints the Car and Cdr cells with etpf (flat).
329%---------------------------------------------------------------------------
330end
331
332
333
334define etp-boxed-1
335# Args: Eterm, int depth
336#
337# Reentrant
338#
339  if (($arg0) & 0x3) != 0x2
340    printf "#NotBoxed<%p>", ($arg0)
341  else
342    if (((Eterm*)(($arg0) & etp_ptr_mask))[0] & 0x3) != 0x0
343      if $etp_chart
344        etp-chart-entry-1 (($arg0)&etp_ptr_mask) ($arg1) 1
345      end
346      printf "#BoxedError<%p>", ($arg0)
347    else
348      if $etp_chart
349        etp-chart-entry-1 (($arg0)&etp_ptr_mask) ($arg1) \
350                          ((((Eterm*)(($arg0)&etp_ptr_mask))[0]>>6)+1)
351      end
352      if (((Eterm*)(($arg0) & etp_ptr_mask))[0] & 0x3f) == 0x0
353        printf "{"
354        etp-array-1 ((Eterm*)(($arg0)&etp_ptr_mask)) ($arg1) ($arg1) \
355                    1 ((((Eterm*)(($arg0)&etp_ptr_mask))[0]>>6)+1) '}'
356      else
357        if (((Eterm*)(($arg0) & etp_ptr_mask))[0] & 0x3c) == 0x3c
358	  # A map
359	  if (((Eterm*)(($arg0) & etp_ptr_mask))[0] & 0xc0) == 0x0
360	    # Flat map
361	    printf "#{Keys:"
362	    etp-1 ((flatmap_t*)(($arg0)&etp_ptr_mask))->keys (($arg1)+1)
363	    printf " Values:{"
364	    etp-array-1 ((Eterm*)(($arg0)&etp_ptr_mask)+3) ($arg1) ($arg1) \
365                        0 ((flatmap_t*)(($arg0)&etp_ptr_mask))->size '}'
366	    printf "}"
367          else
368	    # Hashmap
369            printf "#<%x>{", (((((Eterm*)(($arg0)&etp_ptr_mask))[0])>>(6+2+8))&0xffff)
370	    if (((Eterm*)(($arg0) & etp_ptr_mask))[0] & 0xc0) >= 0x80
371              # head bitmap/array
372	      etp-bitmap-array-1 ((Eterm*)(($arg0)&etp_ptr_mask)+2) ($arg1) ($arg1) \
373                        0 (((((Eterm*)(($arg0)&etp_ptr_mask))[0])>>(6+2+8))&0xffff) '}'
374            else
375              # node bitmap
376	      etp-bitmap-array-1 ((Eterm*)(($arg0)&etp_ptr_mask)+1) ($arg1) ($arg1) \
377                        0 (((((Eterm*)(($arg0)&etp_ptr_mask))[0])>>(6+2+8))&0xffff) '}'
378            end
379	  end
380        else
381          etp-boxed-immediate-1 ($arg0)
382        end
383      end
384    end
385  end
386end
387
388define etp-boxed-immediate-1
389# Args: Eterm, int depth
390#
391# Non-reentrant
392#
393  if (($arg0) & 0x3) != 0x2
394    printf "#NotBoxed<%p>", ($arg0)
395  else
396    if (((Eterm*)(($arg0) & etp_ptr_mask))[0] & 0x3) != 0x0
397      printf "#BoxedError<%p>", ($arg0)
398    else
399      set $etp_boxed_immediate_p = (Eterm*)(($arg0) & etp_ptr_mask)
400      set $etp_boxed_immediate_h = ($etp_boxed_immediate_p[0] >> 2) & 0xF
401      if $etp_boxed_immediate_h == 0xC
402        etp-extpid-1 ($arg0)
403      else
404        if $etp_boxed_immediate_h == 0xD
405          etp-extport-1 ($arg0)
406        else
407          if ($etp_boxed_immediate_h == 0x2) || \
408             ($etp_boxed_immediate_h == 0x3)
409            etp-bignum-1 ($arg0)
410          else
411            if ($etp_boxed_immediate_h == 0x6)
412              etp-float-1 ($arg0)
413            else
414              if ($etp_boxed_immediate_h == 0x4)
415                etp-ref-1 ($arg0)
416              else
417                if ($etp_boxed_immediate_h == 0xE)
418                  etp-extref-1 ($arg0)
419                else
420                  # Hexdump the rest
421                  if ($etp_boxed_immediate_h == 0x5)
422                    printf "#Fun<"
423                  else
424                    if ($etp_boxed_immediate_h == 0x8)
425                      printf "#RefcBinary<"
426                    else
427                    if ($etp_boxed_immediate_h == 0x9)
428                      printf "#HeapBinary<"
429                    else
430                    if ($etp_boxed_immediate_h == 0xA)
431                      printf "#SubBinary<"
432                    else
433                      printf "#Header%X<", $etp_boxed_immediate_h
434                    end
435		  end
436		  end
437                  end
438                  set $etp_boxed_immediate_arity = $etp_boxed_immediate_p[0]>>6
439                  while $etp_boxed_immediate_arity > 0
440                    set $etp_boxed_immediate_p++
441                    if $etp_boxed_immediate_arity > 1
442                      printf "%p,", *$etp_boxed_immediate_p
443                    else
444                      printf "%p", *$etp_boxed_immediate_p
445        	      if ($etp_boxed_immediate_h == 0xA)
446                        set $etp_boxed_immediate_p++
447			printf ":%p", *$etp_boxed_immediate_p
448		      end
449		      printf ">"
450                    end
451                    set $etp_boxed_immediate_arity--
452                  end
453                  # End of hexdump
454                end
455              end
456            end
457          end
458        end
459      end
460    end
461  end
462end
463
464define etpf-boxed
465# Args: Eterm
466#
467# Non-reentrant
468#
469  set $etp_flat = 1
470  etp-boxed-1 ((Eterm)($arg0)) 0
471  set $etp_flat = 0
472  printf ".\n"
473end
474
475document etpf-boxed
476%---------------------------------------------------------------------------
477% etpf-boxed Eterm
478%
479% Take a Boxed ptr and print the contents in one level using etpf (flat).
480%---------------------------------------------------------------------------
481end
482
483
484
485define etp-array-1
486# Args: Eterm* p, int depth, int width, int pos, int size, int end_char
487#
488# Reentrant
489#
490  if ($arg3) < ($arg4)
491    if (($arg1) < $etp_max_depth) && (($arg2) < $etp_max_depth)
492      etp-1 (($arg0)[($arg3)]) (($arg1)+1)
493      if (($arg3) + 1) != ($arg4)
494        printf ","
495      end
496      etp-array-1 ($arg0) ($arg1) (($arg2)+1) (($arg3)+1) ($arg4) ($arg5)
497    else
498      printf "...%c", ($arg5)
499    end
500  else
501    printf "%c", ($arg5)
502  end
503end
504
505define etp-bitmap-array-1
506# Args: Eterm* p, int depth, int width, int pos, int bitmap, int end_char
507#
508# Reentrant
509#
510# Same as etp-array-1 with size = bitcount(bitmap)
511#
512  if ($arg4) & 1 != 0
513    if (($arg1) < $etp_max_depth) && (($arg2) < $etp_max_depth)
514      etp-1 (($arg0)[($arg3)]) (($arg1)+1)
515      if (($arg4) & (($arg4)-1)) != 0
516        printf ","
517      end
518      etp-bitmap-array-1 ($arg0) ($arg1) (($arg2)+1) (($arg3)+1) (($arg4)>>1) ($arg5)
519    else
520      printf "...%c", ($arg5)
521    end
522  else
523    if ($arg4) == 0
524      printf "%c", ($arg5)
525    else
526      etp-bitmap-array-1 $arg0 $arg1 $arg2 $arg3 (($arg4)>>1) $arg5
527
528      # WARNING: One might be tempted to optimize the bitcounting here
529      # by passing the bitmap argument as ($arg4 & ($arg4 - 1)). This is a very
530      # bad idea as arguments are passed as string substitution.
531      # The size of $arg4 would thus grow exponentially for each recursion.
532    end
533  end
534end
535
536
537#define etpa-1
538## Args: Eterm, int depth, int index, int arity
539##
540## Reentrant
541##
542#  if ($arg1) >= $etp_max_depth+$etp_max_string_length
543#    printf "%% Max depth for term %d\n", $etp_chart_id
544#  else
545#    if ($arg2) < ($arg3)
546#      etp-1 (((Eterm*)(($arg0)&etp_ptr_mask))[$arg2]) (($arg1)+1)
547#      etpa-1 ($arg0) (($arg1)+1) (($arg2)+1) ($arg3)
548#    end
549#  end
550#end
551
552############################################################################
553# Commands for non-nested terms. Recursion leaves. Some call other leaves.
554#
555
556define etp-immediate-1
557# Args: Eterm
558#
559# Reentrant capable
560#
561  if (($arg0) & 0x3) != 0x3
562    printf "#NotImmediate<%p>", ($arg0)
563  else
564    if (($arg0) & 0xF) == 0x3
565      etp-pid-1 ($arg0)
566    else
567      if (($arg0) & 0xF) == 0x7
568        etp-port-1 ($arg0)
569      else
570        if (($arg0) & 0xF) == 0xf
571          # Fixnum
572          printf "%ld", (long)((Sint)($arg0)>>4)
573        else
574          # Immediate2  - 0xB
575          if (($arg0) & 0x3f) == 0x0b
576            etp-atom-1 ($arg0)
577          else
578            if (($arg0) & 0x3f) == 0x1b
579              printf "#Catch<%d>", ($arg0)>>6
580            else
581              if (($arg0) == $etp_nil)
582                printf "[]"
583              else
584                printf "#UnknownImmediate<%p>", ($arg0)
585              end
586            end
587          end
588        end
589      end
590    end
591  end
592end
593
594
595
596define etp-atom-1
597# Args: Eterm atom
598#
599# Non-reentrant
600#
601  if ((Eterm)($arg0) & 0x3f) != 0xb
602    printf "#NotAtom<%p>", ($arg0)
603  else
604    set $etp_atom_1_ap = (Atom*)erts_atom_table.seg_table[(Eterm)($arg0)>>16][((Eterm)($arg0)>>6)&0x3FF]
605    set $etp_atom_1_i = ($etp_atom_1_ap)->len
606    set $etp_atom_1_p = ($etp_atom_1_ap)->name
607    set $etp_atom_1_quote = 1
608    # Check if atom has to be quoted
609    if ($etp_atom_1_i > 0)
610      etp-ct-atom-1 (*$etp_atom_1_p)
611      if $etp_ct_atom
612        # Atom start character
613        set $etp_atom_1_p++
614        set $etp_atom_1_i--
615        set $etp_atom_1_quote = 0
616      else
617        set $etp_atom_1_i = 0
618      end
619    end
620    while $etp_atom_1_i > 0
621      etp-ct-name-1 (*$etp_atom_1_p)
622      if $etp_ct_name
623        # Name character
624        set $etp_atom_1_p++
625        set $etp_atom_1_i--
626      else
627        set $etp_atom_1_quote = 1
628        set $etp_atom_1_i = 0
629      end
630    end
631    # Print the atom
632    if $etp_atom_1_quote
633      printf "'"
634    end
635    set $etp_atom_1_i = ($etp_atom_1_ap)->len
636    set $etp_atom_1_p = ($etp_atom_1_ap)->name
637    while $etp_atom_1_i > 0
638        etp-char-1 (*$etp_atom_1_p) '\''
639	set $etp_atom_1_p++
640        set $etp_atom_1_i--
641    end
642    if $etp_atom_1_quote
643      printf "'"
644    end
645  end
646end
647
648
649define etp-string-to-atom
650# Args: (char*) null-terminated
651#
652# Non-reentrant
653
654  set $etp_i = 0
655  set $etp_h = ((UWord)0)
656  while (($arg0)[$etp_i]) != 0
657    set $etp_c = (unsigned char)(($arg0)[$etp_i])
658
659    if $etp_c & 0x80
660      printf "Non ASCII atoms not implemented\n"
661      loop_break
662    end
663
664    set $etp_h = ($etp_h << 4) + $etp_c
665    set $etp_g = $etp_h & 0xf0000000
666    if $etp_g != 0
667      set $etp_h ^= ($etp_g >> 24)
668      set $etp_h ^= $etp_g
669    end
670    set $etp_i++
671  end
672
673  # hash_get_slot
674  set $etp_h ^= $etp_h >> erts_atom_table.htable.shift
675  if $etp_arch64
676    set $etp_h = (11400714819323198485UL * $etp_h) >> erts_atom_table.htable.shift
677  else
678    set $etp_h = (2654435769UL * $etp_h) >> erts_atom_table.htable.shift
679  end
680  set $etp_p = (Atom*)erts_atom_table.htable.bucket[$etp_h]
681
682  # search hash bucket list
683  while $etp_p
684    set $etp_i = 0
685    while $etp_i < $etp_p->len && ($arg0)[$etp_i]
686      if $etp_p->name[$etp_i] != ($arg0)[$etp_i]
687	loop_break
688      end
689      set $etp_i++
690    end
691    if $etp_i == $etp_p->len && ($arg0)[$etp_i] == 0
692      loop_break
693    end
694    set $etp_p = (Atom*)$etp_p->slot.bucket.next
695  end
696  if $etp_p
697    print ($etp_p->slot.index << 6) | (2 << 2) | 3
698  else
699    printf "Can't find atom\n"
700  end
701end
702
703document etp-string-to-atom
704%----------------------------------------
705% etp-string-to-atom (char*)
706%
707% Ex: etp-string-to-atom "erlang"
708%----------------------------------------
709end
710
711define etp-char-1
712# Args: int char, int quote_char
713#
714# Non-reentrant
715#
716  if (($arg0) < 0) || (0377 < ($arg0))
717    printf "#NotChar<%p>", ($arg0)
718  else
719    if ($arg0) == ($arg1)
720      printf "\\%c", ($arg0)
721    else
722      etp-ct-printable-1 ($arg0)
723      if $etp_ct_printable
724        if $etp_ct_printable < 0
725          printf "%c", ($arg0)
726        else
727          printf "\\%c", $etp_ct_printable
728        end
729      else
730        printf "\\%03o", ($arg0)
731      end
732    end
733  end
734end
735
736define etp-ct-printable-1
737# Args: int
738#
739# Determines if integer is a printable character
740#
741# Non-reentrant
742# Returns: $etp_ct_printable
743#          escape alias char, or -1 if no escape alias
744  if ($arg0) == 010
745    set $etp_ct_printable = 'b'
746  else
747    if ($arg0) == 011
748      set $etp_ct_printable = 't'
749    else
750      if ($arg0) == 012
751        set $etp_ct_printable = 'n'
752      else
753        if ($arg0) == 013
754          set $etp_ct_printable = 'v'
755        else
756          if ($arg0) == 014
757            set $etp_ct_printable = 'f'
758          else
759            if ($arg0) == 033
760              set $etp_ct_printable = 'e'
761            else
762              if ((040 <= ($arg0)) && (($arg0) <= 0176)) || \
763                 ((0240 <= ($arg0)) && (($arg0) <= 0377))
764                # Other printable character
765                set $etp_ct_printable = -1
766              else
767                set $etp_ct_printable = 0
768              end
769            end
770          end
771        end
772      end
773    end
774  end
775end
776
777define etp-ct-atom-1
778# Args: int
779#
780# Determines if integer is an atom first character
781#
782# Non-reentrant
783# Returns: $etp_ct_atom
784  if ((0141 <= ($arg0)) && (($arg0) <= 0172)) || \
785     ((0337 <= ($arg0)) && (($arg0) != 0367) && (($arg0) <= 0377))
786    # Atom start character
787    set $etp_ct_atom = 1
788  else
789    set $etp_ct_atom = 0
790  end
791end
792
793define etp-ct-variable-1
794# Args: int
795#
796# Determines if integer is a variable first character
797#
798# Non-reentrant
799# Returns: $etp_ct_variable
800  if ((056 == ($arg0)) || \
801      (0101 <= ($arg0)) && (($arg0) <= 0132)) || \
802      (0137 == ($arg0)) || \
803      ((0300 <= ($arg0)) && (($arg0) != 0327) && (($arg0) <= 0336))
804    # Variable start character
805    set $etp_ct_variable = 1
806  else
807    set $etp_ct_variable = 0
808  end
809end
810
811define etp-ct-name-1
812# Args: int
813#
814# Determines if integer is a name character,
815# i.e non-first atom or variable character.
816#
817# Non-reentrant
818# Returns: $etp_ct_variable
819  if (($arg0) == 0100 || \
820      (060 <= ($arg0)) && (($arg0) <= 071))
821    set $etp_ct_name = 1
822  else
823    etp-ct-atom-1 ($arg0)
824    if $etp_ct_atom
825      set $etp_ct_name = 1
826    else
827      etp-ct-variable-1 ($arg0)
828      set $etp_ct_name = $etp_ct_variable
829    end
830  end
831end
832
833define etp-pid-1
834# Args: Eterm pid
835#
836# Non-reentrant
837#
838  set $etp_pid_1 = (Eterm)($arg0)
839  if ($etp_pid_1 & 0xF) == 0x3
840    if (etp_arch_bits == 64)
841      if (etp_endianness > 0)
842      	set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 35) & 0x0fffffff)
843      else
844        set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff)
845      end
846   else
847      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))
848   end
849    # Internal pid
850    printf "<0.%u.%u>", $etp_pid_data & 0x7fff, ($etp_pid_data >> 15) & 0x1fff
851  else
852    printf "#NotPid<%p>", ($arg0)
853  end
854end
855
856define etp-extpid-1
857# Args: Eterm extpid
858#
859# Non-reentrant
860#
861  if ((Eterm)($arg0) & 0x3) != 0x2
862    printf "#NotBoxed<%p>", (Eterm)($arg0)
863  else
864    set $etp_extpid_1_p = (ExternalThing*)((Eterm)($arg0) & etp_ptr_mask)
865    if ($etp_extpid_1_p->header & 0x3f) != 0x30
866      printf "#NotExternalPid<%p>", $etp_extpid_1_p->header
867    else
868      ## External pid
869      set $etp_extpid_1_number = $etp_extpid_1_p->data.ui32[0]
870      set $etp_extpid_1_serial = $etp_extpid_1_p->data.ui32[1]
871      set $etp_extpid_1_np = $etp_extpid_1_p->node
872      set $etp_extpid_1_creation = $etp_extpid_1_np->creation
873      set $etp_extpid_1_dep = $etp_extpid_1_np->dist_entry
874      set $etp_extpid_1_node = $etp_extpid_1_np->sysname
875      if ($etp_extpid_1_node & 0x3f) != 0xb
876        # Should be an atom
877        printf "#ExternalPidError<%p>", ($arg0)
878      else
879        if $etp_extpid_1_dep == erts_this_dist_entry
880          printf "<0:"
881        else
882          printf "<%u:", $etp_extpid_1_node>>6
883        end
884        etp-atom-1 ($etp_extpid_1_node)
885        printf "/%u.%u.%u>", $etp_extpid_1_creation, \
886               $etp_extpid_1_number, $etp_extpid_1_serial
887      end
888    end
889  end
890end
891
892
893define etp-port-1
894# Args: Eterm port
895#
896# Non-reentrant
897#
898  set $etp_port_1 = (Eterm)($arg0)
899  if ($etp_port_1 & 0xF) == 0x7
900    if (etp_arch_bits == 64)
901      if (etp_endianness > 0)
902      	set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 36) & 0x0fffffff)
903      else
904        set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 4) & 0x0fffffff)
905      end
906   else
907      set $etp_port_data = (unsigned) (((((Uint32) $etp_port_1) >> 4) & ~erts_port.r.o.pix_mask) | ((((Uint32) $etp_port_1) >> (erts_port.r.o.pix_cl_shift + 4)) & erts_port.r.o.pix_cl_mask) | (((((Uint32) $etp_port_1) >> 4) & erts_port.r.o.pix_cli_mask) << erts_port.r.o.pix_cli_shift))
908   end
909    # Internal port
910    printf "#Port<0.%u>", $etp_port_data
911  else
912    printf "#NotPort<%p>", ($arg0)
913  end
914end
915
916define etp-extport-1
917# Args: Eterm extport
918#
919# Non-reentrant
920#
921  if ((Eterm)($arg0) & 0x3) != 0x2
922    printf "#NotBoxed<%p>", (Eterm)($arg0)
923  else
924    set $etp_extport_1_p = (ExternalThing*)((Eterm)($arg0) & etp_ptr_mask)
925    if ($etp_extport_1_p->header & 0x3F) != 0x34
926      printf "#NotExternalPort<%p>", $etp_extport_1->header
927    else
928      ## External port
929      if $etp_arch64
930	set $etp_extport_1_number = $etp_extport_1_p->data.port.id
931      else
932	set $etp_extport_1_number = $etp_extport_1_p->data.port.low | (((Uint64)$etp_extport_1_p->data.port.high) << 32)
933      end
934      set $etp_extport_1_np = $etp_extport_1_p->node
935      set $etp_extport_1_creation = $etp_extport_1_np->creation
936      set $etp_extport_1_dep = $etp_extport_1_np->dist_entry
937      set $etp_extport_1_node = $etp_extport_1_np->sysname
938      if ($etp_extport_1_node & 0x3f) != 0xb
939        # Should be an atom
940        printf "#ExternalPortError<%p>", ($arg0)
941      else
942        if $etp_extport_1_dep == erts_this_dist_entry
943          printf "#Port<0:"
944        else
945          printf "#Port<%u:", $etp_extport_1_node>>6
946        end
947        etp-atom-1 ($etp_extport_1_node)
948        printf "/%u.%lu>", $etp_extport_1_creation, $etp_extport_1_number
949      end
950    end
951  end
952end
953
954
955
956define etp-bignum-1
957# Args: Eterm bignum
958#
959# Non-reentrant
960#
961  if ((Eterm)($arg0) & 0x3) != 0x2
962    printf "#NotBoxed<%p>", (Eterm)($arg0)
963  else
964    set $etp_bignum_1_p = (Eterm*)((Eterm)($arg0) & etp_ptr_mask)
965    if ($etp_bignum_1_p[0] & 0x3b) != 0x08
966      printf "#NotBignum<%p>", $etp_bignum_1_p[0]
967    else
968      set $etp_bignum_1_i = ($etp_bignum_1_p[0] >> 6)
969      if $etp_bignum_1_i < 1
970        printf "#BignumError<%p>", (Eterm)($arg0)
971      else
972        if $etp_bignum_1_p[0] & 0x04
973          printf "-"
974        end
975        set $etp_bignum_1_p = (ErtsDigit *)($etp_bignum_1_p + 1)
976        printf "16#"
977        if $etp_arch64
978          while $etp_bignum_1_i > 0
979            set $etp_bignum_1_i--
980            printf "%016lx", $etp_bignum_1_p[$etp_bignum_1_i]
981          end
982        else
983          while $etp_bignum_1_i > 0
984            set $etp_bignum_1_i--
985            printf "%08x", $etp_bignum_1_p[$etp_bignum_1_i]
986          end
987        end
988      end
989    end
990  end
991end
992
993
994
995define etp-float-1
996# Args: Eterm float
997#
998# Non-reentrant
999#
1000  if ((Eterm)($arg0) & 0x3) != 0x2
1001    printf "#NotBoxed<%p>", (Eterm)($arg0)
1002  else
1003    set $etp_float_1_p = (Eterm*)((Eterm)($arg0) & etp_ptr_mask)
1004    if ($etp_float_1_p[0] & 0x3f) != 0x18
1005      printf "#NotFloat<%p>", $etp_float_1_p[0]
1006    else
1007      printf "%f", *(double*)($etp_float_1_p+1)
1008    end
1009  end
1010end
1011
1012
1013
1014define etp-ref-1
1015# Args: Eterm ref
1016#
1017# Non-reentrant
1018#
1019  if ((Eterm)($arg0) & 0x3) != 0x2
1020    printf "#NotBoxed<%p>", (Eterm)($arg0)
1021  else
1022    set $etp_ref_1_p = (ErtsORefThing *)((Eterm)($arg0) & etp_ptr_mask)
1023    if ($etp_ref_1_p->header & 0x3b) != 0x10
1024      printf "#NotRef<%p>", $etp_ref_1_p->header
1025    else
1026      if $etp_ref_1_p->header != etp_ref_header && $etp_ref_1_p->header != etp_magic_ref_header
1027        printf "#InternalRefError<%p>", ($arg0)
1028      else
1029	set $etp_magic_ref = 0
1030	set $etp_ref_1_i = 3
1031	set $etp_ref_1_error = 0
1032	set $etp_ref_1_nump = (Uint32 *) 0
1033	if etp_ref_header == etp_magic_ref_header
1034          if $etp_ref_1_p->marker != 0xffffffff
1035      	     set $etp_magic_ref = 1
1036          end
1037	else
1038	  if $etp_ref_1_p->header == etp_magic_ref_header
1039      	     set $etp_magic_ref = 1
1040          end
1041	end
1042        if $etp_magic_ref == 0
1043          set $etp_ref_1_nump = $etp_ref_1_p->num
1044        else
1045          set $etp_ref_1_nump = ((ErtsMRefThing *) $etp_ref_1_p)->mb->refn
1046        end
1047        printf "#Ref<0"
1048        set $etp_ref_1_i--
1049        while $etp_ref_1_i >= 0
1050          printf ".%u", (unsigned) $etp_ref_1_nump[$etp_ref_1_i]
1051          set $etp_ref_1_i--
1052        end
1053        printf ">"
1054      end
1055    end
1056  end
1057end
1058
1059
1060
1061define etp-extref-1
1062# Args: Eterm extref
1063#
1064# Non-reentrant
1065#
1066  if ((Eterm)($arg0) & 0x3) != 0x2
1067    printf "#NotBoxed<%p>", (Eterm)($arg0)
1068  else
1069    set $etp_extref_1_p = (ExternalThing*)((Eterm)($arg0) & etp_ptr_mask)
1070    if ($etp_extref_1_p->header & 0x3F) != 0x38
1071      printf "#NotExternalRef<%p>", $etp_extref_1->header
1072    else
1073      ## External ref
1074      set $etp_extref_1_nump = (Uint32 *) 0
1075      set $etp_extref_1_error = 0
1076      set $etp_extref_1_i = (int) ($etp_extref_1_p->header >> 6)
1077      set $etp_extref_1_np = $etp_extref_1_p->node
1078      set $etp_extref_1_creation = $etp_extref_1_np->creation
1079      set $etp_extref_1_dep = $etp_extref_1_np->dist_entry
1080      set $etp_extref_1_node = $etp_extref_1_np->sysname
1081      if ($etp_extref_1_node & 0x3f) != 0xb || $etp_extref_1_i < 3
1082        # Node should be an atom
1083	set $etp_extref_1_error = 1
1084      else
1085        ## $etp_extref_1_i now equals data (Uint) words
1086	set $etp_extref_1_i -= 2
1087        if $etp_arch64
1088          if ((((int) $etp_extref_1_p->data.ui32[0]) + 1) \
1089              > (2 * $etp_extref_1_i))
1090	    set $etp_extref_1_error = 1
1091          else
1092            set $etp_extref_1_nump = &$etp_extref_1_p->data.ui32[1]
1093            set $etp_extref_1_i = (int) $etp_extref_1_p->data.ui32[0]
1094          end
1095        else
1096            set $etp_extref_1_nump = &$etp_extref_1_p->data.ui32[0]
1097        end
1098        ## $etp_extref_1_i now equals no of ref num (Uint32) words
1099        if !$etp_extref_1_error
1100          if $etp_extref_1_dep == erts_this_dist_entry
1101            printf "#Ref<0:"
1102          else
1103            printf "#Ref<%u:", $etp_extref_1_node>>6
1104          end
1105          etp-atom-1 ($etp_extref_1_node)
1106          printf "/%u", $etp_extref_1_creation
1107        end
1108      end
1109      if $etp_extref_1_error
1110        printf "#ExternalRefError<%p>", ($arg0)
1111      else
1112        set $etp_extref_1_i--
1113        while $etp_extref_1_i >= 0
1114          printf ".%u", (unsigned) $etp_extref_1_nump[$etp_extref_1_i]
1115          set $etp_extref_1_i--
1116        end
1117        printf ">"
1118      end
1119    end
1120  end
1121end
1122
1123
1124
1125define etp-mfa-1
1126# Args: Eterm*, int offset
1127#
1128# Reentrant
1129#
1130  printf "<"
1131  etp-atom-1 (((Eterm*)($arg0))[0])
1132  printf ":"
1133  etp-atom-1 (((Eterm*)($arg0))[1])
1134  printf "/%d", ((Eterm*)($arg0))[2]
1135  if ($arg1) > 0
1136    printf "+%#x>", ($arg1)
1137  else
1138    printf ">"
1139  end
1140end
1141
1142define etp-mfa
1143# Args: Eterm*
1144#
1145# Reentrant capable
1146#
1147  etp-mfa-1 ($arg0) 0
1148  printf ".\n"
1149end
1150
1151document etp-mfa
1152%---------------------------------------------------------------------------
1153% etp-mfa Eterm*
1154%
1155% Take an Eterm* to an MFA function name entry and print it.
1156% These can be found e.g in the process structure;
1157% process_tab[i]->current and process_tab[i]->initial.
1158%---------------------------------------------------------------------------
1159end
1160
1161define etp-export-get
1162  # Args: Eterm Eterm Uint
1163
1164  set $etp_h = (((Eterm)$arg0 >> 6) * ((Eterm)$arg1 >> 6)) ^ (Uint)$arg2
1165
1166  #hash_get_slot
1167  set $etp_t = &export_tables[the_active_code_index.counter].htable
1168  set $etp_h ^= $etp_h >> $etp_t->shift
1169  if $etp_arch64
1170    set $etp_h = (11400714819323198485UL * $etp_h) >> $etp_t->shift
1171  else
1172    set $etp_h = (2654435769UL * $etp_h) >> $etp_t->shift
1173  end
1174
1175  set $etp_p = (struct export_entry*) $etp_t->bucket[$etp_h]
1176  while $etp_p
1177    if $etp_p->ep->info.mfa.module == $arg0 && $etp_p->ep->info.mfa.function == $arg1 && $etp_p->ep->info.mfa.arity == $arg2
1178      loop_break
1179    end
1180    set $etp_p = (struct export_entry*) $etp_p->slot.bucket.next
1181  end
1182  if $etp_p
1183    print $etp_p->ep
1184  else
1185    printf "Can't find export entry\n"
1186  end
1187end
1188
1189document etp-export-get
1190%---------------------------------------------------------
1191% etp-export-get module function arity
1192%
1193% Lookup and print pointer to Export entry.
1194% Example:
1195% (gdb) etp-string-to-atom "erlang"
1196% $1 = 13323
1197% (gdb) etp-string-to-atom "self"
1198% $2 = 47115
1199% (gdb) etp-export-get 13323 47115 0
1200% $3 = (Export *) 0x7f53caf1f358
1201%---------------------------------------------------------
1202end
1203
1204define etp-module-get
1205  # Args: Eterm
1206
1207  set $etp_ix = ((Eterm)$arg0 >> 6)
1208  set $etp_h = $etp_ix
1209
1210  #hash_get_slot
1211  set $etp_t = &module_tables[the_active_code_index.counter].htable
1212  set $etp_h ^= $etp_h >> $etp_t->shift
1213  if $etp_arch64
1214    set $etp_h = (11400714819323198485UL * $etp_h) >> $etp_t->shift
1215  else
1216    set $etp_h = (2654435769UL * $etp_h) >> $etp_t->shift
1217  end
1218
1219  set $etp_p = (Module*) $etp_t->bucket[$etp_h]
1220  while $etp_p
1221    if $etp_p->module == $etp_ix
1222      loop_break
1223    end
1224    set $etp_p = (Module*) $etp_p->slot.bucket.next
1225  end
1226  if $etp_p
1227    print $etp_p
1228  else
1229    printf "Can't find module entry\n"
1230  end
1231end
1232
1233document etp-module-get
1234%---------------------------------------------------------
1235% etp-module-get module
1236%
1237% Lookup and print pointer to Module entry.
1238% Example:
1239% (gdb) etp-string-to-atom "erlang"
1240% $1 = 13323
1241% (gdb) etp-module-get 13323
1242% $2 = (Module *) 0x7f53caf1f358
1243%---------------------------------------------------------
1244end
1245
1246
1247define etp-cp-func-info-1
1248# Args: Eterm cp
1249#
1250# Non-reentrant, takes cp, sets $etp_cp_p to MFA in func_info
1251#
1252  set $etp_cp = (Eterm)($arg0)
1253  set $etp_ranges = &r[(int)the_active_code_index]
1254  set $etp_cp_low = $etp_ranges->modules
1255  set $etp_cp_high = $etp_cp_low + $etp_ranges->n
1256  set $etp_cp_mid = (Range*)$etp_ranges->mid
1257  set $etp_cp_p = 0
1258  #
1259  while $etp_cp_low < $etp_cp_high
1260    if $etp_cp < $etp_cp_mid->start
1261      set $etp_cp_high = $etp_cp_mid
1262    else
1263      if $etp_cp > (BeamInstr*)$etp_cp_mid->end
1264        set $etp_cp_low = $etp_cp_mid + 1
1265      else
1266        set $etp_cp_p = $etp_cp_low = $etp_cp_high = $etp_cp_mid
1267      end
1268    end
1269    set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2
1270  end
1271  if $etp_cp_p
1272    # 13 = MI_FUNCTIONS
1273    set $etp_cp_low = &((Eterm**)$etp_cp_p->start)[13]
1274    # 0 = MI_NUM_FUNCTIONS
1275    set $etp_cp_high = $etp_cp_low + ((Eterm*)$etp_cp_p->start)[0]
1276    set $etp_cp_p = 0
1277    while $etp_cp_low < $etp_cp_high
1278      set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2
1279      if $etp_cp < $etp_cp_mid[0]
1280        set $etp_cp_high = $etp_cp_mid
1281      else
1282        if $etp_cp < $etp_cp_mid[1]
1283          set $etp_cp_p = $etp_cp_mid[0]+2
1284          set $etp_cp_low = $etp_cp_high = $etp_cp_mid
1285        else
1286          set $etp_cp_low = $etp_cp_mid + 1
1287        end
1288      end
1289    end
1290  end
1291  if $etp_cp_p
1292    set $cp_cp_p_offset = ($etp_cp-((Eterm)($etp_cp_p-2)))
1293  else
1294    set $cp_cp_p_offset = 0
1295  end
1296end
1297
1298define etp-cp-1
1299# Args: Eterm cp
1300#
1301# Non-reentrant
1302#
1303  etp-cp-func-info-1 $arg0
1304  if $etp_cp_p
1305    printf "#Cp"
1306    etp-mfa-1 $etp_cp_p $cp_cp_p_offset
1307  else
1308    if $etp_cp == beam_apply+1
1309      printf "#Cp<terminate process normally>"
1310    else
1311      if ($etp_cp) == beam_return_trace
1312	printf "#Cp<return trace>"
1313      else
1314        if ($etp_cp) == beam_exception_trace
1315	  printf "#Cp<exception trace>"
1316        else
1317          if ($etp_cp) == beam_return_to_trace
1318	    printf "#Cp<return to trace>"
1319	  else
1320            printf "#Cp<%p>", $etp_cp
1321          end
1322	end
1323      end
1324    end
1325  end
1326end
1327
1328define etp-cp
1329# Args: Eterm cp
1330#
1331# Reentrant capable
1332#
1333  etp-cp-1 ($arg0)
1334  printf ".\n"
1335end
1336
1337document etp-cp
1338%---------------------------------------------------------------------------
1339% etp-cp Eterm
1340%
1341% Take a code continuation pointer or instruction pointer and print
1342% module, function, arity and offset.
1343%
1344% Code continuation pointers can be found on the stack. The instruction
1345% pointer is found in the process struct. For example:
1346%
1347%    c_p->i
1348%    process_tab[i]->i
1349%---------------------------------------------------------------------------
1350end
1351
1352define etp-check-beam-ranges
1353  set $etp_ci = 0
1354  while $etp_ci < 3
1355    printf "Checking code index %i...\n", $etp_ci
1356    set $etp_j = 0
1357    while $etp_j < r[$etp_ci].n
1358      set $etp_p = &r[$etp_ci].modules[$etp_j]
1359      if $etp_j > 0 && $etp_p->start < (Range*)$etp_p[-1].end.counter
1360        printf "r[%i].modules[%i]: ERROR start < previous\n", $etp_ci, $etp_j
1361      end
1362      if $etp_p->start > (Range*)$etp_p->end.counter
1363        printf "r[%i].modules[%i]: ERROR start > end\n", $etp_ci, $etp_j
1364      else
1365        if $etp_p->start == (Range*)$etp_p->end.counter
1366          printf "r[%i].modules[%i]: Purged\n", $etp_ci, $etp_j
1367        end
1368      end
1369      set $etp_j = $etp_j + 1
1370    end
1371    set $etp_ci = $etp_ci + 1
1372  end
1373end
1374
1375document etp-check-beam-ranges
1376%---------------------------------------------------------------------------
1377% etp-check-beam-ranges
1378%
1379% Do consistency check of beam_ranges data structure
1380% and print errors and empty slots from purged modules.
1381%---------------------------------------------------------------------------
1382end
1383
1384
1385############################################################################
1386# Commands for special term bunches.
1387#
1388
1389define etp-sig-int
1390  set $etp_sig_is_message = 0
1391  set $etp_sig_is_recv_marker = 0
1392  set $etp_sig_tag = ($arg0)->m[0]
1393  if ($etp_sig_tag & 0x3) != 0 || $etp_sig_tag == etp_the_non_value
1394    set $etp_sig_is_message = !0
1395    # A message
1396    if $etp_sig_tag != etp_the_non_value
1397      etp-1 $etp_sig_tag 0
1398    else
1399      printf "!ENCODED-DIST-MSG"
1400    end
1401    if ($arg0)->m[1] != $etp_nil
1402      printf " @token= "
1403      etp-1 ($arg0)->m[1] 0
1404    end
1405    printf " @from= "
1406    etp-1 ($arg0)->m[2] 0
1407  else
1408    if ($etp_sig_tag & 0x3f) != 0x30
1409      printf "!INVALID-SIGNAL"
1410    else
1411      set $etp_sig_op = (($etp_sig_tag >> 6) & 0xff)
1412      set $etp_sig_type = (($etp_sig_tag >> 14) & 0xff)
1413      if $etp_sig_op == 0
1414	printf "!EXIT[%d]", $etp_sig_type
1415      else
1416      if $etp_sig_op == 1
1417	printf "!EXIT-LINKED[%d]", $etp_sig_type
1418      else
1419      if $etp_sig_op == 2
1420	printf "!MONITOR-DOWN[%d]", $etp_sig_type
1421      else
1422      if $etp_sig_op == 3
1423	printf "!MONITOR[%d]", $etp_sig_type
1424      else
1425      if $etp_sig_op == 4
1426	printf "!DEMONITOR[%d]", $etp_sig_type
1427      else
1428      if $etp_sig_op == 5
1429	printf "!LINK[%d]", $etp_sig_type
1430      else
1431      if $etp_sig_op == 6
1432	printf "!UNLINK[%d]", $etp_sig_type
1433      else
1434      if $etp_sig_op == 7
1435	printf "!GROUP-LEADER[%d]", $etp_sig_type
1436      else
1437      if $etp_sig_op == 8
1438	printf "!TRACE-CHANGE-STATE[%d]", $etp_sig_type
1439      else
1440      if $etp_sig_op == 9
1441	printf "!PERSISTENT-MONITOR-MESSAGE[%d]", $etp_sig_type
1442      else
1443      if $etp_sig_op == 10
1444	printf "!IS-ALIVE[%d]", $etp_sig_type
1445      else
1446      if $etp_sig_op == 11
1447	printf "!PROCESS-INFO[%d]", $etp_sig_type
1448      else
1449      if $etp_sig_op == 12
1450	printf "!SYNC-SUSPEND[%d]", $etp_sig_type
1451      else
1452      if $etp_sig_op == 13
1453	printf "!RPC[%d]", $etp_sig_type
1454      else
1455      if $etp_sig_op == 14
1456	printf "!DIST_SPAWN_REPLY[%d]", $etp_sig_type
1457      else
1458      if $etp_sig_op == 15
1459	printf "!ALIAS[%d]", $etp_sig_type
1460      else
1461      if $etp_sig_op == 16
1462	printf "!RECV_MARKER[%d]", $etp_sig_type
1463      else
1464      if $etp_sig_op == 17
1465	printf "!UNLINK_ACK[%d]", $etp_sig_type
1466      else
1467      if $etp_sig_op == 18
1468	printf "!ADJUST_MSGQ[%d]", $etp_sig_type
1469      else
1470      if $etp_sig_op == 255
1471	printf "->OFFSET_MARKER"
1472      else
1473	printf "UNKNOWN SIGNAL %d [%d]", $etp_sig_op, $etp_sig_type
1474      end
1475      end
1476      end
1477      end
1478      end
1479      end
1480      end
1481      end
1482      end
1483      end
1484      end
1485      end
1486      end
1487      end
1488      end
1489      end
1490      end
1491      end
1492      end
1493      end
1494    end
1495  end
1496end
1497
1498
1499define etp-sigq-int
1500# Args: ErlMessageQueue*
1501#
1502# Non-reentrant
1503#
1504  set $etp_sig = ($arg0)
1505  set $etp_sig_save = ($arg1)
1506  set $etp_sigq_msig_len = 0
1507  set $etp_sigq_nmsig_len = 0
1508
1509  printf "    ["
1510  while $etp_sig != (void *) 0
1511    set $etp_sig_next = $etp_sig->next
1512    if $etp_sig != ($arg0)
1513      printf "     "
1514    end
1515    etp-sig-int $etp_sig
1516    if $etp_sig_is_message
1517      set $etp_sigq_msig_len++
1518    else
1519      set $etp_sigq_nmsig_len++
1520    end
1521    if $etp_sig_next
1522      printf ","
1523    end
1524    if $etp_sig_save && *$etp_sig_save == $etp_sig
1525      printf " %% <== SAVE"
1526    end
1527    if $etp_sig_next
1528      printf "\n"
1529    end
1530    set $etp_sig = $etp_sig_next
1531  end
1532  if $etp_sig_save && $etp_sig_save == ($arg2)
1533    printf "\n     %% <== SAVE"
1534  end
1535  printf "]\n\n"
1536  printf "    Message signals: %d\n", $etp_sigq_msig_len
1537  printf "    Non-message signals: %d\n\n", $etp_sigq_nmsig_len
1538end
1539
1540define etp-sigq-flags-int
1541# Args: int
1542#
1543  if ($arg0 & ~((1 << 9)-1))
1544    printf "GARBAGE<%x> ", ($arg0 & ~((1 << 9)-1))
1545  end
1546  if ($arg0 & (1 << 6))
1547    printf "delayed-sigq-len "
1548  end
1549  if ($arg0 & (1 << 5))
1550    printf "wait-handle-sig "
1551  end
1552  if ($arg0 & (1 << 4))
1553    printf "handling-sig "
1554  end
1555  if ($arg0 & (1 << 3))
1556    printf "local-signals-only "
1557  end
1558  if ($arg0 & (1 << 2))
1559    printf "offheap-msgq-changing "
1560  end
1561  if ($arg0 & (1 << 1))
1562    printf "on-heap "
1563  end
1564  if ($arg0 & (1 << 0))
1565    printf "off-heap "
1566  end
1567  printf "\n"
1568end
1569
1570define etp-sigq-flags
1571# Args: Process*
1572#
1573  set $flags_int = ((Process *) $arg0)->sig_qs.flags
1574  etp-sigq-flags-int $flags_int
1575end
1576
1577document etp-sigq-flags
1578%---------------------------------------------------------------------------
1579% etp-sigqs-flags Process*
1580%
1581% Print the signal queue flags of process
1582%---------------------------------------------------------------------------
1583end
1584
1585define etp-sigqs
1586  set $proc_int = ((Process*)($arg0))
1587  printf "  Msgq Flags: "
1588  etp-sigq-flags $proc_int
1589  printf "  --- Inner signal queue (message queue) ---\n"
1590  etp-sigq-int ($proc_int)->sig_qs.first ($proc_int)->sig_qs.save ($proc_int)->sig_qs.last
1591  printf "  --- Middle signal queue ---\n"
1592  etp-sigq-int ($proc_int)->sig_qs.cont ($proc_int)->sig_qs.save ($proc_int)->sig_qs.cont_last
1593  printf "  --- Outer queue ---\n"
1594  etp-sigq-int ($proc_int)->sig_inq.first ($proc_int)->sig_qs.save ($proc_int)->sig_inq.last
1595end
1596
1597define etp-msgq
1598# Args: ErlMessageQueue*
1599#
1600# Non-reentrant
1601#
1602  set $etp_msgq = ($arg0)
1603  set $etp_msgq_p = $etp_msgq->first
1604  set $etp_msgq_i = $etp_msgq->len
1605  set $etp_msgq_prev = $etp_msgq->last
1606  printf "%% Message queue (%d):", $etp_msgq_i
1607  if ($etp_msgq_i > 0) && $etp_msgq_p
1608    printf "\n["
1609  else
1610    printf "\n"
1611  end
1612  while ($etp_msgq_i > 0) && $etp_msgq_p
1613    set $etp_msgq_i--
1614    set $etp_msgq_next = $etp_msgq_p->next
1615    # Msg
1616    etp-1 ($etp_msgq_p->m[0]) 0
1617    if ($etp_msgq_i > 0) && $etp_msgq_next
1618      printf ", %% "
1619    else
1620      printf "]. %% "
1621    end
1622    # Seq_trace token
1623    etp-1 ($etp_msgq_p->m[1]) 0
1624    if $etp_msgq_p == $etp_msgq->save
1625      printf ", <=\n"
1626    else
1627      printf "\n"
1628    end
1629    if ($etp_msgq_i > 0) && $etp_msgq_next
1630      printf " "
1631    end
1632    #
1633    set $etp_msgq_prev = $etp_msgq_p
1634    set $etp_msgq_p = $etp_msgq_next
1635  end
1636  if $etp_msgq_i != 0
1637    printf "#MsgQShort<%d>\n", $etp_msgq_i
1638  end
1639  if $etp_msgq_p != 0
1640    printf "#MsgQLong<%#lx%p>\n", (unsigned long)$etp_msgq_p
1641  end
1642  if $etp_msgq_prev != $etp_msgq->last
1643    printf "#MsgQEndError<%#lx%p>\n", (unsigned long)$etp_msgq_prev
1644  end
1645end
1646
1647document etp-msgq
1648%---------------------------------------------------------------------------
1649% etp-msgq ErlMessageQueue*
1650%
1651% Take an ErlMessageQueue* and print the contents of the message queue.
1652% Sequential trace tokens are included in comments and
1653% the current match position in the queue is marked '<='.
1654%
1655% A process's message queue is process_tab[i]->sig_qs.
1656%---------------------------------------------------------------------------
1657end
1658
1659
1660
1661define etpf-msgq
1662# Args: Process*
1663#
1664# Non-reentrant
1665#
1666  set $etp_flat = 1
1667  etp-msgq ($arg0)
1668  set $etp_flat = 0
1669end
1670
1671document etpf-msgq
1672%---------------------------------------------------------------------------
1673% etpf-msgq ErlMessageQueue*
1674%
1675% Same as 'etp-msgq' but print the messages using etpf (flat).
1676%---------------------------------------------------------------------------
1677end
1678
1679define etp-stack-preamble
1680  set $etp_stack_p = ($arg0)->stop
1681  set $etp_stack_end = ($arg0)->hend
1682  if ($arg0)->state.counter & 0x8000
1683    printf "%%%%%% WARNING: The process is currently running, so c_p->stop will not be correct\r\n"
1684    printf "%%%%%%          Consider using -emu variant instead\r\n"
1685  end
1686  printf "%% Stacktrace (%u)\n", $etp_stack_end-$etp_stack_p
1687  if ($arg0)->i != 0
1688    printf "I: "
1689    etp ((Eterm)($arg0)->i)
1690  end
1691end
1692
1693define etp-stack-preamble-emu
1694  set $etp_stack_p = E
1695  set $etp_stack_end = ($arg0)->hend
1696  printf "%% Stacktrace (%u)\n", $etp_stack_end-$etp_stack_p
1697  printf "I: "
1698  etp ((BeamInstr)I)
1699end
1700
1701define etp-stacktrace-1
1702  set $etp_stack_stop = (Eterm*)($arg0)
1703  set $etp_stack_send = (Eterm*)($arg1)
1704  set $etp_stack_cnt = 0
1705  while $etp_stack_stop < $etp_stack_send
1706    if ($etp_stack_stop[0] & 0x3) == 0x0
1707      # Continuation pointer
1708      printf "%d: ", $etp_stack_cnt
1709      etp $etp_stack_stop[0]
1710    end
1711    set $etp_stack_stop++
1712    set $etp_stack_cnt++
1713  end
1714end
1715
1716define etp-stacktrace-emu
1717# Args: Process*
1718#
1719# Non-reentrant
1720#
1721  etp-stack-preamble-emu ($arg0)
1722  etp-stacktrace-1 $etp_stack_p $etp_stack_end
1723end
1724
1725document etp-stacktrace-emu
1726%---------------------------------------------------------------------------
1727% etp-stacktrace-emu Process*
1728%
1729% Take an Process* and print a stactrace for the process.
1730% This macro assumes that the current frame is the process_main frame
1731% and that E is not optimized out.
1732%---------------------------------------------------------------------------
1733end
1734
1735define etp-stacktrace
1736# Args: Process*
1737#
1738# Non-reentrant
1739#
1740  etp-stack-preamble ($arg0) "etp-stacktrace"
1741  etp-stacktrace-1 $etp_stack_p $etp_stack_end
1742end
1743
1744document etp-stacktrace
1745%---------------------------------------------------------------------------
1746% etp-stacktrace Process*
1747%
1748% Take an Process* and print a stactrace for the process.
1749% The stacktrace consists just of the pushed code continuation
1750% pointers on the stack, the most recently pushed first.
1751%---------------------------------------------------------------------------
1752end
1753
1754define etp-stackdump-1
1755  # Args: Eterm *stop, Eterm *hend
1756  #
1757  # Non-reentrant
1758  #
1759  set $etp_stackdump_stop = (Eterm*)($arg0)
1760  set $etp_stackdump_send = (Eterm*)($arg1)
1761  set $etp_stackdump_cnt = 0
1762  while $etp_stackdump_stop < $etp_stackdump_send
1763    printf "%d: ", $etp_stackdump_cnt
1764    etp $etp_stackdump_stop[0]
1765    set $etp_stackdump_stop++
1766    set $etp_stackdump_cnt++
1767  end
1768end
1769
1770define etp-stackdump-emu
1771# Args: Process*
1772#
1773# Non-reentrant
1774#
1775  etp-stack-preamble-emu ($arg0)
1776  etp-stackdump-1 $etp_stack_p $etp_stack_end
1777end
1778
1779document etp-stacktrace-emu
1780%---------------------------------------------------------------------------
1781% etp-stacktrace-emu Process*
1782%
1783% Take an Process* and print a stactdump for the process.
1784% This macro assumes that the current frame is the process_main frame
1785% and that E is not optimized out.
1786%---------------------------------------------------------------------------
1787end
1788
1789define etp-stackdump
1790# Args: Process*
1791#
1792# Non-reentrant
1793#
1794  etp-stack-preamble ($arg0) "etp-stackdump"
1795  etp-stackdump-1 $etp_stack_p $etp_stack_end
1796end
1797
1798document etp-stackdump
1799%---------------------------------------------------------------------------
1800% etp-stackdump Process*
1801%
1802% Take an Process* and print a stackdump for the process.
1803% The stackdump consists of all pushed values on the stack.
1804% All code continuation pointers are preceeded with a line
1805% of dashes to make the stack frames more visible.
1806%---------------------------------------------------------------------------
1807end
1808
1809define etpf-stackdump
1810# Args: Process*
1811#
1812# Non-reentrant
1813#
1814  set $etp_flat = 1
1815  etp-stackdump ($arg0)
1816  set $etp_flat = 0
1817end
1818
1819document etpf-stackdump
1820%---------------------------------------------------------------------------
1821% etpf-stackdump Process*
1822%
1823% Same as etp-stackdump but print the values using etpf (flat).
1824%---------------------------------------------------------------------------
1825end
1826
1827define etp-heapdump
1828# Args: Process*
1829#
1830# Non-reentrant
1831  etp-heapdump-1 ($arg0)->heap ($arg0)->htop
1832end
1833
1834document etp-heapdump
1835%---------------------------------------------------------------------------
1836% etp-heapdump Process*
1837%
1838% Take an Process* and print a heapdump for the process heap.
1839%---------------------------------------------------------------------------
1840end
1841
1842define etp-heapdump-old
1843# Args: Process*
1844#
1845# Non-reentrant
1846  etp-heapdump-1 ($arg0)->old_heap ($arg0)->old_htop
1847end
1848
1849document etp-heapdump
1850%---------------------------------------------------------------------------
1851% etp-heapdump-old Process*
1852%
1853% Take an Process* and print a heapdump for the process old heap (gen-heap).
1854%---------------------------------------------------------------------------
1855end
1856
1857
1858define etp-heapdump-1
1859# Args: Eterm* heap, Eterm* htop
1860#
1861# Non-reentrant
1862  set $etp_heapdump_heap = (Eterm*)($arg0)
1863  set $etp_heapdump_p = (Eterm*)($arg0)
1864  set $etp_heapdump_end = (Eterm*)($arg1)
1865  set $etp_heapdump_skips = 0
1866  printf "%% heapdump (%u):\n", $etp_heapdump_end-$etp_heapdump_p
1867  while $etp_heapdump_p < $etp_heapdump_end
1868    set $etp_heapdump_ix = 0
1869    printf " %p: ", $etp_heapdump_p
1870    while $etp_heapdump_p < $etp_heapdump_end && $etp_heapdump_ix < 8
1871	if ($etp_heapdump_skips > 0)
1872	  printf "|   0x%08x ", ($etp_heapdump_p)
1873	  set $etp_heapdump_skips--
1874	else
1875	  etp-term-dump $etp_heapdump_p[0]
1876	end
1877	set $etp_heapdump_p++
1878	set $etp_heapdump_ix++
1879    end
1880    printf "\n"
1881  end
1882end
1883
1884
1885define etp-term-dump
1886# Args: Eterm
1887  if (($arg0) & 0x3) == 0
1888    etp-term-dump-header ($arg0)
1889  else
1890    if (($arg0) & 0x3) == 1
1891      # Cons pointer
1892      set $etp_term_dump_cons_p = ((Eterm*)(($arg0) & etp_ptr_mask))
1893      if $etp_term_dump_cons_p > $etp_heapdump_heap &&  $etp_term_dump_cons_p < $etp_heapdump_end
1894        printf "| C:0x%08x ", $etp_term_dump_cons_p
1895        #printf "| C: --> %5d ", $etp_heapdump_p - $etp_term_dump_cons_p - 1
1896      else
1897        printf "| C:0x%08x ", $etp_term_dump_cons_p
1898      end
1899    else
1900      if (($arg0) & 0x3) == 2
1901        # Box pointer
1902        printf "| B:0x%08x ", ($arg0)
1903      else
1904        if (($arg0) & 0x3) == 3
1905          # immediate
1906          etp-term-dump-immediate ($arg0)
1907        else
1908          printf "| U:0x%08x ", ($arg0)
1909        end
1910      end
1911    end
1912  end
1913end
1914
1915define etp-term-dump-immediate
1916# Args: immediate term
1917  if (($arg0) & 0xF) == 0xf
1918    # Fixnum
1919    etp-ct-printable-1 ((long)((Sint)($arg0)>>4))
1920      if $etp_ct_printable
1921        if $etp_ct_printable < 0
1922	  printf "| I:   %c (%3ld) ", (long)((Sint)($arg0)>>4), (long)((Sint)($arg0)>>4)
1923        else
1924	  printf "| I:  \\%c (%3ld) ", (long)((Sint)($arg0)>>4), (long)((Sint)($arg0)>>4)
1925        end
1926      else
1927      printf "| I:%10ld ", (long)((Sint)($arg0)>>4)
1928    end
1929  else
1930    if (($arg0) & 0xF) == 0x3
1931      etp-term-dump-pid ($arg0)
1932    else
1933      if (($arg0) & 0xF) == 0x7
1934        printf "| port:0x%05x ", ($arg0)
1935       else
1936         # Immediate2  - 0xB
1937         if (($arg0) & 0x3f) == 0x0b
1938	   etp-term-dump-atom ($arg0)
1939         else
1940           if (($arg0) & 0x3f) == 0x1b
1941	     printf "| #Catch<%06d> ", ($arg0)>>6
1942           else
1943             if (($arg0) == $etp_nil)
1944               printf "|    [] (NIL)  "
1945             else
1946               printf "| I:0x%08x ", ($arg0)
1947             end
1948	   end
1949	 end
1950      end
1951    end
1952  end
1953end
1954
1955define etp-term-dump-atom
1956# Args: atom term
1957  set $etp_atom_1_ap = (Atom*)erts_atom_table.seg_table[(Eterm)($arg0)>>16][((Eterm)($arg0)>>6)&0x3FF]
1958  set $etp_atom_1_i = ($etp_atom_1_ap)->len
1959  set $etp_atom_1_p = ($etp_atom_1_ap)->name
1960  set $etp_atom_1_quote = 1
1961  set $etp_atom_indent = 13
1962
1963  if ($etp_atom_1_i < 11)
1964    if ($etp_atom_1_i > 0)
1965      etp-ct-atom-1 (*$etp_atom_1_p)
1966      if $etp_ct_atom
1967        set $etp_atom_indent = 13
1968      else
1969        set $etp_atom_indent = 11
1970      end
1971    end
1972    # perform indentation
1973    printf "|"
1974    while ($etp_atom_1_i < $etp_atom_indent)
1975	printf " "
1976        set $etp_atom_1_i++
1977    end
1978    set $etp_atom_1_i = ($etp_atom_1_ap)->len
1979    # Check if atom has to be quoted
1980    if ($etp_atom_1_i > 0)
1981      etp-ct-atom-1 (*$etp_atom_1_p)
1982      if $etp_ct_atom
1983        # Atom start character
1984        set $etp_atom_1_p++
1985        set $etp_atom_1_i--
1986        set $etp_atom_1_quote = 0
1987      else
1988        set $etp_atom_1_i = 0
1989      end
1990    end
1991    while $etp_atom_1_i > 0
1992      etp-ct-name-1 (*$etp_atom_1_p)
1993      if $etp_ct_name
1994        # Name character
1995        set $etp_atom_1_p++
1996        set $etp_atom_1_i--
1997      else
1998        set $etp_atom_1_quote = 1
1999        set $etp_atom_1_i = 0
2000      end
2001    end
2002    # Print the atom
2003    if $etp_atom_1_quote
2004      printf "'"
2005    end
2006    set $etp_atom_1_i = ($etp_atom_1_ap)->len
2007    set $etp_atom_1_p = ($etp_atom_1_ap)->name
2008    while $etp_atom_1_i > 0
2009        etp-char-1 (*$etp_atom_1_p) '\''
2010        set $etp_atom_1_p++
2011        set $etp_atom_1_i--
2012    end
2013    if $etp_atom_1_quote
2014      printf "'"
2015    end
2016    printf " "
2017  else
2018    printf "| A:0x%08x ", ($arg0)
2019  end
2020end
2021
2022define etp-term-dump-pid
2023# Args: Eterm pid
2024#
2025# Non-reentrant
2026#
2027  set $etp_pid_1 = (Eterm)($arg0)
2028  if ($etp_pid_1 & 0xF) == 0x3
2029    if (etp_arch_bits == 64)
2030      if (etp_endianness > 0)
2031        set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff)
2032      else
2033        set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff)
2034      end
2035   else
2036      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))
2037   end
2038    # Internal pid
2039    printf "| <0.%04u.%03u> ", $etp_pid_data & 0x7fff, ($etp_pid_data >> 15) & 0x1fff
2040  else
2041    printf "| #NotPid<%p> ", ($arg0)
2042  end
2043end
2044
2045define etp-term-dump-header
2046# Args: Header term
2047  if (($arg0) & 0x3f) == 0
2048    printf  "| H:%4d-tuple ", ($arg0) >> 6
2049  else
2050    set $etp_heapdump_skips = ($arg0) >> 6
2051    if ((($arg0) & 0x3f) == 0x18)
2052      printf  "| H: float %3d ", ($arg0) >> 6
2053    else
2054      if ((($arg0) & 0x3f) == 0x28)
2055        # sub-binary
2056        printf  "| H:   sub-bin "
2057      else
2058        if ((($arg0) & 0x3f) == 0x8)
2059          # pos-bignum
2060          printf  "| H:bignum %3u ", ($arg0) >> 6
2061        else
2062          printf  "| header %5d ", ($arg0) >> 6
2063	end
2064      end
2065    end
2066  end
2067end
2068
2069
2070
2071define etp-pid2pix-1
2072# Args: Eterm
2073#
2074   if (etp_arch_bits == 64)
2075      if (etp_endianness > 0)
2076      	 set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff)
2077      else
2078      	 set $etp_pix = (int) ((((Uint64) $arg0) >> 32) & 0x0fffffff)
2079      end
2080   else
2081      set $etp_pix =  (int) ((((Uint32) $arg0) >> 4) & erts_proc.r.o.pix_mask)
2082   end
2083end
2084
2085define etp-pix2proc
2086# Args: Eterm
2087#
2088   set $proc = (Process *) *((UWord *) &erts_proc.r.o.tab[((int) $arg0)])
2089   printf "(Process*)%p\n", $proc
2090end
2091
2092define etp-pid2proc-1
2093# Args: Eterm
2094#
2095  etp-pid2pix-1 $arg0
2096  set $proc = (Process *) *((UWord *) &erts_proc.r.o.tab[$etp_pix])
2097end
2098
2099define etp-pid2proc
2100# Args: Eterm
2101#
2102   etp-pid2proc-1 $arg0
2103   printf "(Process*)%p\n", $proc
2104end
2105
2106define etp-proc-state-int
2107# Args: int
2108#
2109  if ($arg0 & 0x80000000)
2110    printf "GARBAGE<0x80000000> | "
2111  end
2112  if ($arg0 & 0x40000000)
2113    printf "dirty-running-sys | "
2114  end
2115  if ($arg0 & 0x20000000)
2116    printf "dirty-running | "
2117  end
2118  if ($arg0 & 0x10000000)
2119    printf "dirty-active-sys | "
2120  end
2121  if ($arg0 & 0x8000000)
2122    printf "dirty-io-proc | "
2123  end
2124  if ($arg0 & 0x4000000)
2125    printf "dirty-cpu-proc | "
2126  end
2127  if ($arg0 & 0x2000000)
2128    printf "sig-q | "
2129  end
2130  if ($arg0 & 0x1000000)
2131    printf "off-heap-msgq | "
2132  end
2133  if ($arg0 & 0x800000)
2134    printf "delayed-sys | "
2135  end
2136  if ($arg0 & 0x400000)
2137    printf "proxy | "
2138    set $proxy_process = 1
2139  else
2140    set $proxy_process = 0
2141  end
2142  if ($arg0 & 0x200000)
2143    printf "running-sys | "
2144  end
2145  if ($arg0 & 0x100000)
2146    printf "active-sys | "
2147  end
2148  if ($arg0 & 0x80000)
2149    printf "sig-in-q | "
2150  end
2151  if ($arg0 & 0x40000)
2152    printf "sys-tasks | "
2153  end
2154  if ($arg0 & 0x20000)
2155    printf "garbage-collecting | "
2156  end
2157  if ($arg0 & 0x10000)
2158    printf "suspended | "
2159  end
2160  if ($arg0 & 0x8000)
2161    printf "running | "
2162  end
2163  if ($arg0 & 0x4000)
2164    printf "in-run-queue | "
2165  end
2166  if ($arg0 & 0x2000)
2167    printf "active | "
2168  end
2169  if ($arg0 & 0x1000)
2170    printf "unused | "
2171  end
2172  if ($arg0 & 0x800)
2173    printf "exiting | "
2174  end
2175  if ($arg0 & 0x400)
2176    printf "free | "
2177  end
2178  if ($arg0 & 0x200)
2179    printf "in-prq-low | "
2180  end
2181  if ($arg0 & 0x100)
2182    printf "in-prq-normal | "
2183  end
2184  if ($arg0 & 0x80)
2185    printf "in-prq-high | "
2186  end
2187  if ($arg0 & 0x40)
2188    printf "in-prq-max | "
2189  end
2190  if ($arg0 & 0x30) == 0x0
2191    printf "prq-prio-max | "
2192  else
2193    if ($arg0 & 0x30) == 0x10
2194      printf "prq-prio-high | "
2195    else
2196      if ($arg0 & 0x30) == 0x20
2197        printf "prq-prio-normal | "
2198      else
2199        printf "prq-prio-low | "
2200      end
2201    end
2202  end
2203  if ($arg0 & 0xc) == 0x0
2204    printf "usr-prio-max | "
2205  else
2206    if ($arg0 & 0xc) == 0x4
2207      printf "usr-prio-high | "
2208    else
2209      if ($arg0 & 0xc) == 0x8
2210        printf "usr-prio-normal | "
2211      else
2212        printf "usr-prio-low | "
2213      end
2214    end
2215  end
2216  if ($arg0 & 0x3) == 0x0
2217    printf "act-prio-max\n"
2218  else
2219    if ($arg0 & 0x3) == 0x1
2220      printf "act-prio-high\n"
2221    else
2222      if ($arg0 & 0x3) == 0x2
2223        printf "act-prio-normal\n"
2224      else
2225        printf "act-prio-low\n"
2226      end
2227    end
2228  end
2229end
2230
2231document etp-proc-state-int
2232%---------------------------------------------------------------------------
2233% etp-proc-state-int int
2234%
2235% Print state of process state value
2236%---------------------------------------------------------------------------
2237end
2238
2239
2240define etp-proc-state
2241# Args: Process*
2242#
2243  set $state_int = *(((Uint32 *) &(((Process *) $arg0)->state)))
2244  etp-proc-state-int $state_int
2245end
2246
2247document etp-proc-state
2248%---------------------------------------------------------------------------
2249% etp-proc-state Process*
2250%
2251% Print state of process
2252%---------------------------------------------------------------------------
2253end
2254
2255define etp-proc-flags-int
2256# Args: int
2257#
2258  if ($arg0 & ~((1 << 24)-1))
2259    printf "GARBAGE<%x> ", ($arg0 & ~((1 << 24)-1))
2260  end
2261  if ($arg0 & (1 << 22))
2262    printf "trap-exit "
2263  end
2264  if ($arg0 & (1 << 21))
2265    printf "hibernated "
2266  end
2267  if ($arg0 & (1 << 20))
2268    printf "dirty-minor-gc "
2269  end
2270  if ($arg0 & (1 << 19))
2271    printf "dirty-major-gc "
2272  end
2273  if ($arg0 & (1 << 18))
2274    printf "dirty-gc-hibernate "
2275  end
2276  if ($arg0 & (1 << 17))
2277    printf "dirty-cla "
2278  end
2279  if ($arg0 & (1 << 16))
2280    printf "delayed-del-proc "
2281  end
2282  if ($arg0 & (1 << 15))
2283    printf "have-blocked-nmsb "
2284  end
2285  if ($arg0 & (1 << 14))
2286    printf "shdlr-onln-wait-q "
2287  end
2288  if ($arg0 & (1 << 13))
2289    printf "delay-gc "
2290  end
2291  if ($arg0 & (1 << 12))
2292    printf "abandoned-heap-use "
2293  end
2294  if ($arg0 & (1 << 11))
2295    printf "disable-gc "
2296  end
2297  if ($arg0 & (1 << 10))
2298    printf "force-gc "
2299  end
2300  if ($arg0 & (1 << 9))
2301    printf "ets-super-user "
2302  end
2303  if ($arg0 & (1 << 8))
2304    printf "have-blocked-msb "
2305  end
2306  if ($arg0 & (1 << 7))
2307    printf "using-ddll "
2308  end
2309  if ($arg0 & (1 << 6))
2310    printf "distribution "
2311  end
2312  if ($arg0 & (1 << 5))
2313    printf "using-db "
2314  end
2315  if ($arg0 & (1 << 4))
2316    printf "need-fullsweep "
2317  end
2318  if ($arg0 & (1 << 3))
2319    printf "heap-grow "
2320  end
2321  if ($arg0 & (1 << 2))
2322    printf "timo "
2323  end
2324  if ($arg0 & (1 << 1))
2325    printf "inslpqueue "
2326  end
2327  if ($arg0 & (1 << 0))
2328    printf "hibernate-sched "
2329  end
2330  printf "\n"
2331end
2332
2333document etp-proc-flags-int
2334%---------------------------------------------------------------------------
2335% etp-proc-flags-int int
2336%
2337% Print flags of process flags value
2338%---------------------------------------------------------------------------
2339end
2340
2341
2342define etp-proc-flags
2343# Args: Process*
2344#
2345  set $flags_int = ((Process *) $arg0)->flags
2346  etp-proc-flags-int $flags_int
2347end
2348
2349document etp-proc-flags
2350%---------------------------------------------------------------------------
2351% etp-proc-flags Process*
2352%
2353% Print flags of process
2354%---------------------------------------------------------------------------
2355end
2356
2357define etp-process-info-int
2358# Args: Process*
2359#
2360  printf "  Pid: "
2361  set $etp_proc = ((Process*)$arg0)
2362  etp-1 $etp_proc->common.id
2363  printf "\n  State: "
2364  etp-proc-state $etp_proc
2365  printf "\n  Flags: "
2366  etp-proc-flags $etp_proc
2367  if $proxy_process != 0
2368    printf "  Pointer: (Process*)%p\n", $etp_proc
2369    printf "  *** PROXY process struct *** refer to: \n"
2370    etp-process-info $etp_proc->u.real_proc
2371  else
2372  if (*(((Uint32 *) &($etp_proc->state))) & 0x800) == 0
2373    if ($etp_proc->common.u.alive.reg)
2374      printf "  Registered name: "
2375      etp-1 $etp_proc->common.u.alive.reg->name
2376      printf "\n"
2377    end
2378  end
2379  printf "  Current function: "
2380  if ($etp_proc->current && !($etp_proc->state.counter & 0x800))
2381    etp-1 $etp_proc->current->module
2382    printf ":"
2383    etp-1 $etp_proc->current->function
2384    printf "/%d\n", $etp_proc->current->arity
2385  else
2386    printf "unknown\n"
2387  end
2388  printf "  I: "
2389  if ($etp_proc->i)
2390    etp-cp-1 $etp_proc->i
2391    printf "\n"
2392  else
2393    printf "unknown\n"
2394  end
2395  printf "  Heap size: %ld\n", $etp_proc->heap_sz
2396  printf "  Old-heap size: "
2397  if ($etp_proc->old_heap)
2398    printf "%ld\n", $etp_proc->old_hend - $etp_proc->old_heap
2399  else
2400    printf "0\n"
2401  end
2402  printf "  Mbuf size: %ld\n", $etp_proc->mbuf_sz
2403  printf "  Msgq len: %ld (inner=%ld, outer=%ld)\n", ($etp_proc->sig_qs.len + $etp_proc->sig_inq.len), $etp_proc->sig_qs.len, $etp_proc->sig_inq.len
2404  if (!($arg1))
2405    printf "  Msgq Flags: "
2406    etp-sigq-flags $etp_proc
2407  end
2408  printf "  Parent: "
2409  etp-1 ((Eterm)($etp_proc->parent))
2410  printf "\n  Pointer: (Process*)%p\n", $etp_proc
2411  end
2412  if ($arg1)
2413    etp-sigqs $etp_proc
2414  end
2415end
2416
2417define etp-process-info
2418  etp-process-info-int ($arg0) 0
2419end
2420
2421define etp-process-info-x
2422  etp-process-info-int ($arg0) !0
2423end
2424
2425document etp-process-info
2426%---------------------------------------------------------------------------
2427% etp-process-info Process*
2428%
2429% Print info about process
2430%---------------------------------------------------------------------------
2431end
2432
2433define etp-processes-free-runq-int
2434  set $runq_prio = 0
2435  while $runq_prio < 3
2436    set $runq_proc = ($arg0)->procs.prio[$runq_prio].first
2437    while $runq_proc != 0
2438      if $runq_proc->state.counter & 0x400
2439        printf "---\n"
2440        printf "  Pix: FREE -> run_queue %p\n", ($arg0)
2441        etp-process-info-int $runq_proc ($arg1)
2442      end
2443      set $runq_proc = $runq_proc->next
2444    end
2445    set $runq_prio++
2446  end
2447end
2448
2449define etp-processes-free-de-int
2450  set $de_ix = 0
2451  set $de = ($arg0)
2452  while $de
2453    set $susp = $de->suspended
2454    set $susp_curr = $susp
2455    set $first_loop = 1
2456    while $susp_curr != 0 && (($susp_curr != $susp) || $first_loop)
2457      if ($susp_curr->u.pid & 0x3) == 0
2458        printf "---\n"
2459        printf "  Pix: FREE "
2460        etp $de->sysname
2461        etp-process-info-int $susp_curr->u.pid ($arg2)
2462      end
2463      set $first_loop = 0
2464      set $susp_curr = $susp_curr->next
2465    end
2466    set $de = $de->next
2467  end
2468end
2469
2470define etp-processes-int
2471  if (!erts_initialized)
2472    printf "No processes, since system isn't initialized!\n"
2473  else
2474    set $proc_ix = 0
2475    set $proc_max_ix = erts_proc.r.o.max
2476    set $proc_tab = erts_proc.r.o.tab
2477    set $proc_cnt = erts_proc.vola.tile.count.counter
2478    set $invalid_proc = &erts_invalid_process
2479    set $proc_decentile = $proc_max_ix / 10
2480    set $proc_printile = $proc_decentile
2481    while $proc_ix < $proc_max_ix && $proc_cnt > 0
2482      set $proc = (Process *) *((UWord *) ($proc_tab + $proc_ix))
2483      if ($proc != ((Process *) 0) && $proc != $invalid_proc)
2484        printf "---\n"
2485        printf "  Pix: %d\n", $proc_ix
2486        etp-process-info-int $proc ($arg0)
2487        set $proc_cnt--
2488      end
2489      if $proc_ix == $proc_printile
2490        printf "--- %d%% (%d / %d) searched, looking for %d more\n", $proc_printile / $proc_decentile * 10, $proc_ix, $proc_max_ix, $proc_cnt
2491        set $proc_printile += $proc_decentile
2492      end
2493      set $proc_ix++
2494    end
2495
2496    ## We should also check for any FREE processes that are running
2497    ## They can be found in esdp->current_process, dep->suspendees and
2498    ## runq. Running FREE processes are processes that either are yielding
2499    ## when exiting or running on a dirty scheduler while having exited.
2500    set $sched_ix = 0
2501    while $sched_ix < erts_no_schedulers
2502      set $sched_data = &erts_aligned_scheduler_data[$sched_ix].esd
2503      if $sched_data->current_process != 0
2504        if $sched_data->current_process.state.counter & 0x400
2505          printf "---\n"
2506          printf "  Pix: FREE -> scheduler %d\n", $sched_ix+1
2507          etp-process-info-int $sched_data->current_process ($arg0)
2508        end
2509      end
2510      etp-processes-free-runq-int $sched_data->run_queue ($arg0)
2511      set $sched_ix++
2512    end
2513    etp-processes-free-runq-int &erts_aligned_run_queues[erts_no_run_queues].runq ($arg0)
2514    etp-processes-free-runq-int &erts_aligned_run_queues[erts_no_run_queues+1].runq ($arg0)
2515    etp-processes-free-de-int erts_hidden_dist_entries erts_no_of_hidden_dist_entries ($arg0)
2516    etp-processes-free-de-int erts_visible_dist_entries erts_no_of_visible_dist_entries ($arg0)
2517    etp-processes-free-de-int erts_pending_dist_entries erts_no_of_pending_dist_entries ($arg0)
2518    etp-processes-free-de-int erts_not_connected_dist_entries erts_no_of_not_connected_dist_entries ($arg0)
2519    etp-processes-free-de-int erts_this_dist_entry 1 ($arg0)
2520    printf "---\n",
2521  end
2522end
2523
2524define etp-processes
2525  etp-processes-int 0
2526end
2527
2528define etp-processes-x
2529  etp-processes-int !0
2530end
2531
2532document etp-processes
2533%---------------------------------------------------------------------------
2534% etp-processes
2535%
2536% Print misc info about all processes
2537%---------------------------------------------------------------------------
2538end
2539
2540define etp-processes-memory
2541  if (!erts_initialized)
2542    printf "No processes, since system isn't initialized!\n"
2543  else
2544    set $proc_ix = 0
2545    printf "--- (%ld processes in wheel)\n", erts_proc.r.o.max
2546    while $proc_ix < erts_proc.r.o.max
2547      set $proc = (Process *) *((UWord *) &erts_proc.r.o.tab[$proc_ix])
2548      if ($proc != ((Process *) 0) && $proc != &erts_invalid_process)
2549        etp-process-memory-info $proc
2550      end
2551      set $proc_ix++
2552    end
2553    printf "---\n",
2554  end
2555end
2556
2557document etp-processes-memory
2558%---------------------------------------------------------------------------
2559% etp-processes-memory
2560%
2561% Print memory info about all processes
2562%---------------------------------------------------------------------------
2563end
2564
2565define etp-process-memory-info
2566# Args: Process*
2567#
2568  set $etp_pmem_proc = ((Process *) $arg0)
2569  if ((*(((Uint32 *) &($etp_pmem_proc->state)))) & 0x400000)
2570    set $proxy_process = 1
2571  else
2572    set $proxy_process = 0
2573  end
2574  printf "  "
2575  etp-1 $etp_pmem_proc->common.id
2576  printf ": (Process*)%p ", $etp_pmem_proc
2577  if $proxy_process != 0
2578    printf "(Process*)%p ", $etp_pmem_proc
2579    printf "  *** PROXY process struct *** refer to next: \n"
2580    etp-pid2proc-1 $etp_pmem_proc->common.id
2581    printf " -"
2582    etp-process-memory-info $proc
2583  else
2584    printf " [Heap: %5ld", $etp_pmem_proc->heap_sz
2585    if ($etp_pmem_proc->old_heap)
2586      printf " | %5ld", $etp_pmem_proc->old_hend - $etp_pmem_proc->old_heap
2587    else
2588      printf " | none "
2589    end
2590    printf "] [Mbuf: %5ld", $etp_pmem_proc->mbuf_sz
2591    printf " | %3ld (%3ld | %3ld)", ($etp_pmem_proc->sig_qs.len + $etp_pmem_proc->sig_inq.len), $etp_pmem_proc->sig_qs.len, $etp_pmem_proc->sig_inq.len
2592    printf "] "
2593    if ($etp_pmem_proc->i)
2594      printf " I: "
2595      etp-cp-1 $etp_pmem_proc->i
2596      printf " "
2597    end
2598
2599    if ($etp_pmem_proc->current)
2600      etp-1 $etp_pmem_proc->current[0]
2601      printf ":"
2602      etp-1 $etp_pmem_proc->current[1]
2603      printf "/%d ", $etp_pmem_proc->current[2]
2604    end
2605
2606    if (*(((Uint32 *) &(((Process *) $etp_pmem_proc)->state))) & 0x4) == 0
2607      if ($etp_pmem_proc->common.u.alive.reg)
2608        etp-1 $etp_pmem_proc->common.u.alive.reg->name
2609        printf " "
2610      end
2611    end
2612
2613    printf "\n"
2614  end
2615end
2616
2617document etp-process-memory-info
2618%---------------------------------------------------------------------------
2619% etp-process-memory-info Process*
2620%
2621% Print memory info about process
2622%---------------------------------------------------------------------------
2623end
2624
2625define etp-port-id2pix-1
2626# Args: Eterm
2627#
2628   if (etp_arch_bits == 64)
2629      if (etp_endianness > 0)
2630      	 set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff)
2631      elser
2632      	 set $etp_pix = (int) ((((Uint64) $arg0) >> 32) & 0x0fffffff)
2633      end
2634   else
2635      set $etp_pix =  (int) ((((Uint32) $arg0) >> 4) & erts_port.r.o.pix_mask)
2636   end
2637end
2638
2639define etp-pix2port
2640# Args: Eterm
2641#
2642   set $port = (Port *) *((UWord *) &erts_port.r.o.tab[((int) $arg0)])
2643   printf "(Port*)%p\n", $port
2644end
2645
2646define etp-id2port-1
2647# Args: Eterm
2648#
2649  etp-port-id2pix-1 $arg0
2650  set $port = (Port *) *((UWord *) &erts_port.r.o.tab[((int) $etp_pix)])
2651end
2652
2653define etp-id2port
2654# Args: Eterm
2655#
2656   etp-id2port-1 $arg0
2657   printf "(Port*)%p\n", $port
2658end
2659
2660define etp-port-sched-flags-int
2661# Args: int
2662#
2663  if ($arg0 & (1 << 0))
2664    printf " in-run-queue"
2665  end
2666  if ($arg0 & (1 << 1))
2667    printf " executing"
2668  end
2669  if ($arg0 & (1 << 2))
2670    printf " have-tasks"
2671  end
2672  if ($arg0 & (1 << 3))
2673    printf " exited"
2674  end
2675  if ($arg0 & (1 << 4))
2676    printf " busy-port"
2677  end
2678  if ($arg0 & (1 << 5))
2679    printf " busy-port-q"
2680  end
2681  if ($arg0 & (1 << 6))
2682    printf " chk-unset-busy-port-q"
2683  end
2684  if ($arg0 & (1 << 7))
2685    printf " have-busy-tasks"
2686  end
2687  if ($arg0 & (1 << 8))
2688    printf " have-nosuspend-tasks"
2689  end
2690  if ($arg0 & (1 << 9))
2691    printf " parallelism"
2692  end
2693  if ($arg0 & (1 << 10))
2694    printf " force-sched"
2695  end
2696  if ($arg0 & (1 << 11))
2697    printf " exiting"
2698  end
2699  if ($arg0 & (1 << 12))
2700    printf " exec-imm"
2701  end
2702  if ($arg0 & 0xffffc000)
2703    printf " GARBAGE"
2704  end
2705  printf "\n"
2706end
2707
2708document etp-port-sched-flags-int
2709%---------------------------------------------------------------------------
2710% etp-proc-sched-flags-int int
2711%
2712% Print port sched-flags
2713%---------------------------------------------------------------------------
2714end
2715
2716
2717define etp-port-sched-flags
2718# Args: Port*
2719#
2720  set $sched_flags_int = *(((Uint32 *) &(((Port *) $arg0)->sched.flags)))
2721  etp-port-sched-flags-int $sched_flags_int
2722end
2723
2724document etp-port-sched-flags
2725%---------------------------------------------------------------------------
2726% etp-proc-sched-flags-int Port *
2727%
2728% Print port sched-flags
2729%---------------------------------------------------------------------------
2730end
2731
2732define etp-port-state-int
2733# Args: int
2734#
2735  if ($arg0 & 0x1)
2736    printf " connected"
2737  end
2738  if ($arg0 & 0x2)
2739    printf " exiting"
2740  end
2741  if ($arg0 & 0x4)
2742    printf " distribution"
2743  end
2744  if ($arg0 & 0x8)
2745    printf " binary-io"
2746  end
2747  if ($arg0 & 0x10)
2748    printf " soft-eof"
2749  end
2750  if ($arg0 & 0x20)
2751    printf " closing"
2752  end
2753  if ($arg0 & 0x40)
2754    printf " send-closed"
2755  end
2756  if ($arg0 & 0x80)
2757    printf " linebuf-io"
2758  end
2759  if ($arg0 & 0x100)
2760    printf " free"
2761  end
2762  if ($arg0 & 0x200)
2763    printf " initializing"
2764  end
2765  if ($arg0 & 0x400)
2766    printf " port-specific-lock"
2767  end
2768  if ($arg0 & 0x800)
2769    printf " invalid"
2770  end
2771  if ($arg0 & 0x1000)
2772    printf " halt"
2773  end
2774  if (etp_debug_compiled)
2775    if ($arg0 & 0x7fffe000)
2776      printf " GARBAGE"
2777    end
2778  else
2779    if ($arg0 & 0xffffe000)
2780      printf " GARBAGE"
2781    end
2782  end
2783  printf "\n"
2784end
2785
2786document etp-port-state-int
2787%---------------------------------------------------------------------------
2788% etp-proc-state-int int
2789%
2790% Print port state
2791%---------------------------------------------------------------------------
2792end
2793
2794
2795define etp-port-state
2796# Args: Port*
2797#
2798  set $state_int = *(((Uint32 *) &(((Port *) $arg0)->state)))
2799  etp-port-state-int $state_int
2800end
2801
2802document etp-port-state
2803%---------------------------------------------------------------------------
2804% etp-proc-state-int Port *
2805%
2806% Print port state
2807%---------------------------------------------------------------------------
2808end
2809
2810define etp-port-info
2811# Args: Port*
2812#
2813  printf "  Port: "
2814  set $etp_pinfo_port = ((Port*)$arg0)
2815  etp-1 $etp_pinfo_port->common.id
2816  printf "\n  Name: %s\n", $etp_pinfo_port->name
2817  printf "  State:"
2818  etp-port-state $etp_pinfo_port
2819  printf "  Scheduler flags:"
2820  etp-port-sched-flags $etp_pinfo_port
2821  if (*(((Uint32 *) &($etp_pinfo_port->state))) & 0x5C00) == 0
2822    if ($etp_pinfo_port->common.u.alive.reg)
2823      printf "  Registered name: "
2824      etp-1 $etp_pinfo_port->common.u.alive.reg->name
2825      printf "\n"
2826    end
2827  end
2828  printf "  Connected: "
2829  set $connected = *(((Eterm *) &(((Port *) $etp_pinfo_port)->connected)))
2830  etp-1 $connected
2831  printf "\n  Pointer: (Port*)%p\n", $etp_pinfo_port
2832end
2833
2834document etp-port-info
2835%---------------------------------------------------------------------------
2836% etp-port-info Port*
2837%
2838% Print info about port
2839%---------------------------------------------------------------------------
2840end
2841
2842define etp-ports
2843  if (!erts_initialized)
2844    printf "No ports, since system isn't initialized!\n"
2845  else
2846    set $port_ix = 0
2847    set $port_max_ix = erts_port.r.o.max
2848    set $port_tab = erts_port.r.o.tab
2849    set $port_cnt = erts_proc.vola.tile.count.counter
2850    set $invalid_port = &erts_invalid_port
2851    set $port_decentile = $port_max_ix / 10
2852    set $port_printile = $port_decentile
2853    while $port_ix < $port_max_ix && $port_cnt > 0
2854      set $port = (Port *) *((UWord *) ($port_tab + $port_ix))
2855      if ($port != ((Port *) 0) && $port != $invalid_port)
2856        if (*(((Uint32 *) &(((Port *) $port)->state))) & 0x100) == 0
2857          # I.e, not free
2858          printf "---\n"
2859          printf "  Pix: %d\n", $port_ix
2860          etp-port-info $port
2861          set $port_cnt--
2862        end
2863      end
2864      if $port_ix == $port_printile
2865        printf "--- %d%% (%d / %d) searched\n", $port_printile / $port_decentile * 10, $port_ix, $port_max_ix
2866        set $port_printile += $port_decentile
2867      end
2868      set $port_ix++
2869    end
2870    printf "---\n",
2871  end
2872end
2873
2874document etp-ports
2875%---------------------------------------------------------------------------
2876% etp-ports
2877%
2878% Print misc info about all ports
2879%---------------------------------------------------------------------------
2880end
2881
2882define etp-rq-flags-int
2883# Args: int
2884#
2885  if ($arg0 & 0x1f)
2886    printf "  Queue Mask:"
2887    if ($arg0 & 0x1)
2888      printf " max"
2889    end
2890    if ($arg0 & 0x2)
2891      printf " high"
2892    end
2893    if ($arg0 & 0x4)
2894      printf " normal"
2895    end
2896    if ($arg0 & 0x8)
2897      printf " low"
2898    end
2899    if ($arg0 & 0x10)
2900      printf " ports"
2901    end
2902    printf "\n"
2903  end
2904
2905  if ($arg0 & 0x3fe0)
2906    printf "  Emigrate Mask:"
2907    if ($arg0 & 0x20)
2908      printf " max"
2909    end
2910    if ($arg0 & 0x40)
2911      printf " high"
2912    end
2913    if ($arg0 & 0x80)
2914      printf " normal"
2915    end
2916    if ($arg0 & 0x100)
2917      printf " low"
2918    end
2919    if ($arg0 & 0x200)
2920      printf " ports"
2921    end
2922    printf "\n"
2923  end
2924
2925  if ($arg0 & 0x7fc00)
2926    printf "  Immigrate Mask:"
2927    if ($arg0 & 0x400)
2928      printf " max"
2929    end
2930    if ($arg0 & 0x800)
2931      printf " high"
2932    end
2933    if ($arg0 & 0x1000)
2934      printf " normal"
2935    end
2936    if ($arg0 & 0x2000)
2937      printf " low"
2938    end
2939    if ($arg0 & 0x4000)
2940      printf " ports"
2941    end
2942    printf "\n"
2943  end
2944
2945  if ($arg0 & 0xf8000)
2946    printf "  Evaquate Mask:"
2947    if ($arg0 & 0x8000)
2948      printf " max"
2949    end
2950    if ($arg0 & 0x10000)
2951      printf " high"
2952    end
2953    if ($arg0 & 0x20000)
2954      printf " normal"
2955    end
2956    if ($arg0 & 0x40000)
2957      printf " low"
2958    end
2959    if ($arg0 & 0x80000)
2960      printf " ports"
2961    end
2962    printf "\n"
2963  end
2964
2965  if ($arg0 & ~0xfffff)
2966    printf "  Misc Flags:"
2967    if ($arg0 & 0x100000)
2968      printf " out-of-work"
2969    end
2970    if ($arg0 & 0x200000)
2971      printf " halftime-out-of-work"
2972    end
2973    if ($arg0 & 0x400000)
2974      printf " suspended"
2975    end
2976    if ($arg0 & 0x800000)
2977      printf " check-cpu-bind"
2978    end
2979    if ($arg0 & 0x1000000)
2980      printf " inactive"
2981    end
2982    if ($arg0 & 0x2000000)
2983      printf " non-empty"
2984    end
2985    if ($arg0 & 0x4000000)
2986      printf " protected"
2987    end
2988    if ($arg0 & 0x8000000)
2989      printf " exec"
2990    end
2991    if ($arg0 & 0x10000000)
2992      printf " msb_exec"
2993    end
2994    if ($arg0 & 0x20000000)
2995      printf " misc_op"
2996    end
2997    if ($arg0 & 0x40000000)
2998      printf " halting"
2999    end
3000    if ($arg0 & ~0x7fffffff)
3001      printf " GARBAGE(0x%x)", ($arg0 & ~0x7fffffff)
3002    end
3003    printf "\n"
3004  end
3005end
3006
3007document etp-rq-flags-int
3008%---------------------------------------------------------------------------
3009% etp-rq-flags-int
3010%
3011% Print run queue flags
3012%---------------------------------------------------------------------------
3013end
3014
3015define etp-ssi-flags
3016# Args: int
3017#
3018  if ($arg0 & 0x1)
3019    printf " sleeping"
3020  end
3021  if ($arg0 & 0x2)
3022    printf " poll"
3023  end
3024  if ($arg0 & 0x4)
3025    printf " tse"
3026  end
3027  if ($arg0 & 0x8)
3028    printf " waiting"
3029  end
3030  if ($arg0 & 0x10)
3031    printf " suspended"
3032  end
3033  if ($arg0 & 0x20)
3034    printf " msb_exec"
3035  end
3036  printf "\n"
3037end
3038
3039document etp-ssi-flags
3040%---------------------------------------------------------------------------
3041% etp-ssi-flags
3042% Arg int
3043%
3044% Print aux work flags
3045%---------------------------------------------------------------------------
3046end
3047
3048define etp-aux-work-flags
3049# Args: int
3050#
3051  if ($arg0 & 0x1)
3052    printf " delayed-aw-wakeup"
3053  end
3054  if ($arg0 & 0x2)
3055    printf " delayed-dealloc"
3056  end
3057  if ($arg0 & 0x4)
3058    printf " delayed-dealloc-thr-prgr"
3059  end
3060  if ($arg0 & 0x8)
3061    printf " fix-alloc-dealloc"
3062  end
3063  if ($arg0 & 0x10)
3064    printf " fix-alloc-lower-lim"
3065  end
3066  if ($arg0 & 0x20)
3067    printf " later-op"
3068  end
3069  if ($arg0 & 0x40)
3070    printf " canceled-timers"
3071  end
3072  if ($arg0 & 0x80)
3073    printf " canceled-timers-thr-prgr"
3074  end
3075  if ($arg0 & 0x100)
3076    printf " async-ready"
3077  end
3078  if ($arg0 & 0x200)
3079    printf " async-ready-clean"
3080  end
3081  if ($arg0 & 0x400)
3082    printf " misc-thr-prgr"
3083  end
3084  if ($arg0 & 0x800)
3085    printf " misc"
3086  end
3087  if ($arg0 & 0x1000)
3088    printf " set-tmo"
3089  end
3090  if ($arg0 & 0x2000)
3091    printf " mseg-cache-check"
3092  end
3093  if ($arg0 & 0x4000)
3094    printf " yield"
3095  end
3096  if ($arg0 & 0x8000)
3097    printf " reap-ports"
3098  end
3099  if ($arg0 & 0x10000)
3100    printf " debug-wait-completed"
3101  end
3102  if ($arg0 & ~0x1ffff)
3103    printf " GARBAGE"
3104  end
3105  printf "\n"
3106end
3107
3108document etp-aux-work-flags
3109%---------------------------------------------------------------------------
3110% etp-aux-work-flags
3111% Arg int
3112%
3113% Print aux work flags
3114%---------------------------------------------------------------------------
3115end
3116
3117define etp-schedulers
3118  if (!erts_initialized)
3119    printf "No schedulers, since system isn't initialized!\n"
3120  else
3121    set $sched_type = 0
3122    set $sched_ix = 0
3123    while $sched_ix < erts_no_schedulers
3124      etp-scheduler-info-internal
3125      etp-run-queue-info-internal
3126      set $sched_ix++
3127    end
3128    printf "---------------------\n"
3129    if (erts_no_dirty_cpu_schedulers)
3130       printf "\n\n"
3131       set $sched_type = 1
3132       set $sched_ix = 0
3133       while $sched_ix < erts_no_dirty_cpu_schedulers
3134         etp-scheduler-info-internal
3135         set $sched_ix++
3136       end
3137       etp-run-queue-info-internal
3138       printf "---------------------\n"
3139    end
3140    if (erts_no_dirty_io_schedulers)
3141       printf "\n\n"
3142       set $sched_type = 2
3143       set $sched_ix = 0
3144       while $sched_ix < erts_no_dirty_io_schedulers
3145         etp-scheduler-info-internal
3146         set $sched_ix++
3147       end
3148       etp-run-queue-info-internal
3149       printf "---------------------\n"
3150    end
3151  end
3152end
3153
3154document etp-schedulers
3155%---------------------------------------------------------------------------
3156% etp-schedulers
3157%
3158% Print misc info about all schedulers
3159%---------------------------------------------------------------------------
3160end
3161
3162define etp-scheduler-info-internal
3163  if ($sched_type == 0)
3164    printf "--- Scheduler %d ---\n", $sched_ix+1
3165    set $sched_data=&erts_aligned_scheduler_data[$sched_ix].esd
3166  else
3167    if ($sched_type == 1)
3168      printf "--- Dirty CPU Scheduler %d ---\n", $sched_ix+1
3169      set $sched_data=&erts_aligned_dirty_cpu_scheduler_data[$sched_ix].esd
3170    else
3171      printf "--- Dirty I/O Scheduler %d ---\n", $sched_ix+1
3172      set $sched_data=&erts_aligned_dirty_io_scheduler_data[$sched_ix].esd
3173    end
3174  end
3175  printf " IX: %d\n", $sched_ix
3176  if ($sched_data->cpu_id < 0)
3177    printf " CPU Binding: unbound\n"
3178  else
3179    printf " CPU Binding: %d\n", $sched_data->cpu_id
3180  end
3181  printf " Aux work Flags:"
3182  set $aux_work_flags = *((Uint32 *) &$sched_data->ssi->aux_work)
3183  etp-aux-work-flags $aux_work_flags
3184  printf " Sleep Info Flags:"
3185  set $ssi_flags = *((Uint32 *) &$sched_data->ssi->flags)
3186  etp-ssi-flags $ssi_flags
3187  printf " Pointer: (ErtsSchedulerData*)%p\n", $sched_data
3188end
3189
3190define etp-run-queue-info-internal
3191  if ($sched_type == 0)
3192    printf " - Run Queue -\n"
3193    set $runq = erts_aligned_scheduler_data[$sched_ix].esd.run_queue
3194  else
3195    if ($sched_type == 1)
3196      printf "\n--- Dirty CPU Run Queue ---\n"
3197      set $runq = &erts_aligned_run_queues[erts_no_run_queues].runq
3198    else
3199      printf "\n--- Dirty I/O Run Queue ---\n"
3200      set $runq = &erts_aligned_run_queues[erts_no_run_queues+1].runq
3201    end
3202  end
3203  printf "  Length: total=%d", *((Uint32 *) &($runq->len))
3204  printf ", max=%d", *((Uint32 *) &($runq->procs.prio_info[0].len))
3205  printf ", high=%d", *((Uint32 *) &($runq->procs.prio_info[1].len))
3206  printf ", normal=%d", *((Uint32 *) &($runq->procs.prio_info[2].len))
3207  printf ", low=%d", *((Uint32 *) &($runq->procs.prio_info[3].len))
3208  printf ", port=%d\n", *((Uint32 *) &($runq->ports.info.len))
3209  if ($runq->misc.start)
3210    printf "  Misc Jobs: yes\n"
3211  else
3212    printf "  Misc Jobs: no\n"
3213  end
3214  set $rq_flags = *((Uint32 *) &($runq->flags))
3215  etp-rq-flags-int $rq_flags
3216  printf "  Pointer: (ErtsRunQueue*)%p\n", $runq
3217end
3218
3219define etp-fds
3220  if $_exitsignal == -1
3221    call erts_check_io_debug(0)
3222  else
3223    printf "Not yet implemented for core files"
3224  end
3225end
3226
3227document etp-fds
3228%---------------------------------------------------------------------------
3229% etp-fds
3230%
3231% Print the state of the fds currently in check_io. Only works in running systems.
3232%---------------------------------------------------------------------------
3233end
3234
3235define etp-disasm-1
3236  set $code_ptr = ((BeamInstr*)($arg0))
3237  set $addr32 = (BeamInstr)(Uint32)*$code_ptr
3238  set $addr64 = (BeamInstr)(Uint64)*$code_ptr
3239  set $i = 0
3240  while $i < num_instructions
3241    if $addr32 == beam_ops[$i] || $addr64 == beam_ops[$i]
3242      printf "%s %d", opc[$i].name, opc[$i].sz
3243      set $next_i = $code_ptr + opc[$i].sz
3244      set $i += 4999
3245    end
3246    set $i++
3247  end
3248end
3249
3250define etp-disasm
3251  if $argc == 1
3252    set $code_end = $arg0
3253  else
3254    set $code_end = $arg1
3255  end
3256  etp-cp-func-info-1 $arg0
3257  if $etp_cp_p == 0
3258    printf "invalid argument"
3259  else
3260    etp-mfa-1 $etp_cp_p $cp_cp_p_offset
3261    printf ": "
3262    etp-disasm-1 $arg0
3263    printf "\r\n"
3264    while $next_i < ((BeamInstr*)$code_end)
3265      set $prev_i = $next_i
3266      etp-cp-func-info-1 $next_i
3267      etp-mfa-1 $etp_cp_p $cp_cp_p_offset
3268      printf ": "
3269      etp-disasm-1 $next_i
3270      if $prev_i == $next_i
3271        # ptr did not advance, we are inside some strange opcode with argument
3272        set $next_i++
3273        printf "instr argument"
3274      end
3275      printf "\r\n"
3276    end
3277  end
3278end
3279
3280document etp-disasm
3281%---------------------------------------------------------------------------
3282% etp-fds BeamInstr* (BeamInstr*)
3283%
3284% Disassemble the instructions inbetween arg0 and arg1,
3285% if no second argument is given only the current
3286% instruction is printed.
3287%---------------------------------------------------------------------------
3288end
3289
3290############################################################################
3291#
3292# Timer Wheel
3293#
3294
3295define etp-timer-wheel
3296# Args: TimerWheel
3297  if (!erts_initialized)
3298    printf "System not initialized!\n"
3299  else
3300    set $tiw = $arg0
3301    printf "Number of timers: %d\n", $tiw->nto
3302    printf "Min timeout pos: %d\n", $tiw->next_timeout_pos
3303    printf "\n--- Soon Wheel ---\n"
3304    set $ix = $tiw->pos & etp_tw_soon_wheel_mask
3305    printf "Position: %ld (%d)\n", $tiw->pos, $ix
3306    printf "Min timeout position: %ld (%d)\n", $tiw->soon.min_tpos, $tiw->soon.min_tpos & etp_tw_soon_wheel_mask
3307    printf "Number of timers: %d\n", $tiw->soon.nto
3308    set $slots = etp_tw_soon_wheel_size
3309    while $slots > 0
3310      set $tmr = $tiw->w[$ix]
3311      if ($tmr != (ErtsTWheelTimer *) 0x0)
3312        printf "---\n"
3313        printf "Slot: %d\n", $ix
3314        printf "\n"
3315        while 1
3316           printf "- Timeout pos: %ld\n", $tmr->timeout_pos
3317	   printf "  Pointer: (ErtsTWheelTimer*)%p\n", $tmr
3318           set $tmr = $tmr->next
3319           if ($tmr == $tiw->w[$ix])
3320             loop_break
3321           end
3322        end
3323      end
3324      set $ix++
3325      if ($ix == (etp_tw_soon_wheel_first_slot + etp_tw_soon_wheel_size))
3326        set $ix = etp_tw_soon_wheel_first_slot
3327      end
3328      set $slots--
3329    end
3330    printf "\n--- Later Wheel ---\n"
3331    set $ix = (($tiw->later.pos >> etp_tw_later_wheel_shift) & etp_tw_later_wheel_mask) + etp_tw_later_wheel_first_slot
3332    printf "Position: %ld (%d)\n", $tiw->later.pos, $ix
3333    printf "Min timeout position: %ld (%d)\n", $tiw->later.min_tpos, (($tiw->later.min_tpos >> etp_tw_later_wheel_shift) & etp_tw_later_wheel_mask) + etp_tw_later_wheel_first_slot
3334    printf "Number of timers: %d\n", $tiw->later.nto
3335    set $slots = etp_tw_later_wheel_size
3336    set $slot_pos = $tiw->later.pos
3337    while $slots > 0
3338      set $tmr = $tiw->w[$ix]
3339      if ($tmr != (ErtsTWheelTimer *) 0x0)
3340        printf "---\n"
3341        printf "Slot: %d\n", $ix
3342        printf "Slot Range: [%ld, %ld]\n", $slot_pos, $slot_pos + etp_tw_later_wheel_slot_size
3343        printf "Pre timeout pos: %ld\n", $slot_pos - etp_tw_later_wheel_slot_size
3344        printf "\n"
3345        while 1
3346           printf "- Timeout pos: %ld\n", $tmr->timeout_pos
3347	   printf "  Pointer: (ErtsTWheelTimer*)%p\n", $tmr
3348           set $tmr = $tmr->next
3349           if ($tmr == $tiw->w[$ix])
3350             loop_break
3351           end
3352        end
3353      end
3354      set $ix++
3355      if ($ix == (etp_tw_later_wheel_first_slot + etp_tw_later_wheel_size))
3356        set $ix = etp_tw_later_wheel_first_slot
3357      end
3358      set $slot_pos = $slot_pos + etp_tw_later_wheel_slot_size
3359      set $slots--
3360    end
3361  end
3362  printf "---\n"
3363end
3364
3365document etp-disasm
3366%---------------------------------------------------------------------------
3367% etp-disasm StartI EndI
3368%
3369% Disassemble the code between StartI and EndI
3370%---------------------------------------------------------------------------
3371end
3372
3373define etp-migration-info
3374  set $minfo = (ErtsMigrationPaths *) *((UWord *) &erts_migration_paths)
3375  set $rq_ix = 0
3376  while $rq_ix < erts_no_run_queues
3377    if ($minfo->mpath[$rq_ix])
3378      printf "---\n"
3379      printf "Run Queue Ix: %d\n", $rq_ix
3380      etp-rq-flags-int $minfo->mpath[$rq_ix].flags
3381    end
3382    set $rq_ix++
3383  end
3384end
3385
3386document etp-migration-info
3387%---------------------------------------------------------------------------
3388% etp-migration-info
3389%
3390% Print migration information
3391%---------------------------------------------------------------------------
3392end
3393
3394define etp-system-info
3395  printf "--------------- System Information ---------------\n"
3396  printf "OTP release: %s\n", etp_otp_release
3397  printf "ERTS version: %s\n", etp_erts_version
3398  printf "Compile date: %s\n", etp_compile_date
3399  printf "Arch: %s\n", etp_arch
3400  printf "Endianness: "
3401  if (etp_endianness > 0)
3402    printf "Big\n"
3403  else
3404    if (etp_endianness < 0)
3405      printf "Little\n"
3406    else
3407      printf "Unknown\n"
3408    end
3409  end
3410  printf "Word size: %d-bit\n", etp_arch_bits
3411  printf "BeamAsm support: "
3412  if (etp_beamasm)
3413    printf "yes\n"
3414  else
3415    printf "no\n"
3416  end
3417  printf "SMP support: yes\n"
3418  printf "Thread support: yes\n"
3419  printf "Kernel poll: "
3420  if (etp_kernel_poll_support)
3421    if (!erts_initialized)
3422        printf "Supported\n"
3423    else
3424      if (erts_use_kernel_poll)
3425        printf "Supported and used\n"
3426      else
3427        printf "Supported but not used\n"
3428      end
3429    end
3430  else
3431    printf "No support\n"
3432  end
3433  printf "Debug compiled: "
3434  if (etp_debug_compiled)
3435    printf "yes\n"
3436  else
3437    printf "no\n"
3438  end
3439  printf "Lock checking: "
3440  if (etp_lock_check)
3441    printf "yes\n"
3442  else
3443    printf "no\n"
3444  end
3445  printf "Lock counting: "
3446  if (etp_lock_count)
3447    printf "yes\n"
3448  else
3449    printf "no\n"
3450  end
3451
3452  if (!erts_initialized)
3453    printf "System not initialized\n"
3454  else
3455    printf "Node name: "
3456    etp-1 erts_this_node->sysname
3457    printf "\n"
3458    printf "Number of schedulers: %d\n", erts_no_schedulers
3459    printf "Number of async-threads: %d\n", erts_async_max_threads
3460  end
3461  printf "--------------------------------------------------\n"
3462end
3463
3464document etp-system-info
3465%---------------------------------------------------------------------------
3466% etp-system-info
3467%
3468% Print general information about the system
3469%---------------------------------------------------------------------------
3470end
3471
3472define etp-compile-info
3473  printf "--------------- Compile Information ---------------\n"
3474  printf "CFLAGS: %s\n", erts_build_flags_CFLAGS
3475  printf "LDFLAGS: %s\n", erts_build_flags_LDFLAGS
3476  printf "Use etp-config-h-info to dump config.h\n"
3477end
3478
3479document etp-compile-info
3480%---------------------------------------------------------------------------
3481% etp-compile-info
3482%
3483% Print information about how the system was compiled
3484%---------------------------------------------------------------------------
3485end
3486
3487define etp-config-h-info
3488  ## Printing the whole string at once sometimes crashes gdb...
3489  # printf "%s", erts_build_flags_CONFIG_H
3490
3491  set $ix=0
3492  while erts_build_flags_CONFIG_H[$ix]
3493    printf "%c", erts_build_flags_CONFIG_H[$ix]
3494    set $ix++
3495  end
3496end
3497
3498document etp-config-h-info
3499%---------------------------------------------------------------------------
3500% etp-config-h-info
3501%
3502% Dump the contents of config.h when the system was compiled
3503%---------------------------------------------------------------------------
3504end
3505
3506define etp-dictdump
3507# Args: ProcDict*
3508#
3509# Non-reentrant
3510#
3511  set $etp_dictdump = ($arg0)
3512  if $etp_dictdump
3513    set $etp_dictdump_n = \
3514      $etp_dictdump->homeSize + $etp_dictdump->splitPosition
3515    set $etp_dictdump_i = 0
3516    set $etp_dictdump_written = 0
3517    if $etp_dictdump_n > $etp_dictdump->size
3518      set $etp_dictdump_n = $etp_dictdump->size
3519    end
3520    set $etp_dictdump_cnt = $etp_dictdump->numElements
3521    printf "%% Dictionary (%d):\n[", $etp_dictdump_cnt
3522    while $etp_dictdump_i < $etp_dictdump_n && \
3523          $etp_dictdump_cnt > 0
3524      set $etp_dictdump_p = $etp_dictdump->data[$etp_dictdump_i]
3525      if $etp_dictdump_p != $etp_nil
3526        if ((Eterm)$etp_dictdump_p & 0x3) == 0x2
3527          # Boxed
3528          if $etp_dictdump_written
3529            printf ",\n "
3530          else
3531            set $etp_dictdump_written = 1
3532          end
3533          etp-1 $etp_dictdump_p 0
3534          set $etp_dictdump_cnt--
3535        else
3536          while ((Eterm)$etp_dictdump_p & 0x3) == 0x1 && \
3537                $etp_dictdump_cnt > 0
3538            # Cons ptr
3539            if $etp_dictdump_written
3540              printf ",\n "
3541            else
3542              set $etp_dictdump_written = 1
3543            end
3544            etp-1 (((Eterm*)((Eterm)$etp_dictdump_p&etp_ptr_mask))[0]) 0
3545            set $etp_dictdump_cnt--
3546            set $etp_dictdump_p = ((Eterm*)((Eterm)$etp_dictdump_p & etp_ptr_mask))[1]
3547          end
3548          if $etp_dictdump_p != $etp_nil
3549            printf "#DictSlotError<%d>:", $etp_dictdump_i
3550	    set $etp_dictdump_flat = $etp_flat
3551	    set $etp_flat = 1
3552            etp-1 ((Eterm)$etp_dictdump_p) 0
3553	    set $etp_flat = $etp_dictdump_flat
3554          end
3555        end
3556      end
3557      set $etp_dictdump_i++
3558    end
3559    if $etp_dictdump_cnt != 0
3560      printf "#DictCntError<%d>, ", $etp_dictdump_cnt
3561    end
3562  else
3563    printf "%% Dictionary (0):\n["
3564  end
3565  printf "].\n"
3566end
3567
3568document etp-dictdump
3569%---------------------------------------------------------------------------
3570% etp-dictdump ErlProcDict*
3571%
3572% Take an ErlProcDict* and print all entries in the process dictionary.
3573%---------------------------------------------------------------------------
3574end
3575
3576define etpf-dictdump
3577# Args: ErlProcDict*
3578#
3579# Non-reentrant
3580#
3581  set $etp_flat = 1
3582  etp-dictdump ($arg0)
3583  set $etp_flat = 0
3584end
3585
3586document etpf-dictdump
3587%---------------------------------------------------------------------------
3588% etpf-dictdump ErlProcDict*
3589%
3590% Same as etp-dictdump but print the values using etpf (flat).
3591%---------------------------------------------------------------------------
3592end
3593
3594
3595
3596define etp-offheapdump
3597# Args: ( ExternalThing* | ProcBin* | ErlFunThing* )
3598#
3599# Non-reentrant
3600#
3601  set $etp_offheapdump_p = ($arg0)
3602  set $etp_offheapdump_i = 0
3603  set $etp_offheapdump_
3604  printf "%% Offheap dump:\n["
3605  while ($etp_offheapdump_p != 0) && ($etp_offheapdump_i < $etp_max_depth)
3606    if ((Eterm)$etp_offheapdump_p & 0x3) == 0x0
3607      if $etp_offheapdump_i > 0
3608        printf ",\n "
3609      end
3610      etp-1 ((Eterm)$etp_offheapdump_p|0x2) 0
3611      set $etp_offheapdump_p = $etp_offheapdump_p->next
3612      set $etp_offheapdump_i++
3613    else
3614      printf "#TaggedPtr<%p>", $etp_offheapdump_p
3615      set $etp_offheapdump_p = 0
3616    end
3617  end
3618  printf "].\n"
3619end
3620
3621document etp-offheapdump
3622%---------------------------------------------------------------------------
3623% etp-offheapdump ( ExternalThing* | ProcBin* | ErlFunThing* )
3624%
3625% Take an pointer to a linked list and print the terms in the list
3626% up to the max depth.
3627%---------------------------------------------------------------------------
3628end
3629
3630define etpf-offheapdump
3631# Args: ( ExternalThing* | ProcBin* | ErlFunThing* )
3632#
3633# Non-reentrant
3634#
3635  set $etp_flat = 1
3636  etp-offheapdump ($arg0)
3637  set $etp_flat = 0
3638end
3639
3640document etpf-offheapdump
3641%---------------------------------------------------------------------------
3642% etpf-offheapdump ( ExternalThing* | ProcBin* | ErlFunThing* )
3643%
3644% Same as etp-offheapdump but print the values using etpf (flat).
3645%---------------------------------------------------------------------------
3646end
3647
3648define etp-search-heaps
3649# Args: Eterm
3650#
3651# Non-reentrant
3652#
3653  printf "%% Search all (<%u) process heaps for ", erts_proc.r.o.max
3654  set $etp_flat = 1
3655  etp-1 ($arg0) 0
3656  set $etp_flat = 0
3657  printf ":...\n"
3658  etp-search-heaps-1 ((Eterm*)((Eterm)($arg0)&etp_ptr_mask))
3659end
3660
3661define etp-search-heaps-1
3662# Args: Eterm*
3663#
3664# Non-reentrant
3665#
3666  set $etp_search_heaps_q = erts_proc.r.o.max / 10
3667  set $etp_search_heaps_r = erts_proc.r.o.max % 10
3668  set $etp_search_heaps_t = 10
3669  set $etp_search_heaps_m = $etp_search_heaps_q
3670  if $etp_search_heaps_r > 0
3671    set $etp_search_heaps_m++
3672    set $etp_search_heaps_r--
3673  end
3674  set $etp_search_heaps_i = 0
3675  set $etp_search_heaps_found = 0
3676  while $etp_search_heaps_i < erts_proc.r.o.max
3677    set $proc = (Process *) *((UWord *) &erts_proc.r.o.tab[$etp_search_heaps_i])
3678    if $proc
3679      if ($proc->heap <= ($arg0)) && \
3680         (($arg0) < $proc->hend)
3681        printf "process_tab[%d]->heap+%d\n", $etp_search_heaps_i, \
3682               ($arg0)-$proc->heap
3683      end
3684      if ($proc->old_heap <= ($arg0)) && \
3685         (($arg0) <= $proc->old_hend)
3686        printf "process_tab[%d]->old_heap+%d\n", $etp_search_heaps_i, \
3687               ($arg0)-$proc->old_heap
3688      end
3689      set $etp_search_heaps_cnt = 0
3690      set $etp_search_heaps_p = $proc->mbuf
3691      while $etp_search_heaps_p && ($etp_search_heaps_cnt < $etp_max_depth)
3692        set $etp_search_heaps_cnt++
3693        if (&($etp_search_heaps_p->mem) <= ($arg0)) && \
3694           (($arg0) < &($etp_search_heaps_p->mem)+$etp_search_heaps_p->used_size)
3695          printf "process_tab[%d]->mbuf(%d)+%d\n", \
3696                 $etp_search_heaps_i, $etp_search_heaps_cnt, \
3697                 ($arg0)-&($etp_search_heaps_p->mem)
3698        end
3699        set $etp_search_heaps_p = $etp_search_heaps_p->next
3700      end
3701      if $etp_search_heaps_p
3702        printf "Process ix=%d %% Too many HeapFragments\n", \
3703               $etp_search_heaps_i
3704      end
3705    end
3706    set $etp_search_heaps_i++
3707    if $etp_search_heaps_i > $etp_search_heaps_m
3708      printf "%% %d%%...\n", $etp_search_heaps_t
3709      set $etp_search_heaps_t += 10
3710      set $etp_search_heaps_m += $etp_search_heaps_q
3711      if $etp_search_heaps_r > 0
3712        set $etp_search_heaps_m++
3713        set $etp_search_heaps_r--
3714      end
3715    end
3716  end
3717  printf "%% 100%%.\n"
3718end
3719
3720document etp-search-heaps
3721%---------------------------------------------------------------------------
3722% etp-search-heaps Eterm
3723%
3724% Search all process heaps in process_tab[], including the heap fragments
3725% (process_tab[]->mbuf) for the specified Eterm.
3726%---------------------------------------------------------------------------
3727end
3728
3729
3730
3731define etp-search-alloc
3732# Args: Eterm
3733#
3734# Non-reentrant
3735#
3736  printf "%% Search allocated memory blocks for "
3737  set $etp_flat = 1
3738  etp-1 ($arg0) 0
3739  set $etp_flat = 0
3740  printf ":...\n"
3741  set $etp_search_alloc_n = sizeof(erts_allctrs) / sizeof(*erts_allctrs)
3742  set $etp_search_alloc_i = 0
3743  while $etp_search_alloc_i < $etp_search_alloc_n
3744    if erts_allctrs[$etp_search_alloc_i].alloc
3745      set $etp_search_alloc_f = (erts_allctrs+$etp_search_alloc_i)
3746      while ($etp_search_alloc_f->alloc == debug_alloc) || \
3747            ($etp_search_alloc_f->alloc == stat_alloc) || \
3748            ($etp_search_alloc_f->alloc == map_stat_alloc)
3749        set $etp_search_alloc_f = \
3750          (ErtsAllocatorFunctions_t*)$etp_search_alloc_f->extra
3751      end
3752      if ($etp_search_alloc_f->alloc != erts_sys_alloc) && \
3753         ($etp_search_alloc_f->alloc != erts_fix_alloc)
3754        if ($etp_search_alloc_f->alloc == erts_alcu_alloc) || \
3755           ($etp_search_alloc_f->alloc == erts_alcu_alloc_ts)
3756          # alcu alloc
3757          set $etp_search_alloc_e = (Allctr_t*)$etp_search_alloc_f->extra
3758          # mbc_list
3759          set $etp_search_alloc_p = $etp_search_alloc_e->mbc_list.first
3760          set $etp_search_alloc_cnt = 0
3761          while $etp_search_alloc_p && \
3762                ($etp_search_alloc_cnt < $etp_max_depth)
3763            set $etp_search_alloc_cnt++
3764            if $etp_search_alloc_p <= ($arg0) && \
3765               ($arg0) < (char*)$etp_search_alloc_p + \
3766                         ($etp_search_alloc_p->chdr & (Uint)~7)
3767              printf "erts_allctrs[%d] %% %salloc: mbc_list: %d\n", \
3768                     $etp_search_alloc_i, $etp_search_alloc_e->name_prefix, \
3769                     $etp_search_alloc_cnt
3770            end
3771            if $etp_search_alloc_p == $etp_search_alloc_e->mbc_list.last
3772              if $etp_search_alloc_p->next
3773                printf \
3774                  "erts_allctrs[%d] %% %salloc: mbc_list.last error %p\n",\
3775                  $etp_search_alloc_i, $etp_search_alloc_e->name_prefix,\
3776                  $etp_search_alloc_p
3777              end
3778              set $etp_search_alloc_p = 0
3779            else
3780              set $etp_search_alloc_p = $etp_search_alloc_p->next
3781            end
3782          end
3783          if $etp_search_alloc_p
3784            printf "erts_allctrs[%d] %% %salloc: too large mbc_list %p\n", \
3785                   $ept_search_alloc_i, $etp_search_alloc_e->name_prefix,
3786                   $ept_search_alloc_p
3787          end
3788          # sbc_list
3789          set $etp_search_alloc_p = $etp_search_alloc_e->sbc_list.first
3790          set $etp_search_alloc_cnt = 0
3791          while $etp_search_alloc_p && \
3792                ($etp_search_alloc_cnt < $etp_max_depth)
3793            set $etp_search_alloc_cnt++
3794            if $etp_search_alloc_p <= ($arg0) && \
3795               ($arg0) < (char*)$etp_search_alloc_p + \
3796                         ($etp_search_alloc_p->chdr & (Uint)~7)
3797              printf "erts_allctrs[%d] %% %salloc: sbc_list: %d\n", \
3798                     $etp_search_alloc_i, $etp_search_alloc_e->name_prefix, \
3799                     $etp_search_alloc_cnt
3800            end
3801            if $etp_search_alloc_p == $etp_search_alloc_e->sbc_list.last
3802              if $etp_search_alloc_p->next
3803                printf \
3804                  "erts_allctrs[%d] %% %salloc: sbc_list.last error %p",\
3805                  $etp_search_alloc_i, $etp_search_alloc_e->name_prefix,\
3806                  $etp_search_alloc_p
3807              end
3808              set $etp_search_alloc_p = 0
3809            else
3810              set $etp_search_alloc_p = $etp_search_alloc_p->next
3811            end
3812          end
3813          if $etp_search_alloc_p
3814            printf "erts_allctrs[%d] %% %salloc: too large sbc_list %p\n", \
3815                   $ept_search_alloc_i, $etp_search_alloc_e->name_prefix,
3816                   $ept_search_alloc_p
3817          end
3818        else
3819          printf "erts_allctrs[%d] %% %s: unknown allocator\n", \
3820                 $etp_search_alloc_i, erts_alc_a2ad[$etp_search_alloc_i]
3821        end
3822      end
3823    end
3824    set $etp_search_alloc_i++
3825  end
3826end
3827
3828document etp-search-alloc
3829%---------------------------------------------------------------------------
3830% etp-search-heaps Eterm
3831%
3832% Search all internal allocator memory blocks for for the specified Eterm.
3833%---------------------------------------------------------------------------
3834end
3835
3836
3837define etp-alloc-stats
3838  printf "\nIx Name    Inst.   Blocks        Bytes    Carriers    Crr.bytes  Util\n"
3839  set $etp_tot_block_no = 0
3840  set $etp_tot_block_sz = 0
3841  set $etp_tot_crr_no = 0
3842  set $etp_tot_crr_sz = 0
3843  set $etp_ERTS_ALC_A_MIN = 1
3844  set $etp_ERTS_ALC_A_MAX = (sizeof(erts_allctrs) / sizeof(*erts_allctrs)) - 1
3845
3846  set $etp_ix = $etp_ERTS_ALC_A_MIN
3847  while $etp_ix <= $etp_ERTS_ALC_A_MAX
3848    set $etp_allctr = 0
3849    set $etp_alloc = erts_allctrs[$etp_ix].alloc
3850    if $etp_alloc != erts_sys_alloc
3851      if $etp_alloc == erts_alcu_alloc_thr_spec || \
3852         $etp_alloc == erts_alcu_alloc_thr_pref
3853        set $etp_instance = 0
3854        set $etp_block_no = 0
3855        set $etp_block_sz = 0
3856        set $etp_crr_no = 0
3857        set $etp_crr_sz = 0
3858        set $etp_tspec = (ErtsAllocatorThrSpec_t *) erts_allctrs[$etp_ix].extra
3859	if $etp_tspec->enabled
3860          while $etp_instance < $etp_tspec->size
3861            set $etp_allctr = $etp_tspec->allctr[$etp_instance]
3862            set $etp_block_no = $etp_block_no + $etp_allctr->mbcs.blocks.curr.no \
3863					      + $etp_allctr->sbcs.blocks.curr.no
3864            set $etp_block_sz = $etp_block_sz + $etp_allctr->mbcs.blocks.curr.size \
3865					      + $etp_allctr->sbcs.blocks.curr.size
3866            set $etp_crr_no = $etp_crr_no + $etp_allctr->mbcs.curr.norm.mseg.no \
3867					  + $etp_allctr->sbcs.curr.norm.mseg.no \
3868					  + $etp_allctr->mbcs.curr.norm.sys_alloc.no \
3869					  + $etp_allctr->sbcs.curr.norm.sys_alloc.no
3870            set $etp_crr_sz = $etp_crr_sz + $etp_allctr->mbcs.curr.norm.mseg.size \
3871					  + $etp_allctr->sbcs.curr.norm.mseg.size \
3872					  + $etp_allctr->mbcs.curr.norm.sys_alloc.size \
3873					  + $etp_allctr->sbcs.curr.norm.sys_alloc.size
3874            set $etp_instance = $etp_instance + 1
3875          end
3876	else
3877          printf "erts_allctr[%d]: Disabled (thread specific)\n", $etp_ix
3878	end
3879      else
3880        if $etp_alloc == erts_alcu_alloc_ts || $etp_alloc == erts_alcu_alloc
3881          set $etp_allctr = (Allctr_t*) erts_allctrs[$etp_ix].extra
3882          set $etp_block_no = $etp_allctr->mbcs.blocks.curr.no \
3883			    + $etp_allctr->sbcs.blocks.curr.no
3884          set $etp_block_sz = $etp_allctr->mbcs.blocks.curr.size \
3885			    + $etp_allctr->sbcs.blocks.curr.size
3886          set $etp_crr_no = $etp_allctr->mbcs.curr.norm.mseg.no \
3887			  + $etp_allctr->sbcs.curr.norm.mseg.no \
3888			  + $etp_allctr->mbcs.curr.norm.sys_alloc.no \
3889			  + $etp_allctr->sbcs.curr.norm.sys_alloc.no
3890          set $etp_crr_sz = $etp_allctr->mbcs.curr.norm.mseg.size \
3891			  + $etp_allctr->sbcs.curr.norm.mseg.size \
3892			  + $etp_allctr->mbcs.curr.norm.sys_alloc.size \
3893			  + $etp_allctr->sbcs.curr.norm.sys_alloc.size
3894	  set $etp_instance = 1
3895        else
3896          printf "erts_allctr[%d]: Unknown allocation function: ", $etp_ix
3897          p $etp_alloc
3898        end
3899      end
3900    end
3901    if $etp_allctr != 0
3902      printf "%2d %-8s%2d%12lu%13lu%12lu%13lu", $etp_ix, $etp_allctr->name_prefix, \
3903	     $etp_instance, \
3904	     $etp_block_no, $etp_block_sz, $etp_crr_no, $etp_crr_sz
3905      if $etp_crr_sz != 0
3906        printf "%5lu%%", ($etp_block_sz * 100) / $etp_crr_sz
3907      end
3908      printf "\n"
3909      set $etp_tot_block_no = $etp_tot_block_no + $etp_block_no
3910      set $etp_tot_block_sz = $etp_tot_block_sz + $etp_block_sz
3911      set $etp_tot_crr_no = $etp_tot_crr_no + $etp_crr_no
3912      set $etp_tot_crr_sz = $etp_tot_crr_sz + $etp_crr_sz
3913    end
3914    set $etp_ix = $etp_ix + 1
3915  end
3916  printf "\nTotal:       %12lu%13lu%12lu%13lu", $etp_tot_block_no, $etp_tot_block_sz, \
3917				     $etp_tot_crr_no, $etp_tot_crr_sz
3918  if $etp_tot_crr_sz != 0
3919    printf "%5lu%%", ($etp_tot_block_sz * 100) / $etp_tot_crr_sz
3920  end
3921  printf "\n"
3922end
3923
3924document etp-alloc-stats
3925%---------------------------------------------------------------------------
3926% etp-alloc-stats
3927%
3928% Combine and print allocator statistics
3929%---------------------------------------------------------------------------
3930end
3931
3932
3933define etp-alloc-instances
3934  set $etp_ERTS_ALC_A_MIN = 1
3935  set $etp_ERTS_ALC_A_MAX = (sizeof(erts_allctrs) / sizeof(*erts_allctrs)) - 1
3936
3937  set $etp_ix = $arg0
3938  if $etp_ix >= $etp_ERTS_ALC_A_MIN && $etp_ix <= $etp_ERTS_ALC_A_MAX
3939    set $etp_allctr = 0
3940    set $etp_alloc = erts_allctrs[$etp_ix].alloc
3941    if $etp_alloc == erts_sys_alloc
3942      printf "Allocator %d is sys_alloc\n", $etp_ix
3943    else
3944      if $etp_alloc == erts_alcu_alloc_thr_spec || \
3945         $etp_alloc == erts_alcu_alloc_thr_pref
3946        set $etp_instance = 0
3947        set $etp_tspec = (ErtsAllocatorThrSpec_t *) erts_allctrs[$etp_ix].extra
3948	if $etp_tspec->enabled
3949          printf "All instances for allocator '%s'\n", $etp_tspec->allctr[0]->name_prefix
3950          while $etp_instance < $etp_tspec->size
3951	    p $etp_tspec->allctr[$etp_instance]
3952            set $etp_instance = $etp_instance + 1
3953          end
3954	else
3955          printf "erts_allctr[%d]: Disabled (thread specific)\n", $etp_ix
3956	end
3957      else
3958        if $etp_alloc == erts_alcu_alloc_ts || $etp_alloc == erts_alcu_alloc
3959          set $etp_allctr = (Allctr_t*) erts_allctrs[$etp_ix].extra
3960          printf "Single instances for allocator '%s'\n", $etp_allctr->name_prefix
3961	  p $etp_allctr
3962        else
3963          printf "erts_allctr[%d]: Unknown allocation function: ", $etp_ix
3964          p $etp_alloc
3965        end
3966      end
3967    end
3968  else
3969    printf "Allocator type not between %d and %d\n", $etp_ERTS_ALC_A_MIN, $etp_ERTS_ALC_A_MAX
3970  end
3971end
3972
3973document etp-alloc-instances
3974%---------------------------------------------------------------------------
3975% etp-alloc-instances
3976%
3977% Print pointers to all allocator instances for a specific type (Ix)
3978%---------------------------------------------------------------------------
3979end
3980
3981
3982
3983
3984define etp-overlapped-heaps
3985# Args:
3986#
3987# Non-reentrant
3988#
3989  printf "%% Dumping heap addresses to \"etp-commands.bin\"\n"
3990  set $etp_overlapped_heaps_q = erts_proc.r.o.max / 10
3991  set $etp_overlapped_heaps_r = erts_proc.r.o.max % 10
3992  set $etp_overlapped_heaps_t = 10
3993  set $etp_overlapped_heaps_m = $etp_overlapped_heaps_q
3994  if $etp_overlapped_heaps_r > 0
3995    set $etp_overlapped_heaps_m++
3996    set $etp_overlapped_heaps_r--
3997  end
3998  set $etp_overlapped_heaps_i = 0
3999  set $etp_overlapped_heaps_found = 0
4000  dump binary value etp-commands.bin 'o'
4001  append binary value etp-commands.bin 'v'
4002  append binary value etp-commands.bin 'e'
4003  append binary value etp-commands.bin 'r'
4004  append binary value etp-commands.bin 'l'
4005  append binary value etp-commands.bin 'a'
4006  append binary value etp-commands.bin 'p'
4007  append binary value etp-commands.bin 'p'
4008  append binary value etp-commands.bin 'e'
4009  append binary value etp-commands.bin 'd'
4010  append binary value etp-commands.bin '-'
4011  append binary value etp-commands.bin 'h'
4012  append binary value etp-commands.bin 'e'
4013  append binary value etp-commands.bin 'a'
4014  append binary value etp-commands.bin 'p'
4015  append binary value etp-commands.bin 's'
4016  append binary value etp-commands.bin '\0'
4017  while $etp_overlapped_heaps_i < erts_proc.r.o.max
4018    if process_tab[$etp_overlapped_heaps_i]
4019      append binary value etp-commands.bin \
4020        (Eterm)$etp_overlapped_heaps_i
4021      append binary value etp-commands.bin \
4022        (Eterm)process_tab[$etp_overlapped_heaps_i]->heap
4023      append binary value etp-commands.bin \
4024        (Eterm)process_tab[$etp_overlapped_heaps_i]->hend
4025      append binary value etp-commands.bin \
4026        (Eterm)process_tab[$etp_overlapped_heaps_i]->old_heap
4027      append binary value etp-commands.bin \
4028        (Eterm)process_tab[$etp_overlapped_heaps_i]->old_hend
4029      set $etp_overlapped_heaps_p = process_tab[$etp_overlapped_heaps_i]->mbuf
4030      set $etp_overlapped_heaps_cnt = 0
4031      while $etp_overlapped_heaps_p && \
4032            ($etp_overlapped_heaps_cnt < $etp_max_depth)
4033        set $etp_overlapped_heaps_cnt++
4034        append binary value etp-commands.bin \
4035          (Eterm)$etp_overlapped_heaps_p
4036        append binary value etp-commands.bin \
4037(Eterm)(&($etp_overlapped_heaps_p->mem)+$etp_overlapped_heaps_p->size)
4038        set $etp_overlapped_heaps_p = $etp_overlapped_heaps_p->next
4039      end
4040      if $etp_overlapped_heaps_p
4041        printf "process_tab[%d] %% Too many HeapFragments\n", \
4042               $etp_overlapped_heaps_i
4043      end
4044      append binary value etp-commands.bin (Eterm)0x0
4045      append binary value etp-commands.bin (Eterm)0x0
4046    end
4047    set $etp_overlapped_heaps_i++
4048    if $etp_overlapped_heaps_i > $etp_overlapped_heaps_m
4049      printf "%% %d%%...\n", $etp_overlapped_heaps_t
4050      set $etp_overlapped_heaps_t += 10
4051      set $etp_overlapped_heaps_m += $etp_overlapped_heaps_q
4052      if $etp_overlapped_heaps_r > 0
4053        set $etp_overlapped_heaps_m++
4054        set $etp_overlapped_heaps_r--
4055      end
4056    end
4057  end
4058  etp-run
4059end
4060
4061document etp-overlapped-heaps
4062%---------------------------------------------------------------------------
4063% etp-overlapped-heaps
4064%
4065% Dump all process heap addresses in process_tab[], including
4066% the heap fragments in binary format on the file etp-commands.bin.
4067% Then call etp_commands:file/1 to analyze if any heaps overlap.
4068%
4069% Requires 'erl' in the path and 'etp_commands.beam' in 'erl's search path.
4070%---------------------------------------------------------------------------
4071end
4072
4073
4074
4075define etp-chart
4076# Args: Process*
4077#
4078# Non-reentrant
4079  etp-chart-start ($arg0)
4080  set ($arg0) = ($arg0)
4081  etp-msgq (($arg0)->sig_qs)
4082  etp-stackdump ($arg0)
4083  etp-dictdump (($arg0)->dictionary)
4084  etp-dictdump (($arg0)->debug_dictionary)
4085  printf "%% Dumping other process data...\n"
4086  etp ($arg0)->seq_trace_token
4087  etp ($arg0)->fvalue
4088  printf "%% Dumping done.\n"
4089  etp-chart-print
4090end
4091
4092document etp-chart
4093%---------------------------------------------------------------------------
4094% etp-chart Process*
4095%
4096% Dump all process data to the file "etp-commands.bin" and then use
4097% the Erlang support module to print a memory chart of all terms.
4098%---------------------------------------------------------------------------
4099end
4100
4101
4102
4103define etp-chart-start
4104# Args: Process*
4105#
4106# Non-reentrant
4107  set $etp_chart = 1
4108  set $etp_chart_id = 0
4109  set $etp_chart_start_p = ($arg0)
4110  dump binary value etp-commands.bin 'c'
4111  append binary value etp-commands.bin 'h'
4112  append binary value etp-commands.bin 'a'
4113  append binary value etp-commands.bin 'r'
4114  append binary value etp-commands.bin 't'
4115  append binary value etp-commands.bin '\0'
4116  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->heap)
4117  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->high_water)
4118  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->hend)
4119  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->old_heap)
4120  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->old_hend)
4121  set $etp_chart_start_cnt = 0
4122  set $etp_chart_start_p = $etp_chart_start_p->mbuf
4123  while $etp_chart_start_p && ($etp_chart_start_cnt < $etp_max_depth)
4124    set $etp_chart_start_cnt++
4125    append binary value etp-commands.bin (Eterm)($etp_chart_start_p->mem)
4126    append binary value etp-commands.bin (Eterm)($etp_chart_start_p->size)
4127    set $etp_chart_start_p = $etp_chart_start_p->next
4128  end
4129  append binary value etp-commands.bin (Eterm)(0)
4130  append binary value etp-commands.bin (Eterm)(0)
4131  if $etp_chart_start_p
4132    printf "%% Too many HeapFragments\n"
4133  end
4134end
4135
4136document etp-chart-start
4137%---------------------------------------------------------------------------
4138% etp-chart-start Process*
4139%
4140% Dump a chart head to the file "etp-commands.bin".
4141%---------------------------------------------------------------------------
4142end
4143
4144
4145
4146define etp-chart-entry-1
4147# Args: Eterm, int depth, int words
4148#
4149# Reentrant capable
4150  if ($arg1) == 0
4151    set $etp_chart_id++
4152    printf "#%d:", $etp_chart_id
4153  end
4154  append binary value etp-commands.bin ($arg0)&etp_ptr_mask
4155  append binary value etp-commands.bin (Eterm)(($arg2)*sizeof(Eterm))
4156  append binary value etp-commands.bin (Eterm)$etp_chart_id
4157  append binary value etp-commands.bin (Eterm)($arg1)
4158#   printf "<dumped %p %lu %lu %lu>", ($arg0)&etp_ptr_mask, \
4159#     (Eterm)(($arg2)*sizeof(Eterm)), (Eterm)$etp_chart_id, (Eterm)($arg1)
4160end
4161
4162
4163
4164define etp-chart-print
4165  set $etp_chart = 0
4166  etp-run
4167end
4168
4169document etp-chart-print
4170%---------------------------------------------------------------------------
4171% etp-chart-print Process*
4172%
4173% Print a memory chart of the dumped data in "etp-commands.bin", and stop
4174% chart recording.
4175%---------------------------------------------------------------------------
4176end
4177
4178############################################################################
4179# ETS table debug
4180#
4181
4182define etp-ets-tab-status-int
4183# Args:
4184#
4185# Non-reentrant
4186  if ($arg0 & 0x1)
4187    printf "priv"
4188  end
4189  if ($arg0 & 0x2)
4190    printf "prot"
4191  end
4192  if ($arg0 & 0x4)
4193    printf "pub"
4194  end
4195  if ($arg0 & 0x8)
4196    printf "|del"
4197  end
4198  if ($arg0 & 0x10)
4199    printf "|set"
4200  end
4201  if ($arg0 & 0x20)
4202    printf "|bag"
4203  end
4204  if ($arg0 & 0x40)
4205    printf "|dbag"
4206  end
4207  if ($arg0 & 0x80)
4208    printf "|oset"
4209  end
4210  if ($arg0 & 0x100)
4211    printf "|caoset"
4212  end
4213  if ($arg0 & 0x200)
4214    printf "|flocked"
4215  end
4216  if ($arg0 & 0x400)
4217    printf "|fread"
4218  end
4219  if ($arg0 & 0x800)
4220    printf "|named"
4221  end
4222  if ($arg0 & 0x1000)
4223    printf "|busy"
4224  end
4225end
4226
4227define etp-ets-tables
4228# Args:
4229#
4230# Non-reentrant
4231  set $sched_ix = 0
4232  while $sched_ix < erts_no_schedulers
4233    set $ets_tabs = &erts_aligned_scheduler_data[$sched_ix].esd.ets_tables
4234    set $no_ets_tabs = *(unsigned long *)&($ets_tabs->count)
4235    printf "\n%% %lu ETS tables created on scheduler %lu...\n\n", $no_ets_tabs, (unsigned long)$sched_ix+1
4236    set $ets_tab = $ets_tabs->clist
4237    set $first_ets_tab = $ets_tab
4238    while $ets_tab
4239      set $refn = &((ErtsMagicBinary *)$ets_tab->common->btid)->refn
4240      printf "%% "
4241      etp-1 $ets_tab->common.the_name 0
4242      printf " #Ref<0.%u.%u.%u> ", (unsigned)$refn[2], (unsigned)$refn[1], (unsigned)$refn[0]
4243      etp-1 $ets_tab->common.owner 0
4244      printf " "
4245      etp-ets-tab-status-int $ets_tab->common.status
4246      printf " (DbTable*)%p\n", $ets_tab
4247      if $ets_tab->common.all.next == $first_ets_tab
4248	set $ets_tab = (DbTable *) 0
4249      else
4250	set $ets_tab = $ets_tab->common.all.next
4251      end
4252    end
4253    set $sched_ix++
4254  end
4255end
4256
4257document etp-ets-tables
4258%---------------------------------------------------------------------------
4259% etp-ets-tables
4260%
4261% Dump all ETS table names and their indexies.
4262%---------------------------------------------------------------------------
4263end
4264
4265define etp-ets-obj
4266# Args: DbTerm*
4267#
4268  set $etp_ets_obj_i = 1
4269  while $etp_ets_obj_i <= (($arg0)->tpl[0] >> 6)
4270    if $etp_ets_obj_i == 1
4271      printf "{"
4272    else
4273      printf ", "
4274    end
4275    set $etp_ets_elem = ($arg0)->tpl[$etp_ets_obj_i]
4276    if ($etp_ets_elem & 3) == 0
4277      printf "<compressed>"
4278    else
4279      etp-1 $etp_ets_elem 0
4280    end
4281    set $etp_ets_obj_i++
4282  end
4283  printf "}"
4284end
4285
4286
4287define etp-ets-tabledump
4288# Args: int tableindex
4289#
4290# Non-reentrant
4291  printf "%% Dumping ETS table %d:", ($arg0)
4292  set $etp_ets_tabledump_n = 0
4293  set $etp_ets_tabledump_t = meta_main_tab[($arg0)].u.tb
4294  set $etp_ets_tabledump_i = 0
4295  etp-1 ($etp_ets_tabledump_t->common.the_name) 0
4296  printf " status=%#x\n", $etp_ets_tabledump_t->common.status
4297  if $etp_ets_tabledump_t->common.status & 0x130
4298    # Hash table
4299    set $etp_ets_tabledump_h = $etp_ets_tabledump_t->hash
4300    printf "%% nitems=%d\n", (long) $etp_ets_tabledump_t->common.nitems
4301    while $etp_ets_tabledump_i < (long) $etp_ets_tabledump_h->nactive
4302      set $etp_ets_tabledump_seg = ((struct segment**)$etp_ets_tabledump_h->segtab)[$etp_ets_tabledump_i>>8]
4303      set $etp_ets_tabledump_l = $etp_ets_tabledump_seg->buckets[$etp_ets_tabledump_i&0xFF]
4304      if $etp_ets_tabledump_l
4305        printf "%% Slot %d:\n", $etp_ets_tabledump_i
4306        while $etp_ets_tabledump_l
4307          if $etp_ets_tabledump_n
4308            printf ","
4309          else
4310            printf "["
4311          end
4312          set $etp_ets_tabledump_n++
4313	  etp-ets-obj &($etp_ets_tabledump_l->dbterm)
4314          if $etp_ets_tabledump_l->hvalue == ((unsigned long)-1)
4315            printf "% *\n"
4316          else
4317            printf "\n"
4318          end
4319          set $etp_ets_tabledump_l = $etp_ets_tabledump_l->next
4320          if $etp_ets_tabledump_n >= $etp_max_depth
4321            set $etp_ets_tabledump_l = 0
4322          end
4323        end
4324      end
4325      set $etp_ets_tabledump_i++
4326    end
4327    if $etp_ets_tabledump_n
4328      printf "].\n"
4329    end
4330  else
4331    printf "%% Not a hash table\n"
4332  end
4333end
4334
4335document etp-ets-tabledump
4336%---------------------------------------------------------------------------
4337% etp-ets-tabledump Slot
4338%
4339% Dump an ETS table with a specified slot index.
4340%---------------------------------------------------------------------------
4341end
4342
4343define etp-lc-dump
4344# Non-reentrant
4345  set $etp_lc_dump_thread = erts_locked_locks
4346  while $etp_lc_dump_thread
4347    printf "Thread %s\n", $etp_lc_dump_thread->thread_name
4348    set $etp_lc_dump_thread_locked = $etp_lc_dump_thread->locked.first
4349    while $etp_lc_dump_thread_locked
4350      if 0 <= $etp_lc_dump_thread_locked->id && $etp_lc_dump_thread_locked->id < sizeof(erts_lock_order)/sizeof(erts_lc_lock_order_t)
4351        printf "  %s:", erts_lock_order[$etp_lc_dump_thread_locked->id].name
4352      else
4353        printf "  unkown:"
4354      end
4355      if ($etp_lc_dump_thread_locked->extra & 0x3) == 0x3
4356        etp-1 $etp_lc_dump_thread_locked->extra
4357      else
4358        printf "%p", $etp_lc_dump_thread_locked->extra
4359      end
4360      if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 0)
4361        printf "[spinlock]"
4362      end
4363      if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 1)
4364        printf "[rw(spin)lock]"
4365      end
4366      if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 2)
4367        printf "[mutex]"
4368      end
4369      if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 3)
4370        printf "[rwmutex]"
4371      end
4372      if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 4)
4373        printf "[proclock]"
4374      end
4375      printf "(%s:%d)", $etp_lc_dump_thread_locked->file, $etp_lc_dump_thread_locked->line
4376      if ($etp_lc_dump_thread_locked->flags & (0x60)) == (1 << 5)
4377        printf "(r)"
4378      end
4379      if ($etp_lc_dump_thread_locked->flags & (0x60)) == ((1 << 5) | (1 << 6))
4380        printf "(rw)"
4381      end
4382      printf "\n"
4383      set $etp_lc_dump_thread_locked = $etp_lc_dump_thread_locked->next
4384    end
4385    set $etp_lc_dump_thread = $etp_lc_dump_thread->next
4386  end
4387end
4388
4389document etp-lc-dump
4390%---------------------------------------------------------------------------
4391% etp-lc-dump
4392%
4393% Dump all info about locks in the lock checker
4394%---------------------------------------------------------------------------
4395end
4396
4397define etp-ppc-stacktrace
4398# Args: R1
4399# Non-reentrant
4400  set $etp_ppc_st_fp = ($arg0)
4401  while $etp_ppc_st_fp
4402    info symbol ((void**)$etp_ppc_st_fp)[1]
4403    set $etp_ppc_st_fp = ((void**)$etp_ppc_st_fp)[0]
4404 end
4405end
4406
4407document etp-ppc-stacktrace
4408%---------------------------------------------------------------------------
4409% etp-ppc-stacktrace R1
4410%
4411% Dump stacktrace from given $r1 frame pointer
4412%---------------------------------------------------------------------------
4413end
4414
4415############################################################################
4416# OSE support
4417#
4418define etp-ose-attach
4419  target ose $arg0:21768
4420  attach block start_beam start_beam
4421end
4422
4423document etp-ose-attach
4424%---------------------------------------------------------------------------
4425% etp-ose-attach Host
4426%
4427% Connect and attach to erlang vm at Host.
4428%---------------------------------------------------------------------------
4429end
4430
4431
4432############################################################################
4433# Erlang support module handling
4434#
4435
4436define etp-run
4437  shell make -f "${ROOTDIR:?}/erts/etc/unix/etp_commands.mk" \
4438    ROOTDIR="${ROOTDIR:?}" ETP_DATA="etp-commands.bin"
4439end
4440
4441document etp-run
4442%---------------------------------------------------------------------------
4443% etp-run
4444%
4445% Make and run the Erlang support module on the input file
4446% "erl-commands.bin". The environment variable ROOTDIR must
4447% be set to find $ROOTDIR/erts/etc/unix/etp_commands.mk.
4448%
4449% Also, erl and erlc must be in the path.
4450%---------------------------------------------------------------------------
4451end
4452
4453define etp-thr
4454  source @ERL_TOP@/erts/etc/unix/etp-thr.py
4455end
4456
4457############################################################################
4458# erl_alloc_util (blocks and carriers)
4459#
4460
4461define etp-block-size-1
4462#
4463# In:  (Block_t*) in $arg0
4464# Out: Byte size in $etp_blk_sz
4465#
4466  if ($arg0)->bhdr & 1
4467      # Free block
4468      set $etp_blk_sz = ($arg0)->bhdr & ~7
4469  else
4470      # Allocated block
4471      set $etp_blk_sz = ($arg0)->bhdr & $etp_MBC_ABLK_SZ_MASK
4472  end
4473end
4474
4475define etp-block2mbc-1
4476#
4477# In: (Block_t*) in $arg0
4478# Out: (Carrier_t*) in $etp_mbc
4479#
4480  if (($arg0)->bhdr) & 1
4481      # Free block
4482      set $etp_mbc = ($arg0)->u.carrier
4483  else
4484      # Allocated block
4485    set $etp_mbc = (Carrier_t*) ((((UWord)($arg0) >> $etp_SUPER_ALIGN_BITS) \
4486        - ((($arg0)->bhdr & $etp_MBC_ABLK_OFFSET_MASK) >> $etp_MBC_ABLK_OFFSET_SHIFT)) \
4487        << $etp_SUPER_ALIGN_BITS)
4488  end
4489end
4490
4491define etp-block2mbc
4492  etp-block2mbc-1 ((Block_t*)$arg0)
4493  print $etp_mbc
4494end
4495
4496document etp-block2mbc
4497%---------------------------------------------------------------------------
4498% Print pointer to multiblock carrier containing the argument (Block_t*)
4499%---------------------------------------------------------------------------
4500end
4501
4502define etp-block
4503  etp-block-size-1 ((Block_t*)$arg0)
4504  if ((Block_t*)$arg0)->bhdr & 1
4505     printf "%#lx: FREE sz=%#x\n", ($arg0), $etp_blk_sz
4506  else
4507     printf "%#lx: ALLOCATED sz=%#x\n", ($arg0), $etp_blk_sz
4508  end
4509end
4510
4511document etp-block
4512%---------------------------------------------------------------------------
4513% Print memory block (Block_t*)
4514%---------------------------------------------------------------------------
4515end
4516
4517define etp-smp-atomic
4518  set $arg1 = (($arg0).counter)
4519end
4520
4521document etp-smp-atomic
4522%---------------------------------------------------------------------------
4523% Read an erts_smp_atomic_t value from $arg0 into $arg1
4524%---------------------------------------------------------------------------
4525end
4526
4527define etp-carrier-blocks-1
4528  set $etp_crr = (Carrier_t*) $arg0
4529  etp-smp-atomic $etp_crr->allctr $etp_alc
4530  set $etp_alc = (Allctr_t*)($etp_alc & ~7)
4531  set $etp_crr_end = ((char*)$etp_crr + ($etp_crr->chdr & ~7) - (sizeof(void*) & ~8))
4532  set $etp_blk = (Block_t*) ((char*)$etp_crr + $etp_alc->mbc_header_size)
4533  set $etp_prev_blk = 0
4534  set $etp_error_cnt = 0
4535  set $etp_ablk_cnt = 0
4536  set $etp_fblk_cnt = 0
4537  set $etp_aborted = 0
4538
4539  while 1
4540    if !$etp_be_silent
4541      etp-block $etp_blk
4542    else
4543      etp-block-size-1 $etp_blk
4544    end
4545    etp-block2mbc-1 $etp_blk
4546    if $etp_mbc != $etp_crr
4547      printf "ERROR: Invalid carrier pointer %#lx in block at %#lx\n", $etp_mbc, $etp_blk
4548      set $etp_error_cnt = $etp_error_cnt + 1
4549    end
4550    if $etp_prev_blk
4551      if ($etp_prev_blk->bhdr & 1)
4552        # Prev is FREE
4553        if ($etp_blk->bhdr & 1)
4554          printf "ERROR: Adjacent FREE blocks at %#lx and %#lx\n", $etp_prev_blk, $etp_blk
4555	  set $etp_error_cnt = $etp_error_cnt + 1
4556        end
4557        if !($etp_blk->bhdr & 2)
4558          printf "ERROR: Missing PREV_FREE_BLK_HDR_FLG (2) in block at %#lx\n", $etp_blk
4559	  set $etp_error_cnt = $etp_error_cnt + 1
4560        end
4561      else
4562	# Prev is ALLOCATED
4563        if ($etp_blk->bhdr & 2)
4564          printf "ERROR: Invalid PREV_FREE_BLK_HDR_FLG (2) set in block at %#lx\n", $etp_blk
4565	  set $etp_error_cnt = $etp_error_cnt + 1
4566        end
4567      end
4568    end
4569    if $etp_blk->bhdr & 1
4570      set $etp_fblk_cnt = $etp_fblk_cnt + 1
4571    else
4572      set $etp_ablk_cnt = $etp_ablk_cnt + 1
4573    end
4574    if $etp_blk->bhdr & 4
4575      # Last block
4576      loop_break
4577    end
4578    # All free blocks except the last have a footer
4579    if ($etp_blk->bhdr & 1) && ((UWord*)((char*)$etp_blk + $etp_blk_sz))[-1] != $etp_blk_sz
4580      printf "ERROR: Invalid footer of free block at %#lx\n", $etp_blk
4581    end
4582    set $etp_prev_blk = $etp_blk
4583    set $etp_blk = (Block_t*) ((char*)$etp_blk + $etp_blk_sz)
4584    if $etp_blk < (Block_t*) ((char*)$etp_prev_blk + $etp_alc->min_block_size) || $etp_blk >= $etp_crr_end
4585      printf "ERROR: Invalid size of block at %#lx. ABORTING\n", $etp_prev_blk
4586      set $etp_aborted = 1
4587      loop_break
4588    end
4589  end
4590
4591  if !$etp_aborted
4592    if ((char*)$etp_blk + $etp_blk_sz) != $etp_crr_end
4593      printf "ERROR: Last block not at end of carrier\n"
4594      set $etp_error_cnt = $etp_error_cnt + 1
4595    end
4596    printf "Allocated blocks: %u\n", $etp_ablk_cnt
4597    printf "Free      blocks: %u\n", $etp_fblk_cnt
4598  end
4599  if $etp_error_cnt
4600    printf "%u ERRORs reported above\n", $etp_error_cnt
4601  end
4602end
4603
4604define etp-carrier-print
4605  set $etp_be_silent = 0
4606  etp-carrier-blocks-1 $arg0
4607end
4608
4609document etp-carrier-print
4610%---------------------------------------------------------------------------
4611% Print all memory blocks in carrier
4612% Args: (Carrier_t*)
4613%---------------------------------------------------------------------------
4614end
4615
4616define etp-carrier-check
4617  set $etp_be_silent = 1
4618  etp-carrier-blocks-1 $arg0
4619end
4620
4621document etp-carrier-check
4622%---------------------------------------------------------------------------
4623% Check all memory blocks in carrier
4624% Args: (Carrier_t*)
4625%---------------------------------------------------------------------------
4626end
4627
4628
4629define etp-address-to-beam-opcode
4630  set $etp_i = 0
4631  set $etp_min_diff = ((UWord)1 << (sizeof(UWord)*8 - 1))
4632  set $etp_min_opcode = -1
4633  set $etp_addr = (UWord) ($arg0)
4634
4635  while $etp_i < num_instructions && $etp_min_diff > 0
4636    if ($etp_addr - (UWord)beam_ops[$etp_i]) < $etp_min_diff
4637      set $etp_min_diff = $etp_addr - (UWord)beam_ops[$etp_i]
4638      set $etp_min_opcode = $etp_i
4639    end
4640    set $etp_i = $etp_i + 1
4641  end
4642  if $etp_min_diff == 0
4643    printf "Address %p is start of '%s'\n", $etp_addr, opc[$etp_min_opcode].name
4644  else
4645    if $etp_min_opcode >= 0
4646      printf "Address is %ld bytes into opcode '%s' at %p\n", $etp_min_diff, opc[$etp_min_opcode].name, beam_ops[$etp_min_opcode]
4647    else
4648      printf "Invalid opcode address\n"
4649    end
4650  end
4651end
4652
4653document etp-address-to-beam-opcode
4654%---------------------------------------------------------------------------
4655% Get beam opcode from a native instruction address (within process_main())
4656% Arg: Instructon pointer value
4657%
4658% Does not work with NO_JUMP_TABLE
4659%---------------------------------------------------------------------------
4660end
4661
4662define etp-compile-debug
4663  shell (cd $ERL_TOP && make emulator FLAVOR=smp TYPE=debug)
4664end
4665
4666document etp-compile-debug
4667%---------------------------------------------------------------------------
4668% Re-compile the debug erlang emulator
4669%---------------------------------------------------------------------------
4670end
4671
4672define etp-compile
4673  shell (cd $ERL_TOP && make emulator)
4674end
4675
4676document etp-compile
4677%---------------------------------------------------------------------------
4678% Re-compile the erlang emulator
4679%---------------------------------------------------------------------------
4680end
4681
4682
4683############################################################################
4684# Toolbox parameter handling
4685#
4686
4687define etp-set-max-depth
4688  if ($arg0) > 0
4689    set $etp_max_depth = ($arg0)
4690  else
4691    echo %%%Error: max-depth <= 0 %%%\n
4692  end
4693end
4694
4695document etp-set-max-depth
4696%---------------------------------------------------------------------------
4697% etp-set-max-depth Depth
4698%
4699% Set the max term depth to use for etp. The term dept limit
4700% works in both depth and width, so if you set the max depth to 10,
4701% an 11 element flat tuple will be truncated.
4702%---------------------------------------------------------------------------
4703end
4704
4705define etp-set-max-string-length
4706  if ($arg0) > 0
4707    set $etp_max_string_length = ($arg0)
4708  else
4709    echo %%%Error: max-string-length <= 0 %%%\n
4710  end
4711end
4712
4713document etp-set-max-string-length
4714%---------------------------------------------------------------------------
4715% etp-set-max-strint-length Length
4716%
4717% Set the max string length to use for ept when printing lists
4718% that can be shown as printable strings. Printable strings
4719% that are longer will be truncated, and not even checked if
4720% they really are printable all the way to the end.
4721%---------------------------------------------------------------------------
4722end
4723
4724define etp-show
4725  printf "etp-set-max-depth %d\n", $etp_max_depth
4726  printf "etp-set-max-string-length %d\n", $etp_max_string_length
4727end
4728
4729document etp-show
4730%---------------------------------------------------------------------------
4731% etp-show
4732%
4733% Show the commands needed to set all etp parameters
4734% to their current value.
4735%---------------------------------------------------------------------------
4736end
4737
4738define etp-rr-run-until-beam
4739  source @ERL_TOP@/erts/etc/unix/etp-rr-run-until-beam.py
4740end
4741
4742document etp-rr-run-until-beam
4743%---------------------------------------------------------------------------
4744% etp-rr-run-until-beam
4745%
4746% Use this gdb macro to make cerl -rr replay -p PID walk until
4747% the correct execute has been made. You may have to change the
4748% file that is used to debug with.
4749%---------------------------------------------------------------------------
4750end
4751
4752############################################################################
4753# Init
4754#
4755
4756define etp-init
4757  set $etp_arch64 = (sizeof(void *) == 8)
4758  if $etp_arch64
4759    set $etp_MBC_ABLK_OFFSET_BITS = 23
4760    set $etp_SUPER_ALIGN_BITS = 14
4761  else
4762    set $etp_MBC_ABLK_OFFSET_BITS = 8
4763    set $etp_SUPER_ALIGN_BITS = 18
4764  end
4765  set $etp_nil = 0x3b
4766  set $etp_MBC_ABLK_OFFSET_SHIFT = (sizeof(UWord)*8 - 1 - $etp_MBC_ABLK_OFFSET_BITS)
4767  set $etp_MBC_ABLK_OFFSET_MASK = ((((UWord)1 << $etp_MBC_ABLK_OFFSET_BITS) - 1) << $etp_MBC_ABLK_OFFSET_SHIFT)
4768  set $etp_MBC_ABLK_SZ_MASK = ((UWord)1 << $etp_MBC_ABLK_OFFSET_SHIFT) - 1 - 7
4769  set $etp_flat = 0
4770  set $etp_chart_id = 0
4771  set $etp_chart = 0
4772
4773  set $etp_max_depth = 20
4774  set $etp_max_string_length = 100
4775
4776  set $etp_ets_tables_i = 0
4777  set disassembly-flavor intel
4778  if etp_beamasm
4779    jit-reader-load @ERL_TOP@/bin/@TARGET@/jit-reader.so
4780  end
4781end
4782
4783document etp-init
4784%---------------------------------------------------------------------------
4785% Use etp-help for a command overview and general help.
4786%
4787% To use the Erlang support module, the environment variable ROOTDIR
4788% must be set to the toplevel installation directory of Erlang/OTP,
4789% so the etp-commands file becomes:
4790%     $ROOTDIR/erts/etc/unix/etp-commands
4791% Also, erl and erlc must be in the path.
4792%---------------------------------------------------------------------------
4793end
4794
4795define hook-run
4796  set $_exitsignal = -1
4797end
4798
4799handle SIGPIPE nostop
4800
4801etp-init
4802help etp-init
4803if $etp_rr_run_until_beam
4804  help etp-rr-run-until-beam
4805else
4806  etp-show
4807  etp-system-info
4808end
4809