summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHan-Wen Nienhuys <hanwen@lilypond.org>2002-08-05 23:04:44 +0000
committerHan-Wen Nienhuys <hanwen@lilypond.org>2002-08-05 23:04:44 +0000
commitba1b222692b1ee69e51825397bf1368dffd1a28a (patch)
treebb5043e62736ffb13707dac7f52e43eef8604478
parent3d0f4c6292008ec9b8182455da2dcbe13053c8da (diff)
downloadguile-ba1b222692b1ee69e51825397bf1368dffd1a28a.tar.gz
* 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.
-rw-r--r--doc/ref/ChangeLog5
-rw-r--r--doc/ref/scheme-memory.texi8
-rw-r--r--libguile/ChangeLog7
-rw-r--r--libguile/gc-malloc.c14
-rw-r--r--libguile/gc.h1
-rw-r--r--libguile/pairs.c2
-rw-r--r--libguile/read.c88
-rw-r--r--test-suite/ChangeLog4
-rw-r--r--test-suite/tests/reader.test5
9 files changed, 75 insertions, 59 deletions
diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog
index 339082c3d..e836c2e05 100644
--- a/doc/ref/ChangeLog
+++ b/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
diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi
index 8f9d8e143..8fad86466 100644
--- a/doc/ref/scheme-memory.texi
+++ b/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
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 62b6a1e4b..5835323d0 100644
--- a/libguile/ChangeLog
+++ b/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.
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 2720ed8d8..86f2b50c1 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -142,7 +142,19 @@ 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)
diff --git a/libguile/gc.h b/libguile/gc.h
index bce48debd..7161e3805 100644
--- a/libguile/gc.h
+++ b/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);
diff --git a/libguile/pairs.c b/libguile/pairs.c
index 5fed8d078..0b66ee5ca 100644
--- a/libguile/pairs.c
+++ b/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)
diff --git a/libguile/read.c b/libguile/read.c
index 6b85d0fc8..8b0b0b2f4 100644
--- a/libguile/read.c
+++ b/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
-
-#ifndef HAVE_SNPRINTF
-#define snprintf sprintf
-/*
- should warn about buffer overflow?
- */
-#endif
+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>";
+
+ SCM string_port = scm_open_output_string ();
+ SCM string = SCM_EOL;
+ scm_simple_format (string_port,
+ scm_makfrom0str ("~A:~S:~S: ~A"),
+ scm_list_4 (scm_makfrom0str (fn),
+ scm_int2num (SCM_LINUM (port) + 1),
+ scm_int2num (SCM_COL (port) + 1),
+ scm_makfrom0str (message)));
-#define INPUT_ERROR(port, message, arg) { \
- char s[1024];\
- int fn_found = SCM_STRINGP (SCM_FILENAME(port));\
- char *fn = "";\
- if (fn_found)\
- fn = SCM_STRING_CHARS(SCM_FILENAME(port));\
- snprintf (s, 1024, "%s\nThis happened in %s%s%s line %d column %d", message, \
- fn_found ? "`" : "", \
- 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
+
+ string = scm_get_output_string (string_port);
+ scm_close_output_port (string_port);
+ scm_error_scm (scm_str2symbol ("read-error"),
+ scm_makfrom0str (function),
+ string,
+ SCM_EOL,
+ SCM_BOOL_F);
+}
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;
}
diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index da61a418f..0a6cca940 100644
--- a/test-suite/ChangeLog
+++ b/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
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 64bd05aa7..ab8d49e13 100644
--- a/test-suite/tests/reader.test
+++ b/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))))