[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