Commit d4a4d46c authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

more gc protection in ports and mainly the reader

parent a50afea3
......@@ -55,6 +55,7 @@ obp_t sweep_runner(obp_t obs, obp_t result)
obp_t rest = obs->next;
if (first->mark) {
first->mark = 0;
first->next = result;
return sweep_runner(rest, first);
} else {
......@@ -89,7 +90,7 @@ void gc(void)
traverse_ob(symbols, gc_mark, gc_stop_traverse);
fprintf(stderr, ".");
gc_sweep();
fprintf(stderr, " %u marked, %u freed, %u alloced, %u swept]\n",
fprintf(stderr, " %u marked, %u freed, %u alloced, %u swept]",
marked, freed, alloced, swept);
}
......
......@@ -14,6 +14,7 @@
#include "reader.h"
#include "eval.h"
#include "repl.h"
#include "gc.h"
obp_t the_Stdin;
obp_t the_Stdout;
......@@ -176,17 +177,26 @@ obp_t port_ungetc(obp_t port, int c)
obp_t port_getc(obp_t port)
{
obp_t retval;
PROTECT; protect(retval);
Lport_t *p = AS(port, PORT);
if (p->ungotten >= 0) {
obp_t ch = new_char(p->ungotten);
retval = new_char(p->ungotten);
p->ungotten = -1;
return ch;
goto EXIT;
}
obp_t string = port_read(port, 1);
CHECK_ERROR(string);
if (!string || IS_EXIT(string)) {
retval = string;
goto EXIT;
}
Lstring_t *s = AS(string, STRING);
return new_char(s->length ? s->content[0] : EOF);
retval = new_char(s->length ? s->content[0] : EOF);
EXIT:
UNPROT;
return retval;
}
obp_t port_read(obp_t port, uint len)
......@@ -279,14 +289,17 @@ void init_io(void)
the_Stdout = new_port(new_zstring("<stdout>"), stdout, -1, 0,
STREAM_PORT, 0, 1);
AS(get_symbol_z(STDOUT_PORT_NAME), SYMBOL)->value = the_Stdout;
protect(the_Stdout);
the_Stderr = new_port(new_zstring("<stderr>"), stderr, -1, 0,
STREAM_PORT, 0, 1);
AS(get_symbol_z(STDERR_PORT_NAME), SYMBOL)->value = the_Stderr;
protect(the_Stderr);
the_Stdin = new_port(new_zstring("<stdin>"), stdin, -1, 0,
STREAM_PORT, 1, 0);
AS(get_symbol_z(STDIN_PORT_NAME), SYMBOL)->value = the_Stdin;
protect(the_Stdin);
}
/* EOF */
......@@ -14,6 +14,7 @@
#include "io.h"
#include "reader.h"
#include "xmemory.h"
#include "gc.h"
#define TABWIDTH 8 /* assumed */
......@@ -440,19 +441,22 @@ obp_t do_special(char *name, reader_t rdr)
obp_t read_loop(token_t end_token, uint *n_exprs, reader_t rdr)
{
uint n = 0;
obp_t list = the_Nil; /* the whole collected list */
obp_t retval = the_Nil; /* the whole collected list */
obp_t last = 0; /* last element of the list */
obp_t expr;
obp_t pair;
PROTECT; protect4(retval, last, expr, pair);
while (1) {
obp_t expr;
token_t token = read_next_token(rdr);
if (token == end_token) {
*n_exprs = n;
return list;
break;
}
if (token == T_ENDOFF) {
ERROR(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected eof",
rdr->name, rdr->lineno, rdr->column);
retval = throw_error(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected eof",
rdr->name, rdr->lineno, rdr->column);
}
if (token == T_PERIOD) {
if (end_token != T_CPAREN || last == 0) {
......@@ -461,32 +465,40 @@ obp_t read_loop(token_t end_token, uint *n_exprs, reader_t rdr)
rdr->name, rdr->lineno, rdr->column);
}
expr = read_expr(rdr);
CHECK_ERROR(expr);
if (!expr || IS_EXIT(expr)) {
retval = expr;
break;
}
CDR(last) = expr;
/* now we need the closing paren */
token = read_next_token(rdr);
if (token != T_CPAREN) {
ERROR(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected %s",
rdr->name, rdr->lineno, rdr->column,
token_name[token]);
retval = throw_error(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected %s",
rdr->name, rdr->lineno,
rdr->column,
token_name[token]);
}
return list;
break;
}
pushback(token, rdr);
expr = read_expr(rdr);
CHECK_ERROR(expr);
obp_t pair = new_pair(expr, the_Nil);
if (list == the_Nil) {
list = pair;
if (!expr || IS_EXIT(expr)) {
retval = expr;
break;
}
pair = new_pair(expr, the_Nil);
if (retval == the_Nil) {
retval = pair;
} else {
CDR(last) = pair;
}
last = pair;
n++;
}
return list;
UNPROT;
return retval;
}
......@@ -510,77 +522,99 @@ obp_t reader_macro(reader_t rdr)
obp_t read_expr(reader_t rdr)
{
uint nelem;
obp_t retval;
PROTECT; protect(retval);
token_t token = read_next_token(rdr);
switch (token) {
case T_ISATOM:
return rdr->tok_atom;
retval = rdr->tok_atom;
break;
case T_OPAREN:
return read_loop(T_CPAREN, &nelem, rdr);
retval = read_loop(T_CPAREN, &nelem, rdr);
break;
case T_CPAREN:
ERROR(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected close paren",
rdr->name, rdr->lineno, rdr->column);
retval = throw_error(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected close paren",
rdr->name, rdr->lineno, rdr->column);
break;
case T_OBRACE: {
obp_t kvpairs = read_loop(T_CBRACE, &nelem, rdr);
CHECK_ERROR(kvpairs);
protect(kvpairs);
if (!kvpairs || IS_EXIT(kvpairs)) {
retval = kvpairs;
break;
}
obp_t map = new_map(EQ_EQV, 0);
protect(map);
hashmap_t hashmap = AS(map, MAP)->map;
while (kvpairs != the_Nil) {
obp_t first = CAR(kvpairs);
hashmap_put(hashmap, CAR(first), CDR(first));
kvpairs = CDR(kvpairs);
}
return (obp_t) map;
retval = map;
break;
}
case T_CBRACE:
ERROR(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected close brace",
rdr->name, rdr->lineno, rdr->column);
retval = throw_error(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected close brace",
rdr->name, rdr->lineno, rdr->column);
break;
case T_OBRACK: {
obp_t elems = read_loop(T_CBRACE, &nelem, rdr);
CHECK_ERROR(elems);
protect(elems);
if (!elems || IS_EXIT(elems)) {
retval = elems;
break;
}
obp_t vec = new_vector(nelem);
protect(vec);
while (elems != the_Nil) {
vector_append(vec, CAR(elems));
elems = CDR(elems);
}
return (obp_t) vec;
retval = vec;
break;
}
case T_CBRACK:
ERROR(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected close bracket",
rdr->name, rdr->lineno, rdr->column);
retval = throw_error(rdr->out_port, ERR_RSYNTAX, 0,
"%s:%d:%d: unexpected close bracket",
rdr->name, rdr->lineno, rdr->column);
break;
case T_SQUOTE:
return do_special(QUOTE_NAME, rdr);
retval = do_special(QUOTE_NAME, rdr);
break;
case T_QQUOTE:
return do_special(QUASIQUOTE_NAME, rdr);
retval = do_special(QUASIQUOTE_NAME, rdr);
break;
case T_UNQUOT:
return do_special(UNQUOTE_NAME, rdr);
retval = do_special(UNQUOTE_NAME, rdr);
break;
case T_SPLICE:
return do_special(SPLICE_NAME, rdr);
retval = do_special(SPLICE_NAME, rdr);
break;
case T_PERIOD:
ERROR(rdr->out_port, ERR_RSYNTAX, 0, "unexpected period");
retval = throw_error(rdr->out_port, ERR_RSYNTAX, 0,
"unexpected period");
break;
case T_ENDOFF:
return 0;
retval = 0;
break;
case T_LERROR:
return rdr->tok_atom;
retval = rdr->tok_atom;
break;
case T_RMACRO:
return reader_macro(rdr);
retval = reader_macro(rdr);
break;
default:
fprintf(stderr, "%s:%d:%d: invalid token type %d in parser",
rdr->name, rdr->lineno, rdr->column, token);
exit(EX_SOFTWARE);
break;
}
/* NOTREACHED */
return the_Nil;
UNPROT;
return retval;
}
......
#define GC_OBJ_COUNT 10000 /* gc every n objects */
#define GC_OBJ_COUNT 10000 /* gc every n objects */
#define HMAP_MAXLISTLEN 4 /* Maximum length of bucket lists. */
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment