Shiro Kawai
shiro****@lava*****
2004年 1月 17日 (土) 13:47:14 JST
sloppyなスタック操作のコードが元凶でした。 深い再帰が極端に遅くなる問題と同根です。 このパッチを試してみて下さい。 --shiro =================================================================== RCS file: /cvsroot/gauche/Gauche/src/vm.c,v retrieving revision 1.203 diff -u -r1.203 vm.c --- vm.c 8 Dec 2003 21:13:17 -0000 1.203 +++ vm.c 17 Jan 2004 04:45:33 -0000 @@ -1459,37 +1459,54 @@ ScmEnvFrame *env_begin, ScmContFrame *cont_begin) { - ScmEnvFrame *e = env_begin, *prev = NULL, *head = env_begin, *saved; + ScmEnvFrame *e = env_begin, *prev = NULL, *next, *head = env_begin, *saved; ScmContFrame *c = cont_begin; ScmObj *s; ScmCStack *cstk; ScmEscapePoint *eh; - int esize, bsize; + + if (!IN_STACK_P((ScmObj*)e)) return e; - for (; IN_STACK_P((ScmObj*)e); e = e->up) { - esize = e->size; - bsize = ENV_SIZE(esize) * sizeof(ScmObj); + /* First pass - move envs in stack to heap. After env is moved, + the location of 'up' pointer in the env frame in the stack + contains the new location of env frame, so that the env pointers + in continuation frames will be adjusted in the second pass. + Such forwarded pointer is indicated by env->size == -1. */ + do { + int esize = e->size; + int bsize = ENV_SIZE(esize) * sizeof(ScmObj); s = SCM_NEW2(ScmObj*, bsize); memcpy(s, ENV_FP(e), bsize); saved = (ScmEnvFrame*)(s + esize); - for (c = cont_begin; c; c = c->prev) { - if (c->env == e) c->env = saved; + if (prev) prev->up = saved; + if (e == env_begin) head = saved; + next = e->up; + e->up = prev = saved; /* forwarding pointer */ + e->size = -1; /* indicates forwarded */ + e->info = SCM_FALSE; /* clear pointer for GC */ + e = next; + } while (IN_STACK_P((ScmObj*)e)); + + /* Second pass - scan continuation frames in the stack, and forwards + env pointers */ + for (c = cont_begin; IN_STACK_P((ScmObj*)c); c = c->prev) { + if (IN_STACK_P((ScmObj*)(c->env)) && c->env->size == -1) { + c->env = c->env->up; } - for (cstk = vm->cstack; cstk; cstk = cstk->prev) { - for (c = cstk->cont; c; c = c->prev) { - if (!IN_STACK_P((ScmObj*)c)) break; - if (c->env == e) c->env = saved; + } + for (cstk = vm->cstack; cstk; cstk = cstk->prev) { + for (c = cstk->cont; IN_STACK_P((ScmObj*)c); c = c->prev) { + if (IN_STACK_P((ScmObj*)(c->env)) && c->env->size == -1) { + c->env = c->env->up; } } - for (eh = vm->escapePoint; eh; eh = eh->prev) { - for (c = eh->cont; c; c = c->prev) { - if (!IN_STACK_P((ScmObj*)c)) break; - if (c->env == e) c->env = saved; + } + for (eh = vm->escapePoint; eh; eh = eh->prev) { + for (c = eh->cont; IN_STACK_P((ScmObj*)c); c = c->prev) { + if (IN_STACK_P((ScmObj*)(c->env)) && c->env->size == -1) { + c->env = c->env->up; } } - if (e == env_begin) head = saved; - if (prev) prev->up = saved; - prev = saved; } return head; } ===================================================================