← Back to branch summary

~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to erts/etc/unix/etp-commands

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
erts/etc/unix/etp-commands
 
1
## ``The contents of this file are subject to the Erlang Public License,
 
2
## Version 1.1, (the "License"); you may not use this file except in
 
3
## compliance with the License. You should have received a copy of the
 
4
## Erlang Public License along with this software. If not, it can be
 
5
## retrieved via the world wide web at http://www.erlang.org/.
 
6
## 
 
7
## Software distributed under the License is distributed on an "AS IS"
 
8
## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
9
## the License for the specific language governing rights and limitations
 
10
## under the License.
 
11
## 
 
12
## The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 
13
## Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 
14
## AB. All Rights Reserved.''
 
15
## 
 
16
##     $Id$
 
17
##
 
18
############################################################################
 
19
# Help commands
 
20
# 
 
21
 
 
22
define etp-help
 
23
  help etp-help
 
24
end
 
25
 
 
26
document etp-help
 
27
%---------------------------------------------------------------------------
 
28
% etp-help
 
29
% 
 
30
% Same as "help etp-help"
 
31
% 
 
32
% Emulator Toolbox for Pathologists
 
33
% - GDB commad toolbox for analyzing core dumps form the 
 
34
% Erlang emulator (BEAM).
 
35
% 
 
36
% Should work for 32-bit erts-5.2/R9B, ...
 
37
% 
 
38
% The commands are prefixed with:
 
39
%   etp:  Acronym for erts-term-print
 
40
%   etpf: Acronym for erts-term-print-flat
 
41
% 
 
42
% User commands (these have help themselves):
 
43
% 
 
44
% Most useful:
 
45
%   etp, etpf
 
46
% 
 
47
% Useful for doing step-by-step traversal of lists and tuples after 
 
48
% calling the toplevel command etpf:
 
49
%   etpf-cons, etpf-boxed, 
 
50
% 
 
51
% Special commands for not really terms:
 
52
%   etp-mfa, etp-cp, 
 
53
%   etp-msgq, etpf-msgq, 
 
54
%   etp-stacktrace, etp-stackdump, etpf-stackdump, etp-dictdump
 
55
%   etp-offheapdump, etpf-offheapdump,
 
56
%   etp-search-heaps, etp-search-alloc,
 
57
%   etp-ets-tables, etp-ets-tabledump
 
58
%
 
59
% Complex commands that use the Erlang support module.
 
60
%   etp-overlapped-heaps, etp-chart, etp-chart-start, etp-chart-end
 
61
% 
 
62
% Erlang support module handling commands:
 
63
%   etp-run
 
64
%
 
65
% Parameter handling commands:
 
66
%   etp-show, etp-set-max-depth, etp-set-max-string-length
 
67
% 
 
68
% Other commands you may find in this toolbox are suffixed -1, -2, ...
 
69
% and are internal; not for the console user.
 
70
% 
 
71
% The Erlang support module requires `erl' and `erlc' in the path.
 
72
% The compiled "erl_commands.beam" file is stored in the current
 
73
% working directory, so it is thereby in the search path of `erl'.
 
74
% 
 
75
% These are just helpful commands when analyzing core dumps, but
 
76
% you will not get away without knowing the gory details of the
 
77
% tag bits. Do not forget about the e.g p, p/x, x and x/4x commands.
 
78
%
 
79
% Execution speed of user defined gdb commands is not lightning fast.
 
80
% It may well take half a minute do dump a complex term with the default
 
81
% max depth values on our old Sparc Ultra-10's.
 
82
%
 
83
% To use the Erlang support module, the environment variable ROOTDIR
 
84
% must be set to the toplevel installation directory of Erlang/OTP,
 
85
% so the etp-commands file becomes:
 
86
%     $ROOTDIR/erts/etc/unix/etp-commands
 
87
% Also, erl and erlc must be in the path.
 
88
%---------------------------------------------------------------------------
 
89
end
 
90
 
 
91
############################################################################
 
92
# Toplevel commands
 
93
# 
 
94
 
 
95
define etp
 
96
# Args: Eterm
 
97
#
 
98
# Reentrant
 
99
#
 
100
  etp-1 ((Eterm)($arg0)) 0
 
101
  printf ".\n"
 
102
end
 
103
 
 
104
document etp
 
105
%---------------------------------------------------------------------------
 
106
% etp Eterm
 
107
% 
 
108
% Takes a toplevel Erlang term and prints the whole deep term
 
109
% very much as in Erlang itself. Up to a max depth. See etp-show.
 
110
%---------------------------------------------------------------------------
 
111
end
 
112
 
 
113
define etp-1
 
114
# Args: Eterm, int depth
 
115
#
 
116
# Reentrant
 
117
#
 
118
  if (($arg0) & 0x3) == 1
 
119
    # Cons pointer
 
120
    if $etp_flat
 
121
      printf "<etpf-cons %#x>", ($arg0)
 
122
    else
 
123
      etp-list-1 ($arg0) ($arg1)
 
124
    end
 
125
  else
 
126
    if (($arg0) & 0x3) == 2
 
127
      if $etp_flat
 
128
        printf "<etpf-boxed %#x>", ($arg0)
 
129
      else
 
130
        etp-boxed-1 ($arg0) ($arg1)
 
131
      end
 
132
    else
 
133
      if (($arg0) & 0x3) == 3
 
134
        etp-immediate-1 ($arg0)
 
135
      else
 
136
        # (($arg0) & 0x3) == 0
 
137
        if (($arg0) == 0x0)
 
138
          printf "<the non-value>"
 
139
        else
 
140
          if (($arg0) == 0x4)
 
141
            printf "<the non-value debug>"
 
142
          else
 
143
            etp-cp-1 ($arg0)
 
144
          end
 
145
        end
 
146
      end
 
147
    end
 
148
  end
 
149
end
 
150
 
 
151
define etpf
 
152
# Args: Eterm
 
153
#
 
154
# Non-reentrant
 
155
  set $etp_flat = 1
 
156
  etp-1 ((Eterm)($arg0))
 
157
  set $etp_flat = 0
 
158
  printf ".\n"
 
159
end
 
160
 
 
161
document etpf
 
162
%---------------------------------------------------------------------------
 
163
% etpf Eterm
 
164
% 
 
165
% Takes a toplevel Erlang term and prints it is. If it is a deep term 
 
166
% print which command to use to traverse down one level.
 
167
%---------------------------------------------------------------------------
 
168
end
 
169
 
 
170
############################################################################
 
171
# Commands for nested terms. Some are recursive.
 
172
#
 
173
 
 
174
define etp-list-1
 
175
# Args: Eterm cons_cell, int depth
 
176
#
 
177
# Reentrant
 
178
#
 
179
  if (($arg0) & 0x3) != 0x1
 
180
    printf "#NotCons<%#x>", ($arg0)
 
181
  else
 
182
    # Cons pointer
 
183
    if $etp_chart
 
184
      etp-chart-entry-1 ($arg0) ($arg1) 2
 
185
    end
 
186
    etp-list-printable-1 ($arg0) ($arg1)
 
187
    if !$etp_list_printable
 
188
      # Print normal list
 
189
      printf "["
 
190
      etp-list-2 ($arg0) (($arg1)+1)
 
191
    end
 
192
  end
 
193
end
 
194
 
 
195
define etp-list-printable-1
 
196
# Args: Eterm list, int depth
 
197
#
 
198
# Non-reentrant
 
199
#
 
200
# Returns: $etp_list_printable
 
201
#
 
202
  if (($arg0) & 0x3) != 0x1
 
203
    printf "#NotCons<%#x>", ($arg0)
 
204
  else
 
205
    # Loop to check if it is a printable string
 
206
    set $etp_list_p = ($arg0)
 
207
    set $etp_list_printable = ($etp_list_p != $etp_nil)
 
208
    set $etp_list_i = 0
 
209
    while ($etp_list_p != $etp_nil) && \
 
210
          ($etp_list_i < $etp_max_string_length) && \
 
211
          $etp_list_printable
 
212
      if ($etp_list_p & 0x3) == 0x1
 
213
        # Cons pointer
 
214
        set $etp_list_n = ((Eterm*)($etp_list_p & ~0x3))[0]
 
215
        if ($etp_list_n & 0xF) == 0xF
 
216
          etp-ct-printable-1 ($etp_list_n>>4)
 
217
          if $etp_ct_printable
 
218
            # Printable
 
219
            set $etp_list_p = ((Eterm*)($etp_list_p & ~0x3))[1]
 
220
            set $etp_list_i++
 
221
          else
 
222
            set $etp_list_printable = 0
 
223
          end
 
224
        else
 
225
          set $etp_list_printable = 0
 
226
        end
 
227
      else
 
228
        set $etp_list_printable = 0
 
229
      end
 
230
    end
 
231
    #
 
232
    if $etp_list_printable
 
233
        # Print printable string
 
234
        printf "\""
 
235
      set $etp_list_p = ($arg0)
 
236
      set $etp_list_i = 0
 
237
      while $etp_list_p != $etp_nil
 
238
        set $etp_list_n = ((Eterm*)($etp_list_p & ~0x3))[0]
 
239
        etp-char-1 ($etp_list_n>>4) '"'
 
240
        set $etp_list_p = ((Eterm*)($etp_list_p & ~0x3))[1]
 
241
        set $etp_list_i++
 
242
        if $etp_list_p == $etp_nil
 
243
          printf "\""
 
244
        else
 
245
          if $etp_list_i >= $etp_max_string_length
 
246
            set $etp_list_p = $etp_nil
 
247
            printf "\"++[...]"
 
248
          else
 
249
            if $etp_chart
 
250
              etp-chart-entry-1 ($arg0) (($arg1)+$etp_list_i) 2
 
251
            end
 
252
          end
 
253
        end
 
254
      end
 
255
    end
 
256
  end
 
257
end
 
258
 
 
259
define etp-list-2
 
260
# Args: Eterm cons_cell, int depth
 
261
#
 
262
# Reentrant
 
263
#
 
264
  if (($arg0) & 0x3) != 0x1
 
265
    printf "#NotCons<%#x>", ($arg0)
 
266
  else
 
267
    # Cons pointer
 
268
    if ($arg1) >= $etp_max_depth
 
269
      printf "...]"
 
270
    else
 
271
      etp-1 (((Eterm*)(($arg0)&~0x3))[0]) (($arg1)+1)
 
272
      if ((Eterm*)(($arg0) & ~0x3))[1] == $etp_nil
 
273
        # Tail is []
 
274
        printf "]"
 
275
      else
 
276
        if $etp_chart
 
277
          etp-chart-entry-1 ($arg0) ($arg1) 2
 
278
        end
 
279
        if (((Eterm*)(($arg0)&~0x3))[1]&0x3) == 0x1
 
280
          # Tail is cons cell
 
281
          printf ","
 
282
          etp-list-2 (((Eterm*)(($arg0)&~0x3))[1]) (($arg1)+1)
 
283
        else
 
284
          # Tail is other term
 
285
          printf "|"
 
286
          etp-1 (((Eterm*)(($arg0)&~0x3))[1]) (($arg1)+1)
 
287
          printf "]"
 
288
        end
 
289
      end
 
290
    end
 
291
  end
 
292
end
 
293
 
 
294
define etpf-cons
 
295
# Args: Eterm
 
296
#
 
297
# Reentrant capable
 
298
#
 
299
  if ((Eterm)($arg0) & 0x3) != 0x1
 
300
    printf "#NotCons<%#x>", ($arg0)
 
301
  else
 
302
    # Cons pointer
 
303
    set $etp_flat = 1
 
304
    printf "["
 
305
    etp-1 (((Eterm*)((Eterm)($arg0)&~0x3))[0])
 
306
    printf "|"
 
307
    etp-1 (((Eterm*)((Eterm)($arg0)&~0x3))[1])
 
308
    printf "]\n"
 
309
    set $etp_flat = 0
 
310
  end
 
311
end
 
312
 
 
313
document etpf-cons
 
314
%---------------------------------------------------------------------------
 
315
% etpf-cons Eterm
 
316
% 
 
317
% Takes a Cons ptr and prints the Car and Cdr cells with etpf (flat).
 
318
%---------------------------------------------------------------------------
 
319
end
 
320
 
 
321
 
 
322
 
 
323
define etp-boxed-1
 
324
# Args: Eterm, int depth
 
325
#
 
326
# Reentrant
 
327
#
 
328
  if (($arg0) & 0x3) != 0x2
 
329
    printf "#NotBoxed<%#x>", ($arg0)
 
330
  else
 
331
    if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3) != 0x0
 
332
      if $etp_chart
 
333
        etp-chart-entry-1 (($arg0)&~0x3) ($arg1) 1
 
334
      end
 
335
      printf "#BoxedError<%#x>", ($arg0)
 
336
    else
 
337
      if $etp_chart
 
338
        etp-chart-entry-1 (($arg0)&~0x3) ($arg1) \
 
339
                          ((((Eterm*)(($arg0)&~0x3))[0]>>6)+1)
 
340
      end
 
341
      if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3f) == 0x0
 
342
        printf "{"
 
343
        etp-array-1 ((Eterm*)(($arg0)&~0x3)) ($arg1) ($arg1) \
 
344
                    1 ((((Eterm*)(($arg0)&~0x3))[0]>>6)+1) '}'
 
345
      else
 
346
        etp-boxed-immediate-1 ($arg0)
 
347
      end
 
348
    end
 
349
  end
 
350
end
 
351
 
 
352
define etp-boxed-immediate-1
 
353
# Args: Eterm, int depth
 
354
#
 
355
# Non-reentrant
 
356
#
 
357
  if (($arg0) & 0x3) != 0x2
 
358
    printf "#NotBoxed<%#x>", ($arg0)
 
359
  else
 
360
    if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3) != 0x0
 
361
      printf "#BoxedError<%#x>", ($arg0)
 
362
    else
 
363
      set $etp_boxed_immediate_p = (Eterm*)(($arg0) & ~0x3)
 
364
      set $etp_boxed_immediate_h = ($etp_boxed_immediate_p[0] >> 2) & 0xF
 
365
      if $etp_boxed_immediate_h == 0xC
 
366
        etp-extpid-1 ($arg0)
 
367
      else
 
368
        if $etp_boxed_immediate_h == 0xD
 
369
          etp-extport-1 ($arg0)
 
370
        else
 
371
          if ($etp_boxed_immediate_h == 0x2) || \
 
372
             ($etp_boxed_immediate_h == 0x3)
 
373
            etp-bignum-1 ($arg0)
 
374
          else
 
375
            if ($etp_boxed_immediate_h == 0x6)
 
376
              etp-float-1 ($arg0)
 
377
            else
 
378
              if ($etp_boxed_immediate_h == 0x4)
 
379
                etp-ref-1 ($arg0)
 
380
              else
 
381
                if ($etp_boxed_immediate_h == 0xE)
 
382
                  etp-extref-1 ($arg0)
 
383
                else
 
384
                  # Hexdump the rest
 
385
                  if ($etp_boxed_immediate_h == 0x5)
 
386
                    printf "#Fun<"
 
387
                  else
 
388
                    if ($etp_boxed_immediate_h == 0x8)
 
389
                      printf "#RefcBinary<"
 
390
                    else
 
391
                    if ($etp_boxed_immediate_h == 0x9)
 
392
                      printf "#HeapBinary<"
 
393
                    else
 
394
                    if ($etp_boxed_immediate_h == 0xA)
 
395
                      printf "#SubBinary<"
 
396
                    else
 
397
                      printf "#Header%X<", $etp_boxed_immediate_h
 
398
                    end
 
399
                  end
 
400
                  end
 
401
                  end
 
402
                  set $etp_boxed_immediate_arity = $etp_boxed_immediate_p[0]>>6
 
403
                  while $etp_boxed_immediate_arity > 0
 
404
                    set $etp_boxed_immediate_p++
 
405
                    if $etp_boxed_immediate_arity > 1
 
406
                      printf "%#x,", *$etp_boxed_immediate_p
 
407
                    else
 
408
                      printf "%#x", *$etp_boxed_immediate_p
 
409
                      if ($etp_boxed_immediate_h == 0xA)
 
410
                        set $etp_boxed_immediate_p++
 
411
                        printf ":%#x", *$etp_boxed_immediate_p
 
412
                      end
 
413
                      printf ">"
 
414
                    end
 
415
                    set $etp_boxed_immediate_arity--
 
416
                  end
 
417
                  # End of hexdump
 
418
                end
 
419
              end
 
420
            end
 
421
          end
 
422
        end
 
423
      end
 
424
    end
 
425
  end
 
426
end
 
427
 
 
428
define etpf-boxed
 
429
# Args: Eterm
 
430
#
 
431
# Non-reentrant
 
432
#
 
433
  set $etp_flat = 1
 
434
  etp-boxed-1 ((Eterm)($arg0)) 0
 
435
  set $etp_flat = 0
 
436
  printf ".\n"
 
437
end
 
438
 
 
439
document etpf-boxed
 
440
%---------------------------------------------------------------------------
 
441
% etpf-boxed Eterm
 
442
% 
 
443
% Take a Boxed ptr and print the contents in one level using etpf (flat).
 
444
%---------------------------------------------------------------------------
 
445
end
 
446
 
 
447
 
 
448
 
 
449
define etp-array-1
 
450
# Args: Eterm* p, int depth, int width, int pos, int size, int end_char
 
451
#
 
452
# Reentrant
 
453
#
 
454
  if ($arg3) < ($arg4)
 
455
    if (($arg1) < $etp_max_depth) && (($arg2) < $etp_max_depth)
 
456
      etp-1 (($arg0)[($arg3)]) (($arg1)+1)
 
457
      if (($arg3) + 1) != ($arg4)
 
458
        printf ","
 
459
      end
 
460
      etp-array-1 ($arg0) ($arg1) (($arg2)+1) (($arg3)+1) ($arg4) ($arg5)
 
461
    else
 
462
      printf "...%c", ($arg5)
 
463
    end
 
464
  else
 
465
    printf "%c", ($arg5)
 
466
  end
 
467
end
 
468
 
 
469
 
 
470
 
 
471
#define etpa-1
 
472
## Args: Eterm, int depth, int index, int arity
 
473
##
 
474
## Reentrant
 
475
##
 
476
#  if ($arg1) >= $etp_max_depth+$etp_max_string_length
 
477
#    printf "%% Max depth for term %d\n", $etp_chart_id
 
478
#  else
 
479
#    if ($arg2) < ($arg3)
 
480
#      etp-1 (((Eterm*)(($arg0)&~0x3))[$arg2]) (($arg1)+1)
 
481
#      etpa-1 ($arg0) (($arg1)+1) (($arg2)+1) ($arg3)
 
482
#    end
 
483
#  end
 
484
#end
 
485
 
 
486
############################################################################
 
487
# Commands for non-nested terms. Recursion leaves. Some call other leaves.
 
488
#
 
489
 
 
490
define etp-immediate-1
 
491
# Args: Eterm
 
492
#
 
493
# Reentrant capable
 
494
#
 
495
  if (($arg0) & 0x3) != 0x3
 
496
    printf "#NotImmediate<%#x>", ($arg0)
 
497
  else
 
498
    if (($arg0) & 0xF) == 0x3 
 
499
      etp-pid-1 ($arg0)
 
500
    else
 
501
      if (($arg0) & 0xF) == 0x7
 
502
        etp-port-1 ($arg0)
 
503
      else
 
504
        if (($arg0) & 0xF) == 0xf
 
505
          # Fixnum
 
506
          printf "%d", ($arg0)>>4
 
507
        else
 
508
          # Immediate2  - 0xB
 
509
          if (($arg0) & 0x3f) == 0x0b
 
510
            etp-atom-1 ($arg0)
 
511
          else
 
512
            if (($arg0) & 0x3f) == 0x1b
 
513
              printf "#Catch<%d>", ($arg0)>>6
 
514
            else
 
515
              if (($arg0) == $etp_nil)
 
516
                printf "[]"
 
517
              else
 
518
                printf "#UnknownImmediate<%#x>", ($arg0)
 
519
              end
 
520
            end
 
521
          end
 
522
        end
 
523
      end
 
524
    end
 
525
  end
 
526
end
 
527
 
 
528
 
 
529
 
 
530
define etp-atom-1
 
531
# Args: Eterm atom
 
532
#
 
533
# Non-reentrant
 
534
#
 
535
  if ((Eterm)($arg0) & 0x3f) != 0xb
 
536
    printf "#NotAtom<%#x>", ($arg0)
 
537
  else
 
538
    set $etp_atom_1_ap = (Atom*)erts_atom_table.seg_table[(Eterm)($arg0)>>16][((Eterm)($arg0)>>6)&0x3FF]
 
539
    set $etp_atom_1_i = ($etp_atom_1_ap)->len
 
540
    set $etp_atom_1_p = ($etp_atom_1_ap)->name
 
541
    set $etp_atom_1_quote = 1
 
542
    # Check if atom has to be quoted
 
543
    if ($etp_atom_1_i > 0)
 
544
      etp-ct-atom-1 (*$etp_atom_1_p)
 
545
      if $etp_ct_atom
 
546
        # Atom start character
 
547
        set $etp_atom_1_p++
 
548
        set $etp_atom_1_i--
 
549
        set $etp_atom_1_quote = 0
 
550
      else
 
551
        set $etp_atom_1_i = 0
 
552
      end
 
553
    end
 
554
    while $etp_atom_1_i > 0
 
555
      etp-ct-name-1 (*$etp_atom_1_p)
 
556
      if $etp_ct_name
 
557
        # Name character
 
558
        set $etp_atom_1_p++
 
559
        set $etp_atom_1_i--
 
560
      else
 
561
        set $etp_atom_1_quote = 1
 
562
        set $etp_atom_1_i = 0
 
563
      end
 
564
    end
 
565
    # Print the atom
 
566
    if $etp_atom_1_quote
 
567
      printf "'"
 
568
    end
 
569
    set $etp_atom_1_i = ($etp_atom_1_ap)->len
 
570
    set $etp_atom_1_p = ($etp_atom_1_ap)->name
 
571
    while $etp_atom_1_i > 0
 
572
        etp-char-1 (*$etp_atom_1_p) '\''
 
573
        set $etp_atom_1_p++
 
574
        set $etp_atom_1_i--
 
575
    end
 
576
    if $etp_atom_1_quote
 
577
      printf "'"
 
578
    end
 
579
  end
 
580
end
 
581
 
 
582
 
 
583
 
 
584
define etp-char-1
 
585
# Args: int char, int quote_char
 
586
#
 
587
# Non-reentrant
 
588
#
 
589
  if (($arg0) < 0) || (0377 < ($arg0))
 
590
    printf "#NotChar<%#x>", ($arg0)
 
591
  else
 
592
    if ($arg0) == ($arg1)
 
593
      printf "\\%c", ($arg0)
 
594
    else
 
595
      etp-ct-printable-1 ($arg0)
 
596
      if $etp_ct_printable
 
597
        if $etp_ct_printable < 0
 
598
          printf "%c", ($arg0)
 
599
        else
 
600
          printf "\\%c", $etp_ct_printable
 
601
        end
 
602
      else
 
603
        printf "\\%03o", ($arg0)
 
604
      end
 
605
    end
 
606
  end
 
607
end
 
608
 
 
609
define etp-ct-printable-1
 
610
# Args: int
 
611
#
 
612
# Determines if integer is a printable character
 
613
#
 
614
# Non-reentrant
 
615
# Returns: $etp_ct_printable
 
616
#          escape alias char, or -1 if no escape alias
 
617
  if ($arg0) == 010
 
618
    set $etp_ct_printable = 'b'
 
619
  else
 
620
    if ($arg0) == 011
 
621
      set $etp_ct_printable = 't'
 
622
    else
 
623
      if ($arg0) == 012
 
624
        set $etp_ct_printable = 'n'
 
625
      else
 
626
        if ($arg0) == 013
 
627
          set $etp_ct_printable = 'v'
 
628
        else
 
629
          if ($arg0) == 014
 
630
            set $etp_ct_printable = 'f'
 
631
          else
 
632
            if ($arg0) == 033
 
633
              set $etp_ct_printable = 'e'
 
634
            else
 
635
              if ((040 <= ($arg0)) && (($arg0) <= 0176)) || \
 
636
                 ((0240 <= ($arg0)) && (($arg0) <= 0377))
 
637
                # Other printable character
 
638
                set $etp_ct_printable = -1
 
639
              else
 
640
                set $etp_ct_printable = 0
 
641
              end
 
642
            end
 
643
          end
 
644
        end
 
645
      end
 
646
    end
 
647
  end
 
648
end
 
649
 
 
650
define etp-ct-atom-1
 
651
# Args: int
 
652
#
 
653
# Determines if integer is a atom first character
 
654
#
 
655
# Non-reentrant
 
656
# Returns: $etp_ct_atom
 
657
  if ((0141 <= ($arg0)) && (($arg0) <= 0172)) || \
 
658
     ((0337 <= ($arg0)) && (($arg0) != 0367) && (($arg0) <= 0377))
 
659
    # Atom start character
 
660
    set $etp_ct_atom = 1
 
661
  else
 
662
    set $etp_ct_atom = 0
 
663
  end
 
664
end
 
665
 
 
666
define etp-ct-variable-1
 
667
# Args: int
 
668
#
 
669
# Determines if integer is a variable first character
 
670
#
 
671
# Non-reentrant
 
672
# Returns: $etp_ct_variable
 
673
  if ((056 == ($arg0)) || \
 
674
      (0101 <= ($arg0)) && (($arg0) <= 0132)) || \
 
675
      (0137 == ($arg0)) || \
 
676
      ((0300 <= ($arg0)) && (($arg0) != 0327) && (($arg0) <= 0336))
 
677
    # Variable start character
 
678
    set $etp_ct_variable = 1
 
679
  else
 
680
    set $etp_ct_variable = 0
 
681
  end
 
682
end
 
683
 
 
684
define etp-ct-name-1
 
685
# Args: int
 
686
#
 
687
# Determines if integer is a name character, 
 
688
# i.e non-first atom or variable character.
 
689
#
 
690
# Non-reentrant
 
691
# Returns: $etp_ct_variable
 
692
  if (($arg0) == 0100 || \
 
693
      (060 <= ($arg0)) && (($arg0) <= 071))
 
694
    set $etp_ct_name = 1
 
695
  else
 
696
    etp-ct-atom-1 ($arg0)
 
697
    if $etp_ct_atom
 
698
      set $etp_ct_name = 1
 
699
    else
 
700
      etp-ct-variable-1 ($arg0)
 
701
      set $etp_ct_name = $etp_ct_variable
 
702
    end
 
703
  end
 
704
end
 
705
 
 
706
 
 
707
 
 
708
define etp-pid-1
 
709
# Args: Eterm pid
 
710
#
 
711
# Non-reentrant
 
712
#
 
713
  set $etp_pid_1 = (Eterm)($arg0)
 
714
  if ($etp_pid_1 & 0xF) == 0x3
 
715
    # Internal pid
 
716
    printf "<0/%u.%u.%u>", erts_this_node->creation, \
 
717
           ($etp_pid_1>>4)&0x7fff, ($etp_pid_1>>19)&0x1fff
 
718
  else
 
719
    printf "#NotPid<%#x>", ($arg0)
 
720
  end
 
721
end
 
722
 
 
723
define etp-extpid-1
 
724
# Args: Eterm extpid
 
725
#
 
726
# Non-reentrant
 
727
#
 
728
  if ((Eterm)($arg0) & 0x3) != 0x2
 
729
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
 
730
  else
 
731
    set $etp_extpid_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3)
 
732
    if ($etp_extpid_1_p->header & 0x3f) != 0x30
 
733
      printf "#NotExternalPid<%#x>", $etp_extpid_1_p->header
 
734
    else
 
735
      ## External pid
 
736
      set $etp_extpid_1_number = $etp_extpid_1_p->data[0]&0x7fff
 
737
      set $etp_extpid_1_serial = ($etp_extpid_1_p->data[0]>>15)&0x1fff
 
738
      set $etp_extpid_1_np = $etp_extpid_1_p->node
 
739
      set $etp_extpid_1_creation = $etp_extpid_1_np->creation
 
740
      set $etp_extpid_1_dep = $etp_extpid_1_np->dist_entry
 
741
      set $etp_extpid_1_node = $etp_extpid_1_np->sysname
 
742
      if ($etp_extpid_1_node & 0x3f) != 0xb
 
743
        # Should be an atom
 
744
        printf "#ExternalPidError<%#x>", ($arg0)
 
745
      else
 
746
        if $etp_extpid_1_dep == erts_this_dist_entry
 
747
          printf "<0:"
 
748
        else
 
749
          printf "<%u:", $etp_extpid_1_node>>6
 
750
        end
 
751
        etp-atom-1 ($etp_extpid_1_node)
 
752
        printf "/%u.%u.%u>", $etp_extpid_1_creation, \
 
753
               $etp_extpid_1_number, $etp_extpid_1_serial
 
754
      end
 
755
    end
 
756
  end
 
757
end
 
758
 
 
759
 
 
760
 
 
761
define etp-port-1
 
762
# Args: Eterm port
 
763
#
 
764
# Non-reentrant
 
765
#
 
766
  set $etp_port_1 = (Eterm)($arg0)
 
767
  if ($etp_port_1 & 0xF) == 0x7
 
768
    # Internal port
 
769
    printf "#Port<0/%u.%u>", erts_this_node->creation, \
 
770
           ($etp_port_1>>4)&0x3ffff
 
771
  else
 
772
    printf "#NotPort<%#x>", ($arg0)
 
773
  end
 
774
end
 
775
 
 
776
define etp-extport-1
 
777
# Args: Eterm extport
 
778
#
 
779
# Non-reentrant
 
780
#
 
781
  if ((Eterm)($arg0) & 0x3) != 0x2
 
782
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
 
783
  else
 
784
    set $etp_extport_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3)
 
785
    if ($etp_extport_1_p->header & 0x3F) != 0x34
 
786
      printf "#NotExternalPort<%#x>", $etp_extport_1->header
 
787
    else
 
788
      ## External port
 
789
      set $etp_extport_1_number = $etp_extport_1_p->data[0]&0x3ffff
 
790
      set $etp_extport_1_np = $etp_extport_1_p->node
 
791
      set $etp_extport_1_creation = $etp_extport_1_np->creation
 
792
      set $etp_extport_1_dep = $etp_extport_1_np->dist_entry
 
793
      set $etp_extport_1_node = $etp_extport_1_np->sysname
 
794
      if ($etp_extport_1_node & 0x3f) != 0xb
 
795
        # Should be an atom
 
796
        printf "#ExternalPortError<%#x>", ($arg0)
 
797
      else
 
798
        if $etp_extport_1_dep == erts_this_dist_entry
 
799
          printf "#Port<0:"
 
800
        else
 
801
          printf "#Port<%u:", $etp_extport_1_node>>6
 
802
        end
 
803
        etp-atom-1 ($etp_extport_1_node)
 
804
        printf "/%u.%u>", $etp_extport_1_creation, $etp_extport_1_number
 
805
      end
 
806
    end
 
807
  end
 
808
end
 
809
 
 
810
 
 
811
 
 
812
define etp-bignum-1
 
813
# Args: Eterm bignum
 
814
#
 
815
# Non-reentrant
 
816
#
 
817
  if ((Eterm)($arg0) & 0x3) != 0x2
 
818
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
 
819
  else
 
820
    set $etp_bignum_1_p = (Eterm*)((Eterm)($arg0) & ~0x3)
 
821
    if ($etp_bignum_1_p[0] & 0x3b) != 0x08
 
822
      printf "#NotBignum<%#x>", $etp_bignum_1_p[0]
 
823
    else
 
824
      set $etp_bignum_1_i = 2 * ($etp_bignum_1_p[0] >> 6)
 
825
      if $etp_bignum_1_i < 2
 
826
        printf "#BignumError<%#x>", (Eterm)($arg0)
 
827
      else
 
828
        if $etp_bignum_1_p[0] & 0x04
 
829
          printf "-"
 
830
        end
 
831
        set $etp_bignum_1_p = (unsigned short *)($etp_bignum_1_p + 1)
 
832
        printf "16#"
 
833
        while $etp_bignum_1_i > 0
 
834
          set $etp_bignum_1_i--
 
835
          printf "%04x", $etp_bignum_1_p[$etp_bignum_1_i]
 
836
        end
 
837
      end
 
838
    end
 
839
  end
 
840
end
 
841
 
 
842
 
 
843
 
 
844
define etp-float-1
 
845
# Args: Eterm float
 
846
#
 
847
# Non-reentrant
 
848
#
 
849
  if ((Eterm)($arg0) & 0x3) != 0x2
 
850
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
 
851
  else
 
852
    set $etp_float_1_p = (Eterm*)((Eterm)($arg0) & ~0x3)
 
853
    if ($etp_float_1_p[0] & 0x3f) != 0x18
 
854
      printf "#NotFloat<%#x>", $etp_float_1_p[0]
 
855
    else
 
856
      printf "%f", *(double*)($etp_float_1_p+1)
 
857
    end
 
858
  end
 
859
end
 
860
 
 
861
 
 
862
 
 
863
define etp-ref-1
 
864
# Args: Eterm ref
 
865
#
 
866
# Non-reentrant
 
867
#
 
868
  if ((Eterm)($arg0) & 0x3) != 0x2
 
869
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
 
870
  else
 
871
    set $etp_ref_1_p = (Eterm*)((Eterm)($arg0) & ~0x3)
 
872
    if ($etp_ref_1_p[0] & 0x3b) != 0x10
 
873
      printf "#NotRef<%#x>", $etp_ref_1_p[0]
 
874
    else
 
875
      set $etp_ref_1_i = ($etp_ref_1_p[0] >> 6)
 
876
      printf "#Ref<0"
 
877
      while $etp_ref_1_i > 0
 
878
        printf ".%lu", (unsigned long)$etp_ref_1_p[$etp_ref_1_i]
 
879
        set $etp_ref_1_i--
 
880
      end
 
881
      printf ">"
 
882
    end
 
883
  end
 
884
end
 
885
 
 
886
 
 
887
 
 
888
define etp-extref-1
 
889
# Args: Eterm extref
 
890
#
 
891
# Non-reentrant
 
892
#
 
893
  if ((Eterm)($arg0) & 0x3) != 0x2
 
894
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
 
895
  else
 
896
    set $etp_extref_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3)
 
897
    if ($etp_extref_1_p->header & 0x3F) != 0x38
 
898
      printf "#NotExternalRef<%#x>", $etp_extref_1->header
 
899
    else
 
900
      ## External ref
 
901
      set $etp_extref_1_i = ($etp_extref_1_p->header >> 6)
 
902
      set $etp_extref_1_np = $etp_extref_1_p->node
 
903
      set $etp_extref_1_creation = $etp_extref_1_np->creation
 
904
      set $etp_extref_1_dep = $etp_extref_1_np->dist_entry
 
905
      set $etp_extref_1_node = $etp_extref_1_np->sysname
 
906
      if ($etp_extref_1_node & 0x3f) != 0xb \
 
907
         || $etp_extref_1_i < 2
 
908
        # Node should be an atom
 
909
        printf "#ExternalRefError<%#x>", ($arg0)
 
910
      else
 
911
        if $etp_extref_1_dep == erts_this_dist_entry
 
912
          printf "#Ref<0:"
 
913
        else
 
914
          printf "#Ref<%u:", $etp_extref_1_node>>6
 
915
        end
 
916
        etp-atom-1 ($etp_extref_1_node)
 
917
        printf "/%u", $etp_extref_1_creation
 
918
        set $etp_extref_1_i -= 2
 
919
        while $etp_extref_1_i > 0
 
920
          set $etp_extref_1_i--
 
921
          printf ".%lu", \
 
922
            (unsigned long)$etp_extref_1_p->data[$etp_extref_1_i]
 
923
        end
 
924
        printf ">"
 
925
      end
 
926
    end
 
927
  end
 
928
end
 
929
 
 
930
 
 
931
 
 
932
define etp-mfa-1
 
933
# Args: Eterm*, int offset
 
934
#
 
935
# Reentrant
 
936
#
 
937
  printf "<"
 
938
  etp-atom-1 (((Eterm*)($arg0))[0])
 
939
  printf ":"
 
940
  etp-atom-1 (((Eterm*)($arg0))[1])
 
941
  printf "/%d", ((Eterm*)($arg0))[2]
 
942
  if ($arg1) > 0
 
943
    printf "+%#x>", ($arg1)
 
944
  else
 
945
    printf ">"
 
946
  end   
 
947
end
 
948
 
 
949
define etp-mfa
 
950
# Args: Eterm*
 
951
#
 
952
# Reentrant capable
 
953
#
 
954
  etp-mfa-1 ($arg0) 0
 
955
  printf ".\n"
 
956
end
 
957
 
 
958
document etp-mfa
 
959
%---------------------------------------------------------------------------
 
960
% etp-mfa Eterm*
 
961
% 
 
962
% Take an Eterm* to an MFA function name entry and print it.
 
963
% These can be found e.g in the process structure;
 
964
% process_tab[i]->current and process_tab[i]->initial.
 
965
%---------------------------------------------------------------------------
 
966
end
 
967
 
 
968
 
 
969
 
 
970
define etp-cp-1
 
971
# Args: Eterm cp
 
972
#
 
973
# Non-reentrant
 
974
#
 
975
  set $etp_cp = (Eterm)($arg0)
 
976
  set $etp_cp_low = modules
 
977
  set $etp_cp_high = $etp_cp_low + num_loaded_modules
 
978
  set $etp_cp_mid = mid_module
 
979
  set $etp_cp_p = 0
 
980
  #
 
981
  while $etp_cp_low < $etp_cp_high
 
982
    if $etp_cp < $etp_cp_mid->start
 
983
      set $etp_cp_high = $etp_cp_mid
 
984
    else
 
985
      if $etp_cp > $etp_cp_mid->end
 
986
        set $etp_cp_low = $etp_cp_mid + 1
 
987
      else
 
988
        set $etp_cp_p = $etp_cp_low = $etp_cp_high = $etp_cp_mid
 
989
      end
 
990
    end
 
991
    set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2
 
992
  end
 
993
  if $etp_cp_p
 
994
    set $etp_cp_low = (Eterm**)($etp_cp_p->start + 8)
 
995
    set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0]
 
996
    set $etp_cp_p = 0
 
997
    while $etp_cp_low < $etp_cp_high
 
998
      set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2
 
999
      if $etp_cp < $etp_cp_mid[0]
 
1000
        set $etp_cp_high = $etp_cp_mid
 
1001
      else
 
1002
        if $etp_cp < $etp_cp_mid[1]
 
1003
          set $etp_cp_p = $etp_cp_mid[0]+2
 
1004
          set $etp_cp_low = $etp_cp_high = $etp_cp_mid
 
1005
        else
 
1006
          set $etp_cp_low = $etp_cp_mid + 1
 
1007
        end
 
1008
      end
 
1009
    end
 
1010
  end
 
1011
  if $etp_cp_p
 
1012
    printf "#Cp"
 
1013
    etp-mfa-1 ($etp_cp_p) ($etp_cp-((Eterm)($etp_cp_p-2)))
 
1014
  else
 
1015
    if $etp_cp == beam_apply+1
 
1016
      printf "#Cp<terminate process normally>"
 
1017
    else
 
1018
      if *(Eterm*)($etp_cp) == beam_return_trace[0]
 
1019
        if ($etp_cp) == beam_exception_trace
 
1020
          printf "#Cp<exception trace>"
 
1021
        else
 
1022
          printf "#Cp<return trace>"
 
1023
        end
 
1024
      else
 
1025
        if *(Eterm*)($etp_cp) == beam_return_to_trace[0]
 
1026
          printf "#Cp<return to trace>"
 
1027
        else
 
1028
          printf "#Cp<%#x>", $etp_cp
 
1029
        end
 
1030
      end
 
1031
    end
 
1032
  end
 
1033
end
 
1034
 
 
1035
define etp-cp
 
1036
# Args: Eterm cp
 
1037
#
 
1038
# Reentrant capable
 
1039
#
 
1040
  etp-cp-1 ($arg0)
 
1041
  printf ".\n"
 
1042
end
 
1043
 
 
1044
document etp-cp
 
1045
%---------------------------------------------------------------------------
 
1046
% etp-cp Eterm
 
1047
% 
 
1048
% Take a code continuation pointer and print 
 
1049
% module, function, arity and offset. 
 
1050
% 
 
1051
% Code continuation pointers can be found in the process structure e.g
 
1052
% process_tab[i]->cp and process_tab[i]->i, the second is the
 
1053
% program counter, which is the same thing as a continuation pointer.
 
1054
%---------------------------------------------------------------------------
 
1055
end
 
1056
 
 
1057
############################################################################
 
1058
# Commands for special term bunches.
 
1059
#
 
1060
 
 
1061
define etp-msgq
 
1062
# Args: ErlMessageQueue*
 
1063
#
 
1064
# Non-reentrant
 
1065
#
 
1066
  set $etp_msgq = ($arg0)
 
1067
  set $etp_msgq_p = $etp_msgq->first
 
1068
  set $etp_msgq_i = $etp_msgq->len
 
1069
  set $etp_msgq_prev = $etp_msgq->last
 
1070
  printf "%% Message queue (%d):", $etp_msgq_i
 
1071
  if ($etp_msgq_i > 0) && $etp_msgq_p
 
1072
    printf "\n["
 
1073
  else
 
1074
    printf "\n"
 
1075
  end
 
1076
  while ($etp_msgq_i > 0) && $etp_msgq_p
 
1077
    set $etp_msgq_i--
 
1078
    set $etp_msgq_next = $etp_msgq_p->next
 
1079
    # Msg
 
1080
    etp-1 ($etp_msgq_p->m[0]) 0
 
1081
    if ($etp_msgq_i > 0) && $etp_msgq_next
 
1082
      printf ", %% "
 
1083
    else
 
1084
      printf "]. %% "
 
1085
    end
 
1086
    # Seq_trace token
 
1087
    etp-1 ($etp_msgq_p->m[1]) 0
 
1088
    if $etp_msgq_p == $etp_msgq->save
 
1089
      printf ", <=\n"
 
1090
    else
 
1091
      printf "\n"
 
1092
    end
 
1093
    if ($etp_msgq_i > 0) && $etp_msgq_next
 
1094
      printf " "
 
1095
    end
 
1096
    #
 
1097
    set $etp_msgq_prev = $etp_msgq_p
 
1098
    set $etp_msgq_p = $etp_msgq_next
 
1099
  end
 
1100
  if $etp_msgq_i != 0
 
1101
    printf "#MsgQShort<%d>\n", $etp_msgq_i
 
1102
  end
 
1103
  if $etp_msgq_p != 0
 
1104
    printf "#MsgQLong<%#lx%p>\n", (unsigned long)$etp_msgq_p
 
1105
  end
 
1106
  if $etp_msgq_prev != $etp_msgq->last
 
1107
    printf "#MsgQEndError<%#lx%p>\n", (unsigned long)$etp_msgq_prev
 
1108
  end
 
1109
end
 
1110
 
 
1111
document etp-msgq
 
1112
%---------------------------------------------------------------------------
 
1113
% etp-msgq ErlMessageQueue*
 
1114
% 
 
1115
% Take an ErlMessageQueue* and print the contents of the message queue. 
 
1116
% Sequential trace tokens are included in comments and 
 
1117
% the current match position in the queue is marked '<='.
 
1118
% 
 
1119
% A process's message queue is process_tab[i]->msg.
 
1120
%---------------------------------------------------------------------------
 
1121
end
 
1122
 
 
1123
 
 
1124
 
 
1125
define etpf-msgq
 
1126
# Args: Process*
 
1127
#
 
1128
# Non-reentrant
 
1129
#
 
1130
  set $etp_flat = 1
 
1131
  etp-msgq ($arg0)
 
1132
  set $etp_flat = 0
 
1133
end
 
1134
 
 
1135
document etpf-msgq
 
1136
%---------------------------------------------------------------------------
 
1137
% etpf-msgq ErlMessageQueue*
 
1138
% 
 
1139
% Same as 'etp-msgq' but print the messages using etpf (flat).
 
1140
%---------------------------------------------------------------------------
 
1141
end
 
1142
 
 
1143
 
 
1144
 
 
1145
define etp-stacktrace
 
1146
# Args: Process*
 
1147
#
 
1148
# Non-reentrant
 
1149
#
 
1150
  set $etp_stacktrace_p = ($arg0)->stop
 
1151
  set $etp_stacktrace_end = ($arg0)->hend
 
1152
  printf "%% Stacktrace (%u): ", $etp_stacktrace_end-$etp_stacktrace_p
 
1153
  etp ($arg0)->cp
 
1154
  while $etp_stacktrace_p < $etp_stacktrace_end
 
1155
    if ($etp_stacktrace_p[0] & 0x3) == 0x0
 
1156
      # Continuation pointer
 
1157
      etp $etp_stacktrace_p[0]
 
1158
    end
 
1159
    set $etp_stacktrace_p++
 
1160
  end
 
1161
end
 
1162
 
 
1163
document etp-stacktrace
 
1164
%---------------------------------------------------------------------------
 
1165
% etp-stacktrace Process*
 
1166
% 
 
1167
% Take an Process* and print a stactrace for the process.
 
1168
% The stacktrace consists just of the pushed code continuation
 
1169
% pointers on the stack, the most recently pushed first.
 
1170
%---------------------------------------------------------------------------
 
1171
end
 
1172
 
 
1173
define etp-stackdump
 
1174
# Args: Process*
 
1175
#
 
1176
# Non-reentrant
 
1177
#
 
1178
  set $etp_stackdump_p = ($arg0)->stop
 
1179
  set $etp_stackdump_end = ($arg0)->hend
 
1180
  printf "%% Stackdump (%u): ", $etp_stackdump_end-$etp_stackdump_p
 
1181
  etp ($arg0)->cp
 
1182
  while $etp_stackdump_p < $etp_stackdump_end
 
1183
    etp $etp_stackdump_p[0]
 
1184
    set $etp_stackdump_p++
 
1185
  end
 
1186
end
 
1187
 
 
1188
document etp-stackdump
 
1189
%---------------------------------------------------------------------------
 
1190
% etp-stackdump Process*
 
1191
% 
 
1192
% Take an Process* and print a stackdump for the process.
 
1193
% The stackdump consists of all pushed values on the stack.
 
1194
% All code continuation pointers are preceeded with a line
 
1195
% of dashes to make the stack frames more visible.
 
1196
%---------------------------------------------------------------------------
 
1197
end
 
1198
 
 
1199
define etpf-stackdump
 
1200
# Args: Process*
 
1201
#
 
1202
# Non-reentrant
 
1203
#
 
1204
  set $etp_flat = 1
 
1205
  etp-stackdump ($arg0)
 
1206
  set $etp_flat = 0
 
1207
end
 
1208
 
 
1209
document etpf-stackdump
 
1210
%---------------------------------------------------------------------------
 
1211
% etpf-stackdump Process*
 
1212
% 
 
1213
% Same as etp-stackdump but print the values using etpf (flat).
 
1214
%---------------------------------------------------------------------------
 
1215
end
 
1216
 
 
1217
 
 
1218
 
 
1219
define etp-dictdump
 
1220
# Args: ProcDict*
 
1221
#
 
1222
# Non-reentrant
 
1223
#
 
1224
  set $etp_dictdump = ($arg0)
 
1225
  if $etp_dictdump
 
1226
    set $etp_dictdump_n = \
 
1227
      $etp_dictdump->homeSize + $etp_dictdump->splitPosition
 
1228
    set $etp_dictdump_i = 0
 
1229
    set $etp_dictdump_written = 0
 
1230
    if $etp_dictdump_n > $etp_dictdump->size
 
1231
      set $etp_dictdump_n = $etp_dictdump->size
 
1232
    end
 
1233
    set $etp_dictdump_cnt = $etp_dictdump->numElements
 
1234
    printf "%% Dictionary (%d):\n[", $etp_dictdump_cnt
 
1235
    while $etp_dictdump_i < $etp_dictdump_n && \
 
1236
          $etp_dictdump_cnt > 0
 
1237
      set $etp_dictdump_p = $etp_dictdump->data[$etp_dictdump_i]
 
1238
      if $etp_dictdump_p != $etp_nil
 
1239
        if ((Eterm)$etp_dictdump_p & 0x3) == 0x2
 
1240
          # Boxed
 
1241
          if $etp_dictdump_written
 
1242
            printf ",\n "
 
1243
          else
 
1244
            set $etp_dictdump_written = 1
 
1245
          end
 
1246
          etp-1 $etp_dictdump_p 0
 
1247
          set $etp_dictdump_cnt--
 
1248
        else
 
1249
          while ((Eterm)$etp_dictdump_p & 0x3) == 0x1 && \
 
1250
                $etp_dictdump_cnt > 0
 
1251
            # Cons ptr
 
1252
            if $etp_dictdump_written
 
1253
              printf ",\n "
 
1254
            else
 
1255
              set $etp_dictdump_written = 1
 
1256
            end
 
1257
            etp-1 (((Eterm*)((Eterm)$etp_dictdump_p&~0x3))[0]) 0
 
1258
            set $etp_dictdump_cnt--
 
1259
            set $etp_dictdump_p = ((Eterm*)((Eterm)$etp_dictdump_p & ~0x3))[1]
 
1260
          end
 
1261
          if $etp_dictdump_p != $etp_nil
 
1262
            printf "#DictSlotError<%d>:", $etp_dictdump_i
 
1263
            set $etp_dictdump_flat = $etp_flat
 
1264
            set $etp_flat = 1
 
1265
            etp-1 ((Eterm)$etp_dictdump_p) 0
 
1266
            set $etp_flat = $etp_dictdump_flat
 
1267
          end
 
1268
        end
 
1269
      end
 
1270
      set $etp_dictdump_i++
 
1271
    end
 
1272
    if $etp_dictdump_cnt != 0
 
1273
      printf "#DictCntError<%d>, ", $etp_dictdump_cnt
 
1274
    end
 
1275
  else
 
1276
    printf "%% Dictionary (0):\n["
 
1277
  end
 
1278
  printf "].\n"
 
1279
end
 
1280
 
 
1281
document etp-dictdump
 
1282
%---------------------------------------------------------------------------
 
1283
% etp-dictdump ErlProcDict*
 
1284
% 
 
1285
% Take an ErlProcDict* and print all entries in the process dictionary.
 
1286
%---------------------------------------------------------------------------
 
1287
end
 
1288
 
 
1289
define etpf-dictdump
 
1290
# Args: ErlProcDict*
 
1291
#
 
1292
# Non-reentrant
 
1293
#
 
1294
  set $etp_flat = 1
 
1295
  etp-dictdump ($arg0)
 
1296
  set $etp_flat = 0
 
1297
end
 
1298
 
 
1299
document etpf-dictdump
 
1300
%---------------------------------------------------------------------------
 
1301
% etpf-dictdump ErlProcDict*
 
1302
% 
 
1303
% Same as etp-dictdump but print the values using etpf (flat).
 
1304
%---------------------------------------------------------------------------
 
1305
end
 
1306
 
 
1307
 
 
1308
 
 
1309
define etp-offheapdump
 
1310
# Args: ( ExternalThing* | ProcBin* | ErlFunThing* )
 
1311
#
 
1312
# Non-reentrant
 
1313
#
 
1314
  set $etp_offheapdump_p = ($arg0)
 
1315
  set $etp_offheapdump_i = 0
 
1316
  set $etp_offheapdump_
 
1317
  printf "%% Offheap dump:\n["
 
1318
  while ($etp_offheapdump_p != 0) && ($etp_offheapdump_i < $etp_max_depth)
 
1319
    if ((Eterm)$etp_offheapdump_p & 0x3) == 0x0
 
1320
      if $etp_offheapdump_i > 0
 
1321
        printf ",\n "
 
1322
      end
 
1323
      etp-1 ((Eterm)$etp_offheapdump_p|0x2) 0
 
1324
      set $etp_offheapdump_p = $etp_offheapdump_p->next
 
1325
      set $etp_offheapdump_i++
 
1326
    else
 
1327
      printf "#TaggedPtr<%#x>", $etp_offheapdump_p
 
1328
      set $etp_offheapdump_p = 0
 
1329
    end
 
1330
  end
 
1331
  printf "].\n"
 
1332
end
 
1333
 
 
1334
document etp-offheapdump
 
1335
%---------------------------------------------------------------------------
 
1336
% etp-offheapdump ( ExternalThing* | ProcBin* | ErlFunThing* )
 
1337
% 
 
1338
% Take an pointer to a linked list and print the terms in the list
 
1339
% up to the max depth.
 
1340
%---------------------------------------------------------------------------
 
1341
end
 
1342
 
 
1343
define etpf-offheapdump
 
1344
# Args: ( ExternalThing* | ProcBin* | ErlFunThing* )
 
1345
#
 
1346
# Non-reentrant
 
1347
#
 
1348
  set $etp_flat = 1
 
1349
  etp-offheapdump ($arg0)
 
1350
  set $etp_flat = 0
 
1351
end
 
1352
 
 
1353
document etpf-offheapdump
 
1354
%---------------------------------------------------------------------------
 
1355
% etpf-offheapdump ( ExternalThing* | ProcBin* | ErlFunThing* )
 
1356
% 
 
1357
% Same as etp-offheapdump but print the values using etpf (flat).
 
1358
%---------------------------------------------------------------------------
 
1359
end
 
1360
 
 
1361
 
 
1362
 
 
1363
define etp-search-heaps
 
1364
# Args: Eterm
 
1365
#
 
1366
# Non-reentrant
 
1367
#
 
1368
  printf "%% Search all (<%u) process heaps for ", erts_max_processes
 
1369
  set $etp_flat = 1
 
1370
  etp-1 ($arg0) 0
 
1371
  set $etp_flat = 0
 
1372
  printf ":...\n"
 
1373
  etp-search-heaps-1 ((Eterm*)((Eterm)($arg0)&~3))
 
1374
end
 
1375
 
 
1376
define etp-search-heaps-1
 
1377
# Args: Eterm*
 
1378
#
 
1379
# Non-reentrant
 
1380
#
 
1381
  set $etp_search_heaps_q = erts_max_processes / 10
 
1382
  set $etp_search_heaps_r = erts_max_processes % 10
 
1383
  set $etp_search_heaps_t = 10
 
1384
  set $etp_search_heaps_m = $etp_search_heaps_q
 
1385
  if $etp_search_heaps_r > 0
 
1386
    set $etp_search_heaps_m++
 
1387
    set $etp_search_heaps_r--
 
1388
  end
 
1389
  set $etp_search_heaps_i = 0
 
1390
  set $etp_search_heaps_found = 0
 
1391
  while $etp_search_heaps_i < erts_max_processes
 
1392
    if process_tab[$etp_search_heaps_i]
 
1393
      if (process_tab[$etp_search_heaps_i]->heap <= ($arg0)) && \
 
1394
         (($arg0) < process_tab[$etp_search_heaps_i]->hend)
 
1395
        printf "process_tab[%d]->heap+%d\n", $etp_search_heaps_i, \
 
1396
               ($arg0)-process_tab[$etp_search_heaps_i]->heap
 
1397
      end
 
1398
      if (process_tab[$etp_search_heaps_i]->old_heap <= ($arg0)) && \
 
1399
         (($arg0) <= process_tab[$etp_search_heaps_i]->old_hend)
 
1400
        printf "process_tab[%d]->old_heap+%d\n", $etp_search_heaps_i, \
 
1401
               ($arg0)-process_tab[$etp_search_heaps_i]->old_heap
 
1402
      end
 
1403
      set $etp_search_heaps_cnt = 0
 
1404
      set $etp_search_heaps_p = process_tab[$etp_search_heaps_i]->mbuf
 
1405
      while $etp_search_heaps_p && ($etp_search_heaps_cnt < $etp_max_depth)
 
1406
        set $etp_search_heaps_cnt++
 
1407
        if (&($etp_search_heaps_p->mem) <= ($arg0)) && \
 
1408
           (($arg0) < &($etp_search_heaps_p->mem)+$etp_search_heaps_p->size)
 
1409
          printf "process_tab[%d]->mbuf(%d)+%d\n", \
 
1410
                 $etp_search_heaps_i, $etp_search_heaps_cnt, \
 
1411
                 ($arg0)-&($etp_search_heaps_p->mem)
 
1412
        end
 
1413
        set $etp_search_heaps_p = $etp_search_heaps_p->next
 
1414
      end
 
1415
      if $etp_search_heaps_p
 
1416
        printf "process_tab[%d] %% Too many HeapFragments\n", \
 
1417
               $etp_search_heaps_i
 
1418
      end
 
1419
    end
 
1420
    set $etp_search_heaps_i++
 
1421
    if $etp_search_heaps_i > $etp_search_heaps_m
 
1422
      printf "%% %d%%...\n", $etp_search_heaps_t
 
1423
      set $etp_search_heaps_t += 10
 
1424
      set $etp_search_heaps_m += $etp_search_heaps_q
 
1425
      if $etp_search_heaps_r > 0
 
1426
        set $etp_search_heaps_m++
 
1427
        set $etp_search_heaps_r--
 
1428
      end
 
1429
    end
 
1430
  end
 
1431
  printf "%% 100%%.\n"
 
1432
end
 
1433
 
 
1434
document etp-search-heaps
 
1435
%---------------------------------------------------------------------------
 
1436
% etp-search-heaps Eterm
 
1437
% 
 
1438
% Search all process heaps in process_tab[], including the heap fragments
 
1439
% (process_tab[]->mbuf) for the specified Eterm.
 
1440
%---------------------------------------------------------------------------
 
1441
end
 
1442
 
 
1443
 
 
1444
 
 
1445
define etp-search-alloc
 
1446
# Args: Eterm
 
1447
#
 
1448
# Non-reentrant
 
1449
#
 
1450
  printf "%% Search allocated memory blocks for "
 
1451
  set $etp_flat = 1
 
1452
  etp-1 ($arg0) 0
 
1453
  set $etp_flat = 0
 
1454
  printf ":...\n"
 
1455
  set $etp_search_alloc_n = sizeof(erts_allctrs) / sizeof(*erts_allctrs)
 
1456
  set $etp_search_alloc_i = 0
 
1457
  while $etp_search_alloc_i < $etp_search_alloc_n
 
1458
    if erts_allctrs[$etp_search_alloc_i].alloc
 
1459
      set $etp_search_alloc_f = (erts_allctrs+$etp_search_alloc_i)
 
1460
      while ($etp_search_alloc_f->alloc == debug_alloc) || \
 
1461
            ($etp_search_alloc_f->alloc == stat_alloc) || \
 
1462
            ($etp_search_alloc_f->alloc == map_stat_alloc)
 
1463
        set $etp_search_alloc_f = \
 
1464
          (ErtsAllocatorFunctions_t*)$etp_search_alloc_f->extra
 
1465
      end
 
1466
      if ($etp_search_alloc_f->alloc != erts_sys_alloc) && \
 
1467
         ($etp_search_alloc_f->alloc != erts_fix_alloc)
 
1468
        if ($etp_search_alloc_f->alloc == erts_alcu_alloc) || \
 
1469
           ($etp_search_alloc_f->alloc == erts_alcu_alloc_ts)
 
1470
          # alcu alloc
 
1471
          set $etp_search_alloc_e = (Allctr_t*)$etp_search_alloc_f->extra
 
1472
          # mbc_list
 
1473
          set $etp_search_alloc_p = $etp_search_alloc_e->mbc_list.first
 
1474
          set $etp_search_alloc_cnt = 0
 
1475
          while $etp_search_alloc_p && \
 
1476
                ($etp_search_alloc_cnt < $etp_max_depth)
 
1477
            set $etp_search_alloc_cnt++
 
1478
            if $etp_search_alloc_p <= ($arg0) && \
 
1479
               ($arg0) < (char*)$etp_search_alloc_p + \
 
1480
                         ($etp_search_alloc_p->chdr & (Uint)~7)
 
1481
              printf "erts_allctrs[%d] %% %salloc: mbc_list: %d\n", \
 
1482
                     $etp_search_alloc_i, $etp_search_alloc_e->name_prefix, \
 
1483
                     $etp_search_alloc_cnt
 
1484
            end
 
1485
            if $etp_search_alloc_p == $etp_search_alloc_e->mbc_list.last
 
1486
              if $etp_search_alloc_p->next
 
1487
                printf \
 
1488
                  "erts_allctrs[%d] %% %salloc: mbc_list.last error %p\n",\
 
1489
                  $etp_search_alloc_i, $etp_search_alloc_e->name_prefix,\
 
1490
                  $etp_search_alloc_p
 
1491
              end
 
1492
              set $etp_search_alloc_p = 0
 
1493
            else
 
1494
              set $etp_search_alloc_p = $etp_search_alloc_p->next
 
1495
            end
 
1496
          end
 
1497
          if $etp_search_alloc_p
 
1498
            printf "erts_allctrs[%d] %% %salloc: too large mbc_list %p\n", \
 
1499
                   $ept_search_alloc_i, $etp_search_alloc_e->name_prefix,
 
1500
                   $ept_search_alloc_p
 
1501
          end
 
1502
          # sbc_list
 
1503
          set $etp_search_alloc_p = $etp_search_alloc_e->sbc_list.first
 
1504
          set $etp_search_alloc_cnt = 0
 
1505
          while $etp_search_alloc_p && \
 
1506
                ($etp_search_alloc_cnt < $etp_max_depth)
 
1507
            set $etp_search_alloc_cnt++
 
1508
            if $etp_search_alloc_p <= ($arg0) && \
 
1509
               ($arg0) < (char*)$etp_search_alloc_p + \
 
1510
                         ($etp_search_alloc_p->chdr & (Uint)~7)
 
1511
              printf "erts_allctrs[%d] %% %salloc: sbc_list: %d\n", \
 
1512
                     $etp_search_alloc_i, $etp_search_alloc_e->name_prefix, \
 
1513
                     $etp_search_alloc_cnt
 
1514
            end
 
1515
            if $etp_search_alloc_p == $etp_search_alloc_e->sbc_list.last
 
1516
              if $etp_search_alloc_p->next
 
1517
                printf \
 
1518
                  "erts_allctrs[%d] %% %salloc: sbc_list.last error %p",\
 
1519
                  $etp_search_alloc_i, $etp_search_alloc_e->name_prefix,\
 
1520
                  $etp_search_alloc_p
 
1521
              end
 
1522
              set $etp_search_alloc_p = 0
 
1523
            else
 
1524
              set $etp_search_alloc_p = $etp_search_alloc_p->next
 
1525
            end
 
1526
          end
 
1527
          if $etp_search_alloc_p
 
1528
            printf "erts_allctrs[%d] %% %salloc: too large sbc_list %p\n", \
 
1529
                   $ept_search_alloc_i, $etp_search_alloc_e->name_prefix,
 
1530
                   $ept_search_alloc_p
 
1531
          end
 
1532
        else
 
1533
          printf "erts_allctrs[%d] %% %s: unknown allocator\n", \
 
1534
                 $etp_search_alloc_i, erts_alc_a2ad[$etp_search_alloc_i]
 
1535
        end
 
1536
      end
 
1537
    end
 
1538
    set $etp_search_alloc_i++
 
1539
  end
 
1540
end
 
1541
 
 
1542
document etp-search-alloc
 
1543
%---------------------------------------------------------------------------
 
1544
% etp-search-heaps Eterm
 
1545
% 
 
1546
% Search all internal allocator memory blocks for for the specified Eterm.
 
1547
%---------------------------------------------------------------------------
 
1548
end
 
1549
 
 
1550
 
 
1551
 
 
1552
define etp-overlapped-heaps
 
1553
# Args: 
 
1554
#
 
1555
# Non-reentrant
 
1556
#
 
1557
  printf "%% Dumping heap addresses to \"etp-commands.bin\"\n"
 
1558
  set $etp_overlapped_heaps_q = erts_max_processes / 10
 
1559
  set $etp_overlapped_heaps_r = erts_max_processes % 10
 
1560
  set $etp_overlapped_heaps_t = 10
 
1561
  set $etp_overlapped_heaps_m = $etp_overlapped_heaps_q
 
1562
  if $etp_overlapped_heaps_r > 0
 
1563
    set $etp_overlapped_heaps_m++
 
1564
    set $etp_overlapped_heaps_r--
 
1565
  end
 
1566
  set $etp_overlapped_heaps_i = 0
 
1567
  set $etp_overlapped_heaps_found = 0
 
1568
  dump binary value etp-commands.bin 'o'
 
1569
  append binary value etp-commands.bin 'v'
 
1570
  append binary value etp-commands.bin 'e'
 
1571
  append binary value etp-commands.bin 'r'
 
1572
  append binary value etp-commands.bin 'l'
 
1573
  append binary value etp-commands.bin 'a'
 
1574
  append binary value etp-commands.bin 'p'
 
1575
  append binary value etp-commands.bin 'p'
 
1576
  append binary value etp-commands.bin 'e'
 
1577
  append binary value etp-commands.bin 'd'
 
1578
  append binary value etp-commands.bin '-'
 
1579
  append binary value etp-commands.bin 'h'
 
1580
  append binary value etp-commands.bin 'e'
 
1581
  append binary value etp-commands.bin 'a'
 
1582
  append binary value etp-commands.bin 'p'
 
1583
  append binary value etp-commands.bin 's'
 
1584
  append binary value etp-commands.bin '\0'
 
1585
  while $etp_overlapped_heaps_i < erts_max_processes
 
1586
    if process_tab[$etp_overlapped_heaps_i]
 
1587
      append binary value etp-commands.bin \
 
1588
        (Eterm)$etp_overlapped_heaps_i
 
1589
      append binary value etp-commands.bin \
 
1590
        (Eterm)process_tab[$etp_overlapped_heaps_i]->heap
 
1591
      append binary value etp-commands.bin \
 
1592
        (Eterm)process_tab[$etp_overlapped_heaps_i]->hend
 
1593
      append binary value etp-commands.bin \
 
1594
        (Eterm)process_tab[$etp_overlapped_heaps_i]->old_heap
 
1595
      append binary value etp-commands.bin \
 
1596
        (Eterm)process_tab[$etp_overlapped_heaps_i]->old_hend
 
1597
      set $etp_overlapped_heaps_p = process_tab[$etp_overlapped_heaps_i]->mbuf
 
1598
      set $etp_overlapped_heaps_cnt = 0
 
1599
      while $etp_overlapped_heaps_p && \
 
1600
            ($etp_overlapped_heaps_cnt < $etp_max_depth)
 
1601
        set $etp_overlapped_heaps_cnt++
 
1602
        append binary value etp-commands.bin \
 
1603
          (Eterm)$etp_overlapped_heaps_p
 
1604
        append binary value etp-commands.bin \
 
1605
(Eterm)(&($etp_overlapped_heaps_p->mem)+$etp_overlapped_heaps_p->size)
 
1606
        set $etp_overlapped_heaps_p = $etp_overlapped_heaps_p->next
 
1607
      end
 
1608
      if $etp_overlapped_heaps_p
 
1609
        printf "process_tab[%d] %% Too many HeapFragments\n", \
 
1610
               $etp_overlapped_heaps_i
 
1611
      end
 
1612
      append binary value etp-commands.bin (Eterm)0x0
 
1613
      append binary value etp-commands.bin (Eterm)0x0
 
1614
    end
 
1615
    set $etp_overlapped_heaps_i++
 
1616
    if $etp_overlapped_heaps_i > $etp_overlapped_heaps_m
 
1617
      printf "%% %d%%...\n", $etp_overlapped_heaps_t
 
1618
      set $etp_overlapped_heaps_t += 10
 
1619
      set $etp_overlapped_heaps_m += $etp_overlapped_heaps_q
 
1620
      if $etp_overlapped_heaps_r > 0
 
1621
        set $etp_overlapped_heaps_m++
 
1622
        set $etp_overlapped_heaps_r--
 
1623
      end
 
1624
    end
 
1625
  end
 
1626
  etp-run
 
1627
end
 
1628
 
 
1629
document etp-overlapped-heaps
 
1630
%---------------------------------------------------------------------------
 
1631
% etp-overlapped-heaps
 
1632
% 
 
1633
% Dump all process heap addresses in process_tab[], including 
 
1634
% the heap fragments in binary format on the file etp-commands.bin.
 
1635
% Then call etp_commands:file/1 to analyze if any heaps overlap.
 
1636
%
 
1637
% Requires 'erl' in the path and 'etp_commands.beam' in 'erl's search path.
 
1638
%---------------------------------------------------------------------------
 
1639
end
 
1640
 
 
1641
 
 
1642
 
 
1643
define etp-chart
 
1644
# Args: Process*
 
1645
#
 
1646
# Non-reentrant
 
1647
  etp-chart-start ($arg0)
 
1648
  set ($arg0) = ($arg0)
 
1649
  etp-msgq (($arg0)->msg)
 
1650
  etp-stackdump ($arg0)
 
1651
  etp-dictdump (($arg0)->dictionary)
 
1652
  etp-dictdump (($arg0)->debug_dictionary)
 
1653
  printf "%% Dumping other process data...\n"
 
1654
  etp ($arg0)->seq_trace_token
 
1655
  etp ($arg0)->fvalue
 
1656
  printf "%% Dumping done.\n"
 
1657
  etp-chart-print
 
1658
end
 
1659
 
 
1660
document etp-chart
 
1661
%---------------------------------------------------------------------------
 
1662
% etp-chart Process*
 
1663
% 
 
1664
% Dump all process data to the file "etp-commands.bin" and then use
 
1665
% the Erlang support module to print a memory chart of all terms.
 
1666
%---------------------------------------------------------------------------
 
1667
end
 
1668
 
 
1669
 
 
1670
 
 
1671
define etp-chart-start
 
1672
# Args: Process*
 
1673
#
 
1674
# Non-reentrant
 
1675
  set $etp_chart = 1
 
1676
  set $etp_chart_id = 0
 
1677
  set $etp_chart_start_p = ($arg0)
 
1678
  dump binary value etp-commands.bin 'c'
 
1679
  append binary value etp-commands.bin 'h'
 
1680
  append binary value etp-commands.bin 'a'
 
1681
  append binary value etp-commands.bin 'r'
 
1682
  append binary value etp-commands.bin 't'
 
1683
  append binary value etp-commands.bin '\0'
 
1684
  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->heap)
 
1685
  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->high_water)
 
1686
  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->hend)
 
1687
  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->old_heap)
 
1688
  append binary value etp-commands.bin (Eterm)($etp_chart_start_p->old_hend)
 
1689
  set $etp_chart_start_cnt = 0
 
1690
  set $etp_chart_start_p = $etp_chart_start_p->mbuf
 
1691
  while $etp_chart_start_p && ($etp_chart_start_cnt < $etp_max_depth)
 
1692
    set $etp_chart_start_cnt++
 
1693
    append binary value etp-commands.bin (Eterm)($etp_chart_start_p->mem)
 
1694
    append binary value etp-commands.bin (Eterm)($etp_chart_start_p->size)
 
1695
    set $etp_chart_start_p = $etp_chart_start_p->next
 
1696
  end
 
1697
  append binary value etp-commands.bin (Eterm)(0)
 
1698
  append binary value etp-commands.bin (Eterm)(0)
 
1699
  if $etp_chart_start_p
 
1700
    printf "%% Too many HeapFragments\n"
 
1701
  end
 
1702
end
 
1703
 
 
1704
document etp-chart-start
 
1705
%---------------------------------------------------------------------------
 
1706
% etp-chart-start Process*
 
1707
% 
 
1708
% Dump a chart head to the file "etp-commands.bin".
 
1709
%---------------------------------------------------------------------------
 
1710
end
 
1711
 
 
1712
 
 
1713
 
 
1714
define etp-chart-entry-1
 
1715
# Args: Eterm, int depth, int words
 
1716
#
 
1717
# Reentrant capable
 
1718
  if ($arg1) == 0
 
1719
    set $etp_chart_id++
 
1720
    printf "#%d:", $etp_chart_id
 
1721
  end
 
1722
  append binary value etp-commands.bin ($arg0)&~0x3
 
1723
  append binary value etp-commands.bin (Eterm)(($arg2)*sizeof(Eterm))
 
1724
  append binary value etp-commands.bin (Eterm)$etp_chart_id
 
1725
  append binary value etp-commands.bin (Eterm)($arg1)
 
1726
#   printf "<dumped %#x %lu %lu %lu>", ($arg0)&~0x3, \
 
1727
#     (Eterm)(($arg2)*sizeof(Eterm)), (Eterm)$etp_chart_id, (Eterm)($arg1)
 
1728
end
 
1729
 
 
1730
 
 
1731
 
 
1732
define etp-chart-print
 
1733
  set $etp_chart = 0
 
1734
  etp-run
 
1735
end
 
1736
 
 
1737
document etp-chart-print
 
1738
%---------------------------------------------------------------------------
 
1739
% etp-chart-print Process*
 
1740
% 
 
1741
% Print a memory chart of the dumped data in "etp-commands.bin", and stop
 
1742
% chart recording.
 
1743
%---------------------------------------------------------------------------
 
1744
end
 
1745
 
 
1746
############################################################################
 
1747
# ETS table debug
 
1748
#
 
1749
 
 
1750
define etp-ets-tables
 
1751
# Args:
 
1752
#
 
1753
# Non-reentrant
 
1754
  printf "%% Dumping < %lu ETS tables\n", (unsigned long)db_max_tabs
 
1755
  while $etp_ets_tables_i < db_max_tabs
 
1756
    if (db_tables[$etp_ets_tables_i].id != 0x18) && \
 
1757
       (db_tables[$etp_ets_tables_i].id != 0xd8)
 
1758
      printf "%% %d:", $etp_ets_tables_i
 
1759
      etp-1 ((Eterm)(db_tables[$etp_ets_tables_i].id)) 0
 
1760
      printf " "
 
1761
      etp-1 ((Eterm)(db_tables[$etp_ets_tables_i].t->common.owner)) 0
 
1762
      printf "\n"
 
1763
    end
 
1764
    set $etp_ets_tables_i++
 
1765
  end
 
1766
  set $etp_ets_table_i = 0
 
1767
end
 
1768
 
 
1769
document etp-ets-tables
 
1770
%---------------------------------------------------------------------------
 
1771
% etp-ets-tables
 
1772
%
 
1773
% Dump all ETS table names and their indexies.
 
1774
%---------------------------------------------------------------------------
 
1775
end
 
1776
 
 
1777
define etp-ets-tabledump
 
1778
# Args: int tableindex
 
1779
#
 
1780
# Non-reentrant
 
1781
  printf "%% Dumping ETS table %d:", ($arg0)
 
1782
  set $etp_ets_tabledump_n = 0
 
1783
  set $etp_ets_tabledump_t = db_tables[($arg0)].t
 
1784
  set $etp_ets_tabledump_i = 0
 
1785
  etp-1 ($etp_ets_tabledump_t->common.the_name) 0
 
1786
  printf " status=%#x\n", $etp_ets_tabledump_t->common.status
 
1787
  if $etp_ets_tabledump_t->common.status & 0x130
 
1788
    # Hash table
 
1789
    set $etp_ets_tabledump_h = $etp_ets_tabledump_t->hash
 
1790
    printf "%% nitems=%d\n", $etp_ets_tabledump_h->nitems
 
1791
    while $etp_ets_tabledump_i < $etp_ets_tabledump_h->nactive
 
1792
      set $etp_ets_tabledump_l = $etp_ets_tabledump_h->seg \
 
1793
            [$etp_ets_tabledump_i>>8][$etp_ets_tabledump_i&0xFF]
 
1794
      if $etp_ets_tabledump_l
 
1795
        printf "%% Slot %d:\n", $etp_ets_tabledump_i
 
1796
        while $etp_ets_tabledump_l
 
1797
          if $etp_ets_tabledump_n
 
1798
            printf ","
 
1799
          else
 
1800
            printf "["
 
1801
          end
 
1802
          set $etp_ets_tabledump_n++
 
1803
          etp-1 ((Eterm)($etp_ets_tabledump_l->dbterm.tpl)|0x2) 0
 
1804
          if $etp_ets_tabledump_l->hvalue == ((unsigned long)-1)
 
1805
            printf "% *\n"
 
1806
          else
 
1807
            printf "\n"
 
1808
          end
 
1809
          set $etp_ets_tabledump_l = $etp_ets_tabledump_l->next
 
1810
          if $etp_ets_tabledump_n >= $etp_max_depth
 
1811
            set $etp_ets_tabledump_l = 0
 
1812
          end
 
1813
        end
 
1814
      end
 
1815
      set $etp_ets_tabledump_i++
 
1816
    end
 
1817
    if $etp_ets_tabledump_n
 
1818
      printf "].\n"
 
1819
    end
 
1820
  else
 
1821
    printf "%% Not a hash table\n"
 
1822
  end
 
1823
end
 
1824
 
 
1825
document etp-ets-tabledump
 
1826
%---------------------------------------------------------------------------
 
1827
% etp-ets-tabledump Slot
 
1828
%
 
1829
% Dump an ETS table with a specified slot index.
 
1830
%---------------------------------------------------------------------------
 
1831
end
 
1832
 
 
1833
############################################################################
 
1834
# Erlang support module handling
 
1835
#
 
1836
 
 
1837
define etp-run
 
1838
  shell make -f "${ROOTDIR:?}/erts/etc/unix/etp_commands.mk" \
 
1839
    ROOTDIR="${ROOTDIR:?}" ETP_DATA="etp-commands.bin"
 
1840
end
 
1841
 
 
1842
document etp-run
 
1843
%---------------------------------------------------------------------------
 
1844
% etp-run
 
1845
% 
 
1846
% Make and run the Erlang support module on the input file 
 
1847
% "erl-commands.bin". The environment variable ROOTDIR must
 
1848
% be set to find $ROOTDIR/erts/etc/unix/etp_commands.mk.
 
1849
%
 
1850
% Also, erl and erlc must be in the path.
 
1851
%---------------------------------------------------------------------------
 
1852
end
 
1853
 
 
1854
############################################################################
 
1855
# Toolbox parameter handling
 
1856
#
 
1857
 
 
1858
define etp-set-max-depth
 
1859
  if ($arg0) > 0
 
1860
    set $etp_max_depth = ($arg0)
 
1861
  else
 
1862
    echo %%%Error: max-depth <= 0 %%%\n
 
1863
  end
 
1864
end
 
1865
 
 
1866
document etp-set-max-depth
 
1867
%---------------------------------------------------------------------------
 
1868
% etp-set-max-depth Depth
 
1869
% 
 
1870
% Set the max term depth to use for etp. The term dept limit
 
1871
% works in both depth and width, so if you set the max depth to 10,
 
1872
% an 11 element flat tuple will be truncated.
 
1873
%---------------------------------------------------------------------------
 
1874
end
 
1875
 
 
1876
define etp-set-max-string-length
 
1877
  if ($arg0) > 0
 
1878
    set $etp_max_string_length = ($arg0)
 
1879
  else
 
1880
    echo %%%Error: max-string-length <= 0 %%%\n
 
1881
  end
 
1882
end
 
1883
 
 
1884
document etp-set-max-string-length
 
1885
%---------------------------------------------------------------------------
 
1886
% etp-set-max-strint-length Length
 
1887
% 
 
1888
% Set the max string length to use for ept when printing lists
 
1889
% that can be shown as printable strings. Printable strings
 
1890
% that are longer will be truncated, and not even checked if
 
1891
% they really are printable all the way to the end.
 
1892
%---------------------------------------------------------------------------
 
1893
end
 
1894
 
 
1895
define etp-show
 
1896
  printf "etp-set-max-depth %d\n", $etp_max_depth
 
1897
  printf "etp-set-max-string-length %d\n", $etp_max_string_length
 
1898
end
 
1899
 
 
1900
document etp-show
 
1901
%---------------------------------------------------------------------------
 
1902
% etp-show
 
1903
% 
 
1904
% Show the commands needed to set all etp parameters 
 
1905
% to their current value.
 
1906
%---------------------------------------------------------------------------
 
1907
end
 
1908
 
 
1909
############################################################################
 
1910
# Init
 
1911
#
 
1912
 
 
1913
define etp-init
 
1914
  set $etp_flat = 0
 
1915
  set $etp_nil = 0xfffffffb
 
1916
  set $etp_chart_id = 0
 
1917
  set $etp_chart = 0
 
1918
 
 
1919
  set $etp_max_depth = 20
 
1920
  set $etp_max_string_length = 100
 
1921
 
 
1922
  set $etp_ets_tables_i = 0
 
1923
end
 
1924
 
 
1925
document etp-init
 
1926
%---------------------------------------------------------------------------
 
1927
% Use etp-help for a command overview and general help.
 
1928
% 
 
1929
% To use the Erlang support module, the environment variable ROOTDIR
 
1930
% must be set to the toplevel installation directory of Erlang/OTP,
 
1931
% so the etp-commands file becomes:
 
1932
%     $ROOTDIR/erts/etc/unix/etp-commands
 
1933
% Also, erl and erlc must be in the path.
 
1934
%---------------------------------------------------------------------------
 
1935
end
 
1936
 
 
1937
 
 
1938
etp-init
 
1939
help etp-init
 
1940
etp-show