etp-commands

来自「OTP是开放电信平台的简称」· 代码 · 共 1,993 行 · 第 1/4 页

    else
      if (($arg0) & 0xF) == 0x7
        etp-port-1 ($arg0)
      else
        if (($arg0) & 0xF) == 0xf
          # Fixnum
          printf "%ld", (long)((Sint)($arg0)>>4)
        else
          # Immediate2  - 0xB
          if (($arg0) & 0x3f) == 0x0b
            etp-atom-1 ($arg0)
          else
            if (($arg0) & 0x3f) == 0x1b
              printf "#Catch<%d>", ($arg0)>>6
            else
              if (($arg0) == $etp_nil)
                printf "[]"
              else
                printf "#UnknownImmediate<%#x>", ($arg0)
              end
            end
          end
        end
      end
    end
  end
end



define etp-atom-1
# Args: Eterm atom
#
# Non-reentrant
#
  if ((Eterm)($arg0) & 0x3f) != 0xb
    printf "#NotAtom<%#x>", ($arg0)
  else
    set $etp_atom_1_ap = (Atom*)erts_atom_table.seg_table[(Eterm)($arg0)>>16][((Eterm)($arg0)>>6)&0x3FF]
    set $etp_atom_1_i = ($etp_atom_1_ap)->len
    set $etp_atom_1_p = ($etp_atom_1_ap)->name
    set $etp_atom_1_quote = 1
    # Check if atom has to be quoted
    if ($etp_atom_1_i > 0)
      etp-ct-atom-1 (*$etp_atom_1_p)
      if $etp_ct_atom
        # Atom start character
        set $etp_atom_1_p++
        set $etp_atom_1_i--
        set $etp_atom_1_quote = 0
      else
        set $etp_atom_1_i = 0
      end
    end
    while $etp_atom_1_i > 0
      etp-ct-name-1 (*$etp_atom_1_p)
      if $etp_ct_name
        # Name character
        set $etp_atom_1_p++
        set $etp_atom_1_i--
      else
        set $etp_atom_1_quote = 1
        set $etp_atom_1_i = 0
      end
    end
    # Print the atom
    if $etp_atom_1_quote
      printf "'"
    end
    set $etp_atom_1_i = ($etp_atom_1_ap)->len
    set $etp_atom_1_p = ($etp_atom_1_ap)->name
    while $etp_atom_1_i > 0
        etp-char-1 (*$etp_atom_1_p) '\''
	set $etp_atom_1_p++
        set $etp_atom_1_i--
    end
    if $etp_atom_1_quote
      printf "'"
    end
  end
end



define etp-char-1
# Args: int char, int quote_char
#
# Non-reentrant
#
  if (($arg0) < 0) || (0377 < ($arg0))
    printf "#NotChar<%#x>", ($arg0)
  else
    if ($arg0) == ($arg1)
      printf "\\%c", ($arg0)
    else
      etp-ct-printable-1 ($arg0)
      if $etp_ct_printable
        if $etp_ct_printable < 0
          printf "%c", ($arg0)
        else
          printf "\\%c", $etp_ct_printable
        end
      else
        printf "\\%03o", ($arg0)
      end
    end
  end
end

define etp-ct-printable-1
# Args: int
#
# Determines if integer is a printable character
#
# Non-reentrant
# Returns: $etp_ct_printable
#          escape alias char, or -1 if no escape alias
  if ($arg0) == 010
    set $etp_ct_printable = 'b'
  else
    if ($arg0) == 011
      set $etp_ct_printable = 't'
    else
      if ($arg0) == 012
        set $etp_ct_printable = 'n'
      else
        if ($arg0) == 013
          set $etp_ct_printable = 'v'
        else
          if ($arg0) == 014
            set $etp_ct_printable = 'f'
          else
            if ($arg0) == 033
              set $etp_ct_printable = 'e'
            else
              if ((040 <= ($arg0)) && (($arg0) <= 0176)) || \
                 ((0240 <= ($arg0)) && (($arg0) <= 0377))
                # Other printable character
                set $etp_ct_printable = -1
              else
                set $etp_ct_printable = 0
              end
            end
          end
        end
      end
    end
  end
end

define etp-ct-atom-1
# Args: int
#
# Determines if integer is a atom first character
#
# Non-reentrant
# Returns: $etp_ct_atom
  if ((0141 <= ($arg0)) && (($arg0) <= 0172)) || \
     ((0337 <= ($arg0)) && (($arg0) != 0367) && (($arg0) <= 0377))
    # Atom start character
    set $etp_ct_atom = 1
  else
    set $etp_ct_atom = 0
  end
end

define etp-ct-variable-1
# Args: int
#
# Determines if integer is a variable first character
#
# Non-reentrant
# Returns: $etp_ct_variable
  if ((056 == ($arg0)) || \
      (0101 <= ($arg0)) && (($arg0) <= 0132)) || \
      (0137 == ($arg0)) || \
      ((0300 <= ($arg0)) && (($arg0) != 0327) && (($arg0) <= 0336))
    # Variable start character
    set $etp_ct_variable = 1
  else
    set $etp_ct_variable = 0
  end
end

define etp-ct-name-1
# Args: int
#
# Determines if integer is a name character, 
# i.e non-first atom or variable character.
#
# Non-reentrant
# Returns: $etp_ct_variable
  if (($arg0) == 0100 || \
      (060 <= ($arg0)) && (($arg0) <= 071))
    set $etp_ct_name = 1
  else
    etp-ct-atom-1 ($arg0)
    if $etp_ct_atom
      set $etp_ct_name = 1
    else
      etp-ct-variable-1 ($arg0)
      set $etp_ct_name = $etp_ct_variable
    end
  end
end



define etp-pid-1
# Args: Eterm pid
#
# Non-reentrant
#
  set $etp_pid_1 = (Eterm)($arg0)
  if ($etp_pid_1 & 0xF) == 0x3
    # Internal pid
    printf "<0.%u.%u>", (unsigned) ($etp_pid_1>>4)&0x7fff, \
                        (unsigned) ($etp_pid_1>>19)&0x1fff
  else
    printf "#NotPid<%#x>", ($arg0)
  end
end

define etp-extpid-1
# Args: Eterm extpid
#
# Non-reentrant
#
  if ((Eterm)($arg0) & 0x3) != 0x2
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
  else
    set $etp_extpid_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3)
    if ($etp_extpid_1_p->header & 0x3f) != 0x30
      printf "#NotExternalPid<%#x>", $etp_extpid_1_p->header
    else
      ## External pid
      set $etp_extpid_1_number = $etp_extpid_1_p->data[0]&0x7fff
      set $etp_extpid_1_serial = ($etp_extpid_1_p->data[0]>>15)&0x1fff
      set $etp_extpid_1_np = $etp_extpid_1_p->node
      set $etp_extpid_1_creation = $etp_extpid_1_np->creation
      set $etp_extpid_1_dep = $etp_extpid_1_np->dist_entry
      set $etp_extpid_1_node = $etp_extpid_1_np->sysname
      if ($etp_extpid_1_node & 0x3f) != 0xb
        # Should be an atom
        printf "#ExternalPidError<%#x>", ($arg0)
      else
        if $etp_extpid_1_dep == erts_this_dist_entry
          printf "<0:"
        else
          printf "<%u:", $etp_extpid_1_node>>6
        end
        etp-atom-1 ($etp_extpid_1_node)
        printf "/%u.%u.%u>", $etp_extpid_1_creation, \
               $etp_extpid_1_number, $etp_extpid_1_serial
      end
    end
  end
end



define etp-port-1
# Args: Eterm port
#
# Non-reentrant
#
  set $etp_port_1 = (Eterm)($arg0)
  if ($etp_port_1 & 0xF) == 0x7
    # Internal port
    printf "#Port<0.%u>", (unsigned) ($etp_port_1>>4)&0x3ffff
  else
    printf "#NotPort<%#x>", ($arg0)
  end
end

define etp-extport-1
# Args: Eterm extport
#
# Non-reentrant
#
  if ((Eterm)($arg0) & 0x3) != 0x2
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
  else
    set $etp_extport_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3)
    if ($etp_extport_1_p->header & 0x3F) != 0x34
      printf "#NotExternalPort<%#x>", $etp_extport_1->header
    else
      ## External port
      set $etp_extport_1_number = $etp_extport_1_p->data[0]&0x3ffff
      set $etp_extport_1_np = $etp_extport_1_p->node
      set $etp_extport_1_creation = $etp_extport_1_np->creation
      set $etp_extport_1_dep = $etp_extport_1_np->dist_entry
      set $etp_extport_1_node = $etp_extport_1_np->sysname
      if ($etp_extport_1_node & 0x3f) != 0xb
        # Should be an atom
        printf "#ExternalPortError<%#x>", ($arg0)
      else
        if $etp_extport_1_dep == erts_this_dist_entry
          printf "#Port<0:"
        else
          printf "#Port<%u:", $etp_extport_1_node>>6
        end
        etp-atom-1 ($etp_extport_1_node)
        printf "/%u.%u>", $etp_extport_1_creation, $etp_extport_1_number
      end
    end
  end
end



define etp-bignum-1
# Args: Eterm bignum
#
# Non-reentrant
#
  if ((Eterm)($arg0) & 0x3) != 0x2
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
  else
    set $etp_bignum_1_p = (Eterm*)((Eterm)($arg0) & ~0x3)
    if ($etp_bignum_1_p[0] & 0x3b) != 0x08
      printf "#NotBignum<%#x>", $etp_bignum_1_p[0]
    else
      set $etp_bignum_1_i = 2 * ($etp_bignum_1_p[0] >> 6)
      if $etp_bignum_1_i < 2
        printf "#BignumError<%#x>", (Eterm)($arg0)
      else
        if $etp_bignum_1_p[0] & 0x04
          printf "-"
        end
        set $etp_bignum_1_p = (digit_t *)($etp_bignum_1_p + 1)
        printf "16#"
        if $etp_arch64
          while $etp_bignum_1_i > 0
            set $etp_bignum_1_i--
            printf "%08x", $etp_bignum_1_p[$etp_bignum_1_i]
          end
        else
          while $etp_bignum_1_i > 0
            set $etp_bignum_1_i--
            printf "%04x", $etp_bignum_1_p[$etp_bignum_1_i]
          end
        end
      end
    end
  end
end



define etp-float-1
# Args: Eterm float
#
# Non-reentrant
#
  if ((Eterm)($arg0) & 0x3) != 0x2
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
  else
    set $etp_float_1_p = (Eterm*)((Eterm)($arg0) & ~0x3)
    if ($etp_float_1_p[0] & 0x3f) != 0x18
      printf "#NotFloat<%#x>", $etp_float_1_p[0]
    else
      printf "%f", *(double*)($etp_float_1_p+1)
    end
  end
end



define etp-ref-1
# Args: Eterm ref
#
# Non-reentrant
#
  if ((Eterm)($arg0) & 0x3) != 0x2
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
  else
    set $etp_ref_1_p = (RefThing *)((Eterm)($arg0) & ~0x3)
    if ($etp_ref_1_p->header & 0x3b) != 0x10
      printf "#NotRef<%#x>", $etp_ref_1_p->header
    else
      set $etp_ref_1_nump = (Uint32 *) 0
      set $etp_ref_1_error = 0
      if ($etp_ref_1_p->header >> 6) == 0
        set $etp_ref_1_error = 1
      else
        if $etp_arch64
          set $etp_ref_1_i = (int) ((Uint32 *) $etp_ref_1_p->data)[0]
          if (($etp_ref_1_i + 1) > (2 * ($etp_ref_1_p->header >> 6)))
            set $etp_ref_1_error = 1
          else
            set $etp_ref_1_nump = &((Uint32 *) $etp_ref_1_p->data)[1]
          end
        else
          set $etp_ref_1_i = (int) ($etp_ref_1_p->header >> 6)
          set $etp_ref_1_nump = &((Uint32 *) $etp_ref_1_p->data)[0]
        end
      end
      if $etp_ref_1_error
        printf "#InternalRefError<%#x>", ($arg0)
      else
        printf "#Ref<0"
        set $etp_ref_1_i--
        while $etp_ref_1_i >= 0
          printf ".%u", (unsigned) $etp_ref_1_nump[$etp_ref_1_i]
          set $etp_ref_1_i--
        end
        printf ">"
      end
    end
  end
end



define etp-extref-1
# Args: Eterm extref
#
# Non-reentrant
#
  if ((Eterm)($arg0) & 0x3) != 0x2
    printf "#NotBoxed<%#x>", (Eterm)($arg0)
  else
    set $etp_extref_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3)
    if ($etp_extref_1_p->header & 0x3F) != 0x38
      printf "#NotExternalRef<%#x>", $etp_extref_1->header
    else
      ## External ref
      set $etp_extref_1_nump = (Uint32 *) 0
      set $etp_extref_1_error = 0
      set $etp_extref_1_i = (int) ($etp_extref_1_p->header >> 6)
      set $etp_extref_1_np = $etp_extref_1_p->node
      set $etp_extref_1_creation = $etp_extref_1_np->creation
      set $etp_extref_1_dep = $etp_extref_1_np->dist_entry
      set $etp_extref_1_node = $etp_extref_1_np->sysname
      if ($etp_extref_1_node & 0x3f) != 0xb || $etp_extref_1_i < 3
        # Node should be an atom
	set $etp_extref_1_error = 1
      else
        ## $etp_extref_1_i now equals data (Uint) words
	set $etp_extref_1_i -= 2
        if $etp_arch64
          if ((((int) ((Uint32 *) $etp_extref_1_p->data)[0]) + 1) \
              > (2 * $etp_extref_1_i))
	    set $etp_extref_1_error = 1
          else
            set $etp_extref_1_nump = &((Uint32 *) $etp_extref_1_p->data)[1]
            set $etp_extref_1_i = (int) ((Uint32 *) $etp_extref_1_p->data)[0]
          end
        else
            set $etp_extref_1_nump = &((Uint32 *) $etp_extref_1_p->data)[0]
        end
        ## $etp_extref_1_i now equals no of ref num (Uint32) words
        if !$etp_extref_1_error
          if $etp_extref_1_dep == erts_this_dist_entry
            printf "#Ref<0:"
          else
            printf "#Ref<%u:", $etp_extref_1_node>>6
          end
          etp-atom-1 ($etp_extref_1_node)
          printf "/%u", $etp_extref_1_creation
        end
      end
      if $etp_extref_1_error
        printf "#ExternalRefError<%#x>", ($arg0)
      else
        set $etp_extref_1_i--
        while $etp_extref_1_i >= 0
          printf ".%u", (unsigned) $etp_extref_1_nump[$etp_extref_1_i]
          set $etp_extref_1_i--
        end
        printf ">"
      end
    end
  end
end



define etp-mfa-1
# Args: Eterm*, int offset
#
# Reentrant
#
  printf "<"
  etp-atom-1 (((Eterm*)($arg0))[0])
  printf ":"
  etp-atom-1 (((Eterm*)($arg0))[1])
  printf "/%d", ((Eterm*)($arg0))[2]
  if ($arg1) > 0
    printf "+%#x>", ($arg1)
  else
    printf ">"
  end	
end

define etp-mfa
# Args: Eterm*
#