ScmObj Scm_SocketOutputPort(ScmSocket *sock, int buffering)
{
if (sock->outPort == NULL) {
int outfd;
if (sock->type != SOCK_DGRAM &&
sock->status < SCM_SOCKET_STATUS_CONNECTED) {
sockport_err(sock, "output");
}
#ifndef GAUCHE_WINDOWS
outfd = sock->fd;
#else /*GAUCHE_WINDOWS*/
/* cfd will be closed when this socket is closed. */
if (sock->cfd < 0) {
sock->cfd = _open_osfhandle(sock->fd, 0);
}
outfd = sock->cfd;
#endif /*GAUCHE_WINDOWS*/
if (outfd == INVALID_SOCKET) sockport_err(sock, "output");
/* NB: I keep the socket itself in the port name, in order to avoid
the socket from GCed prematurely if application doesn't keep
pointer to the socket. */
ScmObj sockname = SCM_LIST2(SCM_MAKE_STR("socket output"),
SCM_OBJ(sock));
sock->outPort = SCM_PORT(Scm_MakePortWithFd(sockname, SCM_PORT_OUTPUT,
outfd, buffering, FALSE));
}
return SCM_OBJ(sock->outPort);
}
ScmChar Scm_UcsToChar(int n)
{
if (n < 0) Scm_Error("bad character code: %d", n);
#if defined(GAUCHE_CHAR_ENCODING_UTF_8)
return (ScmChar)n;
#elif defined(GAUCHE_CHAR_ENCODING_EUC_JP) || defined(GAUCHE_CHAR_ENCODING_SJIS)
if (n < 0x80) return (ScmChar)n; /*ASCII range*/
if (ucs2char_hook == NULL) {
/* NB: we don't need mutex here, for the loading of gauche.charconv
is serialized in Scm_Require. */
Scm_Require(SCM_MAKE_STR("gauche/charconv"),
SCM_LOAD_PROPAGATE_ERROR, NULL);
if (ucs2char_hook == NULL) {
Scm_Error("couldn't autoload gauche.charconv");
}
}
return ucs2char_hook(n);
#else
/* Encoding == 'none'. It would be safer to reject anything beyond
0xff, but it prevents 'none' gosh from reading any source files that
have escaped characters in that range, even the section is cond-expanded.
That's awfully incovenient, so we use a substitution character '?' here,
relying the programmer to properly conditionalize the code.
We plan to drop 'none' encoding support in 1.0, so this kludge is
just a temporary measure.
*/
if (n < 0x100) return (ScmChar)n; /* ISO8859-1 */
else return (ScmChar)'?';
#endif
}
static void install_release_thunk(ScmVM *vm, ScmObj promise)
{
/* TODO: the before thunk must be something that
prevents restarting the execution process. */
vm->handlers = Scm_Acons(Scm_NullProc(),
Scm_MakeSubr(release_promise,
(void*)promise, 0, 0,
SCM_MAKE_STR("promise_release")),
vm->handlers);
}
int Scm_CharToUcs(ScmChar ch)
{
if (ch == SCM_CHAR_INVALID) Scm_Error("bad character");
#if defined(GAUCHE_CHAR_ENCODING_UTF_8)
return (int)ch;
#elif defined(GAUCHE_CHAR_ENCODING_EUC_JP) || defined(GAUCHE_CHAR_ENCODING_SJIS)
if (ch < 0x80) return (int)ch; /*ASCII range*/
if (char2ucs_hook == NULL) {
/* NB: we don't need mutex here, for the loading of gauche.charconv
is serialized in Scm_Require. */
Scm_Require(SCM_MAKE_STR("gauche/charconv"),
SCM_LOAD_PROPAGATE_ERROR, NULL);
if (char2ucs_hook == NULL) {
Scm_Error("couldn't autoload gauche.charconv");
}
}
return char2ucs_hook(ch);
#else
return (int)ch; /* ISO8859-1 */
#endif /*!GAUCHE_CHAR_ENCODING_UTF_8*/
}
ScmChar Scm_UcsToChar(int n)
{
if (n < 0) Scm_Error("bad character code: %d", n);
#if defined(GAUCHE_CHAR_ENCODING_UTF_8)
return (ScmChar)n;
#elif defined(GAUCHE_CHAR_ENCODING_EUC_JP) || defined(GAUCHE_CHAR_ENCODING_SJIS)
if (n < 0x80) return (ScmChar)n; /*ASCII range*/
if (ucs2char_hook == NULL) {
/* NB: we don't need mutex here, for the loading of gauche.charconv
is serialized in Scm_Require. */
Scm_Require(SCM_MAKE_STR("gauche/charconv"),
SCM_LOAD_PROPAGATE_ERROR, NULL);
if (ucs2char_hook == NULL) {
Scm_Error("couldn't autoload gauche.charconv");
}
}
return ucs2char_hook(n);
#else
if (n < 0x100) return (ScmChar)n; /* ISO8859-1 */
else return SCM_CHAR_INVALID;
#endif
}
ScmObj test_qnb(void)
{
return SCM_MAKE_STR("qnb is working");
}
ScmObj test_izc(void)
{
return SCM_MAKE_STR("izc is working");
}
ScmObj test_gauche_imlib2(void)
{
return SCM_MAKE_STR("gauche_imlib2 is working");
}
ScmObj Scm_MakeInputConversionPort(ScmPort *fromPort,
const char *fromCode,
const char *toCode,
ScmObj handler,
int bufsiz,
int ownerp)
{
char *inbuf = NULL;
int preread = 0;
if (!SCM_IPORTP(fromPort))
Scm_Error("input port required, but got %S", fromPort);
if (bufsiz <= 0) bufsiz = DEFAULT_CONVERSION_BUFFER_SIZE;
if (bufsiz <= MINIMUM_CONVERSION_BUFFER_SIZE) {
bufsiz = MINIMUM_CONVERSION_BUFFER_SIZE;
}
conv_guess *guess = findGuessingProc(fromCode);
if (guess) {
const char *guessed;
inbuf = SCM_NEW_ATOMIC2(char *, bufsiz);
preread = Scm_Getz(inbuf, bufsiz, fromPort);
if (preread <= 0) {
/* Input buffer is already empty or unreadable.
Determining character code is not necessary.
We just return a dummy empty port. */
return Scm_MakeInputStringPort(SCM_STRING(SCM_MAKE_STR("")), FALSE);
}
guessed = guess->proc(inbuf, preread, guess->data);
if (guessed == NULL)
Scm_Error("%s: failed to guess input encoding", fromCode);
fromCode = guessed;
}
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 = fromPort;
cinfo->ownerp = ownerp;
cinfo->bufsiz = bufsiz;
cinfo->remoteClosed = FALSE;
if (preread > 0) {
cinfo->buf = inbuf;
cinfo->ptr = inbuf + preread;
} else {
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 = conv_input_filler;
bufrec.flusher = NULL;
bufrec.closer = conv_input_closer;
bufrec.ready = conv_ready;
bufrec.filenum = conv_fileno;
bufrec.data = (void*)cinfo;
ScmObj name = conv_name(SCM_PORT_INPUT, fromPort, fromCode, toCode);
return Scm_MakeBufferedPort(SCM_CLASS_PORT, name, SCM_PORT_INPUT, TRUE, &bufrec);
}
ScmObj test_mmlproc(void)
{
return SCM_MAKE_STR("mmlproc is working");
}
/* Process command-line options that needs to run after Scheme runtime
is initialized. CMD_ARGS is an list of (OPTION-CHAR . OPTION-ARG) */
static void process_command_args(ScmObj cmd_args)
{
ScmEvalPacket epak;
ScmLoadPacket lpak;
int standard_given = FALSE;
ScmObj cp;
SCM_FOR_EACH(cp, cmd_args) {
ScmObj p = SCM_CAR(cp);
ScmObj v = SCM_CDR(p);
switch (SCM_CHAR_VALUE(SCM_CAR(p))) {
case 'I':
Scm_AddLoadPath(Scm_GetStringConst(SCM_STRING(v)), FALSE);
break;
case 'A':
Scm_AddLoadPath(Scm_GetStringConst(SCM_STRING(v)), TRUE);
break;
case 'l':
if (Scm_Load(Scm_GetStringConst(SCM_STRING(v)), 0, &lpak) < 0)
error_exit(lpak.exception);
break;
case 'L':
if (Scm_Load(Scm_GetStringConst(SCM_STRING(v)), SCM_LOAD_QUIET_NOFILE, &lpak) < 0)
error_exit(lpak.exception);
break;
case 'u':
if (Scm_Require(Scm_StringJoin(Scm_StringSplitByChar(SCM_STRING(v),
'.'),
SCM_STRING(SCM_MAKE_STR("/")),
SCM_STRING_JOIN_INFIX),
0, &lpak) < 0) {
error_exit(lpak.exception);
}
Scm_ImportModule(SCM_CURRENT_MODULE(), Scm_Intern(SCM_STRING(v)),
SCM_FALSE, 0);
break;
case 'e':
if (Scm_EvalCString(Scm_GetStringConst(SCM_STRING(v)),
SCM_OBJ(Scm_UserModule()),
&epak) < 0) {
error_exit(epak.exception);
}
break;
case 'E':
v = Scm_StringAppend(SCM_LIST3(SCM_MAKE_STR("("),
v,
SCM_MAKE_STR(")")));
if (Scm_EvalCString(Scm_GetStringConst(SCM_STRING(v)),
SCM_OBJ(Scm_UserModule()),
&epak) < 0) {
error_exit(epak.exception);
}
break;
case 'r':
if (standard_given) {
Scm_Error("Multiple -r option is specified.");
} else {
/* R7RS mode. Preload r7rs module, set the default toplevel
to r7rs.user, and define *r7rs-mode* in user module
so that gauche.interactive can do proper setup. */
const char *std = Scm_GetStringConst(SCM_STRING(v));
if (strcmp(std, "7") == 0) {
if (Scm_Require(SCM_MAKE_STR("r7rs"), 0, &lpak) < 0) {
error_exit(lpak.exception);
}
SCM_DEFINE(Scm_UserModule(), "*r7rs-mode*", SCM_TRUE);
default_toplevel_module = SCM_FIND_MODULE("r7rs.user", 0);
standard_given = TRUE;
} else {
Scm_Error("Unsupported standard for -r option: %s", std);
}
}
}
}