Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-12 23:47:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

SEXP_USE_SAFE_ACCESSORS now works for [io]ports and sexp_vector_ref

Browse source
This commit is contained in:
Alex Shinn 2010-09-17 16:16:42 +00:00
parent ed84dbc2f1
commit f3901c1957
2 changed files with 32 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
include/chibi/sexp.h
View file

@ -610,17 +610,24 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#if SEXP_USE_SAFE_ACCESSORS
#define sexp_field(x, type, id, field) (*(((x) && sexp_check_tag(x, id)) ? &((x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, x, sexp_pointerp(x) ? sexp_pointer_tag(x) : -1), &(((sexp)NULL)->value.type.field))))
#define sexp_pred_field(x, type, pred, field) (*(((x) && pred(x)) ? &((x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, x, sexp_pointerp(x) ? sexp_pointer_tag(x) : -1), &(((sexp)NULL)->value.type.field))))
#define sexp_cpointer_field(x, field) (*(((x) && sexp_pointerp(x) && sexp_pointer_tag(x) >= SEXP_CPOINTER) ? &((x)->value.cpointer.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a cpointer\n", __FILE__, __LINE__, x, sexp_pointerp(x) ? sexp_pointer_tag(x) : -1), &(((sexp)NULL)->value.cpointer.field))))
#else
#define sexp_field(x, type, id, field) ((x)->value.type.field)
#define sexp_pred_field(x, type, pred, field) ((x)->value.type.field)
#define sexp_cpointer_field(x, field) ((x)->value.cpointer.field)
#endif
#define sexp_vector_length(x) (sexp_field(x, vector, SEXP_VECTOR, length))
#define sexp_vector_data(x) (sexp_field(x, vector, SEXP_VECTOR, data))
#if SEXP_USE_SAFE_ACCESSORS
#define sexp_vector_ref(x,i) (sexp_unbox_fixnum(i)>=0 && sexp_unbox_fixnum(i)<sexp_vector_length(x) ? sexp_vector_data(x)[sexp_unbox_fixnum(i)] : (fprintf(stderr, "vector-ref length out of range %s on line %d: vector %p (length %u): %d\n", __FILE__, __LINE__, x, sexp_vector_length(x), sexp_unbox_fixnum(i)), SEXP_VOID))
#define sexp_vector_set(x,i,v) (sexp_unbox_fixnum(i)>=0 && sexp_unbox_fixnum(i)<sexp_vector_length(x) ? sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v) : (fprintf(stderr, "vector-set! length out of range in %s on line %d: vector %p (length %u): %d\n", __FILE__, __LINE__, x, sexp_vector_length(x), sexp_unbox_fixnum(i)), SEXP_VOID))
#else
#define sexp_vector_ref(x,i) (sexp_vector_data(x)[sexp_unbox_fixnum(i)])
#define sexp_vector_set(x,i,v) (sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v))
#endif
#define sexp_procedure_num_args(x) (sexp_field(x, procedure, SEXP_PROCEDURE, num_args))
#define sexp_procedure_flags(x) (sexp_field(x, procedure, SEXP_PROCEDURE, flags))
@ -649,16 +656,16 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_symbol_data(x) (sexp_field(x, symbol, SEXP_SYMBOL, data))
#define sexp_symbol_length(x) (sexp_field(x, symbol, SEXP_SYMBOL, length))
#define sexp_port_stream(p) ((p)->value.port.stream)
#define sexp_port_name(p) ((p)->value.port.name)
#define sexp_port_line(p) ((p)->value.port.line)
#define sexp_port_openp(p) ((p)->value.port.openp)
#define sexp_port_no_closep(p) ((p)->value.port.no_closep)
#define sexp_port_sourcep(p) ((p)->value.port.sourcep)
#define sexp_port_cookie(p) ((p)->value.port.cookie)
#define sexp_port_buf(p) ((p)->value.port.buf)
#define sexp_port_size(p) ((p)->value.port.size)
#define sexp_port_offset(p) ((p)->value.port.offset)
#define sexp_port_stream(p) (sexp_pred_field(p, port, sexp_portp, stream))
#define sexp_port_name(p) (sexp_pred_field(p, port, sexp_portp, name))
#define sexp_port_line(p) (sexp_pred_field(p, port, sexp_portp, line))
#define sexp_port_openp(p) (sexp_pred_field(p, port, sexp_portp, openp))
#define sexp_port_no_closep(p) (sexp_pred_field(p, port, sexp_portp, no_closep))
#define sexp_port_sourcep(p) (sexp_pred_field(p, port, sexp_portp, sourcep))
#define sexp_port_cookie(p) (sexp_pred_field(p, port, sexp_portp, cookie))
#define sexp_port_buf(p) (sexp_pred_field(p, port, sexp_portp, buf))
#define sexp_port_size(p) (sexp_pred_field(p, port, sexp_portp, size))
#define sexp_port_offset(p) (sexp_pred_field(p, port, sexp_portp, offset))
#define sexp_exception_kind(x) (sexp_field(x, exception, SEXP_EXCEPTION, kind))
#define sexp_exception_message(x) (sexp_field(x, exception, SEXP_EXCEPTION, message))

24
lib/chibi/io/port.c
View file

@ -12,6 +12,13 @@
#define sexp_cookie_seek(vec) sexp_vector_ref((sexp)vec, SEXP_FOUR)
#define sexp_cookie_close(vec) sexp_vector_ref((sexp)vec, SEXP_FIVE)
#define sexp_cookie_ctx_set(vec, x) sexp_vector_set((sexp)vec, SEXP_ZERO, x)
#define sexp_cookie_buffer_set(vec, x) sexp_vector_set((sexp)vec, SEXP_ONE, x)
#define sexp_cookie_read_set(vec, x) sexp_vector_set((sexp)vec, SEXP_TWO, x)
#define sexp_cookie_write_set(vec, x) sexp_vector_set((sexp)vec, SEXP_THREE, x)
#define sexp_cookie_seek_set(vec, x) sexp_vector_set((sexp)vec, SEXP_FOUR, x)
#define sexp_cookie_close_set(vec, x) sexp_vector_set((sexp)vec, SEXP_FIVE, x)
#if ! SEXP_USE_BOEHM
static int sexp_in_heap_p (sexp_heap h, sexp p) {
for ( ; h; h = h->next)
@ -52,7 +59,7 @@ static ssize_t sexp_cookie_reader (void *cookie, char *buffer, size_t size)
ctx2 = sexp_last_context(ctx, (sexp*)&cookie);
sexp_gc_preserve2(ctx, ctx2, args);
if (size > sexp_string_length(sexp_cookie_buffer(vec)))
sexp_cookie_buffer(vec) = sexp_make_string(ctx, sexp_make_fixnum(size), SEXP_VOID);
sexp_cookie_buffer_set(vec, sexp_make_string(ctx, sexp_make_fixnum(size), SEXP_VOID));
args = sexp_list2(ctx, sexp_cookie_buffer(vec), sexp_make_fixnum(size));
res = sexp_apply(ctx, sexp_cookie_read(vec), args);
sexp_gc_release2(ctx);
@ -77,7 +84,7 @@ static ssize_t sexp_cookie_writer (void *cookie, const char *buffer, size_t size
ctx2 = sexp_last_context(ctx, (sexp*)&cookie);
sexp_gc_preserve2(ctx, ctx2, args);
if (size > sexp_string_length(sexp_cookie_buffer(vec)))
sexp_cookie_buffer(vec) = sexp_make_string(ctx, sexp_make_fixnum(size), SEXP_VOID);
sexp_cookie_buffer_set(vec, sexp_make_string(ctx, sexp_make_fixnum(size), SEXP_VOID));
memcpy(sexp_string_data(sexp_cookie_buffer(vec)), buffer, size);
args = sexp_list2(ctx, sexp_cookie_buffer(vec), sexp_make_fixnum(size));
res = sexp_apply(ctx, sexp_cookie_write(vec), args);
@ -152,13 +159,12 @@ static sexp sexp_make_custom_port (sexp ctx, sexp self, char *mode,
return sexp_type_exception(ctx, self, SEXP_PROCEDURE, close);
sexp_gc_preserve1(ctx, vec);
vec = sexp_make_vector(ctx, SEXP_SIX, SEXP_VOID);
sexp_cookie_ctx(vec) = ctx;
sexp_cookie_buffer(vec)
= sexp_make_string(ctx, sexp_make_fixnum(SEXP_PORT_BUFFER_SIZE), SEXP_VOID);
sexp_cookie_read(vec) = read;
sexp_cookie_write(vec) = write;
sexp_cookie_seek(vec) = seek;
sexp_cookie_close(vec) = close;
sexp_cookie_ctx_set(vec, ctx);
sexp_cookie_buffer_set(vec, sexp_make_string(ctx, sexp_make_fixnum(SEXP_PORT_BUFFER_SIZE), SEXP_VOID));
sexp_cookie_read_set(vec, read);
sexp_cookie_write_set(vec, write);
sexp_cookie_seek_set(vec, seek);
sexp_cookie_close_set(vec, close);
#if SEXP_BSD
in = funopen(vec,
(sexp_procedurep(read) ? sexp_cookie_reader : NULL),