erts: Add erlang:list_to_port/1 debug bif

8 files changed, 116 insertions, 4 deletions

diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index a8836d3cbb..a26a695f2e 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -2499,6 +2499,24 @@ os_prompt%</pre>
     </func>
 
     <func>
+      <name name="list_to_port" arity="1"/>
+      <fsummary>Convert from text representation to a port.</fsummary>
+      <desc>
+        <p>Returns a port identifier whose text representation is a
+          <c><anno>String</anno></c>, for example:</p>
+        <pre>
+> <input>list_to_port("#Port&lt;0.4>").</input>
+#Port&lt;0.4></pre>
+        <p>Failure: <c>badarg</c> if <c><anno>String</anno></c> contains a bad
+          representation of a port identifier.</p>
+        <warning>
+          <p>This BIF is intended for debugging and is not to be used
+            in application programs.</p>
+        </warning>
+      </desc>
+    </func>
+
+    <func>
       <name name="list_to_ref" arity="1"/>
       <fsummary>Convert from text representation to a ref.</fsummary>
       <desc>
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 214de3652f..d7a18e8d88 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -4254,6 +4254,75 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
     BIF_ERROR(BIF_P, BADARG);
 }
 
+BIF_RETTYPE list_to_port_1(BIF_ALIST_1)
+{
+    /*
+     * A valid port identifier is on the format
+     * "#Port<N.P>" where N is node and P is
+     * the port id. Both N and P are of type Uint32.
+     */
+    Uint32 n, p;
+    char* cp;
+    int i;
+    DistEntry *dep = NULL;
+    char buf[6 /* #Port< */
+             + (2)*(10 + 1) /* N.P> */
+             + 1 /* \0 */];
+
+    /* walk down the list and create a C string */
+    if ((i = intlist_to_buf(BIF_ARG_1, buf, sizeof(buf)-1)) < 0)
+	goto bad;
+
+    buf[i] = '\0';		/* null terminal */
+
+    cp = &buf[0];
+    if (strncmp("#Port<", cp, 6) != 0)
+        goto bad;
+
+    cp += 6; /* strlen("#Port<") */
+
+    if (sscanf(cp, "%u.%u>", &n, &p) < 2)
+        goto bad;
+
+    if (p > ERTS_MAX_PORT_NUMBER)
+	goto bad;
+
+    dep = erts_channel_no_to_dist_entry(n);
+
+    if (!dep)
+	goto bad;
+
+    if(dep == erts_this_dist_entry) {
+	erts_deref_dist_entry(dep);
+	BIF_RET(make_internal_port(p));
+    }
+    else {
+      ExternalThing *etp;
+      ErlNode *enp;
+
+      if (is_nil(dep->cid))
+	  goto bad;
+
+      enp = erts_find_or_insert_node(dep->sysname, dep->creation);
+      ASSERT(enp != erts_this_node);
+
+      etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1);
+      etp->header = make_external_port_header(1);
+      etp->next = MSO(BIF_P).first;
+      etp->node = enp;
+      etp->data.ui[0] = p;
+
+      MSO(BIF_P).first = (struct erl_off_heap_header*) etp;
+      erts_deref_dist_entry(dep);
+      BIF_RET(make_external_port(etp));
+    }
+
+ bad:
+    if (dep)
+	erts_deref_dist_entry(dep);
+    BIF_ERROR(BIF_P, BADARG);
+}
+
 BIF_RETTYPE list_to_ref_1(BIF_ALIST_1)
 {
     /*
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 66e5dc2988..56d656a173 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -88,6 +88,7 @@ bif erlang:list_to_binary/1
 bif erlang:list_to_float/1
 bif erlang:list_to_integer/1
 bif erlang:list_to_pid/1
+bif erlang:list_to_port/1
 bif erlang:list_to_ref/1
 bif erlang:list_to_tuple/1
 bif erlang:loaded/0
diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl
index 514dd2f412..9e1e351cd2 100644
--- a/erts/emulator/test/list_bif_SUITE.erl
+++ b/erts/emulator/test/list_bif_SUITE.erl
@@ -23,7 +23,7 @@
 
 -export([all/0, suite/0]).
 -export([hd_test/1,tl_test/1,t_length/1,t_list_to_pid/1,
-	 t_list_to_float/1,t_list_to_integer/1]).
+         t_list_to_port/1,t_list_to_float/1,t_list_to_integer/1]).
 
 
 suite() ->
@@ -32,7 +32,7 @@ suite() ->
 
 
 all() -> 
-    [hd_test, tl_test, t_length, t_list_to_pid,
+    [hd_test, tl_test, t_length, t_list_to_pid, t_list_to_port,
      t_list_to_float, t_list_to_integer].
 
 %% Tests list_to_integer and string:to_integer
@@ -106,10 +106,25 @@ t_list_to_pid(Config) when is_list(Config) ->
         {'EXIT', {badarg, _}} ->
             ok;
         Res ->
-            ct:fail("list_to_pid/1 with incorrect arg succeeded.~nResult: ~p", [Res])
+            ct:fail("list_to_pid/1 with incorrect arg succeeded.~n"
+                    "Result: ~p", [Res])
     end,
     ok.
 
+%% Test list_to_port/1 with correct and incorrect arguments.
+
+t_list_to_port(Config) when is_list(Config) ->
+    Me = hd(erlang:ports()),
+    MyListedPid = port_to_list(Me),
+    Me = list_to_port(MyListedPid),
+    case catch list_to_port(id("Incorrect list")) of
+        {'EXIT', {badarg, _}} ->
+            ok;
+        Res ->
+            ct:fail("list_to_port/1 with incorrect arg succeeded.~n"
+                    "Result: ~p", [Res])
+    end,
+    ok.
 
 %% Test list_to_float/1 with correct and incorrect arguments.
 
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 31ea683ff1..8499d40c9a 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -129,7 +129,7 @@
 -export([list_to_atom/1, list_to_binary/1]).
 -export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]).
 -export([list_to_integer/1, list_to_integer/2]).
--export([list_to_pid/1, list_to_ref/1, list_to_tuple/1, loaded/0]).
+-export([list_to_pid/1, list_to_port/1, list_to_ref/1, list_to_tuple/1, loaded/0]).
 -export([localtime/0, make_ref/0]).
 -export([map_size/1, match_spec_test/3, md5/1, md5_final/1]).
 -export([md5_init/0, md5_update/2, module_loaded/1, monitor/2]).
@@ -1159,6 +1159,12 @@ list_to_integer(_String,_Base) ->
       String :: string().
 list_to_pid(_String) ->
     erlang:nif_error(undefined).
+
+%% list_to_port/1
+-spec list_to_port(String) -> port() when
+      String :: string().
+list_to_port(_String) ->
+    erlang:nif_error(undefined).
  
 %% list_to_ref/1
 -spec list_to_ref(String) -> reference() when
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 2eff9b4efb..b1f1db6fa3 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -108,6 +108,7 @@ is_pure(erlang, list_to_binary, 1) -> true;
 is_pure(erlang, list_to_float, 1) -> true;
 is_pure(erlang, list_to_integer, 1) -> true;
 is_pure(erlang, list_to_pid, 1) -> true;
+is_pure(erlang, list_to_port, 1) -> true;
 is_pure(erlang, list_to_ref, 1) -> true;
 is_pure(erlang, list_to_tuple, 1) -> true;
 is_pure(erlang, max, 2) -> true;
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index 11d02c0999..9a1b17fdb7 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -331,6 +331,7 @@ bif(list_to_float, 1) -> true;
 bif(list_to_integer, 1) -> true;
 bif(list_to_integer, 2) -> true;
 bif(list_to_pid, 1) -> true;
+bif(list_to_port, 1) -> true;
 bif(list_to_ref, 1) -> true;
 bif(list_to_tuple, 1) -> true;
 bif(load_module, 2) -> true;
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 14c21d7dad..5dff4e6e2f 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -836,6 +836,7 @@ resulting regexp is surrounded by \\_< and \\_>."
       "list_to_float"
       "list_to_integer"
       "list_to_pid"
+      "list_to_port"
       "list_to_ref"
       "list_to_tuple"
       "load_module"