mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 20:30:28 +02:00
Code Activity

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

Browse source 
* 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.
This commit is contained in:
Han-Wen Nienhuys 2002-08-05 23:04:44 +00:00
parent 3d0f4c6292
commit ba1b222692
9 changed files with 74 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

5
doc/ref/ChangeLog
View file

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

8
doc/ref/scheme-memory.texi
View file

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

7
libguile/ChangeLog
View file

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

12
libguile/gc-malloc.c
View file

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

1
libguile/gc.h
View file

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

2
libguile/pairs.c
View file

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

84
libguile/read.c
View file

@ -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
#define snprintf sprintf
/*
should warn about buffer overflow?
*/
#endif
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); \
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);
}
#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;
}

4
test-suite/ChangeLog
View file

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

5
test-suite/tests/reader.test
View file

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