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); }