long
scm_mode_bits (char *modes)
{
- return scm_i_mode_bits (scm_from_locale_string (modes));
+ /* Valid characters are rw+a0l. So, use latin1. */
+ return scm_i_mode_bits (scm_from_latin1_string (modes));
}
long
/* Port finalization. */
-static void finalize_port (GC_PTR, GC_PTR);
+struct do_free_data
+{
+ scm_t_ptob_descriptor *ptob;
+ SCM port;
+};
-/* Register a finalizer for PORT. */
-static SCM_C_INLINE_KEYWORD void
-register_finalizer_for_port (SCM port)
+static SCM
+do_free (void *body_data)
{
- GC_finalization_proc prev_finalizer;
- GC_PTR prev_finalization_data;
+ struct do_free_data *data = body_data;
+
+ /* `close' is for explicit `close-port' by user. `free' is for this
+ purpose: ports collected by the GC. */
+ data->ptob->free (data->port);
- /* Register a finalizer for PORT so that its iconv CDs get freed and
- optionally its type's `free' function gets called. */
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (port), finalize_port, 0,
- &prev_finalizer,
- &prev_finalization_data);
+ return SCM_BOOL_T;
}
/* Finalize the object (a port) pointed to by PTR. */
static void
-finalize_port (GC_PTR ptr, GC_PTR data)
+finalize_port (void *ptr, void *data)
{
SCM port = SCM_PACK_POINTER (ptr);
if (SCM_OPENP (port))
{
- if (SCM_REVEALED (port) > 0)
- /* Keep "revealed" ports alive and re-register a finalizer. */
- register_finalizer_for_port (port);
- else
- {
- scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
+ struct do_free_data data;
- if (ptob->free)
- /* Yes, I really do mean `free' rather than `close'. `close'
- is for explicit `close-port' by user. */
- ptob->free (port);
+ SCM_CLR_PORT_OPEN_FLAG (port);
- SCM_SETSTREAM (port, 0);
- SCM_CLR_PORT_OPEN_FLAG (port);
+ data.ptob = SCM_PORT_DESCRIPTOR (port);
+ data.port = port;
- scm_gc_ports_collected++;
- }
+ scm_internal_catch (SCM_BOOL_T, do_free, &data,
+ scm_handle_by_message_noexit, NULL);
+
+ scm_gc_ports_collected++;
}
}
entry->encoding = encoding ? scm_gc_strdup (encoding, "port") : NULL;
if (encoding && strcmp (encoding, "UTF-8") == 0)
entry->encoding_mode = SCM_PORT_ENCODING_MODE_UTF8;
+ else if (!encoding || strcmp (encoding, "ISO-8859-1") == 0)
+ entry->encoding_mode = SCM_PORT_ENCODING_MODE_LATIN1;
else
entry->encoding_mode = SCM_PORT_ENCODING_MODE_ICONV;
entry->ilseq_handler = handler;
entry->iconv_descriptors = NULL;
+ if (SCM_PORT_DESCRIPTOR (ret)->free)
+ scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL);
+
if (SCM_PORT_DESCRIPTOR (ret)->flags & SCM_PORT_TYPE_HAS_FLUSH)
scm_weak_set_add_x (scm_i_port_weak_set, ret);
- if (SCM_PORT_DESCRIPTOR (ret)->free)
- register_finalizer_for_port (ret);
-
return ret;
}
{
return scm_c_make_port_with_encoding (tag, mode_bits,
scm_i_default_port_encoding (),
- scm_i_get_conversion_strategy (SCM_BOOL_F),
+ scm_i_default_port_conversion_handler (),
stream);
}
SCM_VALIDATE_PORT (1, port);
if (SCM_CLOSEDP (port))
return SCM_BOOL_F;
- if (SCM_PORT_DESCRIPTOR (port)->close)
- rv = SCM_PORT_DESCRIPTOR (port)->close (port);
- else
- rv = 0;
p = SCM_PTAB_ENTRY (port);
-
- scm_port_non_buffer (p);
- SCM_SETPTAB_ENTRY (port, 0);
+ SCM_CLR_PORT_OPEN_FLAG (port);
if (SCM_PORT_DESCRIPTOR (port)->flags & SCM_PORT_TYPE_HAS_FLUSH)
scm_weak_set_remove_x (scm_i_port_weak_set, port);
- p->putback_buf = NULL;
- p->putback_buf_size = 0;
+ if (SCM_PORT_DESCRIPTOR (port)->close)
+ /* Note! This may throw an exception. Anything after this point
+ should be resilient to non-local exits. */
+ rv = SCM_PORT_DESCRIPTOR (port)->close (port);
+ else
+ rv = 0;
if (p->iconv_descriptors)
{
+ /* If we don't get here, the iconv_descriptors finalizer will
+ clean up. */
close_iconv_descriptors (p->iconv_descriptors);
p->iconv_descriptors = NULL;
}
- SCM_CLR_PORT_OPEN_FLAG (port);
-
return scm_from_bool (rv >= 0);
}
#undef FUNC_NAME
|| !strcmp (encoding, "ISO-8859-1"))
scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), SCM_BOOL_F);
else
- scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var),
- scm_from_locale_string (encoding));
+ {
+ SCM str;
+ size_t i;
+
+ str = scm_from_latin1_string (encoding);
+
+ /* Restrict to ASCII. */
+ for (i = 0; encoding[i]; i++)
+ if (encoding[i] > 127)
+ scm_misc_error ("scm_i_set_default_port_encoding",
+ "invalid character encoding ~s", scm_list_1 (str));
+
+ scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), str);
+ }
}
/* Return the name of the default encoding for newly created ports; a
}
}
+/* A fluid specifying the default conversion handler for newly created
+ ports. Its value should be one of the symbols below. */
+SCM_VARIABLE (default_conversion_strategy_var,
+ "%default-port-conversion-strategy");
+
+/* Whether the above fluid is initialized. */
+static int scm_conversion_strategy_init = 0;
+
+/* The possible conversion strategies. */
+SCM_SYMBOL (sym_error, "error");
+SCM_SYMBOL (sym_substitute, "substitute");
+SCM_SYMBOL (sym_escape, "escape");
+
+/* Return the default failed encoding conversion policy for new created
+ ports. */
+scm_t_string_failed_conversion_handler
+scm_i_default_port_conversion_handler (void)
+{
+ scm_t_string_failed_conversion_handler handler;
+
+ if (!scm_conversion_strategy_init
+ || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else
+ {
+ SCM fluid, value;
+
+ fluid = SCM_VARIABLE_REF (default_conversion_strategy_var);
+ value = scm_fluid_ref (fluid);
+
+ if (scm_is_eq (sym_substitute, value))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else if (scm_is_eq (sym_escape, value))
+ handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+ else
+ /* Default to 'error also when the fluid's value is not one of
+ the valid symbols. */
+ handler = SCM_FAILED_CONVERSION_ERROR;
+ }
+
+ return handler;
+}
+
+/* Use HANDLER as the default conversion strategy for future ports. */
+void
+scm_i_set_default_port_conversion_handler (scm_t_string_failed_conversion_handler
+ handler)
+{
+ SCM strategy;
+
+ if (!scm_conversion_strategy_init
+ || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
+ scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
+ SCM_EOL);
+
+ switch (handler)
+ {
+ case SCM_FAILED_CONVERSION_ERROR:
+ strategy = sym_error;
+ break;
+
+ case SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE:
+ strategy = sym_escape;
+ break;
+
+ case SCM_FAILED_CONVERSION_QUESTION_MARK:
+ strategy = sym_substitute;
+ break;
+
+ default:
+ abort ();
+ }
+
+ scm_fluid_set_x (SCM_VARIABLE_REF (default_conversion_strategy_var),
+ strategy);
+}
+
static void
-finalize_iconv_descriptors (GC_PTR ptr, GC_PTR data)
+finalize_iconv_descriptors (void *ptr, void *data)
{
close_iconv_descriptors (ptr);
}
{
scm_t_iconv_descriptors *id;
iconv_t input_cd, output_cd;
+ size_t i;
input_cd = (iconv_t) -1;
output_cd = (iconv_t) -1;
+ for (i = 0; encoding[i]; i++)
+ if (encoding[i] > 127)
+ goto invalid_encoding;
+
if (reading)
{
/* Open an input iconv conversion descriptor, from ENCODING
id->input_cd = input_cd;
id->output_cd = output_cd;
- {
- GC_finalization_proc prev_finalizer;
- GC_PTR prev_finalization_data;
-
- /* Register a finalizer to close the descriptors. */
- GC_REGISTER_FINALIZER_NO_ORDER (id, finalize_iconv_descriptors, 0,
- &prev_finalizer, &prev_finalization_data);
- }
+ /* Register a finalizer to close the descriptors. */
+ scm_i_set_finalizer (id, finalize_iconv_descriptors, NULL);
return id;
invalid_encoding:
{
SCM err;
- err = scm_from_locale_string (encoding);
+ err = scm_from_latin1_string (encoding);
scm_misc_error ("open_iconv_descriptors",
"invalid or unknown character encoding ~s",
scm_list_1 (err));
return pt->iconv_descriptors;
}
+/* The name of the encoding is itself encoded in ASCII. */
void
scm_i_set_port_encoding_x (SCM port, const char *encoding)
{
pt = SCM_PTAB_ENTRY (port);
prev = pt->iconv_descriptors;
- if (encoding == NULL)
- encoding = "ISO-8859-1";
-
- if (strcmp (encoding, "UTF-8") == 0)
+ if (encoding && strcmp (encoding, "UTF-8") == 0)
{
pt->encoding = "UTF-8";
pt->encoding_mode = SCM_PORT_ENCODING_MODE_UTF8;
pt->iconv_descriptors = NULL;
}
+ else if (!encoding || strcmp (encoding, "ISO-8859-1") == 0)
+ {
+ pt->encoding = "ISO-8859-1";
+ pt->encoding_mode = SCM_PORT_ENCODING_MODE_LATIN1;
+ pt->iconv_descriptors = NULL;
+ }
else
{
/* Open descriptors before mutating the port. */
pt = SCM_PTAB_ENTRY (port);
enc = pt->encoding;
if (enc)
- return scm_from_locale_string (pt->encoding);
+ return scm_from_latin1_string (pt->encoding);
else
return SCM_BOOL_F;
}
SCM_VALIDATE_PORT (1, port);
SCM_VALIDATE_STRING (2, enc);
- enc_str = scm_to_locale_string (enc);
+ enc_str = scm_to_latin1_string (enc);
scm_i_set_port_encoding_x (port, enc_str);
free (enc_str);
}
#undef FUNC_NAME
-
-/* This determines how conversions handle unconvertible characters. */
-SCM_GLOBAL_VARIABLE (scm_conversion_strategy, "%port-conversion-strategy");
-static int scm_conversion_strategy_init = 0;
-
-scm_t_string_failed_conversion_handler
-scm_i_get_conversion_strategy (SCM port)
-{
- SCM encoding;
-
- if (scm_is_false (port))
- {
- if (!scm_conversion_strategy_init
- || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
- return SCM_FAILED_CONVERSION_QUESTION_MARK;
- else
- {
- encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_conversion_strategy));
- if (scm_is_false (encoding))
- return SCM_FAILED_CONVERSION_QUESTION_MARK;
- else
- return (scm_t_string_failed_conversion_handler) scm_to_int (encoding);
- }
- }
- else
- {
- scm_t_port *pt;
- pt = SCM_PTAB_ENTRY (port);
- return pt->ilseq_handler;
- }
-
-}
-
-void
-scm_i_set_conversion_strategy_x (SCM port,
- scm_t_string_failed_conversion_handler handler)
-{
- SCM strategy;
- scm_t_port *pt;
-
- strategy = scm_from_int ((int) handler);
-
- if (scm_is_false (port))
- {
- /* Set the default encoding for future ports. */
- if (!scm_conversion_strategy_init
- || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
- scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
- SCM_EOL);
- scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), strategy);
- }
- else
- {
- /* Set the character encoding for this port. */
- pt = SCM_PTAB_ENTRY (port);
- pt->ilseq_handler = handler;
- }
-}
-
SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
1, 0, 0, (SCM port),
"Returns the behavior of the port when handling a character that\n"
SCM_VALIDATE_OPPORT (1, port);
- if (!scm_is_false (port))
+ if (scm_is_false (port))
+ h = scm_i_default_port_conversion_handler ();
+ else
{
+ scm_t_port *pt;
+
SCM_VALIDATE_OPPORT (1, port);
+ pt = SCM_PTAB_ENTRY (port);
+
+ h = pt->ilseq_handler;
}
- h = scm_i_get_conversion_strategy (port);
if (h == SCM_FAILED_CONVERSION_ERROR)
return scm_from_latin1_symbol ("error");
else if (h == SCM_FAILED_CONVERSION_QUESTION_MARK)
"this thread.\n")
#define FUNC_NAME s_scm_set_port_conversion_strategy_x
{
- SCM err;
- SCM qm;
- SCM esc;
-
- if (!scm_is_false (port))
- {
- SCM_VALIDATE_OPPORT (1, port);
- }
-
- err = scm_from_latin1_symbol ("error");
- if (scm_is_true (scm_eqv_p (sym, err)))
- {
- scm_i_set_conversion_strategy_x (port, SCM_FAILED_CONVERSION_ERROR);
- return SCM_UNSPECIFIED;
- }
+ scm_t_string_failed_conversion_handler handler;
- qm = scm_from_latin1_symbol ("substitute");
- if (scm_is_true (scm_eqv_p (sym, qm)))
- {
- scm_i_set_conversion_strategy_x (port,
- SCM_FAILED_CONVERSION_QUESTION_MARK);
- return SCM_UNSPECIFIED;
- }
+ if (scm_is_eq (sym, sym_error))
+ handler = SCM_FAILED_CONVERSION_ERROR;
+ else if (scm_is_eq (sym, sym_substitute))
+ handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+ else if (scm_is_eq (sym, sym_escape))
+ handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+ else
+ SCM_MISC_ERROR ("unknown conversion strategy ~s", scm_list_1 (sym));
- esc = scm_from_latin1_symbol ("escape");
- if (scm_is_true (scm_eqv_p (sym, esc)))
+ if (scm_is_false (port))
+ scm_i_set_default_port_conversion_handler (handler);
+ else
{
- scm_i_set_conversion_strategy_x (port,
- SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
- return SCM_UNSPECIFIED;
+ SCM_VALIDATE_OPPORT (1, port);
+ SCM_PTAB_ENTRY (port)->ilseq_handler = handler;
}
- SCM_MISC_ERROR ("unknown conversion behavior ~s", scm_list_1 (sym));
-
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
\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_i_pthread_mutex_t *lock;
- int ret;
-
- scm_c_lock_port (port, &lock);
- ret = SCM_REVEALED (port);
- if (lock)
- scm_i_pthread_mutex_unlock (lock);
-
- return ret;
-}
-
-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
-{
- port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPENPORT (1, port);
- return scm_from_int (scm_revealed_count (port));
-}
-#undef FUNC_NAME
-
-/* Set the revealed count for a port. */
-SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
- (SCM port, SCM rcount),
- "Sets the revealed count for a port to a given value.\n"
- "The return value is unspecified.")
-#define FUNC_NAME s_scm_set_port_revealed_x
-{
- int r;
- scm_i_pthread_mutex_t *lock;
-
- /* FIXME: It doesn't make sense to manipulate revealed counts on ports
- without a free function. */
-
- port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPENPORT (1, port);
- r = scm_to_int (rcount);
- scm_c_lock_port (port, &lock);
- SCM_REVEALED (port) = r;
- if (lock)
- scm_i_pthread_mutex_unlock (lock);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-/* Set the revealed count for a port. */
-SCM_DEFINE (scm_adjust_port_revealed_x, "adjust-port-revealed!", 2, 0, 0,
- (SCM port, SCM addend),
- "Add @var{addend} to the revealed count of @var{port}.\n"
- "The return value is unspecified.")
-#define FUNC_NAME s_scm_adjust_port_revealed_x
-{
- scm_i_pthread_mutex_t *lock;
- int a;
- port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPENPORT (1, port);
- a = scm_to_int (addend);
- scm_c_lock_port (port, &lock);
- SCM_REVEALED (port) += a;
- if (lock)
- scm_i_pthread_mutex_unlock (lock);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-\f
-
/* Input. */
int
#undef ASSERT_NOT_EOF
}
+/* Read an ISO-8859-1 codepoint (a byte) from PORT. On success, return
+ 0 and set *CODEPOINT to the codepoint that was read, fill BUF with
+ its UTF-8 representation, and set *LEN to the length in bytes.
+ Return `EILSEQ' on error. */
+static int
+get_latin1_codepoint (SCM port, scm_t_wchar *codepoint,
+ char buf[SCM_MBCHAR_BUF_SIZE], size_t *len)
+{
+ *codepoint = scm_get_byte_or_eof_unlocked (port);
+
+ if (*codepoint == EOF)
+ *len = 0;
+ else
+ {
+ *len = 1;
+ buf[0] = *codepoint;
+ }
+ return 0;
+}
+
/* Likewise, read a byte sequence from PORT, passing it through its
input conversion descriptor. */
static int
with the byte representation of the codepoint in PORT's encoding, and
set *LEN to the length in bytes of that representation. Return 0 on
success and an errno value on error. */
-static int
+static SCM_C_INLINE int
get_codepoint (SCM port, scm_t_wchar *codepoint,
char buf[SCM_MBCHAR_BUF_SIZE], size_t *len)
{
if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8)
err = get_utf8_codepoint (port, codepoint, (scm_t_uint8 *) buf, len);
+ else if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1)
+ err = get_latin1_codepoint (port, codepoint, buf, len);
else
err = get_iconv_codepoint (port, codepoint, buf, len);
return ret;
}
-/* move up to read_len chars from port's putback and/or read buffers
- into memory starting at dest. returns the number of chars moved. */
+/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
+ into memory starting at DEST. Return the number of bytes moved.
+ PORT's line/column numbers are left unchanged. */
size_t
scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
- size_t chars_read = 0;
+ size_t bytes_read = 0;
size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
if (from_buf > 0)
{
memcpy (dest, pt->read_pos, from_buf);
pt->read_pos += from_buf;
- chars_read += from_buf;
+ bytes_read += from_buf;
read_len -= from_buf;
dest += from_buf;
}
{
memcpy (dest, pt->saved_read_pos, from_buf);
pt->saved_read_pos += from_buf;
- chars_read += from_buf;
+ bytes_read += from_buf;
}
}
- return chars_read;
+
+ return bytes_read;
}
/* Clear a port's read buffers, returning the contents. */
scm_make_fluid_with_default (SCM_BOOL_F));
scm_port_encoding_init = 1;
- SCM_VARIABLE_SET (scm_conversion_strategy,
- scm_make_fluid_with_default
- (scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK)));
+ SCM_VARIABLE_SET (default_conversion_strategy_var,
+ scm_make_fluid_with_default (sym_substitute));
scm_conversion_strategy_init = 1;
-
+
/* These bindings are used when boot-9 turns `current-input-port' et
al into parameters. They are then removed from the guile module. */
scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
HCoop / bpt / guile.git / blobdiff