[uim-commit] r1300 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Wed Aug 24 06:07:04 PDT 2005
Author: kzk
Date: 2005-08-24 06:07:02 -0700 (Wed, 24 Aug 2005)
New Revision: 1300
Modified:
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/debug.c
branches/r5rs/sigscheme/error.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigschemeinternal.h
branches/r5rs/sigscheme/sigschemetype.h
Log:
* change "switch" indent again
* add "scm_" prefix to global variable
* fix handling of EOF and '\0'.
this patch is proposed by Jun Inoue <jun.lambda at gmail.com>.
Thank you!
* sigscheme/io.c
* sigscheme/sigscheme.c
* sigscheme/sigschemeinternal.h
* sigscheme/sigschemetype.h
* sigscheme/debug.c
* sigscheme/eval.c
* sigscheme/error.c
* sigscheme/datas.c
- change "switch" indent
- add "scm_" prefix to global variables
- move declarations of environment related functions to
sigschemeinternal.h
- (CARR, CADR, CDAR, CDDR): new macro
- update comment
* sigscheme/read.c
- fix handling of EOF and '\0'.
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/datas.c 2005-08-24 13:07:02 UTC (rev 1300)
@@ -133,7 +133,7 @@
static int scm_cur_marker = SCM_INITIAL_MARKER;
static jmp_buf save_regs_buf;
-ScmObj *stack_start_pointer = NULL;
+ScmObj *scm_stack_start_pointer = NULL;
static ScmObj *symbol_hash = NULL;
static gc_protected_obj *protected_obj_list = NULL;
@@ -476,7 +476,7 @@
(ScmObj*)(((char*)save_regs_buf) + sizeof(save_regs_buf)));
gc_mark_protected_obj();
- gc_mark_locations(stack_start_pointer, &obj);
+ gc_mark_locations(scm_stack_start_pointer, &obj);
gc_mark_symbol_hash();
}
@@ -568,14 +568,14 @@
void SigScm_gc_protect_stack(ScmObj *stack_start)
{
- if (!stack_start_pointer)
- stack_start_pointer = stack_start;
+ if (!scm_stack_start_pointer)
+ scm_stack_start_pointer = stack_start;
}
void SigScm_gc_unprotect_stack(ScmObj *stack_start)
{
- if (stack_start_pointer == stack_start)
- stack_start_pointer = NULL;
+ if (scm_stack_start_pointer == stack_start)
+ scm_stack_start_pointer = NULL;
}
/*===========================================================================
Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/debug.c 2005-08-24 13:07:02 UTC (rev 1300)
@@ -75,8 +75,8 @@
=======================================*/
void SigScm_Display(ScmObj obj)
{
- print_ScmObj_internal(SCM_PORTINFO_FILE(current_output_port), obj, AS_WRITE);
- fprintf(SCM_PORTINFO_FILE(current_output_port), "\n");
+ print_ScmObj_internal(SCM_PORTINFO_FILE(scm_current_output_port), obj, AS_WRITE);
+ fprintf(SCM_PORTINFO_FILE(scm_current_output_port), "\n");
}
void SigScm_WriteToPort(ScmObj port, ScmObj obj)
Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/error.c 2005-08-24 13:07:02 UTC (rev 1300)
@@ -54,7 +54,7 @@
/*=======================================
Variable Declarations
=======================================*/
-ScmObj current_error_port = NULL;
+ScmObj scm_current_error_port = NULL;
/*=======================================
File Local Function Declarations
@@ -82,7 +82,7 @@
/* show message */
va_start(va, msg);
- vfprintf(SCM_PORTINFO_FILE(current_error_port), msg, va);
+ vfprintf(SCM_PORTINFO_FILE(scm_current_error_port), msg, va);
va_end(va);
/* show backtrace */
@@ -95,11 +95,11 @@
void SigScm_ErrorObj(const char *msg, ScmObj obj)
{
/* print msg */
- fprintf(SCM_PORTINFO_FILE(current_error_port), "%s", msg);
+ fprintf(SCM_PORTINFO_FILE(scm_current_error_port), "%s", msg);
/* print obj */
- SigScm_WriteToPort(current_error_port, obj);
- fprintf(SCM_PORTINFO_FILE(current_error_port), "\n");
+ SigScm_WriteToPort(scm_current_error_port, obj);
+ fprintf(SCM_PORTINFO_FILE(scm_current_error_port), "\n");
/* show backtrace */
SigScm_ShowBacktrace();
@@ -113,12 +113,12 @@
struct trace_frame *f;
/* show title */
- fprintf(SCM_PORTINFO_FILE(current_error_port), "**** BACKTRACE ****\n");
+ fprintf(SCM_PORTINFO_FILE(scm_current_error_port), "**** BACKTRACE ****\n");
/* show each frame's obj */
- for (f = trace_root; f; f = f->prev) {
- SigScm_WriteToPort(current_error_port, f->obj);
+ for (f = scm_trace_root; f; f = f->prev) {
+ SigScm_WriteToPort(scm_current_error_port, f->obj);
- fprintf(SCM_PORTINFO_FILE(current_error_port), "\n");
+ fprintf(SCM_PORTINFO_FILE(scm_current_error_port), "\n");
}
}
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/eval.c 2005-08-24 13:07:02 UTC (rev 1300)
@@ -71,21 +71,14 @@
/*=======================================
Variable Declarations
=======================================*/
-ScmObj continuation_thrown_obj = NULL; /* for storing continuation return object */
-ScmObj letrec_env = NULL; /* for storing environment obj of letrec */
+ScmObj scm_continuation_thrown_obj = NULL; /* for storing continuation return object */
+ScmObj scm_letrec_env = NULL; /* for storing environment obj of letrec */
-struct trace_frame *trace_root = NULL;
+struct trace_frame *scm_trace_root = NULL;
/*=======================================
File Local Function Declarations
=======================================*/
-static ScmObj extend_environment(ScmObj vars, ScmObj vals, ScmObj env);
-static ScmObj add_environment(ScmObj var, ScmObj val, ScmObj env);
-static ScmObj lookup_environment(ScmObj var, ScmObj env);
-static ScmObj lookup_frame(ScmObj var, ScmObj frame);
-
-static ScmObj symbol_value(ScmObj var, ScmObj env);
-
static ScmObj map_eval(ScmObj args, ScmObj env);
static ScmObj qquote_internal(ScmObj expr, ScmObj env, int nest);
static ScmObj qquote_vector(ScmObj vec, ScmObj env, int nest);
@@ -93,8 +86,7 @@
/*=======================================
Function Implementations
=======================================*/
-
-static ScmObj extend_environment(ScmObj vars, ScmObj vals, ScmObj env)
+ScmObj extend_environment(ScmObj vars, ScmObj vals, ScmObj env)
{
ScmObj frame = SCM_NIL;
ScmObj tmp_vars = vars;
@@ -130,8 +122,7 @@
return env;
}
-
-static ScmObj add_environment(ScmObj var, ScmObj val, ScmObj env)
+ScmObj add_environment(ScmObj var, ScmObj val, ScmObj env)
{
ScmObj newest_frame, tmp;
ScmObj new_varlist, new_vallist;
@@ -167,7 +158,7 @@
TODO : describe more precicely
========================================================*/
-static ScmObj lookup_environment(ScmObj var, ScmObj env)
+ScmObj lookup_environment(ScmObj var, ScmObj env)
{
ScmObj frame = SCM_NIL;
ScmObj val = SCM_NIL;
@@ -189,7 +180,7 @@
return SCM_NIL;
}
-static ScmObj lookup_frame(ScmObj var, ScmObj frame)
+ScmObj lookup_frame(ScmObj var, ScmObj frame)
{
ScmObj vals = SCM_NIL;
ScmObj vars = SCM_NIL;
@@ -239,23 +230,20 @@
/* for debugging */
struct trace_frame frame;
- frame.prev = trace_root;
+ frame.prev = scm_trace_root;
frame.obj = obj;
- trace_root = &frame;
+ scm_trace_root = &frame;
eval_loop:
switch (SCM_TYPE(obj)) {
case ScmSymbol:
- {
ret = symbol_value(obj, env);
goto eval_done;
- }
/*====================================================================
Evaluating Expression
====================================================================*/
case ScmCons:
- {
/*============================================================
Evaluating CAR
============================================================*/
@@ -278,12 +266,12 @@
SigScm_ErrorObj("eval : invalid operation ", obj);
break;
}
+
/*============================================================
Evaluating the rest of the List by the type of CAR
============================================================*/
switch (SCM_TYPE(tmp)) {
case ScmFunc:
- {
/*
* Description of FUNCTYPE handling.
*
@@ -306,14 +294,12 @@
*/
switch (SCM_FUNC_NUMARG(tmp)) {
case FUNCTYPE_L:
- {
ret = SCM_FUNC_EXEC_SUBRL(tmp,
map_eval(CDR(obj), env),
env);
goto eval_done;
- }
+
case FUNCTYPE_R:
- {
obj = SCM_FUNC_EXEC_SUBRR(tmp,
CDR(obj),
&env,
@@ -331,9 +317,8 @@
ret = obj;
goto eval_done;
- }
+
case FUNCTYPE_2N:
- {
obj = CDR(obj);
/* check 1st arg */
@@ -358,28 +343,24 @@
ScmOp_eval(CAR(obj), env));
}
goto eval_done;
- }
+
case FUNCTYPE_0:
- {
ret = SCM_FUNC_EXEC_SUBR0(tmp);
goto eval_done;
- }
+
case FUNCTYPE_1:
- {
ret = SCM_FUNC_EXEC_SUBR1(tmp, ScmOp_eval(CAR(CDR(obj)),env));
goto eval_done;
- }
+
case FUNCTYPE_2:
- {
obj = CDR(obj);
arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
ret = SCM_FUNC_EXEC_SUBR2(tmp,
arg,
ScmOp_eval(CAR(CDR(obj)), env)); /* 2nd arg */
goto eval_done;
- }
+
case FUNCTYPE_3:
- {
obj = CDR(obj);
arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
obj = CDR(obj);
@@ -388,9 +369,8 @@
ScmOp_eval(CAR(obj), env), /* 2nd arg */
ScmOp_eval(CAR(CDR(obj)), env)); /* 3rd arg */
goto eval_done;
- }
+
case FUNCTYPE_4:
- {
obj = CDR(obj);
arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
obj = CDR(obj);
@@ -400,9 +380,8 @@
ScmOp_eval(CAR(CDR(obj)), env), /* 3rd arg */
ScmOp_eval(CAR(CDR(CDR(obj))), env)); /* 4th arg */
goto eval_done;
- }
+
case FUNCTYPE_5:
- {
obj = CDR(obj);
arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
obj = CDR(obj);
@@ -413,13 +392,12 @@
ScmOp_eval(CAR(CDR(CDR(obj))), env), /* 4th arg */
ScmOp_eval(CAR(CDR(CDR(CDR(obj)))), env)); /* 5th arg */
goto eval_done;
- }
+
default:
SigScm_Error("eval : unknown functype\n");
}
- }
+
case ScmClosure:
- {
/*
* Description of the ScmClosure handling
*
@@ -468,14 +446,13 @@
*/
obj = ScmExp_begin(CDR(SCM_CLOSURE_EXP(tmp)), &env, &tail_flag);
goto eval_loop;
- }
+
case ScmContinuation:
- {
/*
* Description of ScmContinuation handling
*
* (1) eval 1st arg
- * (2) store it to global variable "continuation_thrown_obj"
+ * (2) store it to global variable "scm_continuation_thrown_obj"
* (3) then longjmp
*
* PROBLEM : setjmp/longjmp is stack based operation, so we
@@ -484,25 +461,24 @@
* class continuation? (TODO).
*/
obj = CAR(CDR(obj));
- continuation_thrown_obj = ScmOp_eval(obj, env);
+ scm_continuation_thrown_obj = ScmOp_eval(obj, env);
longjmp(SCM_CONTINUATION_JMPENV(tmp), 1);
break;
- }
+
case ScmEtc:
- {
SigScm_ErrorObj("eval : invalid application: ", obj);
- }
+
default:
SigScm_ErrorObj("eval : What type of function? ", arg);
}
- }
+
default:
ret = obj;
goto eval_done;
}
eval_done:
- trace_root = frame.prev;
+ scm_trace_root = frame.prev;
return ret;
}
@@ -527,29 +503,22 @@
/* apply proc */
switch (SCM_TYPE(proc)) {
case ScmFunc:
- {
switch (SCM_FUNC_NUMARG(proc)) {
case FUNCTYPE_L:
- {
return SCM_FUNC_EXEC_SUBRL(proc,
obj,
env);
- }
+
case FUNCTYPE_2N:
- {
- args = obj;
-
+ args = obj;
/* check 1st arg */
if (NULLP(args))
- return SCM_FUNC_EXEC_SUBR2N(proc, SCM_NIL, SCM_NIL);
-
+ return SCM_FUNC_EXEC_SUBR2N(proc, SCM_NIL, SCM_NIL);
/* eval 1st arg */
obj = CAR(args);
-
/* check 2nd arg */
if (NULLP(CDR(args)))
return SCM_FUNC_EXEC_SUBR2N(proc, obj, SCM_NIL);
-
/* call proc with each 2 objs */
for (args = CDR(args); !NULLP(args); args = CDR(args)) {
obj = SCM_FUNC_EXEC_SUBR2N(proc,
@@ -557,52 +526,45 @@
CAR(args));
}
return obj;
- }
+
case FUNCTYPE_0:
- {
return SCM_FUNC_EXEC_SUBR0(proc);
- }
+
case FUNCTYPE_1:
- {
return SCM_FUNC_EXEC_SUBR1(proc,
CAR(obj));
- }
+
case FUNCTYPE_2:
- {
return SCM_FUNC_EXEC_SUBR2(proc,
CAR(obj),
CAR(CDR(obj)));
- }
+
case FUNCTYPE_3:
- {
return SCM_FUNC_EXEC_SUBR3(proc,
CAR(obj),
CAR(CDR(obj)),
CAR(CDR(CDR(obj))));
- }
+
case FUNCTYPE_4:
- {
return SCM_FUNC_EXEC_SUBR4(proc,
CAR(obj),
CAR(CDR(obj)),
CAR(CDR(CDR(obj))),
CAR(CDR(CDR(CDR(obj)))));
- }
+
case FUNCTYPE_5:
- {
return SCM_FUNC_EXEC_SUBR5(proc,
CAR(obj),
CAR(CDR(obj)),
CAR(CDR(CDR(obj))),
CAR(CDR(CDR(CDR(obj)))),
CAR(CDR(CDR(CDR(CDR(obj))))));
- }
+
default:
SigScm_ErrorObj("apply : invalid application ", proc);
}
- }
+
case ScmClosure:
- {
/*
* Description of the ScmClosure handling
*
@@ -615,7 +577,6 @@
* (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
*/
args = CAR(SCM_CLOSURE_EXP(proc)); /* arg is <formals> */
-
if (SYMBOLP(args)) {
/* (1) : <variable> */
env = extend_environment(Scm_NewCons(args, SCM_NIL),
@@ -641,7 +602,6 @@
} else {
SigScm_ErrorObj("lambda : bad syntax with ", args);
}
-
/*
* Notice
*
@@ -650,7 +610,7 @@
*/
obj = ScmExp_begin(CDR(SCM_CLOSURE_EXP(proc)), &env, &tail_flag);
return ScmOp_eval(obj, env);
- }
+
default:
SigScm_ErrorObj("apply : invalid application ", args);
}
@@ -659,7 +619,7 @@
return SCM_NIL;
}
-static ScmObj symbol_value(ScmObj var, ScmObj env)
+ScmObj symbol_value(ScmObj var, ScmObj env)
{
ScmObj val = SCM_NIL;
@@ -675,7 +635,7 @@
}
/* next, lookup the special environment for letrec */
- val = lookup_environment(var, letrec_env);
+ val = lookup_environment(var, scm_letrec_env);
if (!NULLP(val)) {
/* variable is found in letrec environment, so returns its value */
return CAR(val);
@@ -1417,15 +1377,15 @@
vals = Scm_NewCons(val, vals);
}
- /* construct new frame for letrec_env */
+ /* construct new frame for scm_letrec_env */
frame = Scm_NewCons(vars, vals);
- letrec_env = Scm_NewCons(frame, letrec_env);
+ scm_letrec_env = Scm_NewCons(frame, scm_letrec_env);
- /* extend environment by letrec_env */
+ /* extend environment by scm_letrec_env */
env = extend_environment(CAR(frame), CDR(frame), env);
/* ok, vars of letrec is extended to env */
- letrec_env = SCM_NIL;
+ scm_letrec_env = SCM_NIL;
/* set new env */
*envp = env;
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/io.c 2005-08-24 13:07:02 UTC (rev 1300)
@@ -53,8 +53,8 @@
/*=======================================
Variable Declarations
=======================================*/
-ScmObj current_input_port = NULL;
-ScmObj current_output_port = NULL;
+ScmObj scm_current_input_port = NULL;
+ScmObj scm_current_output_port = NULL;
ScmObj SigScm_features = NULL;
@@ -149,12 +149,12 @@
ScmObj ScmOp_current_input_port(void)
{
- return current_input_port;
+ return scm_current_input_port;
}
ScmObj ScmOp_current_output_port(void)
{
- return current_output_port;
+ return scm_current_output_port;
}
ScmObj ScmOp_with_input_from_file(ScmObj filepath, ScmObj thunk)
@@ -167,9 +167,9 @@
if (!FUNCP(thunk) && !CLOSUREP(thunk))
SigScm_ErrorObj("with-input-from-file : proc required but got ", thunk);
- /* set current_input_port */
- tmp_port = current_input_port;
- current_input_port = ScmOp_open_input_file(filepath);
+ /* set scm_current_input_port */
+ tmp_port = scm_current_input_port;
+ scm_current_input_port = ScmOp_open_input_file(filepath);
/* (apply thunk ())*/
ret = ScmOp_apply(SCM_LIST_2(thunk,
@@ -177,10 +177,10 @@
SCM_NIL);
/* close port */
- ScmOp_close_input_port(current_input_port);
+ ScmOp_close_input_port(scm_current_input_port);
- /* restore current_input_port */
- current_input_port = tmp_port;
+ /* restore scm_current_input_port */
+ scm_current_input_port = tmp_port;
return ret;
}
@@ -195,9 +195,9 @@
if (!FUNCP(thunk) && !CLOSUREP(thunk))
SigScm_ErrorObj("with-output-to-file : proc required but got ", thunk);
- /* set current_output_port */
- tmp_port = current_output_port;
- current_output_port = ScmOp_open_output_file(filepath);
+ /* set scm_current_output_port */
+ tmp_port = scm_current_output_port;
+ scm_current_output_port = ScmOp_open_output_file(filepath);
/* (apply thunk ())*/
ret = ScmOp_apply(SCM_LIST_2(thunk,
@@ -205,10 +205,10 @@
SCM_NIL);
/* close port */
- ScmOp_close_output_port(current_output_port);
+ ScmOp_close_output_port(scm_current_output_port);
- /* restore current_output_port */
- current_output_port = tmp_port;
+ /* restore scm_current_output_port */
+ scm_current_output_port = tmp_port;
return ret;
}
@@ -275,7 +275,7 @@
ScmObj port = SCM_NIL;
if (NULLP(arg)) {
/* (read) */
- port = current_input_port;
+ port = scm_current_input_port;
} else if (PORTP(CAR(arg))) {
/* (read port) */
port = CAR(arg);
@@ -292,7 +292,7 @@
char *buf = NULL;
if (NULLP(arg)) {
/* (read-char) */
- port = current_input_port;
+ port = scm_current_input_port;
} else if (!NULLP(CDR(arg)) && PORTP(CAR(CDR(arg)))) {
/* (read-char port) */
port = CAR(CDR(arg));
@@ -338,7 +338,7 @@
arg = CDR(arg);
/* get port */
- port = current_output_port;
+ port = scm_current_output_port;
if (!NULLP(arg) && !NULLP(CAR(arg)) && PORTP(CAR(arg)))
port = CAR(arg);
@@ -359,7 +359,7 @@
arg = CDR(arg);
/* get port */
- port = current_output_port;
+ port = scm_current_output_port;
/* (display obj port) */
if (!NULLP(arg) && PORTP(CAR(arg)))
@@ -383,7 +383,7 @@
arg = CDR(arg);
/* get port */
- port = current_output_port;
+ port = scm_current_output_port;
/* (display obj port) */
if (!NULLP(arg) && PORTP(CAR(arg)))
@@ -399,7 +399,7 @@
ScmObj ScmOp_newline(ScmObj arg, ScmObj env)
{
/* get port */
- ScmObj port = current_output_port;
+ ScmObj port = scm_current_output_port;
/* (newline port) */
if (!NULLP(arg) && !NULLP(CAR(arg)) && PORTP(CAR(arg))) {
@@ -425,7 +425,7 @@
SigScm_ErrorObj("write-char : char required but got ", obj);
/* get port */
- port = current_output_port;
+ port = scm_current_output_port;
/* (write-char obj port) */
if (!NULLP(arg) && PORTP(CAR(arg)))
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/read.c 2005-08-24 13:07:02 UTC (rev 1300)
@@ -52,23 +52,25 @@
/*=======================================
File Local Macro Declarations
=======================================*/
-#define SCM_PORT_GETC(port, c) \
- do { \
- if (SCM_PORTINFO_UNGOTTENCHAR(port)) { \
- c = SCM_PORTINFO_UNGOTTENCHAR(port); \
- SCM_PORTINFO_UNGOTTENCHAR(port) = 0; \
- } else { \
- switch (SCM_PORTINFO_PORTTYPE(port)) { \
- case PORT_FILE: \
- c = getc(SCM_PORTINFO_FILE(port)); \
- break; \
- case PORT_STRING: \
- c = (*SCM_PORTINFO_STR_CURRENT(port)); \
- SCM_PORTINFO_STR_CURRENT(port)++; \
- break; \
- } \
- SCM_PORTINFO_UNGOTTENCHAR(port) = 0; \
- } \
+#define SCM_PORT_GETC(port, c) \
+ do { \
+ if (SCM_PORTINFO_UNGOTTENCHAR(port)) { \
+ c = SCM_PORTINFO_UNGOTTENCHAR(port); \
+ SCM_PORTINFO_UNGOTTENCHAR(port) = 0; \
+ } else { \
+ switch (SCM_PORTINFO_PORTTYPE(port)) { \
+ case PORT_FILE: \
+ c = getc(SCM_PORTINFO_FILE(port)); \
+ if (c == '\n') SCM_PORTINFO_LINE(port)++; \
+ break; \
+ case PORT_STRING: \
+ c = (*SCM_PORTINFO_STR_CURRENT(port)); \
+ if (c == '\0') c = EOF; \
+ SCM_PORTINFO_STR_CURRENT(port)++; \
+ break; \
+ } \
+ SCM_PORTINFO_UNGOTTENCHAR(port) = 0; \
+ } \
} while (0);
#define SCM_PORT_UNGETC(port,c ) \
@@ -127,19 +129,11 @@
while (1) {
SCM_PORT_GETC(port, c);
if (c == '\n') {
- if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
- SCM_PORTINFO_LINE(port)++;
- }
break;
}
if (c == EOF ) return c;
}
continue;
- } else if(c == '\n') {
- if (SCM_PORTINFO_PORTTYPE(port) == PORT_FILE) {
- SCM_PORTINFO_LINE(port)++;
- }
- continue;
} else if(isspace(c)) {
continue;
}
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-08-24 13:07:02 UTC (rev 1300)
@@ -65,8 +65,6 @@
ScmObjInternal SigScm_quote_impl, SigScm_quasiquote_impl, SigScm_unquote_impl, SigScm_unquote_splicing_impl;
ScmObjInternal SigScm_unbound_impl, SigScm_undef_impl;
-extern ScmObj continuation_thrown_obj, letrec_env;
-
#if SCM_COMPAT_SIOD
extern ScmObj scm_return_value;
#endif
@@ -77,7 +75,7 @@
void SigScm_Initialize(void)
{
ScmObj obj;
- stack_start_pointer = &obj;
+ SigScm_gc_protect_stack(&obj);
/*=======================================================================
Etc Variable Initialization
@@ -96,8 +94,8 @@
/*=======================================================================
Externed Variable Initialization
=======================================================================*/
- continuation_thrown_obj = SCM_NIL;
- letrec_env = SCM_NIL;
+ scm_continuation_thrown_obj = SCM_NIL;
+ scm_letrec_env = SCM_NIL;
/*=======================================================================
Storage Initialization
=======================================================================*/
@@ -298,12 +296,12 @@
/*=======================================================================
Current Input & Output Initialization
=======================================================================*/
- current_input_port = Scm_NewFilePort(stdin, "stdin", PORT_INPUT);
- SigScm_gc_protect(current_input_port);
- current_output_port = Scm_NewFilePort(stdout, "stdout", PORT_OUTPUT);
- SigScm_gc_protect(current_output_port);
- current_error_port = Scm_NewFilePort(stderr, "stderr", PORT_OUTPUT);
- SigScm_gc_protect(current_error_port);
+ scm_current_input_port = Scm_NewFilePort(stdin, "stdin", PORT_INPUT);
+ SigScm_gc_protect(scm_current_input_port);
+ scm_current_output_port = Scm_NewFilePort(stdout, "stdout", PORT_OUTPUT);
+ SigScm_gc_protect(scm_current_output_port);
+ scm_current_error_port = Scm_NewFilePort(stderr, "stderr", PORT_OUTPUT);
+ SigScm_gc_protect(scm_current_error_port);
#if SCM_USE_SRFI1
/*=======================================================================
@@ -342,7 +340,7 @@
scm_return_value = SCM_NIL;
#endif
- stack_start_pointer = NULL;
+ SigScm_gc_unprotect_stack(&obj);
}
void SigScm_Finalize()
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-08-24 13:07:02 UTC (rev 1300)
@@ -56,20 +56,22 @@
Variable Declarations
=======================================*/
/* datas.c */
-extern ScmObj *stack_start_pointer;
+extern ScmObj *scm_stack_start_pointer;
/* error.c*/
-extern ScmObj current_error_port;
+extern ScmObj scm_current_error_port;
/* eval.c */
-extern struct trace_frame *trace_root;
+extern ScmObj scm_continuation_thrown_obj;
+extern ScmObj scm_letrec_env;
+extern struct trace_frame *scm_trace_root;
/* io.c */
-extern ScmObj current_input_port;
-extern ScmObj current_output_port;
-extern ScmObj current_error_port;
+extern ScmObj scm_current_input_port;
+extern ScmObj scm_current_output_port;
extern ScmObj SigScm_features;
+
/*=======================================
Macro Declarations
=======================================*/
@@ -99,6 +101,10 @@
#define CDR SCM_CDR
#define SET_CAR SCM_CONS_SET_CAR
#define SET_CDR SCM_CONS_SET_CDR
+#define CAAR SCM_CAAR
+#define CADR SCM_CADR
+#define CDAR SCM_CDAR
+#define CDDR SCM_CDDR
#define INTP SCM_INTP
#define CONSP SCM_CONSP
@@ -115,22 +121,6 @@
#define C_POINTERP SCM_C_POINTERP
#define C_FUNCPOINTERP SCM_C_FUNCPOINTERP
-/*
- * Abbrev name for these constants are not provided since it involves some
- * consistency problems and confusions. Use the canonical names always.
- *
- * SCM_NULL
- * SCM_TRUE
- * SCM_FALSE
- * SCM_EOF
- * SCM_QUOTE
- * SCM_QUASIQUOTE
- * SCM_UNQUOTE
- * SCM_UNQUOTE_SPLICING
- * SCM_UNBOUND
- * SCM_UNDEF
- */
-
/* Macros For Argnument Number Checking */
#define CHECK_1_ARG(arg) \
(SCM_NULLP(arg))
@@ -170,5 +160,13 @@
/*=======================================
Function Declarations
=======================================*/
+/* eval.c */
+/* environment related functions */
+ScmObj extend_environment(ScmObj vars, ScmObj vals, ScmObj env);
+ScmObj add_environment(ScmObj var, ScmObj val, ScmObj env);
+ScmObj lookup_environment(ScmObj var, ScmObj env);
+ScmObj lookup_frame(ScmObj var, ScmObj frame);
+ScmObj symbol_value(ScmObj var, ScmObj env);
+
#endif /* __SIGSCHEMEINTERNAL_H */
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-08-24 10:40:54 UTC (rev 1299)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-08-24 13:07:02 UTC (rev 1300)
@@ -110,7 +110,7 @@
} str_port;
} info;
- char ungottenchar;
+ int ungottenchar;
};
typedef struct _ScmContInfo ScmContInfo;
@@ -367,6 +367,22 @@
extern ScmObj SigScm_quote, SigScm_quasiquote, SigScm_unquote, SigScm_unquote_splicing;
extern ScmObj SigScm_unbound, SigScm_undef;
+/*
+ * Abbrev name for these constants are not provided since it involves some
+ * consistency problems and confusions. Use the canonical names always.
+ *
+ * SCM_NULL
+ * SCM_TRUE
+ * SCM_FALSE
+ * SCM_EOF
+ * SCM_QUOTE
+ * SCM_QUASIQUOTE
+ * SCM_UNQUOTE
+ * SCM_UNQUOTE_SPLICING
+ * SCM_UNBOUND
+ * SCM_UNDEF
+ */
+
#define SCM_NIL SigScm_nil
#define SCM_TRUE SigScm_true
#define SCM_FALSE SigScm_false
More information about the uim-commit
mailing list