core: Split-out display.c.

* src/lib.c (display_helper, display_, display_error_, display_port_,
write_, write_error_, write_port_, fdisplay_): Move to ..
* src/display.c: New file.
* build-aux/configure-lib.sh (mes_SOURCES): Add it.
* simple.make: Likewise.

build-aux/configure-lib.sh

@@ -431,6 +431,7 @@ fi
 
 mes_SOURCES="
 src/builtins.c
+src/display.c
 src/eval-apply.c
 src/gc.c
 src/hash.c

build-aux/snarf.sh

@@ -25,6 +25,7 @@ srcdest=${srcdest-./}
 . ${srcdest}build-aux/trace.sh
 
 trace "SNARF$snarf  builtins.c"   ${srcdest}build-aux/mes-snarf.scm src/builtins.c
+trace "SNARF$snarf  display.c"    ${srcdest}build-aux/mes-snarf.scm src/display.c
 trace "SNARF$snarf  eval-apply.c" ${srcdest}build-aux/mes-snarf.scm src/eval-apply.c
 trace "SNARF$snarf  gc.c"         ${srcdest}build-aux/mes-snarf.scm src/gc.c
 trace "SNARF$snarf  hash.c"       ${srcdest}build-aux/mes-snarf.scm src/hash.c

include/mes/builtins.h

@@ -27,6 +27,13 @@ SCM builtin_name (SCM builtin);
 SCM builtin_arity (SCM builtin);
 SCM builtin_p (SCM x);
 SCM builtin_printer (SCM builtin);
+/* src/display.c */
+SCM display_ (SCM x);
+SCM display_error_ (SCM x);
+SCM display_port_ (SCM x, SCM p);
+SCM write_ (SCM x);
+SCM write_error_ (SCM x);
+SCM write_port_ (SCM x, SCM p);
 /* src/eval-apply.c */
 SCM pairlis (SCM x, SCM y, SCM a);
 SCM set_car_x (SCM x, SCM e);
@@ -49,12 +56,6 @@ SCM hash_set_x (SCM table, SCM key, SCM value);
 SCM hash_table_printer (SCM table);
 SCM make_hash_table (SCM x);
 /* src/lib.c */
-SCM display_ (SCM x);
-SCM display_error_ (SCM x);
-SCM display_port_ (SCM x, SCM p);
-SCM write_ (SCM x);
-SCM write_error_ (SCM x);
-SCM write_port_ (SCM x, SCM p);
 SCM exit_ (SCM x);
 SCM frame_printer (SCM frame);
 SCM make_stack (SCM stack);

simple.make

@@ -48,6 +48,7 @@ CFLAGS:=					\
 
 MES_SOURCES =					\
  src/builtins.c					\
+ src/display.c					\
  src/eval-apply.c				\
  src/gc.c					\
  src/hash.c					\

src/builtins.c

@@ -117,26 +117,21 @@ mes_builtins (SCM a)            /*:((internal)) */
   a = init_builtin (builtin_type, "builtin-arity", 1, &builtin_arity, a);
   a = init_builtin (builtin_type, "builtin?", 1, &builtin_p, a);
   a = init_builtin (builtin_type, "builtin-printer", 1, &builtin_printer, a);
+  /* src/display.c */
+  a = init_builtin (builtin_type, "core:display", 1, &display_, a);
+  a = init_builtin (builtin_type, "core:display-error", 1, &display_error_, a);
+  a = init_builtin (builtin_type, "core:display-port", 2, &display_port_, a);
+  a = init_builtin (builtin_type, "core:write", 1, &write_, a);
+  a = init_builtin (builtin_type, "core:write-error", 1, &write_error_, a);
+  a = init_builtin (builtin_type, "core:write-port", 2, &write_port_, a);
   /* src/eval-apply.c */
-  a = init_builtin (builtin_type, "assert-defined", 2, &assert_defined, a);
-  a = init_builtin (builtin_type, "check-formals", 3, &check_formals, a);
-  a = init_builtin (builtin_type, "check-apply", 2, &check_apply, a);
   a = init_builtin (builtin_type, "pairlis", 3, &pairlis, a);
   a = init_builtin (builtin_type, "set-car!", 2, &set_car_x, a);
   a = init_builtin (builtin_type, "set-cdr!", 2, &set_cdr_x, a);
   a = init_builtin (builtin_type, "set-env!", 3, &set_env_x, a);
-  a = init_builtin (builtin_type, "call-lambda", 4, &call_lambda, a);
-  a = init_builtin (builtin_type, "core:make-closure", 3, &make_closure_, a);
-  a = init_builtin (builtin_type, "core:make-variable", 1, &make_variable_, a);
   a = init_builtin (builtin_type, "macro-get-handle", 1, &macro_get_handle, a);
-  a = init_builtin (builtin_type, "get-macro", 1, &get_macro, a);
-  a = init_builtin (builtin_type, "macro-set!", 2, &macro_set_x, a);
-  a = init_builtin (builtin_type, "push-cc", 4, &push_cc, a);
   a = init_builtin (builtin_type, "add-formals", 2, &add_formals, a);
-  a = init_builtin (builtin_type, "expand-variable", 2, &expand_variable, a);
-  a = init_builtin (builtin_type, "apply-builtin", 2, &apply_builtin, a);
   a = init_builtin (builtin_type, "eval-apply", 0, &eval_apply, a);
-  a = init_builtin (builtin_type, "apply", 3, &apply, a);
   /* src/gc.c */
   a = init_builtin (builtin_type, "gc-check", 0, &gc_check, a);
   a = init_builtin (builtin_type, "gc", 0, &gc, a);
@@ -151,12 +146,6 @@ mes_builtins (SCM a)            /*:((internal)) */
   a = init_builtin (builtin_type, "hash-table-printer", 1, &hash_table_printer, a);
   a = init_builtin (builtin_type, "make-hash-table", 1, &make_hash_table, a);
   /* src/lib.c */
-  a = init_builtin (builtin_type, "core:display", 1, &display_, a);
-  a = init_builtin (builtin_type, "core:display-error", 1, &display_error_, a);
-  a = init_builtin (builtin_type, "core:display-port", 2, &display_port_, a);
-  a = init_builtin (builtin_type, "core:write", 1, &write_, a);
-  a = init_builtin (builtin_type, "core:write-error", 1, &write_error_, a);
-  a = init_builtin (builtin_type, "core:write-port", 2, &write_port_, a);
   a = init_builtin (builtin_type, "exit", 1, &exit_, a);
   a = init_builtin (builtin_type, "frame-printer", 1, &frame_printer, a);
   a = init_builtin (builtin_type, "make-stack", -1, &make_stack, a);
@@ -202,6 +191,7 @@ mes_builtins (SCM a)            /*:((internal)) */
   a = init_builtin (builtin_type, "assq", 2, &assq, a);
   a = init_builtin (builtin_type, "assoc", 2, &assoc, a);
   /* src/module.c */
+  a = init_builtin (builtin_type, "make-module-type", 0, &make_module_type, a);
   a = init_builtin (builtin_type, "module-printer", 1, &module_printer, a);
   a = init_builtin (builtin_type, "module-variable", 2, &module_variable, a);
   a = init_builtin (builtin_type, "module-ref", 2, &module_ref, a);
@@ -233,7 +223,9 @@ mes_builtins (SCM a)            /*:((internal)) */
   a = init_builtin (builtin_type, "execl", 2, &execl_, a);
   a = init_builtin (builtin_type, "core:waitpid", 2, &waitpid_, a);
   a = init_builtin (builtin_type, "current-time", 0, &current_time, a);
+  a = init_builtin (builtin_type, "gettimeofday", 0, &gettimeofday_, a);
   a = init_builtin (builtin_type, "get-internal-run-time", 0, &get_internal_run_time, a);
+  a = init_builtin (builtin_type, "getcwd", 0, &getcwd_, a);
   a = init_builtin (builtin_type, "dup", 1, &dup_, a);
   a = init_builtin (builtin_type, "dup2", 2, &dup2_, a);
   a = init_builtin (builtin_type, "delete-file", 1, &delete_file, a);

src/display.c

@@ -0,0 +1,288 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include "mes/lib.h"
+#include "mes/mes.h"
+
+#include <stdlib.h>
+
+int g_depth;
+
+SCM
+display_helper (SCM x, int cont, char *sep, int fd, int write_p)
+{
+  fdputs (sep, fd);
+  if (g_depth == 0)
+    return cell_unspecified;
+  g_depth = g_depth - 1;
+
+  int t = TYPE (x);
+  if (t == TCHAR)
+    {
+      if (write_p == 0)
+        fdputc (VALUE (x), fd);
+      else
+        {
+          fdputs ("#", fd);
+          long v = VALUE (x);
+          if (v == '\0')
+            fdputs ("\\nul", fd);
+          else if (v == '\a')
+            fdputs ("\\alarm", fd);
+          else if (v == '\b')
+            fdputs ("\\backspace", fd);
+          else if (v == '\t')
+            fdputs ("\\tab", fd);
+          else if (v == '\n')
+            fdputs ("\\newline", fd);
+          else if (v == '\v')
+            fdputs ("\\vtab", fd);
+          else if (v == '\f')
+            fdputs ("\\page", fd);
+          //Nyacc bug
+          // else if (v == '\r') fdputs ("return", fd);
+          else if (v == 13)
+            fdputs ("\\return", fd);
+          else if (v == ' ')
+            fdputs ("\\space", fd);
+          else
+            {
+              if (v >= 32 && v <= 127)
+                fdputc ('\\', fd);
+              fdputc (VALUE (x), fd);
+            }
+        }
+    }
+  else if (t == TCLOSURE)
+    {
+      fdputs ("#<closure ", fd);
+      SCM circ = CADR (x);
+      SCM name = CADR (circ);
+      SCM args = CAR (CDDR (x));
+      display_helper (CAR (name), 0, "", fd, 0);
+      fdputc (' ', fd);
+      display_helper (args, 0, "", fd, 0);
+      fdputs (">", fd);
+    }
+  else if (t == TMACRO)
+    {
+      fdputs ("#<macro ", fd);
+      display_helper (CDR (x), cont, "", fd, 0);
+      fdputs (">", fd);
+    }
+  else if (t == TVARIABLE)
+    {
+      fdputs ("#<variable ", fd);
+      display_helper (CAR (VARIABLE (x)), cont, "", fd, 0);
+      fdputs (">", fd);
+    }
+  else if (t == TNUMBER)
+    {
+      fdputs (itoa (VALUE (x)), fd);
+    }
+  else if (t == TPAIR)
+    {
+      if (cont == 0)
+        fdputs ("(", fd);
+      if (CAR (x) == cell_circular && CADR (x) != cell_closure)
+        {
+          fdputs ("(*circ* . ", fd);
+          int i = 0;
+          x = CDR (x);
+          while (x != cell_nil && i < 10)
+            {
+              i = i + 1;
+              fdisplay_ (CAAR (x), fd, write_p);
+              fdputs (" ", fd);
+              x = CDR (x);
+            }
+          fdputs (" ...)", fd);
+        }
+      else
+        {
+          if (x && x != cell_nil)
+            fdisplay_ (CAR (x), fd, write_p);
+          if (CDR (x) && TYPE (CDR (x)) == TPAIR)
+            display_helper (CDR (x), 1, " ", fd, write_p);
+          else if (CDR (x) && CDR (x) != cell_nil)
+            {
+              if (TYPE (CDR (x)) != TPAIR)
+                fdputs (" . ", fd);
+              fdisplay_ (CDR (x), fd, write_p);
+            }
+        }
+      if (cont == 0)
+        fdputs (")", fd);
+    }
+  else if (t == TKEYWORD || t == TPORT || t == TSPECIAL || t == TSTRING || t == TSYMBOL)
+    {
+      if (t == TPORT)
+        {
+          fdputs ("#<port ", fd);
+          fdputs (itoa (PORT (x)), fd);
+          fdputs (" ", fd);
+          x = STRING (x);
+        }
+      if (t == TKEYWORD)
+        fdputs ("#:", fd);
+      if ((write_p && t == TSTRING) || t == TPORT)
+        fdputc ('"', fd);
+      char const *s = CSTRING (x);
+      size_t length = LENGTH (x);
+      size_t i;
+      for (i = 0; i < length; i = i + 1)
+        {
+          long v = -1;
+          if (write_p != 0)
+            v = s[i];
+          if (v == '\0')
+            fdputs ("\\0", fd);
+          else if (v == '\a')
+            fdputs ("\\a", fd);
+          else if (v == '\b')
+            fdputs ("\\b", fd);
+          else if (v == '\t')
+            fdputs ("\\t", fd);
+          else if (v == '\v')
+            fdputs ("\\v", fd);
+          else if (v == '\n')
+            fdputs ("\\n", fd);
+          else if (v == '\f')
+            fdputs ("\\f", fd);
+#if 1                           //__MESC__
+          //Nyacc bug
+          else if (v == 13)
+            fdputs ("\\r", fd);
+          else if (v == 27)
+            fdputs ("\\e", fd);
+#else
+          //else if (v == '\r') fdputs ("\\r", fd);
+          //Nyacc crash
+          //else if (v == '\e') fdputs ("\\e", fd);
+#endif
+          else if (v == '\\')
+            fdputs ("\\\\", fd);
+          else if (v == '"')
+            fdputs ("\\\"", fd);
+          else
+            fdputc (s[i], fd);
+        }
+      if ((write_p && t == TSTRING) || t == TPORT)
+        fdputc ('"', fd);
+      if (t == TPORT)
+        fdputs (">", fd);
+    }
+  else if (t == TREF)
+    fdisplay_ (REF (x), fd, write_p);
+  else if (t == TSTRUCT)
+    {
+      //SCM printer = STRUCT (x) + 1;
+      SCM printer = struct_ref_ (x, STRUCT_PRINTER);
+      if (TYPE (printer) == TREF)
+        printer = REF (printer);
+      if (TYPE (printer) == TCLOSURE || builtin_p (printer) == cell_t)
+        apply (printer, cons (x, cell_nil), r0);
+      else
+        {
+          fdputs ("#<", fd);
+          fdisplay_ (STRUCT (x), fd, write_p);
+          SCM t = CAR (x);
+          long size = LENGTH (x);
+          long i;
+          for (i = 2; i < size; i = i + 1)
+            {
+              fdputc (' ', fd);
+              fdisplay_ (STRUCT (x) + i, fd, write_p);
+            }
+          fdputc ('>', fd);
+        }
+    }
+  else if (t == TVECTOR)
+    {
+      fdputs ("#(", fd);
+      SCM t = CAR (x);
+      long i;
+      for (i = 0; i < LENGTH (x); i = i + 1)
+        {
+          if (i != 0)
+            fdputc (' ', fd);
+          fdisplay_ (VECTOR (x) + i, fd, write_p);
+        }
+      fdputc (')', fd);
+    }
+  else
+    {
+      fdputs ("<", fd);
+      fdputs (itoa (t), fd);
+      fdputs (":", fd);
+      fdputs (itoa (x), fd);
+      fdputs (">", fd);
+    }
+  return 0;
+}
+
+SCM
+display_ (SCM x)
+{
+  g_depth = 5;
+  return display_helper (x, 0, "", __stdout, 0);
+}
+
+SCM
+display_error_ (SCM x)
+{
+  g_depth = 5;
+  return display_helper (x, 0, "", __stderr, 0);
+}
+
+SCM
+display_port_ (SCM x, SCM p)
+{
+  assert_msg (TYPE (p) == TNUMBER, "TYPE (p) == TNUMBER");
+  return fdisplay_ (x, VALUE (p), 0);
+}
+
+SCM
+write_ (SCM x)
+{
+  g_depth = 5;
+  return display_helper (x, 0, "", __stdout, 1);
+}
+
+SCM
+write_error_ (SCM x)
+{
+  g_depth = 5;
+  return display_helper (x, 0, "", __stderr, 1);
+}
+
+SCM
+write_port_ (SCM x, SCM p)
+{
+  assert_msg (TYPE (p) == TNUMBER, "TYPE (p) == TNUMBER");
+  return fdisplay_ (x, VALUE (p), 1);
+}
+
+SCM
+fdisplay_ (SCM x, int fd, int write_p)  /*:((internal)) */
+{
+  g_depth = 5;
+  return display_helper (x, 0, "", fd, write_p);
+}

src/lib.c

@@ -24,270 +24,6 @@
 
 #include <stdlib.h>
 
-int g_depth;
-
-SCM
-display_helper (SCM x, int cont, char *sep, int fd, int write_p)
-{
-  fdputs (sep, fd);
-  if (g_depth == 0)
-    return cell_unspecified;
-  g_depth = g_depth - 1;
-
-  int t = TYPE (x);
-  if (t == TCHAR)
-    {
-      if (write_p == 0)
-        fdputc (VALUE (x), fd);
-      else
-        {
-          fdputs ("#", fd);
-          long v = VALUE (x);
-          if (v == '\0')
-            fdputs ("\\nul", fd);
-          else if (v == '\a')
-            fdputs ("\\alarm", fd);
-          else if (v == '\b')
-            fdputs ("\\backspace", fd);
-          else if (v == '\t')
-            fdputs ("\\tab", fd);
-          else if (v == '\n')
-            fdputs ("\\newline", fd);
-          else if (v == '\v')
-            fdputs ("\\vtab", fd);
-          else if (v == '\f')
-            fdputs ("\\page", fd);
-          //Nyacc bug
-          // else if (v == '\r') fdputs ("return", fd);
-          else if (v == 13)
-            fdputs ("\\return", fd);
-          else if (v == ' ')
-            fdputs ("\\space", fd);
-          else
-            {
-              if (v >= 32 && v <= 127)
-                fdputc ('\\', fd);
-              fdputc (VALUE (x), fd);
-            }
-        }
-    }
-  else if (t == TCLOSURE)
-    {
-      fdputs ("#<closure ", fd);
-      SCM circ = CADR (x);
-      SCM name = CADR (circ);
-      SCM args = CAR (CDDR (x));
-      display_helper (CAR (name), 0, "", fd, 0);
-      fdputc (' ', fd);
-      display_helper (args, 0, "", fd, 0);
-      fdputs (">", fd);
-    }
-  else if (t == TMACRO)
-    {
-      fdputs ("#<macro ", fd);
-      display_helper (CDR (x), cont, "", fd, 0);
-      fdputs (">", fd);
-    }
-  else if (t == TVARIABLE)
-    {
-      fdputs ("#<variable ", fd);
-      display_helper (CAR (VARIABLE (x)), cont, "", fd, 0);
-      fdputs (">", fd);
-    }
-  else if (t == TNUMBER)
-    {
-      fdputs (itoa (VALUE (x)), fd);
-    }
-  else if (t == TPAIR)
-    {
-      if (cont == 0)
-        fdputs ("(", fd);
-      if (CAR (x) == cell_circular && CADR (x) != cell_closure)
-        {
-          fdputs ("(*circ* . ", fd);
-          int i = 0;
-          x = CDR (x);
-          while (x != cell_nil && i < 10)
-            {
-              i = i + 1;
-              fdisplay_ (CAAR (x), fd, write_p);
-              fdputs (" ", fd);
-              x = CDR (x);
-            }
-          fdputs (" ...)", fd);
-        }
-      else
-        {
-          if (x && x != cell_nil)
-            fdisplay_ (CAR (x), fd, write_p);
-          if (CDR (x) && TYPE (CDR (x)) == TPAIR)
-            display_helper (CDR (x), 1, " ", fd, write_p);
-          else if (CDR (x) && CDR (x) != cell_nil)
-            {
-              if (TYPE (CDR (x)) != TPAIR)
-                fdputs (" . ", fd);
-              fdisplay_ (CDR (x), fd, write_p);
-            }
-        }
-      if (cont == 0)
-        fdputs (")", fd);
-    }
-  else if (t == TKEYWORD || t == TPORT || t == TSPECIAL || t == TSTRING || t == TSYMBOL)
-    {
-      if (t == TPORT)
-        {
-          fdputs ("#<port ", fd);
-          fdputs (itoa (PORT (x)), fd);
-          fdputs (" ", fd);
-          x = STRING (x);
-        }
-      if (t == TKEYWORD)
-        fdputs ("#:", fd);
-      if ((write_p && t == TSTRING) || t == TPORT)
-        fdputc ('"', fd);
-      char const *s = CSTRING (x);
-      size_t length = LENGTH (x);
-      size_t i;
-      for (i = 0; i < length; i = i + 1)
-        {
-          long v = -1;
-          if (write_p != 0)
-            v = s[i];
-          if (v == '\0')
-            fdputs ("\\0", fd);
-          else if (v == '\a')
-            fdputs ("\\a", fd);
-          else if (v == '\b')
-            fdputs ("\\b", fd);
-          else if (v == '\t')
-            fdputs ("\\t", fd);
-          else if (v == '\v')
-            fdputs ("\\v", fd);
-          else if (v == '\n')
-            fdputs ("\\n", fd);
-          else if (v == '\f')
-            fdputs ("\\f", fd);
-#if 1                           //__MESC__
-          //Nyacc bug
-          else if (v == 13)
-            fdputs ("\\r", fd);
-          else if (v == 27)
-            fdputs ("\\e", fd);
-#else
-          //else if (v == '\r') fdputs ("\\r", fd);
-          //Nyacc crash
-          //else if (v == '\e') fdputs ("\\e", fd);
-#endif
-          else if (v == '\\')
-            fdputs ("\\\\", fd);
-          else if (v == '"')
-            fdputs ("\\\"", fd);
-          else
-            fdputc (s[i], fd);
-        }
-      if ((write_p && t == TSTRING) || t == TPORT)
-        fdputc ('"', fd);
-      if (t == TPORT)
-        fdputs (">", fd);
-    }
-  else if (t == TREF)
-    fdisplay_ (REF (x), fd, write_p);
-  else if (t == TSTRUCT)
-    {
-      //SCM printer = STRUCT (x) + 1;
-      SCM printer = struct_ref_ (x, STRUCT_PRINTER);
-      if (TYPE (printer) == TREF)
-        printer = REF (printer);
-      if (TYPE (printer) == TCLOSURE || builtin_p (printer) == cell_t)
-        apply (printer, cons (x, cell_nil), r0);
-      else
-        {
-          fdputs ("#<", fd);
-          fdisplay_ (STRUCT (x), fd, write_p);
-          SCM t = CAR (x);
-          long size = LENGTH (x);
-          long i;
-          for (i = 2; i < size; i = i + 1)
-            {
-              fdputc (' ', fd);
-              fdisplay_ (STRUCT (x) + i, fd, write_p);
-            }
-          fdputc ('>', fd);
-        }
-    }
-  else if (t == TVECTOR)
-    {
-      fdputs ("#(", fd);
-      SCM t = CAR (x);
-      long i;
-      for (i = 0; i < LENGTH (x); i = i + 1)
-        {
-          if (i != 0)
-            fdputc (' ', fd);
-          fdisplay_ (VECTOR (x) + i, fd, write_p);
-        }
-      fdputc (')', fd);
-    }
-  else
-    {
-      fdputs ("<", fd);
-      fdputs (itoa (t), fd);
-      fdputs (":", fd);
-      fdputs (itoa (x), fd);
-      fdputs (">", fd);
-    }
-  return 0;
-}
-
-SCM
-display_ (SCM x)
-{
-  g_depth = 5;
-  return display_helper (x, 0, "", __stdout, 0);
-}
-
-SCM
-display_error_ (SCM x)
-{
-  g_depth = 5;
-  return display_helper (x, 0, "", __stderr, 0);
-}
-
-SCM
-display_port_ (SCM x, SCM p)
-{
-  assert_msg (TYPE (p) == TNUMBER, "TYPE (p) == TNUMBER");
-  return fdisplay_ (x, VALUE (p), 0);
-}
-
-SCM
-write_ (SCM x)
-{
-  g_depth = 5;
-  return display_helper (x, 0, "", __stdout, 1);
-}
-
-SCM
-write_error_ (SCM x)
-{
-  g_depth = 5;
-  return display_helper (x, 0, "", __stderr, 1);
-}
-
-SCM
-write_port_ (SCM x, SCM p)
-{
-  assert_msg (TYPE (p) == TNUMBER, "TYPE (p) == TNUMBER");
-  return fdisplay_ (x, VALUE (p), 1);
-}
-
-SCM
-fdisplay_ (SCM x, int fd, int write_p)  /*:((internal)) */
-{
-  g_depth = 5;
-  return display_helper (x, 0, "", fd, write_p);
-}
-
 SCM
 exit_ (SCM x)                   /*:((name . "exit")) */
 {