AFFEND
AFFDEF(__arc_disp_write)
{
AARG(arg, disp);
AOARG(outport, visithash);
typefn_t *tfn;
AFBEGIN;
if (!BOUND_P(AV(outport)))
STDOUT(outport);
if (NIL_P(AV(arg)))
WV(arg, ARC_BUILTIN(c, S_NIL));
if (AV(arg) == CTRUE)
WV(arg, ARC_BUILTIN(c, S_T));
tfn = __arc_typefn(c, AV(arg));
if (tfn == NULL || tfn->pprint == NULL) {
static const char *utype = "#<unknown-type %d %p>";
char *strrep;
int len;
value vstr;
len = snprintf(NULL, 0, utype, TYPE(AV(arg)), (void *)AV(arg));
strrep = alloca(sizeof(char)*(len+1));
snprintf(strrep, len+1, utype, TYPE(AV(arg)), (void *)AV(arg));
vstr = arc_mkstringc(c, strrep);
AFTCALL(arc_mkaff(c, arc_disp, CNIL), vstr, AV(outport));
ARETURN(CNIL);
}
AFTCALL(arc_mkaff(c, tfn->pprint, CNIL), AV(arg), AV(disp), AV(outport),
AV(visithash));
AFEND;
}
void __arc_init_fio(arc *c)
{
value io_ops;
io_ops = arc_mkvector(c, IO_last+1);
SVINDEX(io_ops, IO_closed_p, arc_mkaff(c, fio_closed_p, CNIL));
SVINDEX(io_ops, IO_ready, arc_mkaff(c, fio_ready, CNIL));
SVINDEX(io_ops, IO_wready, arc_mkaff(c, fio_wready, CNIL));
SVINDEX(io_ops, IO_getb, arc_mkaff(c, fio_getb, CNIL));
SVINDEX(io_ops, IO_putb, arc_mkaff(c, fio_putb, CNIL));
SVINDEX(io_ops, IO_seek, arc_mkaff(c, fio_seek, CNIL));
SVINDEX(io_ops, IO_tell, arc_mkaff(c, fio_tell, CNIL));
SVINDEX(io_ops, IO_close, arc_mkaff(c, fio_close, CNIL));
SVINDEX(VINDEX(c->builtins, BI_io), BI_io_fp, io_ops);
io_ops = arc_mkvector(c, IO_last+1);
SVINDEX(io_ops, IO_closed_p, arc_mkaff(c, fio_closed_p, CNIL));
SVINDEX(io_ops, IO_ready, arc_mkaff(c, fio_ready, CNIL));
SVINDEX(io_ops, IO_wready, arc_mkaff(c, fio_wready, CNIL));
SVINDEX(io_ops, IO_getb, arc_mkaff(c, fio_getb, CNIL));
SVINDEX(io_ops, IO_putb, arc_mkaff(c, fio_putb, CNIL));
SVINDEX(io_ops, IO_seek, arc_mkaff(c, fio_seek, CNIL));
SVINDEX(io_ops, IO_tell, arc_mkaff(c, fio_tell, CNIL));
SVINDEX(io_ops, IO_close, arc_mkaff(c, pio_close, CNIL));
SVINDEX(VINDEX(c->builtins, BI_io), BI_io_pfp, io_ops);
arc_bindsym(c, ARC_BUILTIN(c, S_STDIN_FD),
mkfio(c, T_INPORT, stdin, arc_mkstringc(c, "(stdin)")));
arc_bindsym(c, ARC_BUILTIN(c, S_STDOUT_FD),
mkfio(c, T_OUTPORT, stdout, arc_mkstringc(c, "(stdout)")));
arc_bindsym(c, ARC_BUILTIN(c, S_STDERR_FD),
mkfio(c, T_OUTPORT, stderr, arc_mkstringc(c, "(stderr)")));
}
AFFEND
AFFDEF(arc_seek)
{
AARG(fp, offset);
AOARG(whence);
AFBEGIN;
if (!BOUND_P(AV(whence)))
WV(whence, INT2FIX(SEEK_SET));
if (AV(whence) == ARC_BUILTIN(c, S_SEEK_SET))
WV(whence, INT2FIX(SEEK_SET));
else if (AV(whence) == ARC_BUILTIN(c, S_SEEK_CUR))
WV(whence, INT2FIX(SEEK_CUR));
else if (AV(whence) == ARC_BUILTIN(c, S_SEEK_END))
WV(whence, INT2FIX(SEEK_END));
else if (!FIXNUM_P(AV(whence))) {
arc_err_cstrfmt(c, "invalid seek whence argument");
ARETURN(CNIL);
}
AFTCALL(VINDEX(IO(AV(fp))->io_ops, IO_seek), AV(fp), AV(offset), AV(whence));
AFEND;
}
AFFEND
AFFDEF(arc_outfile)
{
AARG(filename);
AOARG(mode);
char *cmode;
AFBEGIN;
if (AV(mode) == ARC_BUILTIN(c, S_APPEND))
cmode = "a";
else if (!BOUND_P(AV(mode)))
cmode = "w";
else {
arc_err_cstrfmt(c, "outfile: invalid mode");
ARETURN(CNIL);
}
ARETURN(openfio(c, T_OUTPORT, AV(filename), cmode));
AFEND;
}
value arc_intern(arc *c, value name)
{
value symid, symval;
int symintid;
if ((symid = arc_hash_lookup(c, c->symtable, name)) != CUNBOUND) {
/* convert the fixnum ID into the symbol value */
symval = ID2SYM(FIX2INT(symid));
/* do not allow nil or t to have a symbol value */
if (symval == ARC_BUILTIN(c, S_NIL))
symval = CNIL;
/* else if (symval == ARC_BUILTIN(c, S_T))
symval = CTRUE; */
return(symval);
}
symintid = ++c->lastsym;
symid = INT2FIX(symintid);
symval = ID2SYM(symintid);
arc_hash_insert(c, c->symtable, name, symid);
arc_hash_insert(c, c->rsymtable, symid, name);
return(symval);
}
void arc_init_symtable(arc *c)
{
int i;
c->symtable = arc_mkwtable(c, ARC_HASHBITS);
c->rsymtable = arc_mkwtable(c, ARC_HASHBITS);
c->lastsym = 0;
/* Set up builtin symbols */
SVINDEX(c->builtins, BI_syms, arc_mkvector(c, S_THE_END));
for (i=0; i<S_THE_END; i++)
SARC_BUILTIN(c, i, arc_intern(c, arc_mkstringc(c, syms[i])));
/* Set up character escape table */
SVINDEX(c->builtins, BI_charesc, arc_mkhash(c, ARC_HASHBITS));
for (i=0; chartbl[i].str; i++) {
value str = arc_mkstringc(c, chartbl[i].str);
value chr = arc_mkchar(c, chartbl[i].val);
arc_hash_insert(c, VINDEX(c->builtins, BI_charesc), str, chr);
arc_hash_insert(c, VINDEX(c->builtins, BI_charesc), chr, str);
}
c->ctrue = ARC_BUILTIN(c, S_T);
}
