/*
* Scm_Write - Standard Write.
*/
void Scm_Write(ScmObj obj, ScmObj p, int mode)
{
if (!SCM_OPORTP(p)) Scm_Error("output port required, but got %S", p);
ScmPort *port = SCM_PORT(p);
ScmWriteContext ctx;
write_context_init(&ctx, mode, 0, 0);
ScmVM *vm = Scm_VM();
if (PORT_LOCK_OWNER_P(port, vm) && PORT_RECURSIVE_P(port)) {
/* Special treatment - if we're "display"-ing a string, we'll bypass
walk path even if we're in the middle of write/ss. Using srfi-38
notation to show displayed strings doesn't make sense at all.
*/
if (PORT_WALKER_P(port) &&
!((mode == SCM_WRITE_DISPLAY) && SCM_STRINGP(obj))) {
write_walk(obj, port);
} else {
write_rec(obj, port, &ctx);
}
return;
}
PORT_LOCK(port, vm);
if (WRITER_NEED_2PASS(&ctx)) {
PORT_SAFE_CALL(port, write_ss(obj, port, &ctx),
cleanup_port_write_state(port));
} else {
PORT_SAFE_CALL(port, write_rec(obj, port, &ctx), /*no cleanup*/);
}
PORT_UNLOCK(port);
}
/*
* Scm_WriteLimited - Write to limited length.
*
* Characters exceeding WIDTH are truncated.
* If the output fits within WIDTH, # of characters actually written
* is returned. Othewise, -1 is returned.
*
* Currently this API is only used from Scm_Printf, for 'format' has been
* moved to libfmt.scm. I don't like the way this is implemented and would
* like to share this with libfmt.scm eventually.
*/
int Scm_WriteLimited(ScmObj obj, ScmObj p, int mode, int width)
{
if (!SCM_OPORTP(p)) {
Scm_Error("output port required, but got %S", p);
}
ScmPort *port = SCM_PORT(p);
/* The walk pass does not produce any output, so we don't bother to
create an intermediate string port. */
if (PORT_LOCK_OWNER_P(port, Scm_VM()) && PORT_WALKER_P(port)) {
SCM_ASSERT(PORT_RECURSIVE_P(port));
write_walk(obj, port);
return 0; /* doesn't really matter */
}
ScmObj out = Scm_MakeOutputStringPort(TRUE);
SCM_PORT(out)->writeState = SCM_PORT(port)->writeState;
ScmWriteContext ctx;
write_context_init(&ctx, mode, 0, width);
/* We don't need to lock 'out', nor clean it up, for it is private. */
/* This part is a bit confusing - we only need to call write_ss
if we're at the toplevel call. */
if (PORT_RECURSIVE_P(SCM_PORT(port))) {
write_rec(obj, SCM_PORT(out), &ctx);
} else if (WRITER_NEED_2PASS(&ctx)) {
write_ss(obj, SCM_PORT(out), &ctx);
} else {
write_rec(obj, SCM_PORT(out), &ctx);
}
ScmString *str = SCM_STRING(Scm_GetOutputString(SCM_PORT(out), 0));
int nc = SCM_STRING_BODY_LENGTH(SCM_STRING_BODY(str));
if (nc > width) {
ScmObj sub = Scm_Substring(str, 0, width, FALSE);
SCM_PUTS(sub, port); /* this locks port */
return -1;
} else {
SCM_PUTS(str, port); /* this locks port */
return nc;
}
}
static inline void write_rec(uint64_t nbr, char *buff, t_pfflags *flags,
int *index)
{
if (nbr > (size_t)(flags->base - 1))
write_rec(nbr / flags->base, buff, flags, index);
if (nbr % flags->base < 10)
buff[++*index] = '0' + nbr % flags->base;
else
buff[++*index] = (BIT_VAL(flags->flg, 1) ? 'A' : 'a') + nbr %
flags->base - 10;
}
inline void write_uint(uint64_t nbr, char *buff, t_pfflags *flags,
int *index)
{
int n;
if (BIT_VAL(flags->flg, 13))
{
n = flags->n_digits - 1;
while (++n < flags->prec)
buff[++*index] = '0';
}
write_rec(nbr, buff, flags, index);
}
/* Write/ss main driver
This should never be called recursively.
We modify port->flags and port->writeState; they are cleaned up
by the caller even if we throw an error during write. */
static void write_ss(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
SCM_ASSERT(port->writeState == NULL);
/* pass 1 */
port->flags |= SCM_PORT_WALKING;
if (SCM_WRITE_MODE(ctx)==SCM_WRITE_SHARED) port->flags |= SCM_PORT_WRITESS;
ScmWriteState *s = Scm_MakeWriteState(NULL);
s->sharedTable = SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 0));
port->writeState = s;
write_walk(obj, port);
port->flags &= ~(SCM_PORT_WALKING|SCM_PORT_WRITESS);
/* pass 2 */
write_rec(obj, port, ctx);
cleanup_port_write_state(port);
}
/*
* Scm_WriteWithControls - the general entry
*/
void Scm_WriteWithControls(ScmObj obj, ScmObj p, int mode,
const ScmWriteControls *ctrl)
{
if (!SCM_OPORTP(p)) Scm_Error("output port required, but got %S", p);
ScmPort *port = SCM_PORT(p);
ScmVM *vm = Scm_VM();
if (ctrl == NULL) ctrl = Scm_DefaultWriteControls();
if (PORT_LOCK_OWNER_P(port, vm) && PORT_RECURSIVE_P(port)) {
/* We're in the recursive call, so we just recurse into write_walk
or write_rec, according to the phase. NB: The controls passed
into the argument CTRL is ignored; the "root" control, passed
to the toplevel write API, will be used. */
if (PORT_WALKER_P(port)) {
/* Special treatment - if we're "display"-ing a string, we'll
bypass walk path even if we're in the middle of write/ss.
Using srfi-38 notation to show displayed strings doesn't
make sense at all. */
if (!((mode == SCM_WRITE_DISPLAY) && SCM_STRINGP(obj))) {
write_walk(obj, port);
}
} else {
ScmWriteContext ctx;
write_context_init(&ctx, mode, 0, 0);
write_rec(obj, port, &ctx);
}
} else {
/* We're in the toplevel call.*/
ScmWriteContext ctx;
write_context_init(&ctx, mode, 0, 0);
PORT_LOCK(port, vm);
if (WRITER_NEED_2PASS(&ctx)) {
ctx.controls = ctrl;
PORT_SAFE_CALL(port, write_ss(obj, port, &ctx),
cleanup_port_write_state(port));
} else {
/* write-simple case. CTRL is ignored. */
PORT_SAFE_CALL(port, write_rec(obj, port, &ctx), /*no cleanup*/);
}
PORT_UNLOCK(port);
}
}
/*
* Internal dhcptab record update routine, used to factor out the
* common code between add_dt(), delete_dt(), and modify_dt(). If
* `origp' is NULL, then act like add_dt(); if `newp' is NULL, then
* act like delete_dt(); otherwise act like modify_dt().
*/
static int
update_dt(const dt_handle_t *dhp, const dt_rec_t *origp, dt_rec_t *newp)
{
char dtpath[MAXPATHLEN], newpath[MAXPATHLEN];
int retval = DSVC_SUCCESS;
off_t recoff, recnext;
dt_rec_list_t *reclist;
FILE *fp;
int newfd;
uint_t found;
int query;
struct stat st;
if ((dhp->dh_oflags & DSVC_WRITE) == 0)
return (DSVC_ACCESS);
/*
* Open the container to update and a new container file which we
* will store the updated version of the container in. When the
* update is done, rename the new file to be the real container.
*/
dt2path(dtpath, MAXPATHLEN, dhp->dh_location, "");
fp = fopen(dtpath, "r");
if (fp == NULL)
return (syserr_to_dsvcerr(errno));
dt2path(newpath, MAXPATHLEN, dhp->dh_location, ".new");
(void) unlink(newpath);
newfd = open(newpath, O_CREAT|O_EXCL|O_WRONLY, 0644);
if (newfd == -1) {
(void) fclose(fp);
return (syserr_to_dsvcerr(errno));
}
DSVC_QINIT(query);
DSVC_QEQ(query, DT_QKEY|DT_QTYPE);
/*
* If we're adding a new record or changing a key for an existing
* record, bail if the record we want to add already exists.
*/
if (newp != NULL) {
if (origp == NULL || origp->dt_type != newp->dt_type ||
strcmp(origp->dt_key, newp->dt_key) != 0) {
retval = find_dt(fp, 0, query, 1, newp, NULL, &found);
if (retval != DSVC_SUCCESS)
goto out;
if (found != 0) {
retval = DSVC_EXISTS;
goto out;
}
}
}
/*
* If we're deleting or modifying record, make sure the record
* still exists. Note that we don't check signatures because this
* is a legacy format that has no signatures.
*/
if (origp != NULL) {
retval = find_dt(fp, FIND_POSITION, query, 1, origp, &reclist,
&found);
if (retval != DSVC_SUCCESS)
goto out;
if (found == 0) {
retval = DSVC_NOENT;
goto out;
}
/*
* Note the offset of the record we're modifying or deleting
* for use down below.
*/
recoff = ((dt_recpos_t *)reclist->dtl_rec)->dtp_off;
recnext = recoff + ((dt_recpos_t *)reclist->dtl_rec)->dtp_size;
free_dtrec_list(reclist);
} else {
/*
* No record to modify or delete, so set `recoff' and
* `recnext' appropriately.
*/
recoff = 0;
recnext = 0;
}
/*
* Make a new copy of the container. If we're deleting or
* modifying a record, don't copy that record to the new container.
*/
if (fstat(fileno(fp), &st) == -1) {
retval = DSVC_INTERNAL;
goto out;
}
retval = copy_range(fileno(fp), 0, newfd, 0, recoff);
if (retval != DSVC_SUCCESS)
goto out;
retval = copy_range(fileno(fp), recnext, newfd, recoff,
st.st_size - recnext);
if (retval != DSVC_SUCCESS)
goto out;
/*
* If there's a new record, append it to the new container.
*/
if (newp != NULL) {
retval = write_rec(newfd, newp, recoff + st.st_size - recnext);
if (retval != DSVC_SUCCESS)
goto out;
}
/*
* Note: we close these descriptors before the rename(2) (rather
* than just having the `out:' label clean them up) to save NFS
* some work (otherwise, NFS has to save `dtpath' to an alternate
* name since its vnode would still be active).
*/
(void) fclose(fp);
(void) close(newfd);
if (rename(newpath, dtpath) == -1)
retval = syserr_to_dsvcerr(errno);
return (retval);
out:
(void) fclose(fp);
(void) close(newfd);
(void) unlink(newpath);
return (retval);
}
/*
* Internal dhcp_network record update routine, used to factor out the
* common code between add_dn(), delete_dn(), and modify_dn(). If
* `origp' is NULL, then act like add_dn(); if `newp' is NULL, then
* act like delete_dn(); otherwise act like modify_dn().
*/
static int
update_dn(const dn_handle_t *dhp, const dn_rec_t *origp, dn_rec_t *newp)
{
char dnpath[MAXPATHLEN], newpath[MAXPATHLEN];
int retval = DSVC_SUCCESS;
off_t recoff, recnext;
dn_rec_list_t *reclist;
int fd, newfd;
uint_t found;
int query;
struct stat st;
if ((dhp->dh_oflags & DSVC_WRITE) == 0)
return (DSVC_ACCESS);
/*
* Open the container to update and a new container file which we
* will store the updated version of the container in. When the
* update is done, rename the new file to be the real container.
*/
net2path(dnpath, MAXPATHLEN, dhp->dh_location, dhp->dh_net, "");
fd = open(dnpath, O_RDONLY);
if (fd == -1)
return (syserr_to_dsvcerr(errno));
net2path(newpath, MAXPATHLEN, dhp->dh_location, dhp->dh_net, ".new");
newfd = open(newpath, O_CREAT|O_TRUNC|O_WRONLY, 0644);
if (newfd == -1) {
(void) close(fd);
return (syserr_to_dsvcerr(errno));
}
DSVC_QINIT(query);
DSVC_QEQ(query, DN_QCIP);
/*
* If we're changing the key for this record, make sure the key
* we're changing to doesn't already exist.
*/
if (origp != NULL && newp != NULL) {
if (origp->dn_cip.s_addr != newp->dn_cip.s_addr) {
retval = find_dn(fd, 0, query, 1, newp, NULL, &found);
if (retval != DSVC_SUCCESS)
goto out;
if (found != 0) {
retval = DSVC_EXISTS;
goto out;
}
}
}
/*
* If we're adding a new record, make sure the record doesn't
* already exist.
*/
if (newp != NULL && origp == NULL) {
retval = find_dn(fd, 0, query, 1, newp, NULL, &found);
if (retval != DSVC_SUCCESS)
goto out;
if (found != 0) {
retval = DSVC_EXISTS;
goto out;
}
}
/*
* If we're deleting or modifying record, make sure the record
* still exists and that our copy isn't stale. Note that we don't
* check signatures if we're deleting the record and origp->dn_sig
* is zero, so that records that weren't looked up can be deleted.
*/
if (origp != NULL) {
retval = find_dn(fd, FIND_POSITION, query, 1, origp, &reclist,
&found);
if (retval != DSVC_SUCCESS)
goto out;
if (found == 0) {
retval = DSVC_NOENT;
goto out;
}
if (reclist->dnl_rec->dn_sig != origp->dn_sig) {
if (newp != NULL || origp->dn_sig != 0) {
free_dnrec_list(reclist);
retval = DSVC_COLLISION;
goto out;
}
}
/*
* Note the offset of the record we're modifying or deleting
* for use down below.
*/
recoff = ((dn_recpos_t *)reclist->dnl_rec)->dnp_off;
recnext = recoff + ((dn_recpos_t *)reclist->dnl_rec)->dnp_size;
free_dnrec_list(reclist);
} else {
/*
* No record to modify or delete, so set `recoff' and
* `recnext' appropriately.
*/
recoff = 0;
recnext = 0;
}
/*
* Make a new copy of the container. If we're deleting or
* modifying a record, don't copy that record to the new container.
*/
if (fstat(fd, &st) == -1) {
retval = DSVC_INTERNAL;
goto out;
}
retval = copy_range(fd, 0, newfd, 0, recoff);
if (retval != DSVC_SUCCESS)
goto out;
retval = copy_range(fd, recnext, newfd, recoff, st.st_size - recnext);
if (retval != DSVC_SUCCESS)
goto out;
/*
* If there's a new/modified record, append it to the new container.
*/
if (newp != NULL) {
if (origp == NULL)
newp->dn_sig = gensig();
else
newp->dn_sig = origp->dn_sig + 1;
retval = write_rec(newfd, newp, recoff + st.st_size - recnext);
if (retval != DSVC_SUCCESS)
goto out;
}
/*
* Note: we close these descriptors before the rename(2) (rather
* than just having the `out:' label clean them up) to save NFS
* some work (otherwise, NFS has to save `dnpath' to an alternate
* name since its vnode would still be active).
*/
(void) close(fd);
(void) close(newfd);
if (rename(newpath, dnpath) == -1)
retval = syserr_to_dsvcerr(errno);
return (retval);
out:
(void) close(fd);
(void) close(newfd);
(void) unlink(newpath);
return (retval);
}
/* Trick: The hashtable contains positive integer after the walk pass.
If we emit a reference tag N, we replace the entry's value to -N,
so that we can distinguish whether we've already emitted the object
or not. */
static void write_rec(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
char numbuf[50]; /* enough to contain long number */
ScmObj stack = SCM_NIL;
ScmWriteState *st = port->writeState;
ScmHashTable *ht = (st? st->sharedTable : NULL);
const ScmWriteControls *wp = Scm_GetWriteControls(ctx, st);
int stack_depth = 0; /* only used when !ht */
#define PUSH(elt) \
do { \
stack = Scm_Cons(elt, stack); \
if (!ht && ++stack_depth > STACK_LIMIT) { \
Scm_Error("write recursed too deeply; " \
"maybe a circular structure?"); \
} \
} while (0)
#define POP() \
do { \
stack = SCM_CDR(stack); \
if (!ht) stack_depth--; \
} while (0)
#define CHECK_LEVEL() \
do { \
if (st) { \
if (wp->printLevel >= 0 && st->currentLevel >= wp->printLevel) { \
Scm_PutcUnsafe('#', port); \
goto next; \
} else { \
if (st) st->currentLevel++; \
} \
} \
} while (0)
for (;;) {
write1:
if (ctx->flags & WRITE_LIMITED) {
if (port->src.ostr.length >= ctx->limit) return;
}
/* number may be heap allocated, but we don't use srfi-38 notation. */
if (!SCM_PTRP(obj) || SCM_NUMBERP(obj)) {
if (SCM_FALSEP(Scm__WritePrimitive(obj, port, ctx))) {
Scm_Panic("write: got a bogus object: %08x", SCM_WORD(obj));
}
goto next;
}
if ((SCM_STRINGP(obj) && SCM_STRING_SIZE(obj) == 0)
|| (SCM_VECTORP(obj) && SCM_VECTOR_SIZE(obj) == 0)) {
/* we don't put a reference tag for these */
write_general(obj, port, ctx);
goto next;
}
/* obj is heap allocated and we may use label notation. */
if (ht) {
ScmObj e = Scm_HashTableRef(ht, obj, SCM_MAKE_INT(1));
long k = SCM_INT_VALUE(e);
if (k <= 0) {
/* This object is already printed. */
snprintf(numbuf, 50, "#%ld#", -k);
Scm_PutzUnsafe(numbuf, -1, port);
goto next;
} else if (k > 1) {
/* This object will be seen again. Put a reference tag. */
ScmWriteState *s = port->writeState;
snprintf(numbuf, 50, "#%d=", s->sharedCounter);
Scm_HashTableSet(ht, obj, SCM_MAKE_INT(-s->sharedCounter), 0);
s->sharedCounter++;
Scm_PutzUnsafe(numbuf, -1, port);
}
}
/* Writes aggregates */
if (SCM_PAIRP(obj)) {
CHECK_LEVEL();
/* special case for quote etc.
NB: we need to check if we've seen SCM_CDR(obj), otherwise we'll
get infinite recursion for the case like (cdr '#1='#1#). */
if (SCM_PAIRP(SCM_CDR(obj)) && SCM_NULLP(SCM_CDDR(obj))
&& (!ht
|| SCM_FALSEP(Scm_HashTableRef(ht, SCM_CDR(obj), SCM_FALSE)))){
const char *prefix = NULL;
if (SCM_CAR(obj) == SCM_SYM_QUOTE) {
prefix = "'";
} else if (SCM_CAR(obj) == SCM_SYM_QUASIQUOTE) {
prefix = "`";
} else if (SCM_CAR(obj) == SCM_SYM_UNQUOTE) {
prefix = ",";
} else if (SCM_CAR(obj) == SCM_SYM_UNQUOTE_SPLICING) {
prefix = ",@";
}
if (prefix) {
Scm_PutzUnsafe(prefix, -1, port);
obj = SCM_CADR(obj);
goto write1;
}
}
if (wp->printLength == 0) {
/* in this case we don't print the elements at all, so we need
to treat this specially. */
Scm_PutzUnsafe("(...)", -1, port);
if (st) st->currentLevel--;
goto next;
}
/* normal case */
Scm_PutcUnsafe('(', port);
PUSH(Scm_Cons(SCM_TRUE, Scm_Cons(SCM_MAKE_INT(1), SCM_CDR(obj))));
obj = SCM_CAR(obj);
goto write1;
} else if (SCM_VECTORP(obj)) {
CHECK_LEVEL();
if (wp->printLength == 0) {
/* in this case we don't print the elements at all, so we need
to treat this specially. */
Scm_PutzUnsafe("#(...)", -1, port);
if (st) st->currentLevel--;
goto next;
}
Scm_PutzUnsafe("#(", -1, port);
PUSH(Scm_Cons(SCM_MAKE_INT(1), obj));
obj = SCM_VECTOR_ELEMENT(obj, 0);
goto write1;
} else if (Scm_ClassOf(obj)->flags & SCM_CLASS_AGGREGATE) {
CHECK_LEVEL();
write_general(obj, port, ctx);
if (st) st->currentLevel--;
goto next;
} else {
write_general(obj, port, ctx);
goto next;
}
next:
while (SCM_PAIRP(stack)) {
ScmObj top = SCM_CAR(stack);
SCM_ASSERT(SCM_PAIRP(top));
if (SCM_INTP(SCM_CAR(top))) {
/* we're processing a vector */
ScmObj v = SCM_CDR(top);
int i = SCM_INT_VALUE(SCM_CAR(top));
int len = SCM_VECTOR_SIZE(v);
if (i == len) { /* we've done this vector */
Scm_PutcUnsafe(')', port);
POP();
} else if (wp->printLength >= 0 && wp->printLength <= i) {
Scm_PutzUnsafe(" ...)", -1, port);
POP();
} else {
Scm_PutcUnsafe(' ', port);
obj = SCM_VECTOR_ELEMENT(v, i);
SCM_SET_CAR(top, SCM_MAKE_INT(i+1));
goto write1;
}
} else {
/* we're processing a list */
SCM_ASSERT(SCM_PAIRP(SCM_CDR(top)));
long count = SCM_INT_VALUE(SCM_CADR(top));
ScmObj v = SCM_CDDR(top);
if (SCM_NULLP(v)) { /* we've done with this list */
Scm_PutcUnsafe(')', port);
POP();
} else if (!SCM_PAIRP(v)) {
/* Improper list. We treat aggregate types specially,
since such object at this position shouldn't increment
"level" - its content is regarded as the same level of
the current list.
*/
Scm_PutzUnsafe(" . ", -1, port);
if (Scm_ClassOf(v)->flags & SCM_CLASS_AGGREGATE) {
if (st) st->currentLevel--;
write_rec(v, port, ctx);
if (st) st->currentLevel++;
Scm_PutcUnsafe(')', port);
POP();
} else {
obj = v;
SCM_SET_CAR(SCM_CDR(top), SCM_MAKE_INT(count+1));
SCM_SET_CDR(SCM_CDR(top), SCM_NIL);
goto write1;
}
} else if (wp->printLength >= 0 && wp->printLength <= count) {
/* print-length limit reached */
Scm_PutzUnsafe(" ...)", -1, port);
POP();
} else if (ht && !SCM_EQ(Scm_HashTableRef(ht, v, SCM_MAKE_INT(1)), SCM_MAKE_INT(1))) {
/* cdr part is shared */
Scm_PutzUnsafe(" . ", -1, port);
obj = v;
SCM_SET_CAR(SCM_CDR(top), SCM_MAKE_INT(count+1));
SCM_SET_CDR(SCM_CDR(top), SCM_NIL);
goto write1;
} else {
Scm_PutcUnsafe(' ', port);
obj = SCM_CAR(v);
SCM_SET_CAR(SCM_CDR(top), SCM_MAKE_INT(count+1));
SCM_SET_CDR(SCM_CDR(top), SCM_CDR(v));
goto write1;
}
}
if (st) st->currentLevel--;
}
break;
}
#undef PUSH
#undef POP
#undef CHECK_DEPTH
}
