From b24b5e13bf0de4825fcd8b5b36f454ef1ddc3493 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Thu, 2 Nov 2000 10:36:31 +0000 Subject: [PATCH] * Get rid of calls to SCM_ROSTRINGP. * 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. --- NEWS | 4 +++- RELEASE | 2 +- libguile/backtrace.c | 16 +++++++--------- libguile/fports.c | 14 +++++++------- libguile/gc.c | 6 ++++-- libguile/gh_data.c | 27 +++++++++------------------ libguile/goops.c | 2 +- libguile/objects.c | 2 +- libguile/ports.c | 5 +++-- libguile/ports.h | 1 + libguile/print.c | 23 ++++++++++++++++------- libguile/symbols.h | 4 ++-- 12 files changed, 55 insertions(+), 51 deletions(-) diff --git a/NEWS b/NEWS index 60db8e26d..5a9c3e204 100644 --- a/NEWS +++ b/NEWS @@ -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 diff --git a/RELEASE b/RELEASE index e2773c54d..37c17ffda 100644 --- a/RELEASE +++ b/RELEASE @@ -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]) diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 7a8ee3a47..6c2b4e3d8 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -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); diff --git a/libguile/fports.c b/libguile/fports.c index 658ab2675..046bdf60a 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -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; diff --git a/libguile/gc.c b/libguile/gc.c index fa6474296..222553d3a 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -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 */ +} /* diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 0e359dc54..abcf27808 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -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; diff --git a/libguile/goops.c b/libguile/goops.c index 83876e0d7..a470ab65a 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -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; } diff --git a/libguile/objects.c b/libguile/objects.c index 700662ba2..68836dea5 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -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; diff --git a/libguile/ports.c b/libguile/ports.c index fe7ea9003..3f952a60a 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -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 diff --git a/libguile/ports.h b/libguile/ports.h index b39c27fc1..0b12af557 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -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) diff --git a/libguile/print.c b/libguile/print.c index 16ac4e4f4..a7408491e 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -439,10 +439,15 @@ taloop: env = SCM_ENV (exp); scm_puts ("#', 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') diff --git a/libguile/symbols.h b/libguile/symbols.h index e742f18b5..6160afc49 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -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) -- 2.20.1