[uim-commit] r1911 - branches/r5rs/sigscheme

yamaken at freedesktop.org yamaken at freedesktop.org
Mon Oct 31 12:20:17 PST 2005


Author: yamaken
Date: 2005-10-31 12:20:10 -0800 (Mon, 31 Oct 2005)
New Revision: 1911

Modified:
   branches/r5rs/sigscheme/config.h
   branches/r5rs/sigscheme/datas.c
   branches/r5rs/sigscheme/debug.c
   branches/r5rs/sigscheme/error.c
   branches/r5rs/sigscheme/io.c
   branches/r5rs/sigscheme/operations-srfi6.c
   branches/r5rs/sigscheme/read.c
   branches/r5rs/sigscheme/sigscheme.c
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/sigschemeinternal.h
   branches/r5rs/sigscheme/sigschemetype.h
Log:
* This commit enables the new abstract port implementation. Basic
  tests are passed. sigschemetype-compact.h is not supported yet

* sigscheme/config.h
  - (SCM_USE_NEWPORT): New macro
  - Enable SCM_USE_SRFI6 if SCM_USE_NEWPORT is enabled
* sigscheme/sigschemetype.h
  - (struct _ScmPortInfo, ScmPortInfo, enum ScmPortDirection, enum
    ScmPortType): Disable when SCM_USE_NEWPORT
  - (enum ScmPortFlag): New type
  - (struct ScmCell_): Support SCM_USE_NEWPORT
  - (SCM_PORT_FLAG, SCM_PORT_SET_FLAG, SCM_PORT_IMPL,
    SCM_PORT_SET_IMPL): New macro
  - (SCM_PORT_LINE): Define as dummy when SCM_USE_NEWPORT
  - (SCM_PORT_PORTDIRECTION, SCM_PORT_SET_PORTDIRECTION,
    SCM_PORT_PORTINFO, SCM_PORT_SET_PORTINFO, SCM_PORT_PORTTYPE,
    SCM_PORT_SET_PORTTYPE, SCM_PORT_UNGOTTENCHAR,
    SCM_PORT_SET_UNGOTTENCHAR, SCM_PORT_GETC_FUNC,
    SCM_PORT_SET_GETC_FUNC, SCM_PORT_PRINT_FUNC,
    SCM_PORT_SET_PRINT_FUNC, SCM_PORT_FILE, SCM_PORT_SET_FILE,
    SCM_PORT_FILENAME, SCM_PORT_SET_FILENAME, SCM_PORT_SET_LINE,
    SCM_PORT_STR, SCM_PORT_SET_STR, SCM_PORT_STR_CURRENTPOS,
    SCM_PORT_SET_STR_CURRENTPOS): Disable when SCM_USE_NEWPORT
* sigscheme/sigscheme.h
  - (SCM_ASSERT_LIVE_PORT, SCM_PORT_CLOSE_IMPL, SCM_PORT_ENCODING,
    SCM_PORT_GET_CHAR, SCM_PORT_PEEK_CHAR, SCM_PORT_CHAR_READYP,
    SCM_PORT_VPRINTF, SCM_PORT_PUTS, SCM_PORT_PUT_CHAR,
    SCM_PORT_FLUSH): New macro
  - (SCM_PORT_GETC, SCM_PORT_UNGETC, SCM_PORT_PRINT): Support
    SCM_USE_NEWPORT as backward compatibility
  - (Scm_NewPort, SigScm_GC_Unprotect): New function decl
  - (Scm_NewFilePort, Scm_NewStringPort): Disable when SCM_USE_NEWPORT
  - (ScmOp_peek_char, ScmOp_char_readyp): Modify function type
    appropriately
* sigscheme/sigschemeinternal.h
  - (SigScm_PortPrintf, SigScm_VPortPrintf): New function decl
* sigscheme/io.c
  - include sbcport.c and fileport.c
  - (ScmOp_input_portp, ScmOp_output_portp, ScmOp_open_input_file,
    ScmOp_open_output_file, ScmOp_close_input_port,
    ScmOp_close_output_port): Support SCM_USE_NEWPORT
  - (ScmOp_read_char):
    * Ditto
    * Fix EOF handling (in SCM_USE_NEWPORT only)
  - (ScmOp_peek_char, ScmOp_char_readyp): Implement (in
    SCM_USE_NEWPORT only) and Modify function type appropriately
* sigscheme/datas.c
  - (sweep_obj): Support SCM_USE_NEWPORT
  - (Scm_NewPort, SigScm_GC_Unprotect): New function
  - (fileport_getc, fileport_print, stringport_getc,
    stringport_print): Disable when SCM_USE_NEWPORT
  - (Scm_NewFilePort, Scm_NewStringPort): Disable when SCM_USE_NEWPORT
* sigscheme/read.c
  - (enum LexerState): New type
  - (DISCARD_LOOKAHEAD): New macro
  - (skip_comment_and_space, read_sexpression, read_list, read_word,
    read_char_sequence): Support SCM_USE_NEWPORT
* sigscheme/debug.c
  - (SigScm_WriteToPort, SigScm_DisplayToPort, print_port): Support
    SCM_USE_NEWPORT
* sigscheme/error.c
  - (SigScm_PortPrintf, SigScm_VPortPrintf): New function
  - (SigScm_VErrorPrintf, SigScm_ErrorNewline): Support SCM_USE_NEWPORT
* sigscheme/operations-srfi6.c
  - include strport.c
  - (SigScm_Initialize_SRFI6): Add Scm_strport_init()
  - (ScmOp_SRFI6_open_input_string, ScmOp_SRFI6_open_output_string,
    ScmOp_SRFI6_get_output_string): Support SCM_USE_NEWPORT
  - (istrport_finalize): New static function
* sigscheme/sigscheme.c
  - (SigScm_Initialize_internal):
    * Support SCM_USE_NEWPORT
    * Add initialization for peek-char and char-ready?
  - (Scm_eval_c_string_internal): Support SCM_USE_NEWPORT


Modified: branches/r5rs/sigscheme/config.h
===================================================================
--- branches/r5rs/sigscheme/config.h	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/config.h	2005-10-31 20:20:10 UTC (rev 1911)
@@ -82,6 +82,7 @@
 #define SCM_VOLATILE_OUTPUT     0  /* always flush files on write */
 #define SCM_EXCEPTION_HANDLING  1  /* use SRFI-34 base exception handling */
 #define SCM_OBJ_COMPACT         0  /* object representation compaction (experimental) */
+#define SCM_USE_NEWPORT         1  /* use experimental port implementation */
 
 #define SCM_GCC4_READY_GC       1  /* use experimental gcc4-ready stack protection */
 
@@ -127,4 +128,10 @@
 #define SCM_VOLATILE_OUTPUT     1
 #endif /* SCM_DEBUG */
 
+#if SCM_USE_NEWPORT
+/* for Scm_eval_c_string_internal() */
+#undef SCM_USE_SRFI6
+#define SCM_USE_SRFI6           1
+#endif /* SCM_USE_NEWPORT */
+
 #endif /* __SIGSCHEME_CONFIG_H */

Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/datas.c	2005-10-31 20:20:10 UTC (rev 1911)
@@ -228,11 +228,13 @@
 static void enter_dynamic_extent(ScmObj dest);
 static void exit_dynamic_extent(ScmObj dest);
 
+#if !SCM_USE_NEWPORT
 /* port */
 static int  fileport_getc(ScmObj port);
 static void fileport_print(ScmObj port, const char *str);
 static int  stringport_getc(ScmObj port);
 static void stringport_print(ScmObj port, const char *str);
+#endif /* SCM_USE_NEWPORT */
 
 /* continuation */
 static void initialize_continuation_env(void);
@@ -488,6 +490,20 @@
     protected_var_list = item;
 }
 
+void SigScm_GC_Unprotect(ScmObj *var)
+{
+    gc_protected_var **item = &protected_var_list;
+    gc_protected_var *next  = NULL;
+    while (*item) {
+        if ((*item)->var == var) {
+            next = (*item)->next_var;
+            free(*item);
+            *item = next;
+            break;
+        }
+    }
+}
+
 static void finalize_protected_var(void)
 {
     gc_protected_var *item = protected_var_list;
@@ -613,6 +629,10 @@
         break;
 
     case ScmPort:
+#if SCM_USE_NEWPORT
+        if (SCM_PORT_IMPL(obj))
+            SCM_PORT_CLOSE_IMPL(obj);
+#else /* SCM_USE_NEWPORT */
         /* handle each port type */
         switch (SCM_PORT_PORTTYPE(obj)) {
         case PORT_FILE:
@@ -627,6 +647,7 @@
         /* free port info */
         if (SCM_PORT_PORTINFO(obj))
             free(SCM_PORT_PORTINFO(obj));
+#endif /* SCM_USE_NEWPORT */
         break;
 
     /* rarely swept objects */
@@ -838,6 +859,28 @@
     return obj;
 }
 
+#if SCM_USE_NEWPORT
+ScmObj Scm_NewPort(ScmCharPort *cport, enum ScmPortFlag flag)
+{
+    ScmObj obj = SCM_FALSE;
+
+    SCM_NEW_OBJ_INTERNAL(obj);
+
+    SCM_ENTYPE_PORT(obj);
+
+    if (flag & SCM_PORTFLAG_INPUT)
+        flag |= SCM_PORTFLAG_LIVE_INPUT;
+    if (flag & SCM_PORTFLAG_OUTPUT)
+        flag |= SCM_PORTFLAG_LIVE_OUTPUT;
+    SCM_PORT_SET_FLAG(obj, flag);
+
+    SCM_PORT_SET_IMPL(obj, cport);
+
+    return obj;
+}
+
+#else /* SCM_USE_NEWPORT */
+
 ScmObj Scm_NewFilePort(FILE *file, const char *filename,
                        enum ScmPortDirection pdirection)
 {
@@ -938,6 +981,7 @@
     SCM_PORT_SET_STR(port, p);
     SCM_PORT_SET_STR_CURRENTPOS(port, p + new_len);
 }
+#endif /* SCM_USE_NEWPORT */
 
 ScmObj Scm_NewContinuation(void)
 {

Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/debug.c	2005-10-31 20:20:10 UTC (rev 1911)
@@ -188,15 +188,24 @@
         return;
 
     ASSERT_PORTP(port);
+#if SCM_USE_NEWPORT
+    SCM_ASSERT_LIVE_PORT(port);
+    if (!(SCM_PORT_FLAG(port) & SCM_PORTFLAG_OUTPUT))
+#else
     if (SCM_PORT_PORTDIRECTION(port) != PORT_OUTPUT)
+#endif
         ERR("output port is required");
 
     print_ScmObj_internal(port, obj, AS_WRITE);
 
 #if SCM_VOLATILE_OUTPUT
+#if SCM_USE_NEWPORT
+    SCM_PORT_FLUSH(port);
+#else /* SCM_USE_NEWPORT */
     if (SCM_PORT_PORTTYPE(port) == PORT_FILE)
         fflush(SCM_PORT_FILE(port));
-#endif
+#endif /* SCM_USE_NEWPORT */
+#endif /* SCM_VOLATILE_OUTPUT */
 }
 
 void SigScm_DisplayToPort(ScmObj port, ScmObj obj)
@@ -207,15 +216,24 @@
         return;
 
     ASSERT_PORTP(port);
+#if SCM_USE_NEWPORT
+    SCM_ASSERT_LIVE_PORT(port);
+    if (!(SCM_PORT_FLAG(port) & SCM_PORTFLAG_OUTPUT))
+#else
     if (SCM_PORT_PORTDIRECTION(port) != PORT_OUTPUT)
+#endif
         ERR("output port is required");
 
     print_ScmObj_internal(port, obj, AS_DISPLAY);
 
 #if SCM_VOLATILE_OUTPUT
+#if SCM_USE_NEWPORT
+    SCM_PORT_FLUSH(port);
+#else /* SCM_USE_NEWPORT */
     if (SCM_PORT_PORTTYPE(port) == PORT_FILE)
         fflush(SCM_PORT_FILE(port));
-#endif
+#endif /* SCM_USE_NEWPORT */
+#endif /* SCM_VOLATILE_OUTPUT */
 }
 
 static void print_ScmObj_internal(ScmObj port, ScmObj obj, enum OutputType otype)
@@ -454,7 +472,11 @@
     SCM_PORT_PRINT(port, "#<");
 
     /* input or output */
+#if SCM_USE_NEWPORT
+    if (SCM_PORT_FLAG(obj) & SCM_PORTFLAG_INPUT)
+#else
     if (SCM_PORT_PORTDIRECTION(obj) == PORT_INPUT)
+#endif
         SCM_PORT_PRINT(port, "i");
     else
         SCM_PORT_PRINT(port, "o");
@@ -463,6 +485,7 @@
 
     /* file or string */
 
+#if !SCM_USE_NEWPORT
     if (SCM_PORT_PORTTYPE(obj) == PORT_FILE) {
         snprintf(scm_portbuffer, PORTBUFFER_SIZE, "file %s", SCM_PORT_FILENAME(obj));
         SCM_PORT_PRINT(port, scm_portbuffer);
@@ -470,6 +493,7 @@
         snprintf(scm_portbuffer, PORTBUFFER_SIZE, "string %s", SCM_PORT_STR(obj));
         SCM_PORT_PRINT(port, scm_portbuffer);
     }
+#endif /* !SCM_USE_NEWPORT */
 
     SCM_PORT_PRINT(port, ">");
 }

Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/error.c	2005-10-31 20:20:10 UTC (rev 1911)
@@ -220,6 +220,28 @@
     SigScm_ErrorPrintf(SCM_ERR_HEADER);
 }
 
+/* TODO: move to io.c */
+#if SCM_USE_NEWPORT
+void SigScm_PortPrintf(ScmObj port, const char *fmt, ...)
+{
+    va_list args;
+
+    va_start(args, fmt);
+    SigScm_VPortPrintf(port, fmt, args);
+    va_end(args);
+}
+
+void SigScm_VPortPrintf(ScmObj port, const char *fmt, va_list args)
+{
+    if (!FALSEP(port)) {
+        SCM_PORT_VPRINTF(port, fmt, args);
+#if SCM_VOLATILE_OUTPUT
+        SCM_PORT_FLUSH(port);
+#endif
+    }
+}
+#endif /* SCM_USE_NEWPORT */
+
 void SigScm_ErrorPrintf(const char *fmt, ...)
 {
     va_list args;
@@ -231,6 +253,9 @@
 
 void SigScm_VErrorPrintf(const char *fmt, va_list args)
 {
+#if SCM_USE_NEWPORT
+    SigScm_VPortPrintf(scm_current_error_port, fmt, args);
+#else /* SCM_USE_NEWPORT */
     FILE *err;
 
     if (!FALSEP(scm_current_error_port)) {
@@ -240,10 +265,14 @@
         fflush(err);
 #endif
     }
+#endif /* SCM_USE_NEWPORT */
 }
 
 void SigScm_ErrorNewline(void)
 {
+#if SCM_USE_NEWPORT
+    SigScm_PortPrintf(scm_current_error_port, "\n");
+#else /* SCM_USE_NEWPORT */
     FILE *err;
 
     if (!FALSEP(scm_current_error_port)) {
@@ -253,4 +282,5 @@
         fflush(err);
 #endif
     }
+#endif /* SCM_USE_NEWPORT */
 }

Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/io.c	2005-10-31 20:20:10 UTC (rev 1911)
@@ -34,12 +34,17 @@
 /*=======================================
   System Include
 =======================================*/
+#include <stdio.h>
 
 /*=======================================
   Local Include
 =======================================*/
 #include "sigscheme.h"
 #include "sigschemeinternal.h"
+#if SCM_USE_NEWPORT
+#include "sbcport.h"
+#include "fileport.h"
+#endif
 
 /*=======================================
   File Local Struct Declarations
@@ -161,7 +166,11 @@
     DECLARE_FUNCTION("input-port?", ProcedureFixed1);
     ASSERT_PORTP(port);
 
+#if SCM_USE_NEWPORT
+    return (SCM_PORT_FLAG(port) & SCM_PORTFLAG_INPUT) ? SCM_TRUE : SCM_FALSE;
+#else /* SCM_USE_NEWPORT */
     return (SCM_PORT_PORTDIRECTION(port) == PORT_INPUT) ? SCM_TRUE : SCM_FALSE;
+#endif /* SCM_USE_NEWPORT */
 }
 
 ScmObj ScmOp_output_portp(ScmObj port)
@@ -169,7 +178,11 @@
     DECLARE_FUNCTION("output-port?", ProcedureFixed1);
     ASSERT_PORTP(port);
 
+#if SCM_USE_NEWPORT
+    return (SCM_PORT_FLAG(port) & SCM_PORTFLAG_OUTPUT) ? SCM_TRUE : SCM_FALSE;
+#else /* SCM_USE_NEWPORT */
     return (SCM_PORT_PORTDIRECTION(port) == PORT_OUTPUT) ? SCM_TRUE : SCM_FALSE;
+#endif /* SCM_USE_NEWPORT */
 }
 
 ScmObj ScmOp_current_input_port(void)
@@ -235,7 +248,12 @@
     if (!f)
         ERR_OBJ("cannot open file ", filepath);
 
+#if SCM_USE_NEWPORT
+    return Scm_NewPort(ScmSingleByteCharPort_new(ScmFilePort_new(f)),
+                       SCM_PORTFLAG_INPUT);
+#else /* SCM_USE_NEWPORT */
     return Scm_NewFilePort(f, SCM_STRING_STR(filepath), PORT_INPUT);
+#endif /* SCM_USE_NEWPORT */
 }
 
 ScmObj ScmOp_open_output_file(ScmObj filepath)
@@ -249,33 +267,58 @@
     if (!f)
         ERR_OBJ("cannot open file ", filepath);
 
+#if SCM_USE_NEWPORT
+    return Scm_NewPort(ScmSingleByteCharPort_new(ScmFilePort_new(f)),
+                       SCM_PORTFLAG_OUTPUT);
+#else /* SCM_USE_NEWPORT */
     return Scm_NewFilePort(f, SCM_STRING_STR(filepath), PORT_OUTPUT);
+#endif /* SCM_USE_NEWPORT */
 }
 
 ScmObj ScmOp_close_input_port(ScmObj port)
 {
+#if SCM_USE_NEWPORT
+    int flag;
+#endif
     DECLARE_FUNCTION("close-input-port", ProcedureFixed1);
 
     ASSERT_PORTP(port);
 
+#if SCM_USE_NEWPORT
+    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_IMPL(port);
+#else /* SCM_USE_NEWPORT */
     if (SCM_PORT_PORTTYPE(port) == PORT_FILE
         && SCM_PORT_PORTDIRECTION(port) == PORT_INPUT
         && SCM_PORT_FILE(port))
         fclose(SCM_PORT_FILE(port));
+#endif /* SCM_USE_NEWPORT */
 
     return SCM_UNDEF;
 }
 
 ScmObj ScmOp_close_output_port(ScmObj port)
 {
+#if SCM_USE_NEWPORT
+    int flag;
+#endif
     DECLARE_FUNCTION("close-output-port", ProcedureFixed1);
 
     ASSERT_PORTP(port);
 
+#if SCM_USE_NEWPORT
+    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_IMPL(port);
+#else /* SCM_USE_NEWPORT */
     if (SCM_PORT_PORTTYPE(port) == PORT_FILE
         && SCM_PORT_PORTDIRECTION(port) == PORT_OUTPUT
         && SCM_PORT_FILE(port))
         fclose(SCM_PORT_FILE(port));
+#endif /* SCM_USE_NEWPORT */
 
     return SCM_UNDEF;
 }
@@ -305,20 +348,49 @@
 ScmObj ScmOp_read_char(ScmObj args)
 {
     ScmObj port = SCM_INVALID;
+    /* FIXME: use int as char */
+    int    ch;
     char   buf[2];
     DECLARE_FUNCTION("read-char", ProcedureVariadic0);
 
     PREPARE_PORT(port, args, scm_current_input_port);
 
+#if SCM_USE_NEWPORT
+    ch = SCM_PORT_GET_CHAR(port);
+    if (ch == EOF)
+        return SCM_EOF;
+
+    buf[0] = ch;
+    buf[1] = '\0';
+#else /* SCM_USE_NEWPORT */
     SCM_PORT_GETC(port, buf[0]);
     buf[1] = '\0';
+#endif /* SCM_USE_NEWPORT */
     return Scm_NewChar(buf);
 }
 
-ScmObj ScmOp_peek_char(ScmObj args, ScmObj env)
+ScmObj ScmOp_peek_char(ScmObj args)
 {
+    ScmObj port = SCM_INVALID;
+    /* FIXME: use int as char */
+    int    ch;
+    char   buf[2];
+    DECLARE_FUNCTION("peek-char", ProcedureVariadic0);
+
+    PREPARE_PORT(port, args, scm_current_input_port);
+
+#if SCM_USE_NEWPORT
+    ch = SCM_PORT_PEEK_CHAR(port);
+    if (ch == EOF)
+        return SCM_EOF;
+
+    buf[0] = ch;
+    buf[1] = '\0';
+    return Scm_NewChar(buf);
+#else /* SCM_USE_NEWPORT */
     /* FIXME: implement this */
     return SCM_FALSE;
+#endif /* SCM_USE_NEWPORT */
 }
 
 ScmObj ScmOp_eof_objectp(ScmObj obj)
@@ -327,10 +399,19 @@
     return (EOFP(obj)) ? SCM_TRUE : SCM_FALSE;
 }
 
-ScmObj ScmOp_char_readyp(ScmObj args, ScmObj env)
+ScmObj ScmOp_char_readyp(ScmObj args)
 {
+    ScmObj port = SCM_INVALID;
+    DECLARE_FUNCTION("char-ready?", ProcedureVariadic0);
+
+    PREPARE_PORT(port, args, scm_current_input_port);
+
+#if SCM_USE_NEWPORT
+    return (SCM_PORT_CHAR_READYP(port))? SCM_TRUE : SCM_FALSE;
+#else /* SCM_USE_NEWPORT */
     /* FIXME: implement this */
     return SCM_FALSE;
+#endif /* SCM_USE_NEWPORT */
 }
 
 /*===========================================================================
@@ -602,3 +683,10 @@
     return 1;
 }
 #endif /* SCM_USE_NONSTD_FEATURES */
+
+
+/* FIXME: link conditionally with autoconf */
+#if SCM_USE_NEWPORT
+#include "sbcport.c"
+#include "fileport.c"
+#endif

Modified: branches/r5rs/sigscheme/operations-srfi6.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi6.c	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/operations-srfi6.c	2005-10-31 20:20:10 UTC (rev 1911)
@@ -41,6 +41,11 @@
 =======================================*/
 #include "sigscheme.h"
 #include "sigschemeinternal.h"
+#if SCM_USE_NEWPORT
+#include "baseport.h"
+#include "sbcport.h"
+#include "strport.h"
+#endif
 
 /*=======================================
   File Local Struct Declarations
@@ -57,12 +62,19 @@
 /*=======================================
   File Local Function Declarations
 =======================================*/
+#if SCM_USE_NEWPORT
+static void istrport_finalize(char **str, int ownership, void **opaque);
+#endif
 
 /*=======================================
   Function Implementations
 =======================================*/
 void SigScm_Initialize_SRFI6(void)
 {
+#if SCM_USE_NEWPORT
+    Scm_strport_init();
+#endif
+
     /*=======================================================================
       SRFI-6 Procedures
     =======================================================================*/
@@ -71,27 +83,72 @@
     Scm_RegisterProcedureFixed1("get-output-string", ScmOp_SRFI6_get_output_string);
 }
 
+#if SCM_USE_NEWPORT
+static void istrport_finalize(char **str, int ownership, void **opaque)
+{
+    SigScm_GC_Unprotect((ScmObj *)opaque);
+}
+#endif /* SCM_USE_NEWPORT */
+
 ScmObj ScmOp_SRFI6_open_input_string(ScmObj str)
 {
+#if SCM_USE_NEWPORT
+    ScmObj      *hold_str;
+    ScmBytePort *bport;
+#endif
     DECLARE_FUNCTION("open-input-string", ProcedureFixed1);
 
     ASSERT_STRINGP(str);
 
+#if SCM_USE_NEWPORT
+    bport = ScmInputStrPort_new_const(SCM_STRING_STR(str), istrport_finalize);
+    hold_str = (ScmObj *)ScmInputStrPort_ref_opaque(bport);
+    *hold_str = str;
+    SigScm_GC_Protect(hold_str);
+    return Scm_NewPort(ScmSingleByteCharPort_new(bport), SCM_PORTFLAG_INPUT);
+#else /* SCM_USE_NEWPORT */
     return Scm_NewStringPort(SCM_STRING_STR(str), PORT_INPUT);
+#endif /* SCM_USE_NEWPORT */
 }
 
 ScmObj ScmOp_SRFI6_open_output_string(void)
 {
+#if SCM_USE_NEWPORT
+    ScmBytePort *bport;
+#endif
     DECLARE_FUNCTION("open-output-string", ProcedureFixed0);
 
+#if SCM_USE_NEWPORT
+    bport = ScmOutputStrPort_new(NULL);
+    return Scm_NewPort(ScmSingleByteCharPort_new(bport), SCM_PORTFLAG_OUTPUT);
+#else /* SCM_USE_NEWPORT */
     return Scm_NewStringPort(NULL, PORT_OUTPUT);
+#endif /* SCM_USE_NEWPORT */
 }
 
 ScmObj ScmOp_SRFI6_get_output_string(ScmObj port)
 {
+#if SCM_USE_NEWPORT
+    ScmBaseCharPort *cport;
+#endif
     DECLARE_FUNCTION("get-output-string", ProcedureFixed1);
 
     ASSERT_PORTP(port);
 
+#if SCM_USE_NEWPORT
+    SCM_ASSERT_LIVE_PORT(port);
+    cport = SCM_PORT_DYNAMIC_CAST(ScmBaseCharPort, SCM_PORT_IMPL(port));
+    if (!cport)
+        SCM_PORT_ERROR_INVALID_TYPE(CHAR,
+                                    SCM_PORT_IMPL(port), ScmBaseCharPort);
+    return Scm_NewStringCopying(ScmOutputStrPort_str(cport->bport));
+#else /* SCM_USE_NEWPORT */
     return Scm_NewStringCopying(SCM_PORT_STR(port));
+#endif /* SCM_USE_NEWPORT */
 }
+
+
+/* FIXME: link conditionally with autoconf */
+#if SCM_USE_NEWPORT
+#include "strport.c"
+#endif

Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/read.c	2005-10-31 20:20:10 UTC (rev 1911)
@@ -69,6 +69,12 @@
 /*=======================================
   File Local Struct Declarations
 =======================================*/
+#if SCM_USE_NEWPORT
+enum LexerState {
+    LEX_ST_NORMAL,
+    LEX_ST_COMMENT
+};
+#endif
 
 /*=======================================
   File Local Macro Declarations
@@ -77,6 +83,13 @@
 #define CASE_ISSPACE                                                         \
     case ' ': case '\t': case '\n': case '\r': case '\v': case '\f'
 
+/* FIXME: discard at first of each reader instead of caller */
+#if SCM_USE_NEWPORT
+#define DISCARD_LOOKAHEAD(port) (SCM_PORT_GET_CHAR(port))
+#else
+#define DISCARD_LOOKAHEAD(port)
+#endif
+
 /*=======================================
   Variable Declarations
 =======================================*/
@@ -133,6 +146,31 @@
 
 static int skip_comment_and_space(ScmObj port)
 {
+#if SCM_USE_NEWPORT
+    /* WARNING: the behavior is different to !SCM_USE_NEWPORT */
+    int c, state;
+
+    state = LEX_ST_NORMAL;
+    for (;;) {
+        c = SCM_PORT_PEEK_CHAR(port);
+        switch (state) {
+        case LEX_ST_NORMAL:
+            if (c == ';')
+                state = LEX_ST_COMMENT;
+            else if (!isspace(c) || c == EOF)
+                return c;  /* peeked */
+            break;
+
+        case LEX_ST_COMMENT:
+            if (c == '\n' || c == '\r')
+                state = LEX_ST_NORMAL;
+            else if (c == EOF)
+                return c;  /* peeked */
+            break;
+        }
+        SCM_PORT_GET_CHAR(port);  /* skip the char */
+    }
+#else /* SCM_USE_NEWPORT */
     int c = 0;
     while (1) {
         SCM_PORT_GETC(port, c);
@@ -153,6 +191,7 @@
 
         return c;
     }
+#endif /* SCM_USE_NEWPORT */
 }
 
 static ScmObj read_sexpression(ScmObj port)
@@ -169,8 +208,10 @@
 
         switch (c) {
         case '(':
+            DISCARD_LOOKAHEAD(port);
             return read_list(port, ')');
         case '\"':
+            DISCARD_LOOKAHEAD(port);
             return read_string(port);
         case '0': case '1': case '2': case '3': case '4':
         case '5': case '6': case '7': case '8': case '9':
@@ -178,14 +219,22 @@
             SCM_PORT_UNGETC(port, c);
             return read_number_or_symbol(port);
         case '\'':
+            DISCARD_LOOKAHEAD(port);
             return read_quote(port, SCM_QUOTE);
         case '`':
+            DISCARD_LOOKAHEAD(port);
             return read_quote(port, SCM_QUASIQUOTE);
         case ',':
+            DISCARD_LOOKAHEAD(port);
+#if SCM_USE_NEWPORT
+            c1 = SCM_PORT_PEEK_CHAR(port);
+#else
             SCM_PORT_GETC(port, c1);
+#endif
             if (c1 == EOF) {
                 SigScm_Error("EOF in unquote");
             } else if (c1 == '@') {
+                DISCARD_LOOKAHEAD(port);
                 return read_quote(port, SCM_UNQUOTE_SPLICING);
             } else {
                 SCM_PORT_UNGETC(port, c1);
@@ -193,15 +242,24 @@
             }
             break;
         case '#':
+            DISCARD_LOOKAHEAD(port);
+#if SCM_USE_NEWPORT
+            c1 = SCM_PORT_PEEK_CHAR(port);
+#else
             SCM_PORT_GETC(port, c1);
+#endif
             switch (c1) {
             case 't': case 'T':
+                DISCARD_LOOKAHEAD(port);
                 return SCM_TRUE;
             case 'f': case 'F':
+                DISCARD_LOOKAHEAD(port);
                 return SCM_FALSE;
             case '(':
+                DISCARD_LOOKAHEAD(port);
                 return ScmOp_list2vector(read_list(port, ')'));
             case '\\':
+                DISCARD_LOOKAHEAD(port);
                 return read_char(port);
             case 'b': case 'o': case 'd': case 'x':
                 SCM_PORT_UNGETC(port, c1);
@@ -244,22 +302,34 @@
         CDBG((SCM_DBG_PARSER, "read_list c = [%c]", c));
 
         if (c == EOF) {
+#if SCM_USE_NEWPORT
+            if (FALSE)
+#else
             if (SCM_PORT_PORTTYPE(port) == PORT_FILE)
+#endif
                 SigScm_Error("EOF inside list. (starting from line %d)", line + 1);
             else
                 SigScm_Error("EOF inside list.");
         } else if (c == closeParen) {
+            DISCARD_LOOKAHEAD(port);
             return list_head;
         } else if (c == '.') {
+            DISCARD_LOOKAHEAD(port);
             c2 = 0;
+#if SCM_USE_NEWPORT
+            c2 = SCM_PORT_PEEK_CHAR(port);
+#else
             SCM_PORT_GETC(port, c2);
+#endif
             CDBG((SCM_DBG_PARSER, "read_list process_dot c2 = [%c]", c2));
             if (isspace(c2) || c2 == '(' || c2 == '"' || c2 == ';') {
+                DISCARD_LOOKAHEAD(port);
                 cdr = read_sexpression(port);
                 if (NULLP(list_tail))
                     SigScm_Error(".(dot) at the start of the list.");
 
                 c = skip_comment_and_space(port);
+                DISCARD_LOOKAHEAD(port);
                 if (c != ')')
                     SigScm_Error("bad dot syntax");
 
@@ -429,7 +499,11 @@
     char *dst = NULL;
 
     while (1) {
+#if SCM_USE_NEWPORT
+        c = SCM_PORT_PEEK_CHAR(port);
+#else
         SCM_PORT_GETC(port, c);
+#endif
 
         CDBG((SCM_DBG_PARSER, "c = %c", c));
 
@@ -443,6 +517,7 @@
             return dst;
 
         default:
+            DISCARD_LOOKAHEAD(port);
             stringbuf[stringlen++] = (char)c;
             break;
         }
@@ -457,7 +532,11 @@
     char *dst = NULL;
 
     while (1) {
+#if SCM_USE_NEWPORT
+        c = SCM_PORT_PEEK_CHAR(port);
+#else
         SCM_PORT_GETC(port, c);
+#endif
 
         CDBG((SCM_DBG_PARSER, "c = %c", c));
 
@@ -471,6 +550,7 @@
         CASE_ISSPACE:
             /* pass through first char */
             if (stringlen == 0) {
+                DISCARD_LOOKAHEAD(port);
                 stringbuf[stringlen++] = (char)c;
                 break;
             }
@@ -481,6 +561,7 @@
             return dst;
 
         default:
+            DISCARD_LOOKAHEAD(port);
             stringbuf[stringlen++] = (char)c;
             break;
         }

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-10-31 20:20:10 UTC (rev 1911)
@@ -40,6 +40,12 @@
 =======================================*/
 #include "sigscheme.h"
 #include "sigschemeinternal.h"
+#if SCM_USE_NEWPORT
+#include "baseport.h"
+#include "sbcport.h"
+#include "fileport.h"
+#include "strport.h"
+#endif
 
 /*=======================================
   File Local Struct Declarations
@@ -154,9 +160,24 @@
     /*=======================================================================
       Preallocated Ports
     =======================================================================*/
+#if SCM_USE_NEWPORT
+    Scm_fileport_init();
+    Scm_sbcport_init();
+
+    scm_current_input_port
+        = Scm_NewPort(ScmSingleByteCharPort_new(ScmFilePort_new(stdin)),
+                      SCM_PORTFLAG_INPUT);
+    scm_current_output_port
+        = Scm_NewPort(ScmSingleByteCharPort_new(ScmFilePort_new(stdout)),
+                      SCM_PORTFLAG_OUTPUT);
+    scm_current_error_port
+        = Scm_NewPort(ScmSingleByteCharPort_new(ScmFilePort_new(stderr)),
+                      SCM_PORTFLAG_OUTPUT);
+#else /* SCM_USE_NEWPORT */
     scm_current_input_port  = Scm_NewFilePort(stdin,  "stdin",  PORT_INPUT);
     scm_current_output_port = Scm_NewFilePort(stdout, "stdout", PORT_OUTPUT);
     scm_current_error_port  = Scm_NewFilePort(stderr, "stderr", PORT_OUTPUT);
+#endif /* SCM_USE_NEWPORT */
     SigScm_GC_Protect(&scm_current_input_port);
     SigScm_GC_Protect(&scm_current_output_port);
     SigScm_GC_Protect(&scm_current_error_port);
@@ -326,6 +347,8 @@
     Scm_RegisterProcedureFixed1("eof-object?"              , ScmOp_eof_objectp);
     Scm_RegisterProcedureVariadic0("read"        , ScmOp_read);
     Scm_RegisterProcedureVariadic0("read-char"   , ScmOp_read_char);
+    Scm_RegisterProcedureVariadic0("peek-char"   , ScmOp_peek_char);
+    Scm_RegisterProcedureVariadic0("char-ready?" , ScmOp_char_readyp);
     Scm_RegisterProcedureVariadic1("write"       , ScmOp_write);
     Scm_RegisterProcedureVariadic1("display"     , ScmOp_display);
     Scm_RegisterProcedureVariadic0("newline"     , ScmOp_newline);
@@ -423,10 +446,18 @@
 
 ScmObj Scm_eval_c_string_internal(const char *exp)
 {
-    ScmObj str_port    = SCM_NULL;
-    ScmObj ret         = SCM_NULL;
+    ScmObj str_port    = SCM_FALSE;
+    ScmObj ret         = SCM_FALSE;
+#if SCM_USE_NEWPORT
+    ScmBytePort *bport;
+    ScmCharPort *cport;
 
+    bport = ScmInputStrPort_new_const(exp, NULL);
+    cport = ScmSingleByteCharPort_new(bport);
+    str_port = Scm_NewPort(cport, SCM_PORTFLAG_INPUT);
+#else
     str_port = Scm_NewStringPort(exp, PORT_INPUT);
+#endif
 
     ret = SigScm_Read(str_port);
     ret = EVAL(ret, SCM_INTERACTION_ENV);

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-10-31 20:20:10 UTC (rev 1911)
@@ -51,6 +51,9 @@
 =======================================*/
 #include "config.h"
 #include "encoding.h"
+#if SCM_USE_NEWPORT
+#include "baseport.h"
+#endif
 
 /*=======================================
    Macro Declarations
@@ -127,12 +130,46 @@
 /*
  * Port I/O Handling macros
  */
+#if SCM_USE_NEWPORT
+#define SCM_ASSERT_LIVE_PORT(port)                                           \
+    (SCM_PORT_IMPL(port)                                                     \
+     || (SigScm_ErrorObj("operated on closed port", port), 1))
+
+#define SCM_PORT_CLOSE_IMPL(port)                                            \
+    (SCM_CHARPORT_CLOSE(SCM_PORT_IMPL(port)), SCM_PORT_SET_IMPL(port, NULL))
+#define SCM_PORT_ENCODING(port)                                              \
+    (SCM_ASSERT_LIVE_PORT(port), SCM_CHARPORT_ENCODING(SCM_PORT_IMPL(port)))
+#define SCM_PORT_GET_CHAR(port)                                              \
+    (SCM_ASSERT_LIVE_PORT(port), SCM_CHARPORT_GET_CHAR(SCM_PORT_IMPL(port)))
+#define SCM_PORT_PEEK_CHAR(port)                                             \
+    (SCM_ASSERT_LIVE_PORT(port), SCM_CHARPORT_PEEK_CHAR(SCM_PORT_IMPL(port)))
+#define SCM_PORT_CHAR_READYP(port)                                           \
+    (SCM_ASSERT_LIVE_PORT(port), SCM_CHARPORT_CHAR_READYP(SCM_PORT_IMPL(port)))
+#define SCM_PORT_VPRINTF(port, str, args)                                    \
+    (SCM_ASSERT_LIVE_PORT(port),                                             \
+     SCM_CHARPORT_VPRINTF(SCM_PORT_IMPL(port), str, args))
+#define SCM_PORT_PUTS(port, str)                                             \
+    (SCM_ASSERT_LIVE_PORT(port), SCM_CHARPORT_PUTS(SCM_PORT_IMPL(port), str))
+#define SCM_PORT_PUT_CHAR(port, ch)                                          \
+    (SCM_ASSERT_LIVE_PORT(port),                                             \
+     SCM_CHARPORT_PUT_CHAR(SCM_PORT_IMPL(port), ch))
+#define SCM_PORT_FLUSH(port)                                                 \
+    (SCM_ASSERT_LIVE_PORT(port), SCM_CHARPORT_FLUSH(SCM_PORT_IMPL(port)))
+
+/* backward compatibility */
+#define SCM_PORT_GETC(port, c) (c = SCM_PORT_GET_CHAR(port))
+#define SCM_PORT_UNGETC(port, c)
+#define SCM_PORT_PRINT SCM_PORT_PUTS
+
+#else /* SCM_USE_NEWPORT */
+
 #define SCM_PORT_GETC(port, c)                  \
     (c = SCM_PORT_GETC_FUNC(port)(port))
 #define SCM_PORT_UNGETC(port,c)                 \
     (SCM_PORT_SET_UNGOTTENCHAR(port, c))
 #define SCM_PORT_PRINT(port, str)               \
     (SCM_PORT_PRINT_FUNC(port)(port, str))
+#endif /* SCM_USE_NEWPORT */
 
 
 /*=======================================
@@ -329,7 +366,8 @@
 #endif
 
 /* datas.c */
-void   SigScm_GC_Protect(ScmObj *var);
+void SigScm_GC_Protect(ScmObj *var);
+void SigScm_GC_Unprotect(ScmObj *var);
 #if SCM_GCC4_READY_GC
 /*
  * Ordinary programs should not call these functions directly. Use
@@ -356,8 +394,12 @@
 ScmObj Scm_NewFunc(enum ScmFuncTypeCode type, ScmFuncType func);
 ScmObj Scm_NewClosure(ScmObj exp, ScmObj env);
 ScmObj Scm_NewVector(ScmObj *vec, int len);
+#if SCM_USE_NEWPORT
+ScmObj Scm_NewPort(ScmCharPort *cport, enum ScmPortFlag flag);
+#else /* SCM_USE_NEWPORT */
 ScmObj Scm_NewFilePort(FILE *file, const char *filename, enum ScmPortDirection pdireciton);
 ScmObj Scm_NewStringPort(const char *str, enum ScmPortDirection pdirection);
+#endif /* SCM_USE_NEWPORT */
 ScmObj Scm_NewContinuation(void);
 #if !SCM_USE_VALUECONS
 ScmObj Scm_NewValuePacket(ScmObj values);
@@ -542,9 +584,9 @@
 
 ScmObj ScmOp_read(ScmObj args);
 ScmObj ScmOp_read_char(ScmObj args);
-ScmObj ScmOp_peek_char(ScmObj args, ScmObj env);
+ScmObj ScmOp_peek_char(ScmObj args);
 ScmObj ScmOp_eof_objectp(ScmObj obj);
-ScmObj ScmOp_char_readyp(ScmObj args, ScmObj env);
+ScmObj ScmOp_char_readyp(ScmObj args);
 ScmObj ScmOp_write(ScmObj obj, ScmObj args);
 ScmObj ScmOp_display(ScmObj obj, ScmObj args);
 ScmObj ScmOp_newline(ScmObj args);

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2005-10-31 20:20:10 UTC (rev 1911)
@@ -352,6 +352,11 @@
 
 /* error.c */
 void SigScm_ShowErrorHeader(void);
+/* TODO: Move these functions to io.c */
+#if SCM_USE_NEWPORT
+void SigScm_PortPrintf(ScmObj port, const char *fmt, ...);
+void SigScm_VPortPrintf(ScmObj port, const char *fmt, va_list args);
+#endif /* SCM_USE_NEWPORT */
 void SigScm_ErrorPrintf(const char *fmt, ...);
 void SigScm_VErrorPrintf(const char *fmt, va_list args);
 void SigScm_ErrorNewline(void);

Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h	2005-10-31 20:17:49 UTC (rev 1910)
+++ branches/r5rs/sigscheme/sigschemetype.h	2005-10-31 20:20:10 UTC (rev 1911)
@@ -49,7 +49,9 @@
 typedef struct ScmCell_ ScmCell;
 typedef ScmCell *ScmObj;
 typedef ScmObj *ScmRef;
+#if !SCM_USE_NEWPORT
 typedef struct _ScmPortInfo ScmPortInfo;
+#endif
 typedef struct ScmEvalState_ ScmEvalState;
 typedef ScmObj (*ScmFuncType)();
 
@@ -88,6 +90,21 @@
     ScmCFuncPointer = 21
 };
 
+#if SCM_USE_NEWPORT
+enum ScmPortFlag {
+    SCM_PORTFLAG_NONE        = 0,
+    SCM_PORTFLAG_OUTPUT      = 1 << 0,
+    SCM_PORTFLAG_INPUT       = 1 << 1,
+    SCM_PORTFLAG_LIVE_OUTPUT = 1 << 2,
+    SCM_PORTFLAG_LIVE_INPUT  = 1 << 3,
+
+    SCM_PORTFLAG_DIR_MASK = (SCM_PORTFLAG_OUTPUT | SCM_PORTFLAG_INPUT),
+    SCM_PORTFLAG_ALIVENESS_MASK = (SCM_PORTFLAG_LIVE_OUTPUT
+                                   | SCM_PORTFLAG_LIVE_INPUT)
+};
+
+#else /* SCM_USE_NEWPORT */
+
 /* ScmPort direction */
 enum ScmPortDirection {
     PORT_INPUT  = 0,
@@ -121,6 +138,7 @@
     void (*print_func) (ScmObj port, const char* str);    
     int ungottenchar;
 };
+#endif /* SCM_USE_NEWPORT */
 
 /*
  * Function types:
@@ -222,8 +240,13 @@
         } vector;
 
         struct ScmPort {
+#if SCM_USE_NEWPORT
+            enum ScmPortFlag flag;
+            ScmCharPort *impl;
+#else
             enum ScmPortDirection port_direction; /* (PORT_INPUT | PORT_OUTPUT) */
             ScmPortInfo *port_info;
+#endif
         } port;
 
         struct ScmContinuation {
@@ -345,6 +368,13 @@
 
 #define SCM_PORTP(a) (SCM_TYPE(a) == ScmPort)
 #define SCM_ENTYPE_PORT(a) (SCM_ENTYPE((a), ScmPort))
+#if SCM_USE_NEWPORT
+#define SCM_PORT_FLAG(a)           (SCM_AS_PORT(a)->obj.port.flag)
+#define SCM_PORT_SET_FLAG(a, flag) (SCM_PORT_FLAG(a) = (flag))
+#define SCM_PORT_IMPL(a)           (SCM_AS_PORT(a)->obj.port.impl)
+#define SCM_PORT_SET_IMPL(a, impl) (SCM_PORT_IMPL(a) = (impl))
+#define SCM_PORT_LINE(a)           (0)
+#else /* SCM_USE_NEWPORT */
 #define SCM_PORT_PORTDIRECTION(a) (SCM_AS_PORT(a)->obj.port.port_direction)
 #define SCM_PORT_SET_PORTDIRECTION(a, pdirection) (SCM_PORT_PORTDIRECTION(a) = pdirection)
 #define SCM_PORT_PORTINFO(a) (SCM_AS_PORT(a)->obj.port.port_info)
@@ -371,6 +401,7 @@
 #define SCM_PORT_SET_STR(a, str) (SCM_PORT_STR(a) = str)
 #define SCM_PORT_STR_CURRENTPOS(a) (SCM_PORT_PORTINFO(a)->info.str_port.str_currentpos)
 #define SCM_PORT_SET_STR_CURRENTPOS(a, pos) (SCM_PORT_STR_CURRENTPOS(a) = pos)
+#endif /* SCM_USE_NEWPORT */
 
 #define SCM_CONTINUATIONP(a) (SCM_TYPE(a) == ScmContinuation)
 #define SCM_ENTYPE_CONTINUATION(a) (SCM_ENTYPE((a), ScmContinuation))



More information about the uim-commit mailing list