* tests/reader.test: change misc-error in read-error.

* read.c (scm_input_error): new function: give meaningful error
messages, and throw read-error

* gc-malloc.c (scm_calloc): add scm_calloc.

* scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc.
correct typos.

doc/ref/ChangeLog

@@ -1,3 +1,8 @@
+2002-08-06  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
+
+	* scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc.
+	correct typos.
+	
 2002-08-05  Marius Vollmer  <marius.vollmer@uni-dortmund.de>
 
 	* intro.texi, srfi-modules.texi: Added (use-modules (ice-9

doc/ref/scheme-memory.texi

@@ -7,11 +7,11 @@ This means that the memory used to store a Scheme string, say, is
 automatically reclaimed when no one is using this string any longer.
 This can work because Guile knows enough about its objects at run-time
 to be able to trace all references between them.  Thus, it can find
-all 'life' objects (objects that are still in use) by starting from a
+all 'live' objects (objects that are still in use) by starting from a
 known set of 'root' objects and following the links that these objects
 have to other objects, and so on.  The objects that are not reached by
 this recursive process can be considered 'dead' and their memory can
-be used for new objects.
+be  reused for new objects.
 
 When you are programming in Scheme, you don't need to worry about the
 garbage collector.  When programming in C, there are a few rules that
@@ -67,7 +67,9 @@ be freed by a garbage collection.  The memory can be freed with
 @code{free}.
 
 There is also @code{scm_gc_realloc} and @code{scm_realloc}, to be used
-in place of @code{realloc} when appropriate.
+in place of @code{realloc} when appropriate, @code{scm_gc_calloc} and
+@code{scm_calloc}, to be used in place of @code{calloc} when
+appropriate.
 
 For really specialized needs, take at look at
 @code{scm_gc_register_collectable_memory} and

libguile/ChangeLog

@@ -1,3 +1,10 @@
+2002-08-06  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
+
+	* read.c (scm_input_error): new function: give meaningful error
+	messages, and throw read-error
+
+	* gc-malloc.c (scm_calloc): add scm_calloc.
+
 2002-08-05  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
 
 	* tags.h: remove GC bits documentation from the tags table. 

libguile/gc-malloc.c

@@ -143,6 +143,18 @@ scm_malloc (size_t sz)
   return scm_realloc (NULL, sz);
 }
 
+/*
+  Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
+  SIZEOF_ELT)? --hwn
+ */
+void *
+scm_calloc (size_t sz)
+{
+  void * ptr = scm_realloc (NULL, sz);
+  memset (ptr, 0x0, sz);
+  return ptr;
+}
+
 
 char *
 scm_strndup (const char *str, size_t n)

libguile/gc.h

@@ -330,6 +330,7 @@ SCM_API int scm_in_heap_p (SCM value);
 SCM_API void scm_gc_sweep (void);
 
 SCM_API void *scm_malloc (size_t size);
+SCM_API void *scm_calloc (size_t size);
 SCM_API void *scm_realloc (void *mem, size_t size);
 SCM_API char *scm_strdup (const char *str);
 SCM_API char *scm_strndup (const char *str, size_t n);

libguile/pairs.c

@@ -54,7 +54,7 @@
 
 #if (SCM_DEBUG_PAIR_ACCESSES == 1)
 
-/~#include "libguile/ports.h"
+#include "libguile/ports.h"
 #include "libguile/strings.h"
 
 void scm_error_pair_access (SCM non_pair)

libguile/read.c

@@ -55,9 +55,10 @@
 #include "libguile/ports.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
+#include "libguile/strports.h"
 #include "libguile/vectors.h"
-
 #include "libguile/validate.h"
+
 #include "libguile/read.h"
 
 
@@ -80,58 +81,41 @@ scm_t_option scm_read_opts[] = {
 
   We use the format
 
-  MESSAGE
+  FILE:LINE:COL: MESSAGE
   This happened in ....
 
   This is not standard GNU format, but the test-suite likes the real
   message to be in front.
 
-  Hmmm.
-
-  Maybe this is a kludge? Perhaps we should throw (list EXPR FILENAME
-  LINENO COLUMNO), and have the exception handler sort out the error
-  message?Where does the handler live, what are the conventions for
-  the expression argument of the handler? How does this work for an
-  error message like
-
-Backtrace:
-In standard input:
-   4: 0* [list ...
-
-standard input:4:1: While evaluating arguments to list in expression (list a b):standard input:4:1: Unbound variable: a
-ABORT: (unbound-variable)
-
-
-
-  In any case, we would have to assemble that information anyway. 
  */
 
 
-#if 0
+static void
+scm_input_error(char const * function,
+		SCM port, const char * message, SCM arg)
+{
+  char *fn = SCM_STRINGP (SCM_FILENAME(port))
+    ? SCM_STRING_CHARS(SCM_FILENAME(port))
+    : "#<unknown port>";
 
-#ifndef HAVE_SNPRINTF
+  SCM string_port =  scm_open_output_string ();
-#define snprintf  sprintf
+  SCM string = SCM_EOL;
-/*
+  scm_simple_format (string_port,
-  should warn about buffer overflow? 
+		     scm_makfrom0str ("~A:~S:~S: ~A"),
- */
+		     scm_list_4 (scm_makfrom0str (fn),
-#endif
+				 scm_int2num (SCM_LINUM (port) + 1),
+				 scm_int2num (SCM_COL (port) + 1),
+				 scm_makfrom0str (message)));
 
-#define  INPUT_ERROR(port, message, arg) { 									\
+    
-      char s[1024];\
+  string = scm_get_output_string (string_port);
-      int fn_found =  SCM_STRINGP (SCM_FILENAME(port));\
+  scm_close_output_port (string_port);
-      char *fn = "";\
+  scm_error_scm (scm_str2symbol ("read-error"),
-      if (fn_found)\
+		 scm_makfrom0str (function),
-         fn = SCM_STRING_CHARS(SCM_FILENAME(port));\
+		 string,
-      snprintf (s, 1024, "%s\nThis happened in %s%s%s line %d column %d", message, \
+		 SCM_EOL,
-		fn_found ? "`" : "", \
+		 SCM_BOOL_F);
-		fn,\
-		fn_found ? "'" : "", \
-	       SCM_LINUM(port) + 1, SCM_COL(port) + 1);			\
-      SCM_MISC_ERROR(s, arg);											\
 }
-#else
-#define  INPUT_ERROR(port, message, arg) SCM_MISC_ERROR(message, arg)
-#endif
 
 
 SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, 
@@ -359,7 +343,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 	? scm_lreadrecparen (tok_buf, port, s_list, copy)
 	: scm_lreadparen (tok_buf, port, s_list, copy);
     case ')':
-      INPUT_ERROR(port,"unexpected \")\"", SCM_EOL);
+      scm_input_error (FUNC_NAME, port,"unexpected \")\"", SCM_EOL);
       goto tryagain;
     
     case '\'':
@@ -489,7 +473,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 	    if (scm_charnames[c]
 		&& (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf))))
 	      return SCM_MAKE_CHAR (scm_charnums[c]);
-	  INPUT_ERROR (port, "unknown # object", SCM_EOL);
+	  scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL);
 
 	  /* #:SYMBOL is a syntax for keywords supported in all contexts.  */
 	case ':':
@@ -519,7 +503,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 	      }
 	  }
 	unkshrp:
-	INPUT_ERROR (port, "Unknown # object: ~S",
+	scm_input_error (FUNC_NAME, port, "Unknown # object: ~S",
 		     scm_list_1 (SCM_MAKE_CHAR (c)));
 	}
 
@@ -528,7 +512,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
       while ('"' != (c = scm_getc (port)))
 	{
 	  if (c == EOF)
-	    INPUT_ERROR (port, "end of file in string constant", SCM_EOL);
+	    scm_input_error (FUNC_NAME, port, "end of file in string constant", SCM_EOL);
 
 	  while (j + 2 >= SCM_STRING_LENGTH (*tok_buf))
 	    scm_grow_tok_buf (tok_buf);
@@ -590,7 +574,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 	      c = SCM_STRING_CHARS (*tok_buf)[1];
 	      goto callshrp;
 	    }
-	  INPUT_ERROR (port, "unknown # object", SCM_EOL);
+	  scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL);
 	}
       goto tok;
 
@@ -721,7 +705,7 @@ scm_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
       ans = scm_lreadr (tok_buf, port, copy);
     closeit:
       if (')' != (c = scm_flush_ws (port, name)))
-	INPUT_ERROR (port, "missing close paren", SCM_EOL);
+	scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL);
       return ans;
     }
   ans = tl = scm_cons (tmp, SCM_EOL);
@@ -761,7 +745,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
     {
       ans = scm_lreadr (tok_buf, port, copy);
       if (')' != (c = scm_flush_ws (port, name)))
-	INPUT_ERROR (port, "missing close paren", SCM_EOL);
+	scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL);
       return ans;
     }
   /* Build the head of the list structure. */
@@ -785,7 +769,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
 				       : tmp,
 				       SCM_EOL));
 	  if (')' != (c = scm_flush_ws (port, name)))
-	    INPUT_ERROR (port, "missing close paren", SCM_EOL);
+	    scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL);
 	  goto exit;
 	}
 

test-suite/ChangeLog

@@ -1,3 +1,7 @@
+2002-08-06  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
+
+	* tests/reader.test: change misc-error in read-error.
+
 2002-07-13  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	* tests/goops.test: Added tests for define-generic and

test-suite/tests/reader.test

@@ -2,9 +2,10 @@
 ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
 
 (define exception:eof
-  (cons 'misc-error "^end of file"))
+  (cons 'read-error "end of file$"))
+
 (define exception:unexpected-rparen
-  (cons 'misc-error "^unexpected \")\""))
+  (cons 'read-error "unexpected \")\"$"))
 
 (define (read-string s)
   (with-input-from-string s (lambda () (read))))