mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* Get rid of calls to SCM_ROSTRINGP.

Browse source 
* Fix some string/symbol output problems with regards to substrings.
* Fix error output to prefer procedure name parameters over stack data.
* Use SCM_(SET_)?FILENAME where appropriate.
* Prefer calling scm_remember over scm_protect/unprotect_object calls.
This commit is contained in:
Dirk Herrmann 2000-11-02 10:36:31 +00:00
parent 66460dfba3
commit b24b5e13bf
12 changed files with 55 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

4
NEWS
View file

@ -227,7 +227,8 @@ SCM_ORD_SIG, SCM_NUM_SIGS, SCM_SYMBOL_SLOTS, SCM_SLOTS, SCM_SLOPPY_STRINGP,
SCM_VALIDATE_STRINGORSUBSTR, SCM_FREEP, SCM_NFREEP, SCM_CHARS, SCM_UCHARS,
SCM_VALIDATE_ROSTRING, SCM_VALIDATE_ROSTRING_COPY,
SCM_VALIDATE_NULLORROSTRING_COPY, SCM_ROLENGTH, SCM_LENGTH, SCM_HUGE_LENGTH,
SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR
SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_COERCE_SUBSTR,
SCM_ROSTRINGP
Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE.
Use scm_memory_error instead of SCM_NALLOC.
@ -238,6 +239,7 @@ Use a type specific accessor macro instead of SCM_CHARS/SCM_UCHARS.
Use a type specific accessor instead of SCM(_|_RO|_HUGE_)LENGTH.
Use SCM_VALIDATE_(SYMBOL|STRING) instead of SCM_VALIDATE_ROSTRING.
Use SCM_STRING_COERCE_0TERMINATION_X instead of SCM_COERCE_SUBSTR.
Use SCM_STRINGP or SCM_SYMBOLP instead of SCM_ROSTRINGP.
** Removed function: scm_struct_init

2
RELEASE
View file

@ -49,7 +49,7 @@ In release 1.6:
SCM_FREEP, SCM_NFREEP, SCM_CHARS, SCM_UCHARS, SCM_VALIDATE_ROSTRING,
SCM_VALIDATE_ROSTRING_COPY, SCM_VALIDATE_NULLORROSTRING_COPY, SCM_ROLENGTH,
SCM_LENGTH, SCM_HUGE_LENGTH, SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET,
SCM_COERCE_SUBSTR
SCM_COERCE_SUBSTR, SCM_ROSTRINGP
- remove scm_vector_set_length_x
- remove function scm_call_catching_errors
(replaced by catch functions from throw.[ch])

16
libguile/backtrace.c
View file

@ -110,15 +110,15 @@ display_header (SCM source, SCM port)
void
scm_display_error_message (SCM message, SCM args, SCM port)
{
if (SCM_ROSTRINGP (message) && SCM_NFALSEP (scm_list_p (args)))
if (SCM_STRINGP (message) && !SCM_FALSEP (scm_list_p (args)))
{
scm_simple_format (port, message, args);
scm_newline (port);
}
else
{
scm_prin1 (message, port, 0);
scm_putc ('\n', port);
scm_display (message, port);
scm_newline (port);
}
}
@ -131,7 +131,7 @@ display_expression (SCM frame,SCM pname,SCM source,SCM port)
pstate->fancyp = 1;
pstate->level = 2;
pstate->length = 3;
if (SCM_ROSTRINGP (pname))
if (SCM_SYMBOLP (pname) || SCM_STRINGP (pname))
{
if (SCM_FRAMEP (frame)
&& SCM_FRAME_EVAL_ARGS_P (frame))
@ -170,8 +170,8 @@ display_error_body (struct display_error_args *a)
{
SCM current_frame = SCM_BOOL_F;
SCM source = SCM_BOOL_F;
SCM pname = SCM_BOOL_F;
SCM prev_frame = SCM_BOOL_F;
SCM pname = a->subr;
if (SCM_DEBUGGINGP
&& SCM_STACKP (a->stack)
@ -182,13 +182,11 @@ display_error_body (struct display_error_args *a)
prev_frame = SCM_FRAME_PREV (current_frame);
if (!SCM_MEMOIZEDP (source) && !SCM_FALSEP (prev_frame))
source = SCM_FRAME_SOURCE (prev_frame);
if (SCM_FRAME_PROC_P (current_frame)
if (!SCM_SYMBOLP (pname) && !SCM_STRINGP (pname) && SCM_FRAME_PROC_P (current_frame)
&& SCM_EQ_P (scm_procedure_p (SCM_FRAME_PROC (current_frame)), SCM_BOOL_T))
pname = scm_procedure_name (SCM_FRAME_PROC (current_frame));
}
if (!SCM_ROSTRINGP (pname))
pname = a->subr;
if (SCM_ROSTRINGP (pname) || SCM_MEMOIZEDP (source))
if (SCM_SYMBOLP (pname) || SCM_STRINGP (pname) || SCM_MEMOIZEDP (source))
{
display_header (source, a->port);
display_expression (current_frame, pname, source, a->port);

14
libguile/fports.c
View file

@ -77,7 +77,7 @@ static void
scm_fport_buffer_add (SCM port, int read_size, int write_size)
{
struct scm_fport *fp = SCM_FSTREAM (port);
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port *pt = SCM_PTAB_ENTRY (port);
char *s_scm_fport_buffer_add = "scm_fport_buffer_add";
if (read_size == -1 || write_size == -1)
@ -377,7 +377,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
else
scm_fport_buffer_add (port, -1, -1);
}
SCM_PTAB_ENTRY (port)->file_name = name;
SCM_SET_FILENAME (port, name);
SCM_ALLOW_INTS;
return port;
}
@ -429,11 +429,11 @@ prinfport (SCM exp,SCM port,scm_print_state *pstate)
if (SCM_OPFPORTP (exp))
{
int fdes;
SCM name = SCM_PTAB_ENTRY (exp)->file_name;
scm_puts (SCM_ROSTRINGP (name)
? SCM_ROCHARS (name)
: SCM_PTOBNAME (SCM_PTOBNUM (exp)),
port);
SCM name = SCM_FILENAME (exp);
if (SCM_STRINGP (name) || SCM_SYMBOLP (name))
scm_display (name, port);
else
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
scm_putc (' ', port);
fdes = (SCM_FSTREAM (exp))->fdes;

6
libguile/gc.c
View file

@ -1319,7 +1319,7 @@ gc_mark_nimp:
if (!(i < scm_numptob))
goto def;
if (SCM_PTAB_ENTRY(ptr))
scm_gc_mark (SCM_PTAB_ENTRY(ptr)->file_name);
scm_gc_mark (SCM_FILENAME (ptr));
if (scm_ptobs[i].mark)
{
ptr = (scm_ptobs[i].mark) (ptr);
@ -2272,7 +2272,9 @@ SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0,
void
scm_remember (SCM *ptr)
{ /* empty */ }
{
/* empty */
}
/*

27
libguile/gh_data.c
View file

@ -113,18 +113,16 @@ gh_set_substr (char *src, SCM dst, int start, int len)
unsigned long dst_len;
unsigned long effective_length;
SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3,
"gh_set_substr");
SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3, "gh_set_substr");
dst_ptr = SCM_STRING_CHARS (dst);
dst_len = SCM_STRING_LENGTH (dst);
SCM_ASSERT (len >= 0 && (unsigned) len <= dst_len,
dst, SCM_ARG4, "gh_set_substr");
scm_protect_object (dst);
effective_length = ((unsigned) len < dst_len) ? len : dst_len;
memmove (dst_ptr + start, src, effective_length);
scm_unprotect_object (dst);
scm_remember (&dst);
}
/* Return the symbol named SYMBOL_STR. */
@ -539,19 +537,17 @@ gh_scm2newstr (SCM str, int *lenp)
SCM_ASSERT (SCM_STRINGP (str), str, SCM_ARG3, "gh_scm2newstr");
/* protect str from GC while we copy off its data */
scm_protect_object (str);
len = SCM_STRING_LENGTH (str);
ret_str = (char *) scm_must_malloc ((len + 1) * sizeof (char),
"gh_scm2newstr");
/* so we copy tmp_str to ret_str, which is what we will allocate */
memcpy (ret_str, SCM_ROCHARS (str), len); /* test ROCHARS here -twp */
/* from now on we don't mind if str gets GC collected. */
scm_remember (&str);
/* now make sure we null-terminate it */
ret_str[len] = '\0';
scm_unprotect_object (str);
if (lenp != NULL)
{
@ -575,12 +571,11 @@ gh_get_substr (SCM src, char *dst, int start, int len)
int src_len, effective_length;
SCM_ASSERT (SCM_STRINGP (src), src, SCM_ARG3, "gh_get_substr");
scm_protect_object (src);
src_len = SCM_STRING_LENGTH (src);
effective_length = (len < src_len) ? len : src_len;
memcpy (dst + start, SCM_ROCHARS (src), effective_length * sizeof (char));
/* FIXME: must signal an error if len > src_len */
scm_unprotect_object (src);
scm_remember (&src);
}
@ -597,23 +592,19 @@ gh_symbol2newstr (SCM sym, int *lenp)
char *ret_str;
int len;
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG3,
"gh_scm2newsymbol");
/* protect str from GC while we copy off its data */
scm_protect_object (sym);
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG3, "gh_scm2newsymbol");
len = SCM_SYMBOL_LENGTH (sym);
ret_str = (char *) scm_must_malloc ((len + 1) * sizeof (char),
"gh_symbol2newstr");
/* so we copy tmp_str to ret_str, which is what we will allocate */
/* so we copy sym to ret_str, which is what we will allocate */
memcpy (ret_str, SCM_SYMBOL_CHARS (sym), len);
/* from now on we don't mind if sym gets GC collected. */
scm_remember (&sym);
/* now make sure we null-terminate it */
ret_str[len] = '\0';
scm_unprotect_object (sym);
if (lenp != NULL)
{
*lenp = len;

2
libguile/goops.c
View file

@ -2479,7 +2479,7 @@ make_struct_class (void *closure, SCM key, SCM data, SCM prev)
if (SCM_NFALSEP (SCM_STRUCT_TABLE_NAME (data)))
SCM_SET_STRUCT_TABLE_CLASS (data,
scm_make_extended_class
(SCM_ROCHARS (SCM_STRUCT_TABLE_NAME (data))));
(SCM_SYMBOL_CHARS (SCM_STRUCT_TABLE_NAME (data))));
return SCM_UNSPECIFIED;
}

2
libguile/objects.c
View file

@ -191,7 +191,7 @@ scm_class_of (SCM x)
{
SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
SCM class = scm_make_extended_class (SCM_NFALSEP (name)
? SCM_ROCHARS (name)
? SCM_SYMBOL_CHARS (name)
: 0);
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
return class;

5
libguile/ports.c
View file

@ -1271,7 +1271,7 @@ SCM_DEFINE (scm_port_filename, "port-filename", 1, 0, 0,
{
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port);
return SCM_PTAB_ENTRY (port)->file_name;
return SCM_FILENAME (port);
}
#undef FUNC_NAME
@ -1286,7 +1286,8 @@ SCM_DEFINE (scm_set_port_filename_x, "set-port-filename!", 2, 0, 0,
port = SCM_COERCE_OUTPORT (port);
SCM_VALIDATE_OPENPORT (1,port);
/* We allow the user to set the filename to whatever he likes. */
return SCM_PTAB_ENTRY (port)->file_name = filename;
SCM_SET_FILENAME (port, filename);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

1
libguile/ports.h
View file

@ -169,6 +169,7 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
#define SCM_STREAM(x) (SCM_PTAB_ENTRY(x)->stream)
#define SCM_SETSTREAM(x,s) (SCM_PTAB_ENTRY(x)->stream = (scm_bits_t) (s))
#define SCM_FILENAME(x) (SCM_PTAB_ENTRY(x)->file_name)
#define SCM_SET_FILENAME(x, n) (SCM_PTAB_ENTRY(x)->file_name = (n))
#define SCM_LINUM(x) (SCM_PTAB_ENTRY(x)->line_number)
#define SCM_COL(x) (SCM_PTAB_ENTRY(x)->column_number)
#define SCM_REVEALED(x) (SCM_PTAB_ENTRY(x)->revealed)

23
libguile/print.c
View file

@ -439,10 +439,15 @@ taloop:
env = SCM_ENV (exp);
scm_puts ("#<procedure", port);
}
if (SCM_ROSTRINGP (name))
if (SCM_SYMBOLP (name))
{
scm_putc (' ', port);
scm_puts (SCM_ROCHARS (name), port);
scm_lfwrite (SCM_SYMBOL_CHARS (name), SCM_SYMBOL_LENGTH (name), port);
}
else if (SCM_STRINGP (name))
{
scm_putc (' ', port);
scm_lfwrite (SCM_ROCHARS (name), SCM_STRING_LENGTH (name), port);
}
if (!SCM_UNBNDP (code))
{
@ -505,7 +510,6 @@ taloop:
len = SCM_SYMBOL_LENGTH (exp);
str = SCM_SYMBOL_CHARS (exp);
scm_remember (&exp);
pos = 0;
weird = 0;
maybe_weird = 0;
@ -568,6 +572,7 @@ taloop:
}
if (pos < end)
scm_lfwrite (str + pos, end - pos, port);
scm_remember (&exp);
if (weird)
scm_lfwrite ("}#", 2, port);
break;
@ -664,7 +669,7 @@ taloop:
if (SCM_NFALSEP (name))
{
scm_putc (' ', port);
scm_puts (SCM_ROCHARS (name), port);
scm_display (name, port);
}
}
scm_putc ('>', port);
@ -972,6 +977,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
int fReturnString = 0;
int writingp;
char *start;
char *end;
char *p;
if (SCM_EQ_P (destination, SCM_BOOL_T))
@ -995,13 +1001,16 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (args);
start = SCM_ROCHARS (message);
for (p = start; *p != '\0'; ++p)
end = start + SCM_STRING_LENGTH (message);
for (p = start; p != end; ++p)
if (*p == '~')
{
if (SCM_IMP (args) || SCM_NCONSP (args))
if (!SCM_CONSP (args))
continue;
if (++p == end)
continue;
++p;
if (*p == 'A' || *p == 'a')
writingp = 0;
else if (*p == 'S' || *p == 's')

4
libguile/symbols.h
View file

@ -75,8 +75,6 @@ extern int scm_symhash_dim;
#define SCM_SYMBOL_HASH(X) (SCM_CELL_WORD_2 (X))
#define SCM_SET_SYMBOL_HASH(X, v) (SCM_SET_CELL_WORD_2 ((X), (v)))
#define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \
|| (SCM_TYP7(x) == scm_tc7_symbol)))
#define SCM_ROCHARS(x) ((SCM_TYP7 (x) == scm_tc7_substring) \
? (SCM_INUM (SCM_CADR (x)) + SCM_STRING_CHARS (SCM_CDDR (x))) \
: ((SCM_TYP7 (x) == scm_tc7_string) \
@ -133,6 +131,8 @@ extern void scm_init_symbols (void);
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
#define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \
|| (SCM_TYP7(x) == scm_tc7_symbol)))
#define SCM_ROLENGTH(x) SCM_LENGTH (x)
#define SCM_SUBSTRP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_substring))
#define SCM_COERCE_SUBSTR(x) SCM_STRING_COERCE_0TERMINATION_X (x)