* strports.c (scm_object_to_string): New procedure.

[bpt/guile.git] / libguile / vports.c

diff --git a/libguile/vports.c b/libguile/vports.c
index 381a569..962759b 100644 (file)
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1998,1999 Free Software Foundation, Inc.
+/*     Copyright (C) 1995,1996,1998,1999, 2000, 2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -45,15 +45,18 @@
 \f
 
 #include <stdio.h>
-#include "_scm.h"
-#include "eval.h"
-#include "chars.h"
-#include "fports.h"
-#include "strings.h"
-#include "vectors.h"
+#include <errno.h>
 
-#include "validate.h"
-#include "vports.h"
+#include "libguile/_scm.h"
+#include "libguile/eval.h"
+#include "libguile/chars.h"
+#include "libguile/fports.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/vectors.h"
+
+#include "libguile/validate.h"
+#include "libguile/vports.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -66,11 +69,14 @@
  */
 
 
+static scm_bits_t scm_tc16_sfport;
+
+
 static void
 sf_flush (SCM port)
 {
   scm_port *pt = SCM_PTAB_ENTRY (port);
-  SCM stream = pt->stream;
+  SCM stream = SCM_PACK (pt->stream);
 
   if (pt->write_pos > pt->write_buf)
     {
@@ -83,7 +89,7 @@ sf_flush (SCM port)
       {
        SCM f = SCM_VELTS (stream)[2];
 
-       if (f != SCM_BOOL_F)
+       if (!SCM_FALSEP (f))
          scm_apply (f, SCM_EOL, SCM_EOL);
       }
     }
@@ -92,7 +98,7 @@ sf_flush (SCM port)
 static void
 sf_write (SCM port, const void *data, size_t size)
 {
-  SCM p = SCM_STREAM (port);
+  SCM p = SCM_PACK (SCM_STREAM (port));
 
   scm_apply (SCM_VELTS (p)[1], 
             scm_cons (scm_makfromstr ((char *) data, size, 0), SCM_EOL),
@@ -107,7 +113,7 @@ sf_write (SCM port, const void *data, size_t size)
 static int 
 sf_fill_input (SCM port)
 {
-  SCM p = SCM_STREAM (port);
+  SCM p = SCM_PACK (SCM_STREAM (port));
   SCM ans;
 
   ans = scm_apply (SCM_VELTS (p)[3], SCM_EOL, SCM_EOL); /* get char.  */
@@ -128,13 +134,13 @@ sf_fill_input (SCM port)
 static int 
 sf_close (SCM port)
 {
-  SCM p = SCM_STREAM (port);
+  SCM p = SCM_PACK (SCM_STREAM (port));
   SCM f = SCM_VELTS (p)[4];
-  if (SCM_BOOL_F == f)
+  if (SCM_FALSEP (f))
     return 0;
   f = scm_apply (f, SCM_EOL, SCM_EOL);
   errno = 0;
-  return SCM_BOOL_F == f ? EOF : 0;
+  return SCM_FALSEP (f) ? EOF : 0;
 }
 
 
@@ -174,41 +180,52 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
            "            (lambda () (char-upcase (read-char)))\n"
            "            (lambda () (display \"@@\" stdout)))\n"
            "           \"rw\"))\n\n"
-           "(write p p) @result{} #<input-output-soft#\space45d10#\>\n"
+           "(write p p) @result{} #<input-output: soft 8081e20>\n"
            "@end example")
 #define FUNC_NAME s_scm_make_soft_port
 {
   scm_port *pt;
   SCM z;
   SCM_VALIDATE_VECTOR_LEN (1,pv,5);
-  SCM_VALIDATE_ROSTRING (2,modes);
-  SCM_COERCE_SUBSTR (modes);
+  SCM_VALIDATE_STRING (2, modes);
+  SCM_STRING_COERCE_0TERMINATION_X (modes);
   SCM_NEWCELL (z);
   SCM_DEFER_INTS;
   pt = scm_add_to_port_table (z);
   scm_port_non_buffer (pt);
-  SCM_SETCAR (z, scm_tc16_sfport | scm_mode_bits (SCM_ROCHARS (modes)));
+  SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_mode_bits (SCM_STRING_CHARS (modes)));
   SCM_SETPTAB_ENTRY (z, pt);
-  SCM_SETSTREAM (z, pv);
+  SCM_SETSTREAM (z, SCM_UNPACK (pv));
   SCM_ALLOW_INTS;
   return z;
 }
 #undef FUNC_NAME
 
 
-void scm_make_sfptob (void); /* Called from ports.c */
-
-void
+static scm_bits_t
 scm_make_sfptob ()
 {
-  long tc = scm_make_port_type ("soft", sf_fill_input, sf_write);
+  scm_bits_t tc = scm_make_port_type ("soft", sf_fill_input, sf_write);
+
   scm_set_port_mark (tc, scm_markstream);
   scm_set_port_flush (tc, sf_flush);
   scm_set_port_close (tc, sf_close);
+
+  return tc;
 }
 
 void
 scm_init_vports ()
 {
-#include "vports.x"
+  scm_tc16_sfport = scm_make_sfptob ();
+
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/vports.x"
+#endif
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/