void write_char(lref_t port, _TCHAR ch)
{
assert(TEXT_PORTP(port) && PORT_OUTPUTP(port));
write_text(port, &ch, 1);
if (ch == _T('\n'))
lflush_port(port);
}
void dscwritef_impl(const _TCHAR * format_str, ...)
{
va_list arglist;
va_start(arglist, format_str);
scvwritef(format_str, VM_DEBUG_PORT(), arglist);
lflush_port(VM_DEBUG_PORT());
}
lref_t lclose_port(lref_t port)
{
if (!PORTP(port))
vmerror_wrong_type_n(1, port);
if (PORT_OUTPUTP(port))
lflush_port(port);
if (PORT_CLASS(port)->close)
PORT_CLASS(port)->close(port);
PORT_PINFO(port)->mode = PORT_CLOSED;
return port;
}
lref_t lport_set_translate_mode(lref_t port, lref_t mode)
{
if (!TEXT_PORTP(port))
vmerror_wrong_type_n(1, port);
if (!BOOLP(mode))
vmerror_wrong_type_n(2, mode);
lflush_port(port);
bool old_translate_mode = PORT_TEXT_INFO(port)->translate;
PORT_TEXT_INFO(port)->translate = TRUEP(mode);
return boolcons(old_translate_mode);
}
void scan_postmortem_dump()
{
#if 0
lref_t oport = CURRENT_DEBUG_PORT();
for(frame_t *frame = CURRENT_TIB()->frame;
frame != NULL;
frame = frame->prev_frame)
{
scwritef(_T("\n*** FRAME=~cd: "), oport, frame);
switch (frame->type)
{
case FRAME_EVAL:
scwritef(_T("eval > ~s in ~s\n"), oport, *frame->as.eval.form,
frame->as.eval.initial_form);
break;
case FRAME_ESCAPE:
scwritef(_T("try > ~s\n"), oport, frame->as.escape.tag);
break;
case FRAME_UNWIND:
scwritef(_T("unwind-protect >\n"), oport);
break;
case FRAME_SUBR:
scwritef(_T("subr > ~s\n"), oport, frame->as.subr.subr);
break;
default:
scwritef(_T("<< INVALID-FRAME-TYPE >>\n"), oport);
break;
}
lflush_port(oport);
}
#endif
}
void text_port_flush(lref_t obj)
{
lflush_port(PORT_UNDERLYING(obj));
}
