/* * 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); }
/* Default method for write-object */ static ScmObj write_object_fallback(ScmObj *args, int nargs, ScmGeneric *gf) { if (nargs != 2 || (nargs == 2 && !SCM_OPORTP(args[1]))) { Scm_Error("No applicable method for write-object with %S", Scm_ArrayToList(args, nargs)); } ScmClass *klass = Scm_ClassOf(args[0]); Scm_Printf(SCM_PORT(args[1]), "#<%A%s%p>", klass->name, (SCM_FALSEP(klass->redefined)? " " : ":redefined "), args[0]); return SCM_TRUE; }
/* * 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); } }
/* * 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; } }
ScmObj Scm_MakeOutputConversionPort(ScmPort *toPort, const char *toCode, const char *fromCode, int bufsiz, int ownerp) { if (!SCM_OPORTP(toPort)) Scm_Error("output port required, but got %S", toPort); if (bufsiz <= 0) bufsiz = DEFAULT_CONVERSION_BUFFER_SIZE; if (bufsiz <= MINIMUM_CONVERSION_BUFFER_SIZE) { bufsiz = MINIMUM_CONVERSION_BUFFER_SIZE; } ScmConvInfo *cinfo = jconv_open(toCode, fromCode); if (cinfo == NULL) { Scm_Error("conversion from code %s to code %s is not supported", fromCode, toCode); } cinfo->remote = toPort; cinfo->ownerp = ownerp; cinfo->bufsiz = (bufsiz > 0)? bufsiz : DEFAULT_CONVERSION_BUFFER_SIZE; cinfo->remoteClosed = FALSE; cinfo->buf = SCM_NEW_ATOMIC2(char *, cinfo->bufsiz); cinfo->ptr = cinfo->buf; ScmPortBuffer bufrec; memset(&bufrec, 0, sizeof(bufrec)); bufrec.size = cinfo->bufsiz; bufrec.buffer = SCM_NEW_ATOMIC2(char *, cinfo->bufsiz); bufrec.mode = SCM_PORT_BUFFER_FULL; bufrec.filler = NULL; bufrec.flusher = conv_output_flusher; bufrec.closer = conv_output_closer; bufrec.ready = conv_ready; bufrec.filenum = conv_fileno; bufrec.data = (void*)cinfo; ScmObj name = conv_name(SCM_PORT_OUTPUT, toPort, fromCode, toCode); return Scm_MakeBufferedPort(SCM_CLASS_PORT, name, SCM_PORT_OUTPUT, TRUE, &bufrec); }