use pic_malloc and pic_free in file.c
This commit is contained in:
parent
2e59b6ab04
commit
3df7d1dd71
|
@ -38,7 +38,7 @@ pic_print_backtrace(pic_state *pic, xFILE *file)
|
|||
assert(! pic_invalid_p(pic->err));
|
||||
|
||||
if (! pic_error_p(pic->err)) {
|
||||
xfprintf(file, "raise: ");
|
||||
xfprintf(pic, file, "raise: ");
|
||||
pic_fwrite(pic, pic->err, file);
|
||||
} else {
|
||||
struct pic_error *e;
|
||||
|
@ -46,14 +46,14 @@ pic_print_backtrace(pic_state *pic, xFILE *file)
|
|||
e = pic_error_ptr(pic->err);
|
||||
if (e->type != pic_intern_cstr(pic, "")) {
|
||||
pic_fwrite(pic, pic_obj_value(e->type), file);
|
||||
xfprintf(file, " ");
|
||||
xfprintf(pic, file, " ");
|
||||
}
|
||||
xfprintf(file, "error: ");
|
||||
xfprintf(pic, file, "error: ");
|
||||
pic_fwrite(pic, pic_obj_value(e->msg), file);
|
||||
xfprintf(file, "\n");
|
||||
xfprintf(pic, file, "\n");
|
||||
|
||||
/* TODO: print error irritants */
|
||||
|
||||
xfputs(pic_str_cstr(pic, e->stack), file);
|
||||
xfputs(pic, pic_str_cstr(pic, e->stack), file);
|
||||
}
|
||||
}
|
||||
|
|
|
@ -27,7 +27,7 @@ pic_warnf(pic_state *pic, const char *fmt, ...)
|
|||
err_line = pic_xvformat(pic, fmt, ap);
|
||||
va_end(ap);
|
||||
|
||||
xfprintf(pic_stderr(pic)->file, "warn: %s\n", pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line))));
|
||||
xfprintf(pic, pic_stderr(pic)->file, "warn: %s\n", pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line))));
|
||||
}
|
||||
|
||||
void
|
||||
|
|
|
@ -93,18 +93,15 @@ xFILE *xfunopen(void *cookie, int (*read)(void *, char *, int), int (*write)(voi
|
|||
return fp;
|
||||
}
|
||||
|
||||
int xfclose(xFILE *fp) {
|
||||
extern void free(void *); /* FIXME */
|
||||
|
||||
xfflush(fp);
|
||||
int xfclose(pic_state *pic, xFILE *fp) {
|
||||
xfflush(pic, fp);
|
||||
fp->flag = 0;
|
||||
if (fp->base != fp->buf)
|
||||
free(fp->base);
|
||||
pic_free(pic, fp->base);
|
||||
return fp->vtable.close(fp->vtable.cookie);
|
||||
}
|
||||
|
||||
int x_fillbuf(xFILE *fp) {
|
||||
extern void *malloc(size_t); /* FIXME */
|
||||
int x_fillbuf(pic_state *pic, xFILE *fp) {
|
||||
int bufsize;
|
||||
|
||||
if ((fp->flag & (X_READ|X_EOF|X_ERR)) != X_READ)
|
||||
|
@ -112,7 +109,7 @@ int x_fillbuf(xFILE *fp) {
|
|||
if (fp->base == NULL) {
|
||||
if ((fp->flag & X_UNBUF) == 0) {
|
||||
/* no buffer yet */
|
||||
if ((fp->base = malloc(XBUFSIZ)) == NULL) {
|
||||
if ((fp->base = pic_malloc(pic, XBUFSIZ)) == NULL) {
|
||||
/* can't get buffer, try unbuffered */
|
||||
fp->flag |= X_UNBUF;
|
||||
}
|
||||
|
@ -138,8 +135,7 @@ int x_fillbuf(xFILE *fp) {
|
|||
return (unsigned char) *fp->ptr++;
|
||||
}
|
||||
|
||||
int x_flushbuf(int x, xFILE *fp) {
|
||||
extern void *malloc(size_t); /* FIXME */
|
||||
int x_flushbuf(pic_state *pic, int x, xFILE *fp) {
|
||||
int num_written=0, bufsize=0;
|
||||
char c = x;
|
||||
|
||||
|
@ -147,7 +143,7 @@ int x_flushbuf(int x, xFILE *fp) {
|
|||
return EOF;
|
||||
if (fp->base == NULL && ((fp->flag & X_UNBUF) == 0)) {
|
||||
/* no buffer yet */
|
||||
if ((fp->base = malloc(XBUFSIZ)) == NULL) {
|
||||
if ((fp->base = pic_malloc(pic, XBUFSIZ)) == NULL) {
|
||||
/* couldn't allocate a buffer, so try unbuffered */
|
||||
fp->flag |= X_UNBUF;
|
||||
} else {
|
||||
|
@ -190,7 +186,7 @@ int x_flushbuf(int x, xFILE *fp) {
|
|||
}
|
||||
}
|
||||
|
||||
int xfflush(xFILE *f) {
|
||||
int xfflush(pic_state *pic, xFILE *f) {
|
||||
int retval;
|
||||
int i;
|
||||
|
||||
|
@ -198,48 +194,48 @@ int xfflush(xFILE *f) {
|
|||
if (f == NULL) {
|
||||
/* flush all output streams */
|
||||
for (i = 0; i < XOPEN_MAX; i++) {
|
||||
if ((x_iob[i].flag & X_WRITE) && (xfflush(&x_iob[i]) == -1))
|
||||
if ((x_iob[i].flag & X_WRITE) && (xfflush(pic, &x_iob[i]) == -1))
|
||||
retval = -1;
|
||||
}
|
||||
} else {
|
||||
if ((f->flag & X_WRITE) == 0)
|
||||
return -1;
|
||||
x_flushbuf(EOF, f);
|
||||
x_flushbuf(pic, EOF, f);
|
||||
if (f->flag & X_ERR)
|
||||
retval = -1;
|
||||
}
|
||||
return retval;
|
||||
}
|
||||
|
||||
int xfputc(int x, xFILE *fp) {
|
||||
return xputc(x, fp);
|
||||
int xfputc(pic_state *pic, int x, xFILE *fp) {
|
||||
return xputc(pic, x, fp);
|
||||
}
|
||||
|
||||
int xfgetc(xFILE *fp) {
|
||||
return xgetc(fp);
|
||||
int xfgetc(pic_state *pic, xFILE *fp) {
|
||||
return xgetc(pic, fp);
|
||||
}
|
||||
|
||||
int xfputs(const char *s, xFILE *stream) {
|
||||
int xfputs(pic_state *pic, const char *s, xFILE *stream) {
|
||||
const char *ptr = s;
|
||||
while(*ptr != '\0') {
|
||||
if (xputc(*ptr, stream) == EOF)
|
||||
if (xputc(pic, *ptr, stream) == EOF)
|
||||
return EOF;
|
||||
++ptr;
|
||||
}
|
||||
return (int)(ptr - s);
|
||||
}
|
||||
|
||||
char *xfgets(char *s, int size, xFILE *stream) {
|
||||
char *xfgets(pic_state *pic, char *s, int size, xFILE *stream) {
|
||||
int c;
|
||||
char *buf;
|
||||
|
||||
xfflush(NULL);
|
||||
xfflush(pic, NULL);
|
||||
|
||||
if (size == 0) {
|
||||
return NULL;
|
||||
}
|
||||
buf = s;
|
||||
while (--size > 0 && (c = xgetc(stream)) != EOF) {
|
||||
while (--size > 0 && (c = xgetc(pic, stream)) != EOF) {
|
||||
if ((*buf++ = c) == '\n')
|
||||
break;
|
||||
}
|
||||
|
@ -248,28 +244,28 @@ char *xfgets(char *s, int size, xFILE *stream) {
|
|||
return (c == EOF && buf == s) ? NULL : s;
|
||||
}
|
||||
|
||||
int xputs(const char *s) {
|
||||
int xputs(pic_state *pic, const char *s) {
|
||||
int i = 1;
|
||||
|
||||
while(*s != '\0') {
|
||||
if (xputchar(*s++) == EOF)
|
||||
if (xputchar(pic, *s++) == EOF)
|
||||
return EOF;
|
||||
i++;
|
||||
}
|
||||
if (xputchar('\n') == EOF) {
|
||||
if (xputchar(pic, '\n') == EOF) {
|
||||
return EOF;
|
||||
}
|
||||
return i;
|
||||
}
|
||||
|
||||
char *xgets(char *s) {
|
||||
char *xgets(pic_state *pic, char *s) {
|
||||
int c;
|
||||
char *buf;
|
||||
|
||||
xfflush(NULL);
|
||||
xfflush(pic, NULL);
|
||||
|
||||
buf = s;
|
||||
while ((c = xgetchar()) != EOF && c != '\n') {
|
||||
while ((c = xgetchar(pic)) != EOF && c != '\n') {
|
||||
*buf++ = c;
|
||||
}
|
||||
*buf = '\0';
|
||||
|
@ -287,7 +283,7 @@ int xungetc(int c, xFILE *fp) {
|
|||
return *--fp->ptr = uc;
|
||||
}
|
||||
|
||||
size_t xfread(void *ptr, size_t size, size_t count, xFILE *fp) {
|
||||
size_t xfread(pic_state *pic, void *ptr, size_t size, size_t count, xFILE *fp) {
|
||||
char *bptr = ptr;
|
||||
long nbytes;
|
||||
int c;
|
||||
|
@ -298,7 +294,7 @@ size_t xfread(void *ptr, size_t size, size_t count, xFILE *fp) {
|
|||
fp->ptr += fp->cnt;
|
||||
bptr += fp->cnt;
|
||||
nbytes -= fp->cnt;
|
||||
if ((c = x_fillbuf(fp)) == EOF) {
|
||||
if ((c = x_fillbuf(pic, fp)) == EOF) {
|
||||
return (size * count - nbytes) / size;
|
||||
} else {
|
||||
xungetc(c, fp);
|
||||
|
@ -310,7 +306,7 @@ size_t xfread(void *ptr, size_t size, size_t count, xFILE *fp) {
|
|||
return count;
|
||||
}
|
||||
|
||||
size_t xfwrite(const void *ptr, size_t size, size_t count, xFILE *fp) {
|
||||
size_t xfwrite(pic_state *pic, const void *ptr, size_t size, size_t count, xFILE *fp) {
|
||||
const char *bptr = ptr;
|
||||
long nbytes;
|
||||
|
||||
|
@ -320,7 +316,7 @@ size_t xfwrite(const void *ptr, size_t size, size_t count, xFILE *fp) {
|
|||
fp->ptr += fp->cnt;
|
||||
bptr += fp->cnt;
|
||||
nbytes -= fp->cnt;
|
||||
if (x_flushbuf(EOF, fp) == EOF) {
|
||||
if (x_flushbuf(pic, EOF, fp) == EOF) {
|
||||
return (size * count - nbytes) / size;
|
||||
}
|
||||
}
|
||||
|
@ -330,10 +326,10 @@ size_t xfwrite(const void *ptr, size_t size, size_t count, xFILE *fp) {
|
|||
return count;
|
||||
}
|
||||
|
||||
long xfseek(xFILE *fp, long offset, int whence) {
|
||||
long xfseek(pic_state *pic, xFILE *fp, long offset, int whence) {
|
||||
long s;
|
||||
|
||||
xfflush(fp);
|
||||
xfflush(pic, fp);
|
||||
|
||||
fp->ptr = fp->base;
|
||||
fp->cnt = 0;
|
||||
|
@ -344,36 +340,36 @@ long xfseek(xFILE *fp, long offset, int whence) {
|
|||
return 0;
|
||||
}
|
||||
|
||||
long xftell(xFILE *fp) {
|
||||
return xfseek(fp, 0, XSEEK_CUR);
|
||||
long xftell(pic_state *pic, xFILE *fp) {
|
||||
return xfseek(pic, fp, 0, XSEEK_CUR);
|
||||
}
|
||||
|
||||
void xrewind(xFILE *fp) {
|
||||
xfseek(fp, 0, XSEEK_SET);
|
||||
void xrewind(pic_state *pic, xFILE *fp) {
|
||||
xfseek(pic, fp, 0, XSEEK_SET);
|
||||
xclearerr(fp);
|
||||
}
|
||||
|
||||
int xprintf(const char *fmt, ...) {
|
||||
int xprintf(pic_state *pic, const char *fmt, ...) {
|
||||
va_list ap;
|
||||
int n;
|
||||
|
||||
va_start(ap, fmt);
|
||||
n = xvfprintf(xstdout, fmt, ap);
|
||||
n = xvfprintf(pic, xstdout, fmt, ap);
|
||||
va_end(ap);
|
||||
return n;
|
||||
}
|
||||
|
||||
int xfprintf(xFILE *stream, const char *fmt, ...) {
|
||||
int xfprintf(pic_state *pic, xFILE *stream, const char *fmt, ...) {
|
||||
va_list ap;
|
||||
int n;
|
||||
|
||||
va_start(ap, fmt);
|
||||
n = xvfprintf(stream, fmt, ap);
|
||||
n = xvfprintf(pic, stream, fmt, ap);
|
||||
va_end(ap);
|
||||
return n;
|
||||
}
|
||||
|
||||
static int print_int(xFILE *stream, long x, int base) {
|
||||
static int print_int(pic_state *pic, xFILE *stream, long x, int base) {
|
||||
static const char digits[] = "0123456789abcdef";
|
||||
char buf[20];
|
||||
int i, c, neg;
|
||||
|
@ -395,12 +391,12 @@ static int print_int(xFILE *stream, long x, int base) {
|
|||
|
||||
c = i;
|
||||
while (i-- > 0) {
|
||||
xputc(buf[i], stream);
|
||||
xputc(pic, buf[i], stream);
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
int xvfprintf(xFILE *stream, const char *fmt, va_list ap) {
|
||||
int xvfprintf(pic_state *pic, xFILE *stream, const char *fmt, va_list ap) {
|
||||
const char *p;
|
||||
char *sval;
|
||||
int ival;
|
||||
|
@ -412,7 +408,7 @@ int xvfprintf(xFILE *stream, const char *fmt, va_list ap) {
|
|||
|
||||
for (p = fmt; *p; p++) {
|
||||
if (*p != '%') {
|
||||
xputc(*p, stream);
|
||||
xputc(pic, *p, stream);
|
||||
cnt++;
|
||||
continue;
|
||||
}
|
||||
|
@ -420,42 +416,42 @@ int xvfprintf(xFILE *stream, const char *fmt, va_list ap) {
|
|||
case 'd':
|
||||
case 'i':
|
||||
ival = va_arg(ap, int);
|
||||
cnt += print_int(stream, ival, 10);
|
||||
cnt += print_int(pic, stream, ival, 10);
|
||||
break;
|
||||
#if PIC_ENABLE_FLOAT
|
||||
case 'f':
|
||||
dval = va_arg(ap, double);
|
||||
cnt += print_int(stream, dval, 10);
|
||||
xputc('.', stream);
|
||||
cnt += print_int(pic, stream, dval, 10);
|
||||
xputc(pic, '.', stream);
|
||||
cnt++;
|
||||
if ((ival = fabs((dval - floor(dval)) * 1e4) + 0.5) == 0) {
|
||||
cnt += xfputs("0000", stream);
|
||||
cnt += xfputs(pic, "0000", stream);
|
||||
} else {
|
||||
int i;
|
||||
for (i = 0; i < 3 - (int)log10(ival); ++i) {
|
||||
xputc('0', stream);
|
||||
xputc(pic, '0', stream);
|
||||
cnt++;
|
||||
}
|
||||
cnt += print_int(stream, ival, 10);
|
||||
cnt += print_int(pic, stream, ival, 10);
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
case 's':
|
||||
sval = va_arg(ap, char*);
|
||||
cnt += xfputs(sval, stream);
|
||||
cnt += xfputs(pic, sval, stream);
|
||||
break;
|
||||
case 'p':
|
||||
vp = va_arg(ap, void*);
|
||||
cnt += xfputs("0x", stream);
|
||||
cnt += print_int(stream, (long)vp, 16);
|
||||
cnt += xfputs(pic, "0x", stream);
|
||||
cnt += print_int(pic, stream, (long)vp, 16);
|
||||
break;
|
||||
case '%':
|
||||
xputc(*(p-1), stream);
|
||||
xputc(pic, *(p-1), stream);
|
||||
cnt++;
|
||||
break;
|
||||
default:
|
||||
xputc('%', stream);
|
||||
xputc(*(p-1), stream);
|
||||
xputc(pic, '%', stream);
|
||||
xputc(pic, *(p-1), stream);
|
||||
cnt += 2;
|
||||
break;
|
||||
}
|
||||
|
|
|
@ -42,7 +42,6 @@ extern "C" {
|
|||
|
||||
#include "picrin/xvect.h"
|
||||
#include "picrin/xhash.h"
|
||||
#include "picrin/file.h"
|
||||
|
||||
#include "picrin/value.h"
|
||||
|
||||
|
@ -72,6 +71,8 @@ typedef struct {
|
|||
|
||||
typedef void *(*pic_allocf)(void *, size_t);
|
||||
|
||||
typedef struct xFILE xFILE;
|
||||
|
||||
typedef struct {
|
||||
int argc;
|
||||
char **argv, **envp;
|
||||
|
@ -254,6 +255,7 @@ struct pic_port *pic_stderr(pic_state *);
|
|||
pic_value pic_write(pic_state *, pic_value); /* returns given obj */
|
||||
pic_value pic_fwrite(pic_state *, pic_value, xFILE *);
|
||||
void pic_printf(pic_state *, const char *, ...);
|
||||
void pic_fprintf(pic_state *, struct pic_port *, const char *, ...);
|
||||
pic_value pic_display(pic_state *, pic_value);
|
||||
pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
|
||||
|
||||
|
@ -281,6 +283,7 @@ pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
|
|||
#include "picrin/read.h"
|
||||
#include "picrin/vector.h"
|
||||
#include "picrin/reg.h"
|
||||
#include "picrin/file.h"
|
||||
|
||||
#if defined(__cplusplus)
|
||||
}
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
#ifndef XFILE_H
|
||||
#define XFILE_H
|
||||
#ifndef PICRIN_FILE_H
|
||||
#define PICRIN_FILE_H
|
||||
|
||||
#if defined(__cplusplus)
|
||||
extern "C" {
|
||||
|
@ -7,10 +7,6 @@ extern "C" {
|
|||
|
||||
#include <stdio.h>
|
||||
|
||||
#ifndef NULL
|
||||
# define NULL 0
|
||||
#endif
|
||||
|
||||
#ifndef EOF
|
||||
# define EOF (-1)
|
||||
#endif
|
||||
|
@ -18,7 +14,7 @@ extern "C" {
|
|||
#define XBUFSIZ 1024
|
||||
#define XOPEN_MAX 1024
|
||||
|
||||
typedef struct {
|
||||
struct xFILE {
|
||||
/* buffer */
|
||||
char buf[1]; /* fallback buffer */
|
||||
long cnt; /* characters left */
|
||||
|
@ -33,7 +29,7 @@ typedef struct {
|
|||
int (*close)(void *);
|
||||
} vtable;
|
||||
int flag; /* mode of the file access */
|
||||
} xFILE;
|
||||
};
|
||||
|
||||
extern xFILE x_iob[XOPEN_MAX];
|
||||
|
||||
|
@ -55,30 +51,30 @@ enum _flags {
|
|||
#define xferror(p) (((p)->flag & X_ERR) != 0)
|
||||
#define xfileno(p) ((p)->fd)
|
||||
|
||||
#define xgetc(p) \
|
||||
#define xgetc(pic, p) \
|
||||
((--(p)->cnt >= 0) \
|
||||
? (unsigned char) *(p)->ptr++ \
|
||||
: x_fillbuf(p))
|
||||
#define xputc(x, p) \
|
||||
: x_fillbuf((pic), p))
|
||||
#define xputc(pic, x, p) \
|
||||
((--(p)->cnt >= 0 && !(((p)->flag & X_LNBUF) && (x) == '\n')) \
|
||||
? *(p)->ptr++ = (x) \
|
||||
: x_flushbuf(x, (p)))
|
||||
#define xgetchar() xgetc(xstdin)
|
||||
#define xputchar(x) xputc((x), xstdout)
|
||||
: x_flushbuf((pic), (x), (p)))
|
||||
#define xgetchar(pic) xgetc((pic), xstdin)
|
||||
#define xputchar(pic, x) xputc((pic), (x), xstdout)
|
||||
|
||||
/* resource aquisition */
|
||||
xFILE *xfunopen(void *cookie, int (*read)(void *, char *, int), int (*write)(void *, const char *, int), long (*seek)(void *, long, int), int (*close)(void *));
|
||||
xFILE *xfopen(const char *, const char *);
|
||||
int xfclose(xFILE *);
|
||||
int xfclose(pic_state *, xFILE *);
|
||||
|
||||
/* buffer management */
|
||||
int x_fillbuf(xFILE *);
|
||||
int x_flushbuf(int, xFILE *);
|
||||
int xfflush(xFILE *);
|
||||
int x_fillbuf(pic_state *, xFILE *);
|
||||
int x_flushbuf(pic_state *, int, xFILE *);
|
||||
int xfflush(pic_state *, xFILE *);
|
||||
|
||||
/* direct IO */
|
||||
size_t xfread(void *, size_t, size_t, xFILE *);
|
||||
size_t xfwrite(const void *, size_t, size_t, xFILE *);
|
||||
size_t xfread(pic_state *, void *, size_t, size_t, xFILE *);
|
||||
size_t xfwrite(pic_state *, const void *, size_t, size_t, xFILE *);
|
||||
|
||||
enum {
|
||||
XSEEK_CUR,
|
||||
|
@ -87,22 +83,22 @@ enum {
|
|||
};
|
||||
|
||||
/* indicator positioning */
|
||||
long xfseek(xFILE *, long, int);
|
||||
long xftell(xFILE *);
|
||||
void xrewind(xFILE *);
|
||||
long xfseek(pic_state *, xFILE *, long, int);
|
||||
long xftell(pic_state *, xFILE *);
|
||||
void xrewind(pic_state *, xFILE *);
|
||||
|
||||
/* character IO */
|
||||
int xfputc(int, xFILE *);
|
||||
int xfgetc(xFILE *);
|
||||
int xfputs(const char *, xFILE *);
|
||||
char *xfgets(char *, int, xFILE *);
|
||||
int xputs(const char *);
|
||||
int xfputc(pic_state *, int, xFILE *);
|
||||
int xfgetc(pic_state *, xFILE *);
|
||||
int xfputs(pic_state *, const char *, xFILE *);
|
||||
char *xfgets(pic_state *, char *, int, xFILE *);
|
||||
int xputs(pic_state *, const char *);
|
||||
int xungetc(int, xFILE *);
|
||||
|
||||
/* formatted I/O */
|
||||
int xprintf(const char *, ...);
|
||||
int xfprintf(xFILE *, const char *, ...);
|
||||
int xvfprintf(xFILE *, const char *, va_list);
|
||||
int xprintf(pic_state *, const char *, ...);
|
||||
int xfprintf(pic_state *, xFILE *, const char *, ...);
|
||||
int xvfprintf(pic_state *, xFILE *, const char *, va_list);
|
||||
|
||||
#if defined(__cplusplus)
|
||||
}
|
||||
|
|
|
@ -574,7 +574,7 @@ pic_number_number_to_string(pic_state *pic)
|
|||
else {
|
||||
struct pic_port *port = pic_open_output_string(pic);
|
||||
|
||||
xfprintf(port->file, "%f", f);
|
||||
xfprintf(pic, port->file, "%f", f);
|
||||
|
||||
str = pic_get_output_string(pic, port);
|
||||
|
||||
|
|
|
@ -178,7 +178,7 @@ pic_get_output_string(pic_state *pic, struct pic_port *port)
|
|||
pic_errorf(pic, "get-output-string: port is not made by open-output-string");
|
||||
}
|
||||
|
||||
xfflush(port->file);
|
||||
xfflush(pic, port->file);
|
||||
|
||||
s = port->file->vtable.cookie;
|
||||
|
||||
|
@ -191,7 +191,7 @@ pic_close_port(pic_state *pic, struct pic_port *port)
|
|||
if ((port->flags & PIC_PORT_OPEN) == 0) {
|
||||
return;
|
||||
}
|
||||
if (xfclose(port->file) == EOF) {
|
||||
if (xfclose(pic, port->file) == EOF) {
|
||||
pic_errorf(pic, "close-port: failure");
|
||||
}
|
||||
port->flags &= ~PIC_PORT_OPEN;
|
||||
|
@ -431,7 +431,7 @@ pic_port_get_output_bytevector(pic_state *pic)
|
|||
pic_errorf(pic, "get-output-bytevector: port is not made by open-output-bytevector");
|
||||
}
|
||||
|
||||
xfflush(port->file);
|
||||
xfflush(pic, port->file);
|
||||
|
||||
s = port->file->vtable.cookie;
|
||||
|
||||
|
@ -451,7 +451,7 @@ pic_port_read_char(pic_state *pic)
|
|||
|
||||
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-char");
|
||||
|
||||
if ((c = xfgetc(port->file)) == EOF) {
|
||||
if ((c = xfgetc(pic, port->file)) == EOF) {
|
||||
return pic_eof_object();
|
||||
}
|
||||
else {
|
||||
|
@ -469,7 +469,7 @@ pic_port_peek_char(pic_state *pic)
|
|||
|
||||
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "peek-char");
|
||||
|
||||
if ((c = xfgetc(port->file)) == EOF) {
|
||||
if ((c = xfgetc(pic, port->file)) == EOF) {
|
||||
return pic_eof_object();
|
||||
}
|
||||
else {
|
||||
|
@ -490,8 +490,8 @@ pic_port_read_line(pic_state *pic)
|
|||
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_TEXT, "read-line");
|
||||
|
||||
buf = pic_open_output_string(pic);
|
||||
while ((c = xfgetc(port->file)) != EOF && c != '\n') {
|
||||
xfputc(c, buf->file);
|
||||
while ((c = xfgetc(pic, port->file)) != EOF && c != '\n') {
|
||||
xfputc(pic, c, buf->file);
|
||||
}
|
||||
|
||||
str = pic_get_output_string(pic, buf);
|
||||
|
@ -529,10 +529,10 @@ pic_port_read_string(pic_state *pic){
|
|||
c = EOF;
|
||||
buf = pic_open_output_string(pic);
|
||||
for(i = 0; i < k; ++i) {
|
||||
if((c = xfgetc(port->file)) == EOF){
|
||||
if((c = xfgetc(pic, port->file)) == EOF){
|
||||
break;
|
||||
}
|
||||
xfputc(c, buf->file);
|
||||
xfputc(pic, c, buf->file);
|
||||
}
|
||||
|
||||
str = pic_get_output_string(pic, buf);
|
||||
|
@ -552,7 +552,7 @@ pic_port_read_byte(pic_state *pic){
|
|||
pic_get_args(pic, "|p", &port);
|
||||
|
||||
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "read-u8");
|
||||
if ((c = xfgetc(port->file)) == EOF) {
|
||||
if ((c = xfgetc(pic, port->file)) == EOF) {
|
||||
return pic_eof_object();
|
||||
}
|
||||
|
||||
|
@ -569,7 +569,7 @@ pic_port_peek_byte(pic_state *pic)
|
|||
|
||||
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, "peek-u8");
|
||||
|
||||
c = xfgetc(port->file);
|
||||
c = xfgetc(pic, port->file);
|
||||
if (c == EOF) {
|
||||
return pic_eof_object();
|
||||
}
|
||||
|
@ -605,7 +605,7 @@ pic_port_read_blob(pic_state *pic)
|
|||
|
||||
blob = pic_make_blob(pic, k);
|
||||
|
||||
i = xfread(blob->data, sizeof(char), k, port->file);
|
||||
i = xfread(pic, blob->data, sizeof(char), k, port->file);
|
||||
if (i == 0) {
|
||||
return pic_eof_object();
|
||||
}
|
||||
|
@ -644,7 +644,7 @@ pic_port_read_blob_ip(pic_state *pic)
|
|||
len = end - start;
|
||||
|
||||
buf = pic_calloc(pic, len, sizeof(char));
|
||||
i = xfread(buf, sizeof(char), len, port->file);
|
||||
i = xfread(pic, buf, sizeof(char), len, port->file);
|
||||
memcpy(bv->data + start, buf, i);
|
||||
pic_free(pic, buf);
|
||||
|
||||
|
@ -665,7 +665,7 @@ pic_port_newline(pic_state *pic)
|
|||
|
||||
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "newline");
|
||||
|
||||
xfputs("\n", port->file);
|
||||
xfputs(pic, "\n", port->file);
|
||||
return pic_undef_value();
|
||||
}
|
||||
|
||||
|
@ -679,7 +679,7 @@ pic_port_write_char(pic_state *pic)
|
|||
|
||||
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "write-char");
|
||||
|
||||
xfputc(c, port->file);
|
||||
xfputc(pic, c, port->file);
|
||||
return pic_undef_value();
|
||||
}
|
||||
|
||||
|
@ -703,7 +703,7 @@ pic_port_write_string(pic_state *pic)
|
|||
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, "write-string");
|
||||
|
||||
for (i = start; i < end && str[i] != '\0'; ++i) {
|
||||
xfputc(str[i], port->file);
|
||||
xfputc(pic, str[i], port->file);
|
||||
}
|
||||
return pic_undef_value();
|
||||
}
|
||||
|
@ -718,7 +718,7 @@ pic_port_write_byte(pic_state *pic)
|
|||
|
||||
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "write-u8");
|
||||
|
||||
xfputc(i, port->file);
|
||||
xfputc(pic, i, port->file);
|
||||
return pic_undef_value();
|
||||
}
|
||||
|
||||
|
@ -743,7 +743,7 @@ pic_port_write_blob(pic_state *pic)
|
|||
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, "write-bytevector");
|
||||
|
||||
for (i = start; i < end; ++i) {
|
||||
xfputc(blob->data[i], port->file);
|
||||
xfputc(pic, blob->data[i], port->file);
|
||||
}
|
||||
return pic_undef_value();
|
||||
}
|
||||
|
@ -757,7 +757,7 @@ pic_port_flush(pic_state *pic)
|
|||
|
||||
assert_port_profile(port, PIC_PORT_OUT, "flush-output-port");
|
||||
|
||||
xfflush(port->file);
|
||||
xfflush(pic, port->file);
|
||||
return pic_undef_value();
|
||||
}
|
||||
|
||||
|
|
|
@ -18,39 +18,39 @@ read_error(pic_state *pic, const char *msg)
|
|||
}
|
||||
|
||||
static int
|
||||
skip(struct pic_port *port, int c)
|
||||
skip(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
while (isspace(c)) {
|
||||
c = xfgetc(port->file);
|
||||
c = xfgetc(pic, port->file);
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
static int
|
||||
next(struct pic_port *port)
|
||||
next(pic_state *pic, struct pic_port *port)
|
||||
{
|
||||
return xfgetc(port->file);
|
||||
return xfgetc(pic, port->file);
|
||||
}
|
||||
|
||||
static int
|
||||
peek(struct pic_port *port)
|
||||
peek(pic_state *pic, struct pic_port *port)
|
||||
{
|
||||
int c;
|
||||
|
||||
xungetc((c = xfgetc(port->file)), port->file);
|
||||
xungetc((c = xfgetc(pic, port->file)), port->file);
|
||||
|
||||
return c;
|
||||
}
|
||||
|
||||
static bool
|
||||
expect(struct pic_port *port, const char *str)
|
||||
expect(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
int c;
|
||||
|
||||
while ((c = (int)*str++) != 0) {
|
||||
if (c != peek(port))
|
||||
if (c != peek(pic, port))
|
||||
return false;
|
||||
next(port);
|
||||
next(pic, port);
|
||||
}
|
||||
|
||||
return true;
|
||||
|
@ -89,7 +89,7 @@ static pic_value
|
|||
read_comment(pic_state PIC_UNUSED(*pic), struct pic_port *port, int c)
|
||||
{
|
||||
do {
|
||||
c = next(port);
|
||||
c = next(pic, port);
|
||||
} while (! (c == EOF || c == '\n'));
|
||||
|
||||
return pic_invalid_value();
|
||||
|
@ -101,11 +101,11 @@ read_block_comment(pic_state PIC_UNUSED(*pic), struct pic_port *port, int PIC_UN
|
|||
int x, y;
|
||||
int i = 1;
|
||||
|
||||
y = next(port);
|
||||
y = next(pic, port);
|
||||
|
||||
while (y != EOF && i > 0) {
|
||||
x = y;
|
||||
y = next(port);
|
||||
y = next(pic, port);
|
||||
if (x == '|' && y == '#') {
|
||||
i--;
|
||||
}
|
||||
|
@ -120,7 +120,7 @@ read_block_comment(pic_state PIC_UNUSED(*pic), struct pic_port *port, int PIC_UN
|
|||
static pic_value
|
||||
read_datum_comment(pic_state *pic, struct pic_port *port, int PIC_UNUSED(c))
|
||||
{
|
||||
read(pic, port, next(port));
|
||||
read(pic, port, next(pic, port));
|
||||
|
||||
return pic_invalid_value();
|
||||
}
|
||||
|
@ -128,15 +128,15 @@ read_datum_comment(pic_state *pic, struct pic_port *port, int PIC_UNUSED(c))
|
|||
static pic_value
|
||||
read_directive(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
switch (peek(port)) {
|
||||
switch (peek(pic, port)) {
|
||||
case 'n':
|
||||
if (expect(port, "no-fold-case")) {
|
||||
if (expect(pic, port, "no-fold-case")) {
|
||||
pic->reader->typecase = PIC_CASE_DEFAULT;
|
||||
return pic_invalid_value();
|
||||
}
|
||||
break;
|
||||
case 'f':
|
||||
if (expect(port, "fold-case")) {
|
||||
if (expect(pic, port, "fold-case")) {
|
||||
pic->reader->typecase = PIC_CASE_FOLD;
|
||||
return pic_invalid_value();
|
||||
}
|
||||
|
@ -149,13 +149,13 @@ read_directive(pic_state *pic, struct pic_port *port, int c)
|
|||
static pic_value
|
||||
read_quote(pic_state *pic, struct pic_port *port, int PIC_UNUSED(c))
|
||||
{
|
||||
return pic_list2(pic, pic_obj_value(pic->sQUOTE), read(pic, port, next(port)));
|
||||
return pic_list2(pic, pic_obj_value(pic->sQUOTE), read(pic, port, next(pic, port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_quasiquote(pic_state *pic, struct pic_port *port, int PIC_UNUSED(c))
|
||||
{
|
||||
return pic_list2(pic, pic_obj_value(pic->sQUASIQUOTE), read(pic, port, next(port)));
|
||||
return pic_list2(pic, pic_obj_value(pic->sQUASIQUOTE), read(pic, port, next(pic, port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -163,23 +163,23 @@ read_unquote(pic_state *pic, struct pic_port *port, int PIC_UNUSED(c))
|
|||
{
|
||||
pic_sym *tag = pic->sUNQUOTE;
|
||||
|
||||
if (peek(port) == '@') {
|
||||
if (peek(pic, port) == '@') {
|
||||
tag = pic->sUNQUOTE_SPLICING;
|
||||
next(port);
|
||||
next(pic, port);
|
||||
}
|
||||
return pic_list2(pic, pic_obj_value(tag), read(pic, port, next(port)));
|
||||
return pic_list2(pic, pic_obj_value(tag), read(pic, port, next(pic, port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_syntax_quote(pic_state *pic, struct pic_port *port, int PIC_UNUSED(c))
|
||||
{
|
||||
return pic_list2(pic, pic_obj_value(pic->sSYNTAX_QUOTE), read(pic, port, next(port)));
|
||||
return pic_list2(pic, pic_obj_value(pic->sSYNTAX_QUOTE), read(pic, port, next(pic, port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_syntax_quasiquote(pic_state *pic, struct pic_port *port, int PIC_UNUSED(c))
|
||||
{
|
||||
return pic_list2(pic, pic_obj_value(pic->sSYNTAX_QUASIQUOTE), read(pic, port, next(port)));
|
||||
return pic_list2(pic, pic_obj_value(pic->sSYNTAX_QUASIQUOTE), read(pic, port, next(pic, port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -187,11 +187,11 @@ read_syntax_unquote(pic_state *pic, struct pic_port *port, int PIC_UNUSED(c))
|
|||
{
|
||||
pic_sym *tag = pic->sSYNTAX_UNQUOTE;
|
||||
|
||||
if (peek(port) == '@') {
|
||||
if (peek(pic, port) == '@') {
|
||||
tag = pic->sSYNTAX_UNQUOTE_SPLICING;
|
||||
next(port);
|
||||
next(pic, port);
|
||||
}
|
||||
return pic_list2(pic, pic_obj_value(tag), read(pic, port, next(port)));
|
||||
return pic_list2(pic, pic_obj_value(tag), read(pic, port, next(pic, port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -206,8 +206,8 @@ read_symbol(pic_state *pic, struct pic_port *port, int c)
|
|||
buf[0] = case_fold(pic, c);
|
||||
buf[1] = 0;
|
||||
|
||||
while (! isdelim(peek(port))) {
|
||||
c = next(port);
|
||||
while (! isdelim(peek(pic, port))) {
|
||||
c = next(pic, port);
|
||||
len += 1;
|
||||
buf = pic_realloc(pic, buf, len + 1);
|
||||
buf[len - 1] = case_fold(pic, c);
|
||||
|
@ -230,8 +230,8 @@ read_uinteger(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
u = c - '0';
|
||||
while (isdigit(c = peek(port))) {
|
||||
u = u * 10 + next(port) - '0';
|
||||
while (isdigit(c = peek(pic, port))) {
|
||||
u = u * 10 + next(pic, port) - '0';
|
||||
}
|
||||
|
||||
return u;
|
||||
|
@ -242,19 +242,19 @@ read_suffix(pic_state *pic, struct pic_port *port)
|
|||
{
|
||||
int c, s = 1;
|
||||
|
||||
c = peek(port);
|
||||
c = peek(pic, port);
|
||||
|
||||
if (c != 'e' && c != 'E') {
|
||||
return 0;
|
||||
}
|
||||
|
||||
next(port);
|
||||
next(pic, port);
|
||||
|
||||
switch ((c = next(port))) {
|
||||
switch ((c = next(pic, port))) {
|
||||
case '-':
|
||||
s = -1;
|
||||
case '+':
|
||||
c = next(port);
|
||||
c = next(pic, port);
|
||||
default:
|
||||
return s * read_uinteger(pic, port, c);
|
||||
}
|
||||
|
@ -271,13 +271,13 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c)
|
|||
|
||||
u = read_uinteger(pic, port, c);
|
||||
|
||||
switch (peek(port)) {
|
||||
switch (peek(pic, port)) {
|
||||
#if PIC_ENABLE_FLOAT
|
||||
case '.':
|
||||
next(port);
|
||||
next(pic, port);
|
||||
g = 0, e = 0;
|
||||
while (isdigit(c = peek(port))) {
|
||||
g = g * 10 + (next(port) - '0');
|
||||
while (isdigit(c = peek(pic, port))) {
|
||||
g = g * 10 + (next(pic, port) - '0');
|
||||
e++;
|
||||
}
|
||||
f = u + g * pow(10, -e);
|
||||
|
@ -348,8 +348,8 @@ read_minus(pic_state *pic, struct pic_port *port, int c)
|
|||
{
|
||||
pic_value sym;
|
||||
|
||||
if (isdigit(peek(port))) {
|
||||
return negate(read_unsigned(pic, port, next(port)));
|
||||
if (isdigit(peek(pic, port))) {
|
||||
return negate(read_unsigned(pic, port, next(pic, port)));
|
||||
}
|
||||
else {
|
||||
sym = read_symbol(pic, port, c);
|
||||
|
@ -370,8 +370,8 @@ read_plus(pic_state *pic, struct pic_port *port, int c)
|
|||
{
|
||||
pic_value sym;
|
||||
|
||||
if (isdigit(peek(port))) {
|
||||
return read_unsigned(pic, port, next(port));
|
||||
if (isdigit(peek(pic, port))) {
|
||||
return read_unsigned(pic, port, next(pic, port));
|
||||
}
|
||||
else {
|
||||
sym = read_symbol(pic, port, c);
|
||||
|
@ -390,8 +390,8 @@ read_plus(pic_state *pic, struct pic_port *port, int c)
|
|||
static pic_value
|
||||
read_true(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
if ((c = peek(port)) == 'r') {
|
||||
if (! expect(port, "rue")) {
|
||||
if ((c = peek(pic, port)) == 'r') {
|
||||
if (! expect(pic, port, "rue")) {
|
||||
read_error(pic, "unexpected character while reading #true");
|
||||
}
|
||||
} else if (! isdelim(c)) {
|
||||
|
@ -404,8 +404,8 @@ read_true(pic_state *pic, struct pic_port *port, int c)
|
|||
static pic_value
|
||||
read_false(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
if ((c = peek(port)) == 'a') {
|
||||
if (! expect(port, "alse")) {
|
||||
if ((c = peek(pic, port)) == 'a') {
|
||||
if (! expect(pic, port, "alse")) {
|
||||
read_error(pic, "unexpected character while reading #false");
|
||||
}
|
||||
} else if (! isdelim(c)) {
|
||||
|
@ -418,29 +418,29 @@ read_false(pic_state *pic, struct pic_port *port, int c)
|
|||
static pic_value
|
||||
read_char(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
c = next(port);
|
||||
c = next(pic, port);
|
||||
|
||||
if (! isdelim(peek(port))) {
|
||||
if (! isdelim(peek(pic, port))) {
|
||||
switch (c) {
|
||||
default: read_error(pic, "unexpected character after char literal");
|
||||
case 'a': c = '\a'; if (! expect(port, "lerm")) goto fail; break;
|
||||
case 'b': c = '\b'; if (! expect(port, "ackspace")) goto fail; break;
|
||||
case 'd': c = 0x7F; if (! expect(port, "elete")) goto fail; break;
|
||||
case 'e': c = 0x1B; if (! expect(port, "scape")) goto fail; break;
|
||||
case 'a': c = '\a'; if (! expect(pic, port, "lerm")) goto fail; break;
|
||||
case 'b': c = '\b'; if (! expect(pic, port, "ackspace")) goto fail; break;
|
||||
case 'd': c = 0x7F; if (! expect(pic, port, "elete")) goto fail; break;
|
||||
case 'e': c = 0x1B; if (! expect(pic, port, "scape")) goto fail; break;
|
||||
case 'n':
|
||||
if ((c = peek(port)) == 'e') {
|
||||
if ((c = peek(pic, port)) == 'e') {
|
||||
c = '\n';
|
||||
if (! expect(port, "ewline"))
|
||||
if (! expect(pic, port, "ewline"))
|
||||
goto fail;
|
||||
} else {
|
||||
c = '\0';
|
||||
if (! expect(port, "ull"))
|
||||
if (! expect(pic, port, "ull"))
|
||||
goto fail;
|
||||
}
|
||||
break;
|
||||
case 'r': c = '\r'; if (! expect(port, "eturn")) goto fail; break;
|
||||
case 's': c = ' '; if (! expect(port, "pace")) goto fail; break;
|
||||
case 't': c = '\t'; if (! expect(port, "ab")) goto fail; break;
|
||||
case 'r': c = '\r'; if (! expect(pic, port, "eturn")) goto fail; break;
|
||||
case 's': c = ' '; if (! expect(pic, port, "pace")) goto fail; break;
|
||||
case 't': c = '\t'; if (! expect(pic, port, "ab")) goto fail; break;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -463,9 +463,9 @@ read_string(pic_state *pic, struct pic_port *port, int c)
|
|||
|
||||
/* TODO: intraline whitespaces */
|
||||
|
||||
while ((c = next(port)) != '"') {
|
||||
while ((c = next(pic, port)) != '"') {
|
||||
if (c == '\\') {
|
||||
switch (c = next(port)) {
|
||||
switch (c = next(pic, port)) {
|
||||
case 'a': c = '\a'; break;
|
||||
case 'b': c = '\b'; break;
|
||||
case 't': c = '\t'; break;
|
||||
|
@ -498,9 +498,9 @@ read_pipe(pic_state *pic, struct pic_port *port, int c)
|
|||
size = 256;
|
||||
buf = pic_malloc(pic, size);
|
||||
cnt = 0;
|
||||
while ((c = next(port)) != '|') {
|
||||
while ((c = next(pic, port)) != '|') {
|
||||
if (c == '\\') {
|
||||
switch ((c = next(port))) {
|
||||
switch ((c = next(pic, port))) {
|
||||
case 'a': c = '\a'; break;
|
||||
case 'b': c = '\b'; break;
|
||||
case 't': c = '\t'; break;
|
||||
|
@ -508,7 +508,7 @@ read_pipe(pic_state *pic, struct pic_port *port, int c)
|
|||
case 'r': c = '\r'; break;
|
||||
case 'x':
|
||||
i = 0;
|
||||
while ((HEX_BUF[i++] = (char)next(port)) != ';') {
|
||||
while ((HEX_BUF[i++] = (char)next(pic, port)) != ';') {
|
||||
if (i >= sizeof HEX_BUF)
|
||||
read_error(pic, "expected ';'");
|
||||
}
|
||||
|
@ -539,7 +539,7 @@ read_blob(pic_state *pic, struct pic_port *port, int c)
|
|||
|
||||
nbits = 0;
|
||||
|
||||
while (isdigit(c = next(port))) {
|
||||
while (isdigit(c = next(pic, port))) {
|
||||
nbits = 10 * nbits + c - '0';
|
||||
}
|
||||
|
||||
|
@ -553,8 +553,8 @@ read_blob(pic_state *pic, struct pic_port *port, int c)
|
|||
|
||||
len = 0;
|
||||
dat = NULL;
|
||||
c = next(port);
|
||||
while ((c = skip(port, c)) != ')') {
|
||||
c = next(pic, port);
|
||||
while ((c = skip(pic, port, c)) != ')') {
|
||||
n = read_uinteger(pic, port, c);
|
||||
if (n < 0 || (1 << nbits) <= n) {
|
||||
read_error(pic, "invalid element in bytevector literal");
|
||||
|
@ -562,7 +562,7 @@ read_blob(pic_state *pic, struct pic_port *port, int c)
|
|||
len += 1;
|
||||
dat = pic_realloc(pic, dat, len);
|
||||
dat[len - 1] = (unsigned char)n;
|
||||
c = next(port);
|
||||
c = next(pic, port);
|
||||
}
|
||||
|
||||
blob = pic_make_blob(pic, len);
|
||||
|
@ -577,8 +577,8 @@ read_blob(pic_state *pic, struct pic_port *port, int c)
|
|||
static pic_value
|
||||
read_undef_or_blob(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
if ((c = peek(port)) == 'n') {
|
||||
if (! expect(port, "ndefined")) {
|
||||
if ((c = peek(pic, port)) == 'n') {
|
||||
if (! expect(pic, port, "ndefined")) {
|
||||
read_error(pic, "unexpected character while reading #undefined");
|
||||
}
|
||||
return pic_undef_value();
|
||||
|
@ -597,16 +597,16 @@ read_pair(pic_state *pic, struct pic_port *port, int c)
|
|||
|
||||
retry:
|
||||
|
||||
c = skip(port, ' ');
|
||||
c = skip(pic, port, ' ');
|
||||
|
||||
if (c == tCLOSE) {
|
||||
return pic_nil_value();
|
||||
}
|
||||
if (c == '.' && isdelim(peek(port))) {
|
||||
cdr = read(pic, port, next(port));
|
||||
if (c == '.' && isdelim(peek(pic, port))) {
|
||||
cdr = read(pic, port, next(pic, port));
|
||||
|
||||
closing:
|
||||
if ((c = skip(port, ' ')) != tCLOSE) {
|
||||
if ((c = skip(pic, port, ' ')) != tCLOSE) {
|
||||
if (pic_invalid_p(read_nullable(pic, port, c))) {
|
||||
goto closing;
|
||||
}
|
||||
|
@ -642,7 +642,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
|
|||
pic_value val;
|
||||
int c;
|
||||
|
||||
switch ((c = skip(port, ' '))) {
|
||||
switch ((c = skip(pic, port, ' '))) {
|
||||
case '(':
|
||||
{
|
||||
pic_value tmp;
|
||||
|
@ -661,7 +661,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
|
|||
{
|
||||
bool vect;
|
||||
|
||||
if (peek(port) == '(') {
|
||||
if (peek(pic, port) == '(') {
|
||||
vect = true;
|
||||
} else {
|
||||
vect = false;
|
||||
|
@ -714,7 +714,7 @@ read_label(pic_state *pic, struct pic_port *port, int c)
|
|||
i = 0;
|
||||
do {
|
||||
i = i * 10 + c - '0';
|
||||
} while (isdigit(c = next(port)));
|
||||
} while (isdigit(c = next(pic, port)));
|
||||
|
||||
if (c == '=') {
|
||||
return read_label_set(pic, port, i);
|
||||
|
@ -734,7 +734,7 @@ read_unmatch(pic_state *pic, struct pic_port PIC_UNUSED(*port), int PIC_UNUSED(c
|
|||
static pic_value
|
||||
read_dispatch(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
c = next(port);
|
||||
c = next(pic, port);
|
||||
|
||||
if (c == EOF) {
|
||||
read_error(pic, "unexpected EOF");
|
||||
|
@ -750,7 +750,7 @@ read_dispatch(pic_state *pic, struct pic_port *port, int c)
|
|||
static pic_value
|
||||
read_nullable(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
c = skip(port, c);
|
||||
c = skip(pic, port, c);
|
||||
|
||||
if (c == EOF) {
|
||||
read_error(pic, "unexpected EOF");
|
||||
|
@ -772,7 +772,7 @@ read(pic_state *pic, struct pic_port *port, int c)
|
|||
val = read_nullable(pic, port, c);
|
||||
|
||||
if (pic_invalid_p(val)) {
|
||||
c = next(port);
|
||||
c = next(pic, port);
|
||||
goto retry;
|
||||
}
|
||||
|
||||
|
@ -860,10 +860,10 @@ pic_value
|
|||
pic_read(pic_state *pic, struct pic_port *port)
|
||||
{
|
||||
pic_value val;
|
||||
int c = next(port);
|
||||
int c = next(pic, port);
|
||||
|
||||
retry:
|
||||
c = skip(port, c);
|
||||
c = skip(pic, port, c);
|
||||
|
||||
if (c == EOF) {
|
||||
return pic_eof_object();
|
||||
|
@ -872,7 +872,7 @@ pic_read(pic_state *pic, struct pic_port *port)
|
|||
val = read_nullable(pic, port, c);
|
||||
|
||||
if (pic_invalid_p(val)) {
|
||||
c = next(port);
|
||||
c = next(pic, port);
|
||||
goto retry;
|
||||
}
|
||||
|
||||
|
|
|
@ -437,7 +437,7 @@ pic_close(pic_state *pic)
|
|||
pic_gc_run(pic);
|
||||
|
||||
/* flush all xfiles */
|
||||
xfflush(NULL);
|
||||
xfflush(pic, NULL);
|
||||
|
||||
/* free heaps */
|
||||
pic_heap_close(pic, pic->heap);
|
||||
|
|
|
@ -310,7 +310,7 @@ pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
|
|||
while ((c = *fmt++)) {
|
||||
switch (c) {
|
||||
default:
|
||||
xfputc(c, file);
|
||||
xfputc(pic, c, file);
|
||||
break;
|
||||
case '%':
|
||||
c = *fmt++;
|
||||
|
@ -318,26 +318,26 @@ pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
|
|||
goto exit;
|
||||
switch (c) {
|
||||
default:
|
||||
xfputc(c, file);
|
||||
xfputc(pic, c, file);
|
||||
break;
|
||||
case '%':
|
||||
xfputc('%', file);
|
||||
xfputc(pic, '%', file);
|
||||
break;
|
||||
case 'c':
|
||||
xfprintf(file, "%c", va_arg(ap, int));
|
||||
xfprintf(pic, file, "%c", va_arg(ap, int));
|
||||
break;
|
||||
case 's':
|
||||
xfprintf(file, "%s", va_arg(ap, const char *));
|
||||
xfprintf(pic, file, "%s", va_arg(ap, const char *));
|
||||
break;
|
||||
case 'd':
|
||||
xfprintf(file, "%d", va_arg(ap, int));
|
||||
xfprintf(pic, file, "%d", va_arg(ap, int));
|
||||
break;
|
||||
case 'p':
|
||||
xfprintf(file, "%p", va_arg(ap, void *));
|
||||
xfprintf(pic, file, "%p", va_arg(ap, void *));
|
||||
break;
|
||||
#if PIC_ENABLE_FLOAT
|
||||
case 'f':
|
||||
xfprintf(file, "%f", va_arg(ap, double));
|
||||
xfprintf(pic, file, "%f", va_arg(ap, double));
|
||||
break;
|
||||
#endif
|
||||
}
|
||||
|
@ -348,13 +348,13 @@ pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
|
|||
goto exit;
|
||||
switch (c) {
|
||||
default:
|
||||
xfputc(c, file);
|
||||
xfputc(pic, c, file);
|
||||
break;
|
||||
case '~':
|
||||
xfputc('~', file);
|
||||
xfputc(pic, '~', file);
|
||||
break;
|
||||
case '%':
|
||||
xfputc('\n', file);
|
||||
xfputc(pic, '\n', file);
|
||||
break;
|
||||
case 'a':
|
||||
irrs = pic_cons(pic, pic_fdisplay(pic, va_arg(ap, pic_value), file), irrs);
|
||||
|
|
|
@ -111,6 +111,7 @@ static void write_core(struct writer_control *p, pic_value);
|
|||
static void
|
||||
write_pair(struct writer_control *p, struct pic_pair *pair)
|
||||
{
|
||||
pic_state *pic = p->pic;
|
||||
xh_entry *e;
|
||||
int c;
|
||||
|
||||
|
@ -123,27 +124,27 @@ write_pair(struct writer_control *p, struct pic_pair *pair)
|
|||
|
||||
/* shared objects */
|
||||
if ((e = xh_get_ptr(&p->labels, pic_obj_ptr(pair->cdr))) && xh_val(e, int) != -1) {
|
||||
xfprintf(p->file, " . ");
|
||||
xfprintf(pic, p->file, " . ");
|
||||
|
||||
if ((xh_get_ptr(&p->visited, pic_obj_ptr(pair->cdr)))) {
|
||||
xfprintf(p->file, "#%d#", xh_val(e, int));
|
||||
xfprintf(pic, p->file, "#%d#", xh_val(e, int));
|
||||
return;
|
||||
}
|
||||
else {
|
||||
xfprintf(p->file, "#%d=", xh_val(e, int));
|
||||
xfprintf(pic, p->file, "#%d=", xh_val(e, int));
|
||||
c = 1;
|
||||
xh_put_ptr(&p->visited, pic_obj_ptr(pair->cdr), &c);
|
||||
}
|
||||
}
|
||||
else {
|
||||
xfprintf(p->file, " ");
|
||||
xfprintf(pic, p->file, " ");
|
||||
}
|
||||
|
||||
write_pair(p, pic_pair_ptr(pair->cdr));
|
||||
return;
|
||||
}
|
||||
else {
|
||||
xfprintf(p->file, " . ");
|
||||
xfprintf(pic, p->file, " . ");
|
||||
write_core(p, pair->cdr);
|
||||
}
|
||||
}
|
||||
|
@ -156,9 +157,9 @@ write_str(pic_state *pic, struct pic_string *str, xFILE *file)
|
|||
|
||||
for (i = 0; i < pic_str_len(str); ++i) {
|
||||
if (cstr[i] == '"' || cstr[i] == '\\') {
|
||||
xfputc('\\', file);
|
||||
xfputc(pic, '\\', file);
|
||||
}
|
||||
xfputc(cstr[i], file);
|
||||
xfputc(pic, cstr[i], file);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -179,11 +180,11 @@ write_core(struct writer_control *p, pic_value obj)
|
|||
&& (e = xh_get_ptr(&p->labels, pic_obj_ptr(obj)))
|
||||
&& xh_val(e, int) != -1) {
|
||||
if ((xh_get_ptr(&p->visited, pic_obj_ptr(obj)))) {
|
||||
xfprintf(file, "#%d#", xh_val(e, int));
|
||||
xfprintf(pic, file, "#%d#", xh_val(e, int));
|
||||
return;
|
||||
}
|
||||
else {
|
||||
xfprintf(file, "#%d=", xh_val(e, int));
|
||||
xfprintf(pic, file, "#%d=", xh_val(e, int));
|
||||
c = 1;
|
||||
xh_put_ptr(&p->visited, pic_obj_ptr(obj), &c);
|
||||
}
|
||||
|
@ -191,122 +192,122 @@ write_core(struct writer_control *p, pic_value obj)
|
|||
|
||||
switch (pic_type(obj)) {
|
||||
case PIC_TT_UNDEF:
|
||||
xfprintf(file, "#undefined");
|
||||
xfprintf(pic, file, "#undefined");
|
||||
break;
|
||||
case PIC_TT_NIL:
|
||||
xfprintf(file, "()");
|
||||
xfprintf(pic, file, "()");
|
||||
break;
|
||||
case PIC_TT_BOOL:
|
||||
if (pic_true_p(obj))
|
||||
xfprintf(file, "#t");
|
||||
xfprintf(pic, file, "#t");
|
||||
else
|
||||
xfprintf(file, "#f");
|
||||
xfprintf(pic, file, "#f");
|
||||
break;
|
||||
case PIC_TT_PAIR:
|
||||
if (is_quote(pic, obj)) {
|
||||
xfprintf(file, "'");
|
||||
xfprintf(pic, file, "'");
|
||||
write_core(p, pic_list_ref(pic, obj, 1));
|
||||
break;
|
||||
}
|
||||
else if (is_unquote(pic, obj)) {
|
||||
xfprintf(file, ",");
|
||||
xfprintf(pic, file, ",");
|
||||
write_core(p, pic_list_ref(pic, obj, 1));
|
||||
break;
|
||||
}
|
||||
else if (is_unquote_splicing(pic, obj)) {
|
||||
xfprintf(file, ",@");
|
||||
xfprintf(pic, file, ",@");
|
||||
write_core(p, pic_list_ref(pic, obj, 1));
|
||||
break;
|
||||
}
|
||||
else if (is_quasiquote(pic, obj)) {
|
||||
xfprintf(file, "`");
|
||||
xfprintf(pic, file, "`");
|
||||
write_core(p, pic_list_ref(pic, obj, 1));
|
||||
break;
|
||||
}
|
||||
xfprintf(file, "(");
|
||||
xfprintf(pic, file, "(");
|
||||
write_pair(p, pic_pair_ptr(obj));
|
||||
xfprintf(file, ")");
|
||||
xfprintf(pic, file, ")");
|
||||
break;
|
||||
case PIC_TT_SYMBOL:
|
||||
xfprintf(file, "%s", pic_symbol_name(pic, pic_sym_ptr(obj)));
|
||||
xfprintf(pic, file, "%s", pic_symbol_name(pic, pic_sym_ptr(obj)));
|
||||
break;
|
||||
case PIC_TT_CHAR:
|
||||
if (p->mode == DISPLAY_MODE) {
|
||||
xfputc(pic_char(obj), file);
|
||||
xfputc(pic, pic_char(obj), file);
|
||||
break;
|
||||
}
|
||||
switch (pic_char(obj)) {
|
||||
default: xfprintf(file, "#\\%c", pic_char(obj)); break;
|
||||
case '\a': xfprintf(file, "#\\alarm"); break;
|
||||
case '\b': xfprintf(file, "#\\backspace"); break;
|
||||
case 0x7f: xfprintf(file, "#\\delete"); break;
|
||||
case 0x1b: xfprintf(file, "#\\escape"); break;
|
||||
case '\n': xfprintf(file, "#\\newline"); break;
|
||||
case '\r': xfprintf(file, "#\\return"); break;
|
||||
case ' ': xfprintf(file, "#\\space"); break;
|
||||
case '\t': xfprintf(file, "#\\tab"); break;
|
||||
default: xfprintf(pic, file, "#\\%c", pic_char(obj)); break;
|
||||
case '\a': xfprintf(pic, file, "#\\alarm"); break;
|
||||
case '\b': xfprintf(pic, file, "#\\backspace"); break;
|
||||
case 0x7f: xfprintf(pic, file, "#\\delete"); break;
|
||||
case 0x1b: xfprintf(pic, file, "#\\escape"); break;
|
||||
case '\n': xfprintf(pic, file, "#\\newline"); break;
|
||||
case '\r': xfprintf(pic, file, "#\\return"); break;
|
||||
case ' ': xfprintf(pic, file, "#\\space"); break;
|
||||
case '\t': xfprintf(pic, file, "#\\tab"); break;
|
||||
}
|
||||
break;
|
||||
#if PIC_ENABLE_FLOAT
|
||||
case PIC_TT_FLOAT:
|
||||
f = pic_float(obj);
|
||||
if (isnan(f)) {
|
||||
xfprintf(file, signbit(f) ? "-nan.0" : "+nan.0");
|
||||
xfprintf(pic, file, signbit(f) ? "-nan.0" : "+nan.0");
|
||||
} else if (isinf(f)) {
|
||||
xfprintf(file, signbit(f) ? "-inf.0" : "+inf.0");
|
||||
xfprintf(pic, file, signbit(f) ? "-inf.0" : "+inf.0");
|
||||
} else {
|
||||
xfprintf(file, "%f", pic_float(obj));
|
||||
xfprintf(pic, file, "%f", pic_float(obj));
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
case PIC_TT_INT:
|
||||
xfprintf(file, "%d", pic_int(obj));
|
||||
xfprintf(pic, file, "%d", pic_int(obj));
|
||||
break;
|
||||
case PIC_TT_EOF:
|
||||
xfprintf(file, "#.(eof-object)");
|
||||
xfprintf(pic, file, "#.(eof-object)");
|
||||
break;
|
||||
case PIC_TT_STRING:
|
||||
if (p->mode == DISPLAY_MODE) {
|
||||
xfprintf(file, "%s", pic_str_cstr(pic, pic_str_ptr(obj)));
|
||||
xfprintf(pic, file, "%s", pic_str_cstr(pic, pic_str_ptr(obj)));
|
||||
break;
|
||||
}
|
||||
xfprintf(file, "\"");
|
||||
xfprintf(pic, file, "\"");
|
||||
write_str(pic, pic_str_ptr(obj), file);
|
||||
xfprintf(file, "\"");
|
||||
xfprintf(pic, file, "\"");
|
||||
break;
|
||||
case PIC_TT_VECTOR:
|
||||
xfprintf(file, "#(");
|
||||
xfprintf(pic, file, "#(");
|
||||
for (i = 0; i < pic_vec_ptr(obj)->len; ++i) {
|
||||
write_core(p, pic_vec_ptr(obj)->data[i]);
|
||||
if (i + 1 < pic_vec_ptr(obj)->len) {
|
||||
xfprintf(file, " ");
|
||||
xfprintf(pic, file, " ");
|
||||
}
|
||||
}
|
||||
xfprintf(file, ")");
|
||||
xfprintf(pic, file, ")");
|
||||
break;
|
||||
case PIC_TT_BLOB:
|
||||
xfprintf(file, "#u8(");
|
||||
xfprintf(pic, file, "#u8(");
|
||||
for (i = 0; i < pic_blob_ptr(obj)->len; ++i) {
|
||||
xfprintf(file, "%d", pic_blob_ptr(obj)->data[i]);
|
||||
xfprintf(pic, file, "%d", pic_blob_ptr(obj)->data[i]);
|
||||
if (i + 1 < pic_blob_ptr(obj)->len) {
|
||||
xfprintf(file, " ");
|
||||
xfprintf(pic, file, " ");
|
||||
}
|
||||
}
|
||||
xfprintf(file, ")");
|
||||
xfprintf(pic, file, ")");
|
||||
break;
|
||||
case PIC_TT_DICT:
|
||||
xfprintf(file, "#.(dictionary");
|
||||
xfprintf(pic, file, "#.(dictionary");
|
||||
for (it = xh_begin(&pic_dict_ptr(obj)->hash); it != NULL; it = xh_next(it)) {
|
||||
xfprintf(file, " '%s ", pic_symbol_name(pic, xh_key(it, pic_sym *)));
|
||||
xfprintf(pic, file, " '%s ", pic_symbol_name(pic, xh_key(it, pic_sym *)));
|
||||
write_core(p, xh_val(it, pic_value));
|
||||
}
|
||||
xfprintf(file, ")");
|
||||
xfprintf(pic, file, ")");
|
||||
break;
|
||||
case PIC_TT_ID:
|
||||
xfprintf(file, "#<identifier %s>", pic_symbol_name(pic, pic_var_name(pic, obj)));
|
||||
xfprintf(pic, file, "#<identifier %s>", pic_symbol_name(pic, pic_var_name(pic, obj)));
|
||||
break;
|
||||
default:
|
||||
xfprintf(file, "#<%s %p>", pic_type_repr(pic_type(obj)), pic_ptr(obj));
|
||||
xfprintf(pic, file, "#<%s %p>", pic_type_repr(pic_type(obj)), pic_ptr(obj));
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
@ -377,7 +378,7 @@ pic_value
|
|||
pic_fwrite(pic_state *pic, pic_value obj, xFILE *file)
|
||||
{
|
||||
write(pic, obj, file);
|
||||
xfflush(file);
|
||||
xfflush(pic, file);
|
||||
return obj;
|
||||
}
|
||||
|
||||
|
@ -391,7 +392,7 @@ pic_value
|
|||
pic_fdisplay(pic_state *pic, pic_value obj, xFILE *file)
|
||||
{
|
||||
display(pic, obj, file);
|
||||
xfflush(file);
|
||||
xfflush(pic, file);
|
||||
return obj;
|
||||
}
|
||||
|
||||
|
@ -408,8 +409,8 @@ pic_printf(pic_state *pic, const char *fmt, ...)
|
|||
|
||||
va_end(ap);
|
||||
|
||||
xfprintf(file, "%s", pic_str_cstr(pic, str));
|
||||
xfflush(file);
|
||||
xfprintf(pic, file, "%s", pic_str_cstr(pic, str));
|
||||
xfflush(pic, file);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
|
Loading…
Reference in New Issue