mirror of https://github.com/GNOME/gimp.git
Applied changes based on official version of TinyScheme (CVS commits dated
2008/01/22 04:18). Fix for the load bug.
This commit is contained in:
parent
9541fe0387
commit
21cebda8a9
|
@ -57,6 +57,8 @@ func_dealloc free;
|
|||
/* return code */
|
||||
int retcode;
|
||||
int tracing;
|
||||
int top_EOF; /* Have we seen EOF at top level? */
|
||||
|
||||
|
||||
#define CELL_SEGSIZE 25000 /* # of cells in one segment */
|
||||
#define CELL_NSEGMENT 50 /* # of segments for cells */
|
||||
|
|
|
@ -396,7 +396,7 @@ static gunichar inchar(scheme *sc);
|
|||
static void backchar(scheme *sc, gunichar c);
|
||||
static char *readstr_upto(scheme *sc, char *delim);
|
||||
static pointer readstrexp(scheme *sc);
|
||||
static INLINE void skipspace(scheme *sc);
|
||||
static INLINE int skipspace(scheme *sc);
|
||||
static int token(scheme *sc);
|
||||
static void printslashstring(scheme *sc, char *s, int len);
|
||||
static void atom2str(scheme *sc, pointer l, int f, char **pp, int *plen);
|
||||
|
@ -1425,8 +1425,11 @@ static int file_push(scheme *sc, const char *fname) {
|
|||
}
|
||||
|
||||
static void file_pop(scheme *sc) {
|
||||
if(sc->file_i==0)
|
||||
{ sc->top_EOF = 1; }
|
||||
else
|
||||
{
|
||||
sc->nesting=sc->nesting_stack[sc->file_i];
|
||||
if(sc->file_i!=0) {
|
||||
port_close(sc,sc->loadport,port_input);
|
||||
sc->file_i--;
|
||||
sc->loadport->_object._port=sc->load_stack+sc->file_i;
|
||||
|
@ -1640,7 +1643,7 @@ static gunichar basic_inchar(port *pt) {
|
|||
static gunichar inchar(scheme *sc) {
|
||||
gunichar c;
|
||||
port *pt;
|
||||
again:
|
||||
|
||||
pt = sc->inport->_object._port;
|
||||
if(pt->kind&port_file)
|
||||
{
|
||||
|
@ -1651,14 +1654,10 @@ static gunichar inchar(scheme *sc) {
|
|||
}
|
||||
else
|
||||
c = basic_inchar(pt);
|
||||
if(c == EOF && sc->inport == sc->loadport && sc->file_i != 0) {
|
||||
if(c == EOF && sc->inport == sc->loadport) {
|
||||
file_pop(sc);
|
||||
if(sc->nesting!=0) {
|
||||
return EOF;
|
||||
} else {
|
||||
return '\n';
|
||||
}
|
||||
goto again;
|
||||
/* NOTREACHED */
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
@ -1904,19 +1903,25 @@ static INLINE int is_one_of(char *s, gunichar c) {
|
|||
}
|
||||
|
||||
/* skip white characters */
|
||||
static INLINE void skipspace(scheme *sc) {
|
||||
static INLINE int skipspace(scheme *sc) {
|
||||
gunichar c;
|
||||
while (g_unichar_isspace(c=inchar(sc)))
|
||||
;
|
||||
do
|
||||
{ c=inchar(sc); }
|
||||
while (g_unichar_isspace(c));
|
||||
|
||||
if(c!=EOF) {
|
||||
backchar(sc,c);
|
||||
return 1;
|
||||
}
|
||||
else
|
||||
{ return EOF; }
|
||||
}
|
||||
|
||||
/* get token */
|
||||
static int token(scheme *sc) {
|
||||
gunichar c;
|
||||
skipspace(sc);
|
||||
c = skipspace(sc);
|
||||
if(c == EOF) { return (TOK_EOF); }
|
||||
switch (c=inchar(sc)) {
|
||||
case EOF:
|
||||
return (TOK_EOF);
|
||||
|
@ -1938,7 +1943,10 @@ static int token(scheme *sc) {
|
|||
case ';':
|
||||
while ((c=inchar(sc)) != '\n' && c!=EOF)
|
||||
;
|
||||
return (token(sc));
|
||||
if(c == EOF)
|
||||
{ return (TOK_EOF); }
|
||||
else
|
||||
{ return (token(sc));}
|
||||
case '"':
|
||||
return (TOK_DQUOTE);
|
||||
case '_':
|
||||
|
@ -1962,7 +1970,10 @@ static int token(scheme *sc) {
|
|||
} else if(c == '!') {
|
||||
while ((c=inchar(sc)) != '\n' && c!=EOF)
|
||||
;
|
||||
return (token(sc));
|
||||
if(c == EOF)
|
||||
{ return (TOK_EOF); }
|
||||
else
|
||||
{ return (token(sc));}
|
||||
} else {
|
||||
backchar(sc,c);
|
||||
if(is_one_of(" tfodxb\\",c)) {
|
||||
|
@ -2573,23 +2584,42 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
|
|||
Error_1(sc,"unable to open", car(sc->args));
|
||||
}
|
||||
else
|
||||
{ s_retbool(1); }
|
||||
{
|
||||
sc->args = mk_integer(sc,sc->file_i);
|
||||
s_goto(sc,OP_T0LVL);
|
||||
}
|
||||
|
||||
case OP_T0LVL: /* top level */
|
||||
if(file_interactive(sc)) {
|
||||
putstr(sc,"\n");
|
||||
}
|
||||
sc->nesting=0;
|
||||
dump_stack_reset(sc);
|
||||
if(file_interactive(sc))
|
||||
{
|
||||
sc->envir = sc->global_env;
|
||||
dump_stack_reset(sc);
|
||||
putstr(sc,"\n");
|
||||
putstr(sc,prompt);
|
||||
s_save(sc,OP_T0LVL, mk_integer(sc,sc->file_i), sc->NIL);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Each load of any file gets its own top-level loop that
|
||||
ends when the file has been read. We detect that by
|
||||
monitoring sc->file_i. */
|
||||
pointer depth = sc->args;
|
||||
if(is_integer(depth) && ivalue(depth) == sc->file_i)
|
||||
{
|
||||
s_save(sc,OP_T0LVL, depth, sc->NIL);
|
||||
}
|
||||
else
|
||||
{
|
||||
s_return(sc,sc->value);
|
||||
/* NOTREACHED */
|
||||
}
|
||||
}
|
||||
|
||||
sc->nesting=0;
|
||||
sc->save_inport=sc->inport;
|
||||
sc->inport = sc->loadport;
|
||||
s_save(sc,OP_T0LVL, sc->NIL, sc->NIL);
|
||||
s_save(sc,OP_VALUEPRINT, sc->NIL, sc->NIL);
|
||||
s_save(sc,OP_T1LVL, sc->NIL, sc->NIL);
|
||||
if (file_interactive(sc)) {
|
||||
putstr(sc,prompt);
|
||||
}
|
||||
s_goto(sc,OP_READ_INTERNAL);
|
||||
|
||||
case OP_T1LVL: /* top level */
|
||||
|
@ -2600,7 +2630,8 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
|
|||
case OP_READ_INTERNAL: /* internal read */
|
||||
sc->tok = token(sc);
|
||||
if(sc->tok==TOK_EOF) {
|
||||
if(sc->inport==sc->loadport) {
|
||||
if(sc->top_EOF)
|
||||
{
|
||||
sc->args=sc->NIL;
|
||||
s_goto(sc,OP_QUIT);
|
||||
} else {
|
||||
|
@ -4083,7 +4114,8 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
|
|||
case OP_RDSEXPR:
|
||||
switch (sc->tok) {
|
||||
case TOK_EOF:
|
||||
if(sc->inport==sc->loadport) {
|
||||
if(sc->top_EOF)
|
||||
{
|
||||
sc->args=sc->NIL;
|
||||
s_goto(sc,OP_QUIT);
|
||||
} else {
|
||||
|
@ -4709,6 +4741,7 @@ int scheme_init_custom_alloc(scheme *sc, func_alloc malloc, func_dealloc free) {
|
|||
sc->loadport=sc->NIL;
|
||||
sc->nesting=0;
|
||||
sc->interactive_repl=0;
|
||||
sc->top_EOF = 0;
|
||||
sc->print_output=0;
|
||||
|
||||
if (alloc_cellseg(sc,FIRST_CELLSEGS) != FIRST_CELLSEGS) {
|
||||
|
@ -4842,6 +4875,8 @@ void scheme_load_file(scheme *sc, FILE *fin) {
|
|||
sc->interactive_repl=1;
|
||||
}
|
||||
sc->inport=sc->loadport;
|
||||
sc->top_EOF = 0;
|
||||
sc->args = mk_integer(sc,sc->file_i);
|
||||
Eval_Cycle(sc, OP_T0LVL);
|
||||
typeflag(sc->loadport)=T_ATOM;
|
||||
if(sc->retcode==0) {
|
||||
|
@ -4861,6 +4896,8 @@ void scheme_load_string(scheme *sc, const char *cmd) {
|
|||
sc->retcode=0;
|
||||
sc->interactive_repl=0;
|
||||
sc->inport=sc->loadport;
|
||||
sc->top_EOF = 0;
|
||||
sc->args = mk_integer(sc,sc->file_i);
|
||||
Eval_Cycle(sc, OP_T0LVL);
|
||||
typeflag(sc->loadport)=T_ATOM;
|
||||
if(sc->retcode==0) {
|
||||
|
|
Loading…
Reference in New Issue