1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 09:40:25 +02:00

(scm_i_mode_bits_n): New, for counted strings.

(scm_mode_bits): Use it.
(scm_c_port_for_each): Blocking GC does not seem to work, allocate
a vector normally and fill that instead of consing a list with a
blocked GC.

* strings.h, strings.c: (scm_i_string_chars, scm_i_string_length,
scm_i_string_writable_chars, scm_i_string_stop_writing): New, to
replace SCM_I_STRING_CHARS and SCM_I_STRING_LENGTH.  Updated all
uses.
(scm_i_make_string, scm_c_make_string): New, to replace
scm_allocate_string.  Updated all uses.
(SCM_STRINGP, SCM_STRING_CHARS, SCM_STRING_UCHARS,
SCM_STRING_LENGTH): Deprecated.
(scm_allocate_string, scm_take_str, scm_take0str, scm_mem2string,
scm_str2string, scm_makfrom0str, scm_makfrom0str_opt):
Discouraged.  Replaced all uses with scm_from_locale_string or
similar, as appropriate.
(scm_c_string_length, scm_c_string_ref, scm_c_string_set_x,
scm_c_substring, scm_c_substring_shared, scm_c_substring_copy,
scm_substring_shared, scm_substring_copy): New.

* symbols.c, symbols.h (SCM_SYMBOLP, SCM_SYMBOL_FUNC,
SCM_SET_SYMBOL_FUNC, SCM_SYMBOL_PROPS, SCM_SET_SYMBOL_PROPS,
SCM_SYMBOL_HASH, SCM_SYMBOL_INTERNED_P, scm_mem2symbol,
scm_str2symbol, scm_mem2uninterned_symbol): Discouraged.
(SCM_SYMBOL_LENGTH, SCM_SYMBOL_CHARS, scm_c_symbol2str):
Deprecated.
(SCM_MAKE_SYMBOL_TAG, SCM_SET_SYMBOL_LENGTH, SCM_SET_SYMBOL_CHARS,
SCM_PROP_SLOTS, SCM_SET_PROP_SLOTS): Removed.
(scm_is_symbol, scm_from_locale_symbol, scm_from_locale_symboln):
New, to replace scm_str2symbol and scm_mem2symbol, respectively.
Updated all uses.
(scm_gensym): Generate only the number suffix in the buffer, just
string-append the prefix.
This commit is contained in:
Marius Vollmer 2004-08-19 17:17:22 +00:00
parent 468e87a786
commit 3a5fb14dbc

View file

@ -39,6 +39,7 @@
#include "libguile/mallocs.h" #include "libguile/mallocs.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/ports.h" #include "libguile/ports.h"
#include "libguile/vectors.h"
#ifdef HAVE_STRING_H #ifdef HAVE_STRING_H
#include <string.h> #include <string.h>
@ -319,6 +320,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
#define FUNC_NAME s_scm_drain_input #define FUNC_NAME s_scm_drain_input
{ {
SCM result; SCM result;
char *data;
scm_t_port *pt; scm_t_port *pt;
long count; long count;
@ -329,9 +331,8 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
if (pt->read_buf == pt->putback_buf) if (pt->read_buf == pt->putback_buf)
count += pt->saved_read_end - pt->saved_read_pos; count += pt->saved_read_end - pt->saved_read_pos;
result = scm_allocate_string (count); result = scm_i_make_string (count, &data);
scm_take_from_input_buffers (port, SCM_I_STRING_CHARS (result), count); scm_take_from_input_buffers (port, data, count);
return result; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -668,16 +669,22 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
* See PORT FLAGS in scm.h * See PORT FLAGS in scm.h
*/ */
static long
scm_i_mode_bits_n (const char *modes, size_t n)
{
return (SCM_OPN
| (memchr (modes, 'r', n) || memchr (modes, '+', n) ? SCM_RDNG : 0)
| ( memchr (modes, 'w', n)
|| memchr (modes, 'a', n)
|| memchr (modes, '+', n) ? SCM_WRTNG : 0)
| (memchr (modes, '0', n) ? SCM_BUF0 : 0)
| (memchr (modes, 'l', n) ? SCM_BUFLINE : 0));
}
long long
scm_mode_bits (char *modes) scm_mode_bits (char *modes)
{ {
return (SCM_OPN return scm_i_mode_bits_n (modes, strlen (modes));
| (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
| ( strchr (modes, 'w')
|| strchr (modes, 'a')
|| strchr (modes, '+') ? SCM_WRTNG : 0)
| (strchr (modes, '0') ? SCM_BUF0 : 0)
| (strchr (modes, 'l') ? SCM_BUFLINE : 0));
} }
long long
@ -688,7 +695,8 @@ scm_i_mode_bits (SCM modes)
if (!scm_is_string (modes)) if (!scm_is_string (modes))
scm_wrong_type_arg_msg (NULL, 0, modes, "string"); scm_wrong_type_arg_msg (NULL, 0, modes, "string");
bits = scm_mode_bits (SCM_I_STRING_CHARS (modes)); bits = scm_i_mode_bits_n (scm_i_string_chars (modes),
scm_i_string_length (modes));
scm_remember_upto_here_1 (modes); scm_remember_upto_here_1 (modes);
return bits; return bits;
} }
@ -720,7 +728,7 @@ SCM_DEFINE (scm_port_mode, "port-mode", 1, 0, 0,
strcpy (modes, "w"); strcpy (modes, "w");
if (SCM_CELL_WORD_0 (port) & SCM_BUF0) if (SCM_CELL_WORD_0 (port) & SCM_BUF0)
strcat (modes, "0"); strcat (modes, "0");
return scm_mem2string (modes, strlen (modes)); return scm_from_locale_string (modes);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -798,26 +806,29 @@ void
scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data) scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data)
{ {
long i; long i;
size_t n;
SCM ports; SCM ports;
/* Even without pre-emptive multithreading, running arbitrary code /* Even without pre-emptive multithreading, running arbitrary code
while scanning the port table is unsafe because the port table while scanning the port table is unsafe because the port table
can change arbitrarily (from a GC, for example). So we build a can change arbitrarily (from a GC, for example). So we first
list in advance while blocking the GC. -mvo */ collect the ports into a vector. -mvo */
scm_mutex_lock (&scm_i_port_table_mutex); scm_mutex_lock (&scm_i_port_table_mutex);
scm_block_gc++; n = scm_i_port_table_size;
ports = SCM_EOL;
for (i = 0; i < scm_i_port_table_size; i++)
ports = scm_cons (scm_i_port_table[i]->port, ports);
scm_block_gc--;
scm_mutex_unlock (&scm_i_port_table_mutex); scm_mutex_unlock (&scm_i_port_table_mutex);
while (ports != SCM_EOL) ports = scm_make_vector (scm_from_size_t (n), SCM_BOOL_F);
{
proc (data, SCM_CAR (ports)); scm_mutex_lock (&scm_i_port_table_mutex);
ports = SCM_CDR (ports); if (n > scm_i_port_table_size)
} n = scm_i_port_table_size;
for (i = 0; i < n; i++)
SCM_VECTOR_SET (ports, i, scm_i_port_table[i]->port);
scm_mutex_unlock (&scm_i_port_table_mutex);
for (i = 0; i < n; i++)
proc (data, SCM_VECTOR_REF (ports, i));
} }
SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0, SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0,
@ -1322,7 +1333,7 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
else else
SCM_VALIDATE_OPINPORT (2, port); SCM_VALIDATE_OPINPORT (2, port);
scm_ungets (SCM_I_STRING_CHARS (str), SCM_I_STRING_LENGTH (str), port); scm_ungets (scm_i_string_chars (str), scm_i_string_length (str), port);
return str; return str;
} }