* 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

@@ -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
 

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])

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_display (message, port);
-      scm_putc ('\n', 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))
+  if (SCM_SYMBOLP (pname) || SCM_STRINGP (pname) || SCM_MEMOIZEDP (source))
-    pname = a->subr;
-  if (SCM_ROSTRINGP (pname) || SCM_MEMOIZEDP (source))
     {
       display_header (source, a->port);
       display_expression (current_frame, pname, source, a->port);

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 name = SCM_FILENAME (exp);
-      scm_puts (SCM_ROSTRINGP (name)
+      if (SCM_STRINGP (name) || SCM_SYMBOLP (name))
-		? SCM_ROCHARS (name)
+	scm_display (name, port);
-		: SCM_PTOBNAME (SCM_PTOBNUM (exp)),
+      else
-		port);
+	scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
       scm_putc (' ', port);
       fdes = (SCM_FSTREAM (exp))->fdes;
       

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 */ 
+}
 
 
 /*

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,
+  SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3, "gh_set_substr");
-	      "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,
+  SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG3, "gh_scm2newsymbol");
-	      "gh_scm2newsymbol");
-
-  /* protect str from GC while we copy off its data */
-  scm_protect_object (sym);
 
   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;

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;
 }
 

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;

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
 

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)

libguile/print.c

@@ -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')

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)