[uim-commit] r3024 - branches/r5rs/sigscheme/src
yamaken at freedesktop.org
yamaken at freedesktop.org
Sun Jan 29 14:05:18 PST 2006
Author: yamaken
Date: 2006-01-29 14:05:11 -0800 (Sun, 29 Jan 2006)
New Revision: 3024
Added:
branches/r5rs/sigscheme/src/port.c
Removed:
branches/r5rs/sigscheme/src/io.c
Modified:
branches/r5rs/sigscheme/src/Makefile.am
branches/r5rs/sigscheme/src/sigscheme.c
branches/r5rs/sigscheme/src/sigscheme.h
branches/r5rs/sigscheme/src/sigschemeinternal.h
Log:
* sigscheme/src/sigschemeinternal.h
- (scm_init_io, scm_init_port): Rename scm_init_io to scm_init_port
* sigscheme/src/io.c
- Rename to port.c
* sigscheme/src/port.c
- Renamed from io.c
- (scm_init_io, scm_init_port): Rename scm_init_io to scm_init_port
* sigscheme/src/sigscheme.c
- (scm_initialize_internal): Follow the renaming
* sigscheme/src/sigscheme.h
- Move prototype section
* sigscheme/src/Makefile.am
- (R5RS_PROC_SRCS, libsscm_la_SOURCES): Follow the file renaming
Modified: branches/r5rs/sigscheme/src/Makefile.am
===================================================================
--- branches/r5rs/sigscheme/src/Makefile.am 2006-01-29 21:49:33 UTC (rev 3023)
+++ branches/r5rs/sigscheme/src/Makefile.am 2006-01-29 22:05:11 UTC (rev 3024)
@@ -24,7 +24,7 @@
./script/functable-footer.txt
R5RS_PROC_SRCS = sigscheme.c operations.c eval.c list.c number.c string.c \
- vector.c io.c read.c write.c load.c
+ vector.c port.c read.c write.c load.c
sigschemefunctable.c: $(FUNC_TABLES)
sigschemefunctable-r5rs-syntax.c: syntax.c $(BUILD_FUNCTBL_SOURCES)
@@ -61,16 +61,14 @@
storage-fatty.h storage-compact.h
libsscm_la_SOURCES = \
config-asprintf.h \
- alloc.c storage.c write.c \
- storage-gc.c \
- storage-symbol.c \
+ alloc.c storage.c storage-gc.c storage-symbol.c \
storage-continuation.c \
encoding.c error.c \
env.c eval.c syntax.c list.c number.c string.c vector.c \
- io.c load.c\
+ port.c read.c write.c load.c\
basecport.c fileport.c \
operations.c \
- read.c sigscheme.c sigschemefunctable.c \
+ sigscheme.c sigschemefunctable.c \
sigscheme.h sigschemefunctable.h
libsscm_la_CFLAGS = -Wall
Deleted: branches/r5rs/sigscheme/src/io.c
===================================================================
--- branches/r5rs/sigscheme/src/io.c 2006-01-29 21:49:33 UTC (rev 3023)
+++ branches/r5rs/sigscheme/src/io.c 2006-01-29 22:05:11 UTC (rev 3024)
@@ -1,518 +0,0 @@
-/*===========================================================================
- * FileName : io.c
- * About : io related functions
- *
- * Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
- *
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions
- * are met:
- *
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- * 3. Neither the name of authors nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
- * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
- * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
- * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
- * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-===========================================================================*/
-/*=======================================
- System Include
-=======================================*/
-#include <stddef.h>
-#include <stdio.h>
-
-/*=======================================
- Local Include
-=======================================*/
-#include "sigscheme.h"
-#include "sigschemeinternal.h"
-#if SCM_USE_MULTIBYTE_CHAR
-#include "mbcport.h"
-#else /* SCM_USE_MULTIBYTE_CHAR */
-#include "sbcport.h"
-#endif /* SCM_USE_MULTIBYTE_CHAR */
-#include "fileport.h"
-
-/*=======================================
- File Local Struct Declarations
-=======================================*/
-
-/*=======================================
- File Local Macro Declarations
-=======================================*/
-
-/*=======================================
- Variable Declarations
-=======================================*/
-ScmObj scm_in; /* current-input-port */
-ScmObj scm_out; /* current-output-port */
-ScmObj scm_err; /* current error port */
-
-/*=======================================
- File Local Function Declarations
-=======================================*/
-
-/*=======================================
- Function Implementations
-=======================================*/
-void
-scm_init_io(void)
-{
- scm_fileport_init();
-#if SCM_USE_MULTIBYTE_CHAR
- scm_mbcport_init();
-#else
- scm_sbcport_init();
-#endif
-
- scm_gc_protect_with_init(&scm_in,
- scm_make_shared_file_port(stdin, "stdin",
- SCM_PORTFLAG_INPUT));
- scm_gc_protect_with_init(&scm_out,
- scm_make_shared_file_port(stdout, "stdout",
- SCM_PORTFLAG_OUTPUT));
- scm_gc_protect_with_init(&scm_err,
- scm_make_shared_file_port(stderr, "stderr",
- SCM_PORTFLAG_OUTPUT));
-}
-
-ScmObj
-scm_prepare_port(ScmObj args, ScmObj default_port)
-{
- ScmObj port;
- DECLARE_INTERNAL_FUNCTION("prepare_port");
-
- ASSERT_PROPER_ARG_LIST(args);
-
- if (NULLP(args)) {
- port = default_port;
- } else {
- port = POP(args);
- ASSERT_NO_MORE_ARG(args);
- ENSURE_PORT(port);
- }
-
- return port;
-}
-
-ScmCharPort *
-scm_make_char_port(ScmBytePort *bport)
-{
-#if SCM_USE_MULTIBYTE_CHAR
- return ScmMultiByteCharPort_new(bport, scm_current_char_codec);
-#else
- return ScmSingleByteCharPort_new(bport);
-#endif
-}
-
-ScmObj
-scm_make_shared_file_port(FILE *file, const char *aux_info,
- enum ScmPortFlag flag)
-{
- ScmBytePort *bport;
- ScmCharPort *cport;
-
- /* GC safe */
- bport = ScmFilePort_new_shared(file, aux_info);
- cport = scm_make_char_port(bport);
- return MAKE_PORT(cport, flag);
-}
-
-int
-scm_port_printf(ScmObj port, const char *fmt, ...)
-{
- int ret;
- va_list args;
-
- va_start(args, fmt);
- ret = scm_port_vprintf(port, fmt, args);
- va_end(args);
-
- return ret;
-}
-
-int
-scm_port_vprintf(ScmObj port, const char *fmt, va_list args)
-{
- int ret;
-
- SCM_ENSURE_LIVE_PORT(port);
- ret = SCM_CHARPORT_VPRINTF(SCM_PORT_IMPL(port), fmt, args);
-#if SCM_VOLATILE_OUTPUT
- scm_port_flush(port);
-#endif
-
- return ret;
-}
-
-int
-scm_port_newline(ScmObj port)
-{
- int err;
-
- err = scm_port_puts(port, SCM_NEWLINE_STR);
- scm_port_flush(port); /* required */
-
- return err;
-}
-
-int
-scm_port_close(ScmObj port)
-{
- int err;
-
- err = SCM_CHARPORT_CLOSE(SCM_PORT_IMPL(port));
- SCM_PORT_SET_IMPL(port, NULL);
-
- return err;
-}
-
-ScmCharCodec *
-scm_port_codec(ScmObj port)
-{
- SCM_ENSURE_LIVE_PORT(port);
- return SCM_CHARPORT_CODEC(SCM_PORT_IMPL(port));
-}
-
-char *
-scm_port_inspect(ScmObj port)
-{
- SCM_ENSURE_LIVE_PORT(port);
- return SCM_CHARPORT_INSPECT(SCM_PORT_IMPL(port));
-}
-
-int
-scm_port_get_char(ScmObj port)
-{
- SCM_ENSURE_LIVE_PORT(port);
- return SCM_CHARPORT_GET_CHAR(SCM_PORT_IMPL(port));
-}
-
-int
-scm_port_peek_char(ScmObj port)
-{
- SCM_ENSURE_LIVE_PORT(port);
- return SCM_CHARPORT_PEEK_CHAR(SCM_PORT_IMPL(port));
-}
-
-scm_bool
-scm_port_char_readyp(ScmObj port)
-{
- SCM_ENSURE_LIVE_PORT(port);
- return SCM_CHARPORT_CHAR_READYP(SCM_PORT_IMPL(port));
-}
-
-int
-scm_port_puts(ScmObj port, const char *str)
-{
- SCM_ENSURE_LIVE_PORT(port);
- return SCM_CHARPORT_PUTS(SCM_PORT_IMPL(port), str);
-}
-
-int
-scm_port_put_char(ScmObj port, scm_ichar_t ch)
-{
- SCM_ENSURE_LIVE_PORT(port);
- return SCM_CHARPORT_PUT_CHAR(SCM_PORT_IMPL(port), ch);
-}
-
-int
-scm_port_flush(ScmObj port)
-{
- SCM_ENSURE_LIVE_PORT(port);
- return SCM_CHARPORT_FLUSH(SCM_PORT_IMPL(port));
-}
-
-/*=======================================
- R5RS : 6.6 Input and Output
-=======================================*/
-/*===========================================================================
- R5RS : 6.6 Input and Output : 6.6.1 Ports
-===========================================================================*/
-ScmObj
-scm_p_call_with_input_file(ScmObj filepath, ScmObj proc)
-{
- ScmObj port, ret;
- DECLARE_FUNCTION("call-with-input-file", procedure_fixed_2);
-
- ENSURE_STRING(filepath);
- ENSURE_PROCEDURE(proc);
-
- port = scm_p_open_input_file(filepath);
-
- ret = scm_call(proc, LIST_1(port));
-
- scm_p_close_input_port(port);
-
- return ret;
-}
-
-ScmObj
-scm_p_call_with_output_file(ScmObj filepath, ScmObj proc)
-{
- ScmObj port, ret;
- DECLARE_FUNCTION("call-with-output-file", procedure_fixed_2);
-
- ENSURE_STRING(filepath);
- ENSURE_PROCEDURE(proc);
-
- port = scm_p_open_output_file(filepath);
-
- ret = scm_call(proc, LIST_1(port));
-
- scm_p_close_output_port(port);
-
- return ret;
-}
-
-ScmObj
-scm_p_input_portp(ScmObj port)
-{
- DECLARE_FUNCTION("input-port?", procedure_fixed_1);
-
- ENSURE_PORT(port);
-
- return MAKE_BOOL(SCM_PORT_FLAG(port) & SCM_PORTFLAG_INPUT);
-}
-
-ScmObj
-scm_p_output_portp(ScmObj port)
-{
- DECLARE_FUNCTION("output-port?", procedure_fixed_1);
-
- ENSURE_PORT(port);
-
- return MAKE_BOOL(SCM_PORT_FLAG(port) & SCM_PORTFLAG_OUTPUT);
-}
-
-ScmObj
-scm_p_current_input_port(void)
-{
- DECLARE_FUNCTION("current-input-port", procedure_fixed_0);
-
- return scm_in;
-}
-
-ScmObj
-scm_p_current_output_port(void)
-{
- DECLARE_FUNCTION("current-output-port", procedure_fixed_0);
-
- return scm_out;
-}
-
-ScmObj
-scm_p_with_input_from_file(ScmObj filepath, ScmObj thunk)
-{
- ScmObj saved_port, ret;
- DECLARE_FUNCTION("with-input-from-file", procedure_fixed_2);
-
- ENSURE_STRING(filepath);
- ENSURE_PROCEDURE(thunk);
-
- saved_port = scm_in;
- scm_in = scm_p_open_input_file(filepath);
-
- ret = scm_call(thunk, SCM_NULL);
-
- scm_p_close_input_port(scm_in);
- scm_in = saved_port;
-
- return ret;
-}
-
-ScmObj
-scm_p_with_output_to_file(ScmObj filepath, ScmObj thunk)
-{
- ScmObj saved_port, ret;
- DECLARE_FUNCTION("with-output-to-file", procedure_fixed_2);
-
- ENSURE_STRING(filepath);
- ENSURE_PROCEDURE(thunk);
-
- saved_port = scm_out;
- scm_out = scm_p_open_output_file(filepath);
-
- ret = scm_call(thunk, SCM_NULL);
-
- scm_p_close_output_port(scm_out);
- scm_out = saved_port;
-
- return ret;
-}
-
-ScmObj
-scm_p_open_input_file(ScmObj filepath)
-{
- ScmBytePort *bport;
- ScmCharPort *cport;
- DECLARE_FUNCTION("open-input-file", procedure_fixed_1);
-
- ENSURE_STRING(filepath);
-
- bport = ScmFilePort_open_input_file(SCM_STRING_STR(filepath));
- if (!bport)
- ERR_OBJ("cannot open file ", filepath);
- cport = scm_make_char_port(bport);
-
- return MAKE_PORT(cport, SCM_PORTFLAG_INPUT);
-}
-
-ScmObj
-scm_p_open_output_file(ScmObj filepath)
-{
- ScmBytePort *bport;
- ScmCharPort *cport;
- DECLARE_FUNCTION("open-output-file", procedure_fixed_1);
-
- ENSURE_STRING(filepath);
-
- bport = ScmFilePort_open_output_file(SCM_STRING_STR(filepath));
- if (!bport)
- ERR_OBJ("cannot open file ", filepath);
- cport = scm_make_char_port(bport);
-
- return MAKE_PORT(cport, SCM_PORTFLAG_OUTPUT);
-}
-
-ScmObj
-scm_p_close_input_port(ScmObj port)
-{
- scm_int_t flag;
- DECLARE_FUNCTION("close-input-port", procedure_fixed_1);
-
- ENSURE_PORT(port);
-
- flag = SCM_PORT_FLAG(port) & ~SCM_PORTFLAG_LIVE_INPUT;
- SCM_PORT_SET_FLAG(port, flag);
- if (!(flag & SCM_PORTFLAG_ALIVENESS_MASK) && SCM_PORT_IMPL(port))
- scm_port_close(port);
-
- return SCM_UNDEF;
-}
-
-ScmObj
-scm_p_close_output_port(ScmObj port)
-{
- scm_int_t flag;
- DECLARE_FUNCTION("close-output-port", procedure_fixed_1);
-
- ENSURE_PORT(port);
-
- flag = SCM_PORT_FLAG(port) & ~SCM_PORTFLAG_LIVE_OUTPUT;
- SCM_PORT_SET_FLAG(port, flag);
- if (!(flag & SCM_PORTFLAG_ALIVENESS_MASK) && SCM_PORT_IMPL(port))
- scm_port_close(port);
-
- return SCM_UNDEF;
-}
-
-/*===========================================================================
- R5RS : 6.6 Input and Output : 6.6.2 Input
-===========================================================================*/
-/* scm_p_read() is separated into read.c */
-
-ScmObj
-scm_p_read_char(ScmObj args)
-{
- ScmObj port;
- scm_ichar_t ch;
- DECLARE_FUNCTION("read-char", procedure_variadic_0);
-
- port = scm_prepare_port(args, scm_in);
-
- ch = scm_port_get_char(port);
- if (ch == EOF)
- return SCM_EOF;
-
- return MAKE_CHAR(ch);
-}
-
-ScmObj
-scm_p_peek_char(ScmObj args)
-{
- ScmObj port;
- scm_ichar_t ch;
- DECLARE_FUNCTION("peek-char", procedure_variadic_0);
-
- port = scm_prepare_port(args, scm_in);
-
- ch = scm_port_peek_char(port);
- if (ch == EOF)
- return SCM_EOF;
-
- return MAKE_CHAR(ch);
-}
-
-ScmObj
-scm_p_eof_objectp(ScmObj obj)
-{
- DECLARE_FUNCTION("eof-object?", procedure_fixed_1);
-
- return MAKE_BOOL(EOFP(obj));
-}
-
-ScmObj
-scm_p_char_readyp(ScmObj args)
-{
- ScmObj port;
- scm_bool res;
- DECLARE_FUNCTION("char-ready?", procedure_variadic_0);
-
- port = scm_prepare_port(args, scm_in);
- res = scm_port_char_readyp(port);
-
- return MAKE_BOOL(res);
-}
-
-/*===========================================================================
- R5RS : 6.6 Input and Output : 6.6.3 Output
-===========================================================================*/
-/* scm_p_write() and scm_p_display() are separated into write.c */
-
-ScmObj
-scm_p_newline(ScmObj args)
-{
- ScmObj port;
- DECLARE_FUNCTION("newline", procedure_variadic_0);
-
- port = scm_prepare_port(args, scm_out);
- scm_port_newline(port);
- return SCM_UNDEF;
-}
-
-ScmObj
-scm_p_write_char(ScmObj obj, ScmObj args)
-{
- ScmObj port;
- DECLARE_FUNCTION("write-char", procedure_variadic_1);
-
- ENSURE_CHAR(obj);
-
- port = scm_prepare_port(args, scm_out);
- scm_port_put_char(port, SCM_CHAR_VALUE(obj));
- return SCM_UNDEF;
-}
-
-/* FIXME: link conditionally with autoconf */
-#if SCM_USE_MULTIBYTE_CHAR
-#include "mbcport.c"
-#else /* SCM_USE_MULTIBYTE_CHAR */
-#include "sbcport.c"
-#endif /* SCM_USE_MULTIBYTE_CHAR */
Copied: branches/r5rs/sigscheme/src/port.c (from rev 3023, branches/r5rs/sigscheme/src/io.c)
===================================================================
--- branches/r5rs/sigscheme/src/io.c 2006-01-29 21:49:33 UTC (rev 3023)
+++ branches/r5rs/sigscheme/src/port.c 2006-01-29 22:05:11 UTC (rev 3024)
@@ -0,0 +1,518 @@
+/*===========================================================================
+ * FileName : port.c
+ * About : R5RS ports
+ *
+ * Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+===========================================================================*/
+/*=======================================
+ System Include
+=======================================*/
+#include <stddef.h>
+#include <stdio.h>
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+#if SCM_USE_MULTIBYTE_CHAR
+#include "mbcport.h"
+#else /* SCM_USE_MULTIBYTE_CHAR */
+#include "sbcport.h"
+#endif /* SCM_USE_MULTIBYTE_CHAR */
+#include "fileport.h"
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+ScmObj scm_in; /* current-input-port */
+ScmObj scm_out; /* current-output-port */
+ScmObj scm_err; /* current error port */
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+
+/*=======================================
+ Function Implementations
+=======================================*/
+void
+scm_init_port(void)
+{
+ scm_fileport_init();
+#if SCM_USE_MULTIBYTE_CHAR
+ scm_mbcport_init();
+#else
+ scm_sbcport_init();
+#endif
+
+ scm_gc_protect_with_init(&scm_in,
+ scm_make_shared_file_port(stdin, "stdin",
+ SCM_PORTFLAG_INPUT));
+ scm_gc_protect_with_init(&scm_out,
+ scm_make_shared_file_port(stdout, "stdout",
+ SCM_PORTFLAG_OUTPUT));
+ scm_gc_protect_with_init(&scm_err,
+ scm_make_shared_file_port(stderr, "stderr",
+ SCM_PORTFLAG_OUTPUT));
+}
+
+ScmObj
+scm_prepare_port(ScmObj args, ScmObj default_port)
+{
+ ScmObj port;
+ DECLARE_INTERNAL_FUNCTION("prepare_port");
+
+ ASSERT_PROPER_ARG_LIST(args);
+
+ if (NULLP(args)) {
+ port = default_port;
+ } else {
+ port = POP(args);
+ ASSERT_NO_MORE_ARG(args);
+ ENSURE_PORT(port);
+ }
+
+ return port;
+}
+
+ScmCharPort *
+scm_make_char_port(ScmBytePort *bport)
+{
+#if SCM_USE_MULTIBYTE_CHAR
+ return ScmMultiByteCharPort_new(bport, scm_current_char_codec);
+#else
+ return ScmSingleByteCharPort_new(bport);
+#endif
+}
+
+ScmObj
+scm_make_shared_file_port(FILE *file, const char *aux_info,
+ enum ScmPortFlag flag)
+{
+ ScmBytePort *bport;
+ ScmCharPort *cport;
+
+ /* GC safe */
+ bport = ScmFilePort_new_shared(file, aux_info);
+ cport = scm_make_char_port(bport);
+ return MAKE_PORT(cport, flag);
+}
+
+int
+scm_port_printf(ScmObj port, const char *fmt, ...)
+{
+ int ret;
+ va_list args;
+
+ va_start(args, fmt);
+ ret = scm_port_vprintf(port, fmt, args);
+ va_end(args);
+
+ return ret;
+}
+
+int
+scm_port_vprintf(ScmObj port, const char *fmt, va_list args)
+{
+ int ret;
+
+ SCM_ENSURE_LIVE_PORT(port);
+ ret = SCM_CHARPORT_VPRINTF(SCM_PORT_IMPL(port), fmt, args);
+#if SCM_VOLATILE_OUTPUT
+ scm_port_flush(port);
+#endif
+
+ return ret;
+}
+
+int
+scm_port_newline(ScmObj port)
+{
+ int err;
+
+ err = scm_port_puts(port, SCM_NEWLINE_STR);
+ scm_port_flush(port); /* required */
+
+ return err;
+}
+
+int
+scm_port_close(ScmObj port)
+{
+ int err;
+
+ err = SCM_CHARPORT_CLOSE(SCM_PORT_IMPL(port));
+ SCM_PORT_SET_IMPL(port, NULL);
+
+ return err;
+}
+
+ScmCharCodec *
+scm_port_codec(ScmObj port)
+{
+ SCM_ENSURE_LIVE_PORT(port);
+ return SCM_CHARPORT_CODEC(SCM_PORT_IMPL(port));
+}
+
+char *
+scm_port_inspect(ScmObj port)
+{
+ SCM_ENSURE_LIVE_PORT(port);
+ return SCM_CHARPORT_INSPECT(SCM_PORT_IMPL(port));
+}
+
+int
+scm_port_get_char(ScmObj port)
+{
+ SCM_ENSURE_LIVE_PORT(port);
+ return SCM_CHARPORT_GET_CHAR(SCM_PORT_IMPL(port));
+}
+
+int
+scm_port_peek_char(ScmObj port)
+{
+ SCM_ENSURE_LIVE_PORT(port);
+ return SCM_CHARPORT_PEEK_CHAR(SCM_PORT_IMPL(port));
+}
+
+scm_bool
+scm_port_char_readyp(ScmObj port)
+{
+ SCM_ENSURE_LIVE_PORT(port);
+ return SCM_CHARPORT_CHAR_READYP(SCM_PORT_IMPL(port));
+}
+
+int
+scm_port_puts(ScmObj port, const char *str)
+{
+ SCM_ENSURE_LIVE_PORT(port);
+ return SCM_CHARPORT_PUTS(SCM_PORT_IMPL(port), str);
+}
+
+int
+scm_port_put_char(ScmObj port, scm_ichar_t ch)
+{
+ SCM_ENSURE_LIVE_PORT(port);
+ return SCM_CHARPORT_PUT_CHAR(SCM_PORT_IMPL(port), ch);
+}
+
+int
+scm_port_flush(ScmObj port)
+{
+ SCM_ENSURE_LIVE_PORT(port);
+ return SCM_CHARPORT_FLUSH(SCM_PORT_IMPL(port));
+}
+
+/*=======================================
+ R5RS : 6.6 Input and Output
+=======================================*/
+/*===========================================================================
+ R5RS : 6.6 Input and Output : 6.6.1 Ports
+===========================================================================*/
+ScmObj
+scm_p_call_with_input_file(ScmObj filepath, ScmObj proc)
+{
+ ScmObj port, ret;
+ DECLARE_FUNCTION("call-with-input-file", procedure_fixed_2);
+
+ ENSURE_STRING(filepath);
+ ENSURE_PROCEDURE(proc);
+
+ port = scm_p_open_input_file(filepath);
+
+ ret = scm_call(proc, LIST_1(port));
+
+ scm_p_close_input_port(port);
+
+ return ret;
+}
+
+ScmObj
+scm_p_call_with_output_file(ScmObj filepath, ScmObj proc)
+{
+ ScmObj port, ret;
+ DECLARE_FUNCTION("call-with-output-file", procedure_fixed_2);
+
+ ENSURE_STRING(filepath);
+ ENSURE_PROCEDURE(proc);
+
+ port = scm_p_open_output_file(filepath);
+
+ ret = scm_call(proc, LIST_1(port));
+
+ scm_p_close_output_port(port);
+
+ return ret;
+}
+
+ScmObj
+scm_p_input_portp(ScmObj port)
+{
+ DECLARE_FUNCTION("input-port?", procedure_fixed_1);
+
+ ENSURE_PORT(port);
+
+ return MAKE_BOOL(SCM_PORT_FLAG(port) & SCM_PORTFLAG_INPUT);
+}
+
+ScmObj
+scm_p_output_portp(ScmObj port)
+{
+ DECLARE_FUNCTION("output-port?", procedure_fixed_1);
+
+ ENSURE_PORT(port);
+
+ return MAKE_BOOL(SCM_PORT_FLAG(port) & SCM_PORTFLAG_OUTPUT);
+}
+
+ScmObj
+scm_p_current_input_port(void)
+{
+ DECLARE_FUNCTION("current-input-port", procedure_fixed_0);
+
+ return scm_in;
+}
+
+ScmObj
+scm_p_current_output_port(void)
+{
+ DECLARE_FUNCTION("current-output-port", procedure_fixed_0);
+
+ return scm_out;
+}
+
+ScmObj
+scm_p_with_input_from_file(ScmObj filepath, ScmObj thunk)
+{
+ ScmObj saved_port, ret;
+ DECLARE_FUNCTION("with-input-from-file", procedure_fixed_2);
+
+ ENSURE_STRING(filepath);
+ ENSURE_PROCEDURE(thunk);
+
+ saved_port = scm_in;
+ scm_in = scm_p_open_input_file(filepath);
+
+ ret = scm_call(thunk, SCM_NULL);
+
+ scm_p_close_input_port(scm_in);
+ scm_in = saved_port;
+
+ return ret;
+}
+
+ScmObj
+scm_p_with_output_to_file(ScmObj filepath, ScmObj thunk)
+{
+ ScmObj saved_port, ret;
+ DECLARE_FUNCTION("with-output-to-file", procedure_fixed_2);
+
+ ENSURE_STRING(filepath);
+ ENSURE_PROCEDURE(thunk);
+
+ saved_port = scm_out;
+ scm_out = scm_p_open_output_file(filepath);
+
+ ret = scm_call(thunk, SCM_NULL);
+
+ scm_p_close_output_port(scm_out);
+ scm_out = saved_port;
+
+ return ret;
+}
+
+ScmObj
+scm_p_open_input_file(ScmObj filepath)
+{
+ ScmBytePort *bport;
+ ScmCharPort *cport;
+ DECLARE_FUNCTION("open-input-file", procedure_fixed_1);
+
+ ENSURE_STRING(filepath);
+
+ bport = ScmFilePort_open_input_file(SCM_STRING_STR(filepath));
+ if (!bport)
+ ERR_OBJ("cannot open file ", filepath);
+ cport = scm_make_char_port(bport);
+
+ return MAKE_PORT(cport, SCM_PORTFLAG_INPUT);
+}
+
+ScmObj
+scm_p_open_output_file(ScmObj filepath)
+{
+ ScmBytePort *bport;
+ ScmCharPort *cport;
+ DECLARE_FUNCTION("open-output-file", procedure_fixed_1);
+
+ ENSURE_STRING(filepath);
+
+ bport = ScmFilePort_open_output_file(SCM_STRING_STR(filepath));
+ if (!bport)
+ ERR_OBJ("cannot open file ", filepath);
+ cport = scm_make_char_port(bport);
+
+ return MAKE_PORT(cport, SCM_PORTFLAG_OUTPUT);
+}
+
+ScmObj
+scm_p_close_input_port(ScmObj port)
+{
+ scm_int_t flag;
+ DECLARE_FUNCTION("close-input-port", procedure_fixed_1);
+
+ ENSURE_PORT(port);
+
+ flag = SCM_PORT_FLAG(port) & ~SCM_PORTFLAG_LIVE_INPUT;
+ SCM_PORT_SET_FLAG(port, flag);
+ if (!(flag & SCM_PORTFLAG_ALIVENESS_MASK) && SCM_PORT_IMPL(port))
+ scm_port_close(port);
+
+ return SCM_UNDEF;
+}
+
+ScmObj
+scm_p_close_output_port(ScmObj port)
+{
+ scm_int_t flag;
+ DECLARE_FUNCTION("close-output-port", procedure_fixed_1);
+
+ ENSURE_PORT(port);
+
+ flag = SCM_PORT_FLAG(port) & ~SCM_PORTFLAG_LIVE_OUTPUT;
+ SCM_PORT_SET_FLAG(port, flag);
+ if (!(flag & SCM_PORTFLAG_ALIVENESS_MASK) && SCM_PORT_IMPL(port))
+ scm_port_close(port);
+
+ return SCM_UNDEF;
+}
+
+/*===========================================================================
+ R5RS : 6.6 Input and Output : 6.6.2 Input
+===========================================================================*/
+/* scm_p_read() is separated into read.c */
+
+ScmObj
+scm_p_read_char(ScmObj args)
+{
+ ScmObj port;
+ scm_ichar_t ch;
+ DECLARE_FUNCTION("read-char", procedure_variadic_0);
+
+ port = scm_prepare_port(args, scm_in);
+
+ ch = scm_port_get_char(port);
+ if (ch == EOF)
+ return SCM_EOF;
+
+ return MAKE_CHAR(ch);
+}
+
+ScmObj
+scm_p_peek_char(ScmObj args)
+{
+ ScmObj port;
+ scm_ichar_t ch;
+ DECLARE_FUNCTION("peek-char", procedure_variadic_0);
+
+ port = scm_prepare_port(args, scm_in);
+
+ ch = scm_port_peek_char(port);
+ if (ch == EOF)
+ return SCM_EOF;
+
+ return MAKE_CHAR(ch);
+}
+
+ScmObj
+scm_p_eof_objectp(ScmObj obj)
+{
+ DECLARE_FUNCTION("eof-object?", procedure_fixed_1);
+
+ return MAKE_BOOL(EOFP(obj));
+}
+
+ScmObj
+scm_p_char_readyp(ScmObj args)
+{
+ ScmObj port;
+ scm_bool res;
+ DECLARE_FUNCTION("char-ready?", procedure_variadic_0);
+
+ port = scm_prepare_port(args, scm_in);
+ res = scm_port_char_readyp(port);
+
+ return MAKE_BOOL(res);
+}
+
+/*===========================================================================
+ R5RS : 6.6 Input and Output : 6.6.3 Output
+===========================================================================*/
+/* scm_p_write() and scm_p_display() are separated into write.c */
+
+ScmObj
+scm_p_newline(ScmObj args)
+{
+ ScmObj port;
+ DECLARE_FUNCTION("newline", procedure_variadic_0);
+
+ port = scm_prepare_port(args, scm_out);
+ scm_port_newline(port);
+ return SCM_UNDEF;
+}
+
+ScmObj
+scm_p_write_char(ScmObj obj, ScmObj args)
+{
+ ScmObj port;
+ DECLARE_FUNCTION("write-char", procedure_variadic_1);
+
+ ENSURE_CHAR(obj);
+
+ port = scm_prepare_port(args, scm_out);
+ scm_port_put_char(port, SCM_CHAR_VALUE(obj));
+ return SCM_UNDEF;
+}
+
+/* FIXME: link conditionally with autoconf */
+#if SCM_USE_MULTIBYTE_CHAR
+#include "mbcport.c"
+#else /* SCM_USE_MULTIBYTE_CHAR */
+#include "sbcport.c"
+#endif /* SCM_USE_MULTIBYTE_CHAR */
Modified: branches/r5rs/sigscheme/src/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.c 2006-01-29 21:49:33 UTC (rev 3023)
+++ branches/r5rs/sigscheme/src/sigscheme.c 2006-01-29 22:05:11 UTC (rev 3024)
@@ -151,7 +151,7 @@
| scm_predefined_debug_categories());
scm_init_storage(storage_conf);
scm_init_error();
- scm_init_io();
+ scm_init_port();
/* fallback to unibyte */
scm_identifier_codec = scm_mb_find_codec("UTF-8");
Modified: branches/r5rs/sigscheme/src/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.h 2006-01-29 21:49:33 UTC (rev 3023)
+++ branches/r5rs/sigscheme/src/sigscheme.h 2006-01-29 22:05:11 UTC (rev 3024)
@@ -1332,7 +1332,6 @@
#endif
/* io.c */
-void scm_set_lib_path(const char *path);
ScmObj scm_make_shared_file_port(FILE *file, const char *aux_info,
enum ScmPortFlag flag);
int scm_port_close(ScmObj port);
@@ -1366,9 +1365,6 @@
ScmObj scm_p_newline(ScmObj args);
ScmObj scm_p_write_char(ScmObj obj, ScmObj args);
-void scm_load(const char *filename);
-ScmObj scm_p_load(ScmObj filename);
-
/* read.c */
ScmObj scm_read(ScmObj port);
ScmObj scm_read_char(ScmObj port);
@@ -1384,6 +1380,11 @@
ScmObj scm_p_write(ScmObj obj, ScmObj args);
ScmObj scm_p_display(ScmObj obj, ScmObj args);
+/* load.c */
+void scm_set_lib_path(const char *path);
+void scm_load(const char *filename);
+ScmObj scm_p_load(ScmObj filename);
+
/* error.c */
int scm_debug_categories(void);
void scm_set_debug_categories(int categories);
Modified: branches/r5rs/sigscheme/src/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-01-29 21:49:33 UTC (rev 3023)
+++ branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-01-29 22:05:11 UTC (rev 3024)
@@ -528,8 +528,8 @@
scm_int_t scm_finite_length(ScmObj lst);
scm_int_t scm_length(ScmObj lst);
-/* io.c */
-void scm_init_io(void);
+/* port.c */
+void scm_init_port(void);
ScmObj scm_prepare_port(ScmObj args, ScmObj default_port);
ScmCharPort *scm_make_char_port(ScmBytePort *bport);
More information about the uim-commit
mailing list