/*------------------------------------------------------------
* Vport puts
*/
static void vport_puts(ScmString *s, ScmPort *p)
{
vport *data = (vport*)p->src.vt.data;
const ScmStringBody *b = SCM_STRING_BODY(s);
SCM_ASSERT(data != NULL);
if (!SCM_FALSEP(data->puts_proc)) {
Scm_ApplyRec(data->puts_proc, SCM_LIST1(SCM_OBJ(s)));
} else if (SCM_STRING_BODY_INCOMPLETE_P(b)
|| (SCM_FALSEP(data->putc_proc)
&& !SCM_FALSEP(data->putb_proc))) {
/* we perform binary output */
vport_putz(SCM_STRING_BODY_START(b), SCM_STRING_BODY_SIZE(b), p);
} else if (!SCM_FALSEP(data->putc_proc)) {
ScmChar c;
int i;
const char *cp = SCM_STRING_BODY_START(b);
for (i=0; i < (int)SCM_STRING_BODY_LENGTH(b); i++) {
SCM_CHAR_GET(cp, c);
cp += SCM_CHAR_NFOLLOWS(*cp)+1;
Scm_ApplyRec(data->putc_proc, SCM_LIST1(SCM_MAKE_CHAR(c)));
}
} else {
Scm_PortError(p, SCM_PORT_ERROR_OTHER,
"cannot perform output to the port %S", p);
}
}
/*------------------------------------------------------------
* Vport Getc
*/
static int vport_getc(ScmPort *p)
{
vport *data = (vport*)p->src.vt.data;
SCM_ASSERT(data != NULL);
if (SCM_FALSEP(data->getc_proc)) {
/* If the port doesn't have get-char method, try get-byte */
ScmObj b;
int n, i;
ScmChar ch;
char buf[SCM_CHAR_MAX_BYTES];
if (SCM_FALSEP(data->getb_proc)) return EOF;
b = Scm_ApplyRec(data->getb_proc, SCM_NIL);
if (!SCM_INTP(b)) return EOF;
buf[0] = (char)SCM_INT_VALUE(b);
n = SCM_CHAR_NFOLLOWS(p->scratch[0]);
for (i=0; i<n; i++) {
b = Scm_ApplyRec(data->getb_proc, SCM_NIL);
if (!SCM_INTP(b)) {
/* TODO: should raise an exception? */
return EOF;
}
buf[i+1] = (char)SCM_INT_VALUE(b);
}
SCM_CHAR_GET(buf, ch);
return ch;
} else {
ScmObj ch = Scm_ApplyRec(data->getc_proc, SCM_NIL);
if (!SCM_CHARP(ch)) return EOF;
return SCM_CHAR_VALUE(ch);
}
}
static int getc_scratch_unsafe(ScmPort *p)
#endif
{
char tbuf[SCM_CHAR_MAX_BYTES];
int nb = SCM_CHAR_NFOLLOWS(p->scratch[0]);
int curr = p->scrcnt;
memcpy(tbuf, p->scratch, curr);
p->scrcnt = 0;
for (int i=curr; i<=nb; i++) {
int r = EOF;
SAFE_CALL(p, r = Scm_Getb(p));
if (r == EOF) {
UNLOCK(p);
Scm_PortError(p, SCM_PORT_ERROR_INPUT,
"encountered EOF in middle of a multibyte character from port %S", p);
}
tbuf[i] = (char)r;
}
int ch;
SCM_CHAR_GET(tbuf, ch);
if (ch == SCM_CHAR_INVALID) {
/* This can happen if the input contains invalid byte sequence.
We return the stray byte (which would eventually result
an incomplete string when accumulated), while keeping the
remaining bytes in the scrach buffer. */
ch = (ScmChar)(tbuf[0] & 0xff);
memcpy(p->scratch, tbuf+1, nb);
p->scrcnt = nb;
}
return ch;
}
/*------------------------------------------------------------
* Vport putb
*/
static void vport_putb(ScmByte b, ScmPort *p)
{
vport *data = (vport*)p->src.vt.data;
SCM_ASSERT(data != NULL);
if (SCM_FALSEP(data->putb_proc)) {
if (!SCM_FALSEP(data->putc_proc)
&& SCM_CHAR_NFOLLOWS(b) == 0) {
/* This byte is a single-byte character, so we can use putc. */
Scm_ApplyRec(data->putc_proc, SCM_LIST1(SCM_MAKE_CHAR(b)));
} else {
/* Given byte is a part of multibyte sequence. We don't
handle it for the time being. */
Scm_PortError(p, SCM_PORT_ERROR_UNIT,
"cannot perform binary output to the port %S", p);
}
} else {
Scm_ApplyRec(data->putb_proc, SCM_LIST1(SCM_MAKE_INT(b)));
}
}
int Scm_GetcUnsafe(ScmPort *p)
#endif
{
VMDECL;
SHORTCUT(p, return Scm_GetcUnsafe(p));
LOCK(p);
CLOSE_CHECK(p);
if (p->scrcnt > 0) {
int r = GETC_SCRATCH(p);
UNLOCK(p);
return r;
}
if (p->ungotten != SCM_CHAR_INVALID) {
int c = p->ungotten;
p->ungotten = SCM_CHAR_INVALID;
UNLOCK(p);
return c;
}
switch (SCM_PORT_TYPE(p)) {
case SCM_PORT_FILE: {
int c = 0;
if (p->src.buf.current >= p->src.buf.end) {
int r = 0;
SAFE_CALL(p, r = bufport_fill(p, 1, FALSE));
if (r == 0) {
UNLOCK(p);
return EOF;
}
}
int first = (unsigned char)*p->src.buf.current++;
int nb = SCM_CHAR_NFOLLOWS(first);
p->bytes++;
if (nb > 0) {
if (p->src.buf.current + nb > p->src.buf.end) {
/* The buffer doesn't have enough bytes to consist a char.
move the incomplete char to the scratch buffer and try
to fetch the rest of the char. */
int rest, filled = 0;
p->scrcnt = (unsigned char)(p->src.buf.end - p->src.buf.current + 1);
memcpy(p->scratch, p->src.buf.current-1, p->scrcnt);
p->src.buf.current = p->src.buf.end;
rest = nb + 1 - p->scrcnt;
for (;;) {
SAFE_CALL(p, filled = bufport_fill(p, rest, FALSE));
if (filled <= 0) {
/* TODO: make this behavior customizable */
UNLOCK(p);
Scm_PortError(p, SCM_PORT_ERROR_INPUT,
"encountered EOF in middle of a multibyte character from port %S", p);
}
if (filled >= rest) {
memcpy(p->scratch+p->scrcnt, p->src.buf.current, rest);
p->scrcnt += rest;
p->src.buf.current += rest;
break;
} else {
memcpy(p->scratch+p->scrcnt, p->src.buf.current, filled);
p->scrcnt += filled;
p->src.buf.current = p->src.buf.end;
rest -= filled;
}
}
SCM_CHAR_GET(p->scratch, c);
p->scrcnt = 0;
} else {
SCM_CHAR_GET(p->src.buf.current-1, c);
p->src.buf.current += nb;
}
p->bytes += nb;
} else {
c = first;
if (c == '\n') p->line++;
}
UNLOCK(p);
return c;
}
case SCM_PORT_ISTR: {
if (p->src.istr.current >= p->src.istr.end) {
UNLOCK(p);
return EOF;
}
int c = 0;
int first = (unsigned char)*p->src.istr.current++;
int nb = SCM_CHAR_NFOLLOWS(first);
p->bytes++;
if (nb > 0) {
if (p->src.istr.current + nb > p->src.istr.end) {
/* TODO: make this behavior customizable */
UNLOCK(p);
Scm_PortError(p, SCM_PORT_ERROR_INPUT,
"encountered EOF in middle of a multibyte character from port %S", p);
}
SCM_CHAR_GET(p->src.istr.current-1, c);
p->src.istr.current += nb;
p->bytes += nb;
} else {
c = first;
if (c == '\n') p->line++;
}
UNLOCK(p);
return c;
}
case SCM_PORT_PROC: {
int c = 0;
SAFE_CALL(p, c = p->src.vt.Getc(p));
if (c == '\n') p->line++;
UNLOCK(p);
return c;
}
default:
UNLOCK(p);
Scm_PortError(p, SCM_PORT_ERROR_INPUT, "bad port type for input: %S", p);
}
return 0;/*dummy*/
}