void
scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM))
{
- scm_ptobs[SCM_TC2PTOBNUM (tc)].input_waiting = input_waiting;
+ scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->input_waiting = input_waiting;
+}
+
++void
++scm_set_port_setvbuf (scm_t_bits tc, void (*setvbuf) (SCM, long, long))
++{
++ scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->setvbuf = setvbuf;
+ }
+
static void
scm_i_set_pending_eof (SCM port)
{
scm_dynwind_fluid (cur_loadport_fluid, port);
}
-\f
-/* The port table --- an array of pointers to ports. */
-
-/*
- We need a global registry of ports to flush them all at exit, and to
- get all the ports matching a file descriptor.
- */
-SCM scm_i_port_weak_hash;
-
-scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
\f
-/* Port finalization. */
+/* Retrieving a port's mode. */
-static void finalize_port (void *, void *);
+/* Return the flags that characterize a port based on the mode
+ * string used to open a file for that port.
+ *
+ * See PORT FLAGS in scm.h
+ */
-/* Register a finalizer for PORT. */
-static SCM_C_INLINE_KEYWORD void
-register_finalizer_for_port (SCM port)
+static long
+scm_i_mode_bits_n (SCM modes)
{
- /* Register a finalizer for PORT so that its
- type's `free' function gets called. */
- scm_i_set_finalizer (SCM2PTR (port), finalize_port, NULL);
+ return (SCM_OPN
+ | (scm_i_string_contains_char (modes, 'r')
+ || scm_i_string_contains_char (modes, '+') ? SCM_RDNG : 0)
+ | (scm_i_string_contains_char (modes, 'w')
+ || scm_i_string_contains_char (modes, 'a')
+ || scm_i_string_contains_char (modes, '+') ? SCM_WRTNG : 0)
+ | (scm_i_string_contains_char (modes, '0') ? SCM_BUF0 : 0)
+ | (scm_i_string_contains_char (modes, 'l') ? SCM_BUFLINE : 0));
}
-/* Finalize the object (a port) pointed to by PTR. */
-static void
-finalize_port (void *ptr, void *data)
+long
+scm_mode_bits (char *modes)
{
- long port_type;
- SCM port = PTR2SCM (ptr);
-
- if (!SCM_PORTP (port))
- abort ();
-
- if (SCM_OPENP (port))
- {
- if (SCM_REVEALED (port) > 0)
- /* Keep "revealed" ports alive and re-register a finalizer. */
- register_finalizer_for_port (port);
- else
- {
- port_type = SCM_TC2PTOBNUM (SCM_CELL_TYPE (port));
- if (port_type >= scm_numptob)
- abort ();
+ /* Valid characters are rw+a0l. So, use latin1. */
+ return scm_i_mode_bits (scm_from_latin1_string (modes));
+}
- if (scm_ptobs[port_type].free)
- /* Yes, I really do mean `.free' rather than `.close'. `.close'
- is for explicit `close-port' by user. */
- scm_ptobs[port_type].free (port);
+long
+scm_i_mode_bits (SCM modes)
+{
+ long bits;
- SCM_SETSTREAM (port, 0);
- SCM_CLR_PORT_OPEN_FLAG (port);
+ if (!scm_is_string (modes))
+ scm_wrong_type_arg_msg (NULL, 0, modes, "string");
- scm_gc_ports_collected++;
- }
- }
+ bits = scm_i_mode_bits_n (modes);
+ scm_remember_upto_here_1 (modes);
+ return bits;
}
+/* Return the mode flags from an open port.
+ * Some modes such as "append" are only used when opening
+ * a file and are not returned here. */
+SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0,
+ (SCM port),
+ "Return the port modes associated with the open port @var{port}.\n"
+ "These will not necessarily be identical to the modes used when\n"
+ "the port was opened, since modes such as \"append\" which are\n"
+ "used only during port creation are not retained.")
+#define FUNC_NAME s_scm_port_mode
+{
+ char modes[4];
+ modes[0] = '\0';
-\f
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_VALIDATE_OPPORT (1, port);
+ if (SCM_CELL_WORD_0 (port) & SCM_RDNG) {
+ if (SCM_CELL_WORD_0 (port) & SCM_WRTNG)
+ strcpy (modes, "r+");
+ else
+ strcpy (modes, "r");
+ }
+ else if (SCM_CELL_WORD_0 (port) & SCM_WRTNG)
+ strcpy (modes, "w");
+ if (SCM_CELL_WORD_0 (port) & SCM_BUF0)
+ strcat (modes, "0");
-/* This function is not and should not be thread safe. */
-SCM
-scm_new_port_table_entry (scm_t_bits tag)
-#define FUNC_NAME "scm_new_port_table_entry"
-{
- /*
- We initialize the cell to empty, this is in case scm_gc_calloc
- triggers GC ; we don't want the GC to scan a half-finished Z.
- */
-
- SCM z = scm_cons (SCM_EOL, SCM_EOL);
- scm_t_port *entry = scm_gc_typed_calloc (scm_t_port);
- scm_t_port_internal *pti = scm_gc_typed_calloc (scm_t_port_internal);
- const char *encoding;
+ return scm_from_latin1_string (modes);
+}
+#undef FUNC_NAME
- entry->file_name = SCM_BOOL_F;
- entry->rw_active = SCM_PORT_NEITHER;
- entry->port = z;
--
- /* Initialize this port with the thread's current default
- encoding. */
- encoding = scm_i_default_port_encoding ();
- entry->ilseq_handler = scm_i_default_port_conversion_handler ();
- entry->encoding = encoding ? scm_gc_strdup (encoding, "port") : NULL;
- if (encoding && c_strcasecmp (encoding, "UTF-8") == 0)
- pti->encoding_mode = SCM_PORT_ENCODING_MODE_UTF8;
- else
- pti->encoding_mode = SCM_PORT_ENCODING_MODE_ICONV;
- pti->iconv_descriptors = NULL;
+\f
- pti->at_stream_start_for_bom_read = 1;
- pti->at_stream_start_for_bom_write = 1;
+/* The port table --- a weak set of all ports.
- /* XXX These fields are not what they seem. They have been
- repurposed, but cannot safely be renamed in 2.0 without breaking
- ABI compatibility. This will be cleaned up in 2.2. */
- entry->input_cd = pti; /* XXX pointer to the internal port structure */
- entry->output_cd = NULL; /* XXX unused */
+ We need a global registry of ports to flush them all at exit, and to
+ get all the ports matching a file descriptor. */
+SCM scm_i_port_weak_set;
- pti->pending_eof = 0;
- pti->alist = SCM_EOL;
- /* Until Guile 2.0.9 included, 'setvbuf' would only work on file
- ports. Now all port types can be supported, but it's not clear
- that port types out in wild accept having someone else fiddle with
- their buffer. Thus, conservatively turn it off by default. */
- pti->setvbuf = NULL;
+\f
+
+/* Port finalization. */
- SCM_SET_CELL_TYPE (z, tag);
- SCM_SETPTAB_ENTRY (z, entry);
+struct do_free_data
+{
+ scm_t_ptob_descriptor *ptob;
+ SCM port;
+};
- scm_hashq_set_x (scm_i_port_weak_hash, z, SCM_BOOL_F);
+static SCM
+do_free (void *body_data)
+{
+ struct do_free_data *data = body_data;
- /* For each new port, register a finalizer so that it port type's free
- function can be invoked eventually. */
- register_finalizer_for_port (z);
+ /* `close' is for explicit `close-port' by user. `free' is for this
+ purpose: ports collected by the GC. */
+ data->ptob->free (data->port);
- return z;
+ return SCM_BOOL_T;
}
-#undef FUNC_NAME
-#if SCM_ENABLE_DEPRECATED==1
-scm_t_port *
-scm_add_to_port_table (SCM port)
+/* Finalize the object (a port) pointed to by PTR. */
+static void
+finalize_port (void *ptr, void *data)
{
- SCM z;
- scm_t_port * pt;
+ SCM port = SCM_PACK_POINTER (ptr);
- scm_c_issue_deprecation_warning ("scm_add_to_port_table is deprecated.");
+ if (!SCM_PORTP (port))
+ abort ();
- scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
- z = scm_new_port_table_entry (scm_tc7_port);
- pt = SCM_PTAB_ENTRY(z);
- pt->port = port;
- SCM_SETCAR (z, SCM_EOL);
- SCM_SETCDR (z, SCM_EOL);
- SCM_SETPTAB_ENTRY (port, pt);
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+ if (SCM_OPENP (port))
+ {
+ struct do_free_data data;
- return pt;
-}
-#endif
+ SCM_CLR_PORT_OPEN_FLAG (port);
+ data.ptob = SCM_PORT_DESCRIPTOR (port);
+ data.port = port;
-/* Remove a port from the table and destroy it. */
+ scm_internal_catch (SCM_BOOL_T, do_free, &data,
+ scm_handle_by_message_noexit, NULL);
-static void close_iconv_descriptors (scm_t_iconv_descriptors *id);
+ scm_gc_ports_collected++;
+ }
+}
-static void
-scm_i_remove_port (SCM port)
-#define FUNC_NAME "scm_remove_port"
+
+\f
+
+SCM
+scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
+ const char *encoding,
+ scm_t_string_failed_conversion_handler handler,
+ scm_t_bits stream)
{
- scm_t_port *p;
+ SCM ret;
+ scm_t_port *entry;
scm_t_port_internal *pti;
+ scm_t_ptob_descriptor *ptob;
- scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+ entry = scm_gc_typed_calloc (scm_t_port);
+ pti = scm_gc_typed_calloc (scm_t_port_internal);
+ ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tag));
- p = SCM_PTAB_ENTRY (port);
- pti = SCM_PORT_GET_INTERNAL (port);
- scm_port_non_buffer (p);
- p->putback_buf = NULL;
- p->putback_buf_size = 0;
+ ret = scm_words (tag | mode_bits, 3);
+ SCM_SET_CELL_WORD_1 (ret, (scm_t_bits) entry);
+ SCM_SET_CELL_WORD_2 (ret, (scm_t_bits) ptob);
- if (pti->iconv_descriptors)
+ entry->lock = scm_gc_malloc_pointerless (sizeof (*entry->lock), "port lock");
+ scm_i_pthread_mutex_init (entry->lock, scm_i_pthread_mutexattr_recursive);
+
+ entry->internal = pti;
+ entry->file_name = SCM_BOOL_F;
+ entry->rw_active = SCM_PORT_NEITHER;
+ entry->port = ret;
+ entry->stream = stream;
+
+ if (encoding_matches (encoding, "UTF-8"))
{
- close_iconv_descriptors (pti->iconv_descriptors);
- pti->iconv_descriptors = NULL;
+ pti->encoding_mode = SCM_PORT_ENCODING_MODE_UTF8;
+ entry->encoding = "UTF-8";
+ }
+ else if (encoding_matches (encoding, "ISO-8859-1"))
+ {
+ pti->encoding_mode = SCM_PORT_ENCODING_MODE_LATIN1;
+ entry->encoding = "ISO-8859-1";
+ }
+ else
+ {
+ pti->encoding_mode = SCM_PORT_ENCODING_MODE_ICONV;
+ entry->encoding = canonicalize_encoding (encoding);
}
- SCM_SETPTAB_ENTRY (port, 0);
+ entry->ilseq_handler = handler;
+ pti->iconv_descriptors = NULL;
- scm_hashq_remove_x (scm_i_port_weak_hash, port);
+ pti->at_stream_start_for_bom_read = 1;
+ pti->at_stream_start_for_bom_write = 1;
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
-}
-#undef FUNC_NAME
+ pti->pending_eof = 0;
+ pti->alist = SCM_EOL;
+ if (SCM_PORT_DESCRIPTOR (ret)->free)
+ scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL);
-/* Functions for debugging. */
-#ifdef GUILE_DEBUG
-SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0,
- (),
- "Return the number of ports in the port table. @code{pt-size}\n"
- "is only included in @code{--enable-guile-debug} builds.")
-#define FUNC_NAME s_scm_pt_size
-{
- return scm_from_int (SCM_HASHTABLE_N_ITEMS (scm_i_port_weak_hash));
+ if (SCM_PORT_DESCRIPTOR (ret)->flags & SCM_PORT_TYPE_HAS_FLUSH)
+ scm_weak_set_add_x (scm_i_port_weak_set, ret);
+
+ return ret;
}
-#undef FUNC_NAME
-#endif
-void
-scm_port_non_buffer (scm_t_port *pt)
+SCM
+scm_c_make_port (scm_t_bits tag, unsigned long mode_bits, scm_t_bits stream)
{
- pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf;
- pt->write_buf = pt->write_pos = &pt->shortbuf;
- pt->read_buf_size = pt->write_buf_size = 1;
- pt->write_end = pt->write_buf + pt->write_buf_size;
+ return scm_c_make_port_with_encoding (tag, mode_bits,
+ scm_i_default_port_encoding (),
+ scm_i_default_port_conversion_handler (),
+ stream);
}
-\f
-/* Revealed counts --- an oddity inherited from SCSH. */
-
-/* Find a port in the table and return its revealed count.
- Also used by the garbage collector.
- */
-
-int
-scm_revealed_count (SCM port)
+SCM
+scm_new_port_table_entry (scm_t_bits tag)
{
- return SCM_REVEALED(port);
+ return scm_c_make_port (tag, 0, 0);
}
+\f
+/* Predicates. */
-/* Return the revealed count for a port. */
-
-SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
- (SCM port),
- "Return the revealed count for @var{port}.")
-#define FUNC_NAME s_scm_port_revealed
+SCM_DEFINE (scm_port_p, "port?", 1, 0, 0,
+ (SCM x),
+ "Return a boolean indicating whether @var{x} is a port.\n"
+ "Equivalent to @code{(or (input-port? @var{x}) (output-port?\n"
+ "@var{x}))}.")
+#define FUNC_NAME s_scm_port_p
{
- port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPENPORT (1, port);
- return scm_from_int (scm_revealed_count (port));
+ return scm_from_bool (SCM_PORTP (x));
}
#undef FUNC_NAME
#ifndef SCM_PORTS_H
#define SCM_PORTS_H
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- * 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- * 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
++ * 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE);
void (*truncate) (SCM port, scm_t_off length);
++ /* When non-NULL, this is the method called by 'setvbuf' for this port.
++ It must create read and write buffers for PORT with the specified
++ sizes (a size of 0 is for unbuffered ports, which should use the
++ 'shortbuf' field.) Size -1 means to use the port's preferred buffer
++ size. */
++ void (*setvbuf) (SCM port, long read_size, long write_size);
++
+ unsigned flags;
} scm_t_ptob_descriptor;
#define SCM_TC2PTOBNUM(x) (0x0ff & ((x) >> 8))
void (*truncate) (SCM port,
scm_t_off length));
SCM_API void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM));
-SCM_API SCM scm_char_ready_p (SCM port);
-SCM_API size_t scm_take_from_input_buffers (SCM port, char *dest,
- size_t read_len);
-SCM_API SCM scm_drain_input (SCM port);
++SCM_API void scm_set_port_setvbuf (scm_t_bits tc,
++ void (*setvbuf) (SCM, long, long));
+
+/* The input, output, error, and load ports. */
SCM_API SCM scm_current_input_port (void);
SCM_API SCM scm_current_output_port (void);
SCM_API SCM scm_current_error_port (void);
HCoop / bpt / guile.git / commitdiff