Gauche:Bugs:log12

Gauche:Bugs:log12


src/port.cのtypo (0.8.13)

(2008/09/12 00:09:33 PDT)

--- src/port.c.orig     2008-09-12 16:05:38.000000000 +0900
+++ src/port.c  2008-09-12 16:06:18.000000000 +0900
@@ -1110,7 +1110,7 @@
  */
 
 /* To create a procedural port, fill in the ScmPortVTable function
-   pointers and pass it to Scm_MakeVirutalPort.  You don't need to
+   pointers and pass it to Scm_MakeVirtualPort.  You don't need to
    provide all the functions; put NULL if you think you don't
    provide the functionality.
 */

imaginary unit with a couple of sign (0.8.13)

tabe(2008/09/11 10:29:16 PDT): R5RS の lexical structure の <complex R> に当てはまりませんが複素数になります。

gosh> ++i
0.0+1.0i
gosh> +-i
0.0-1.0i
gosh> -+i
0.0+1.0i
gosh> --i
0.0-1.0i

ユーザーリファレンスのtypo

osn(2008/07/18 17:33:39 PDT)

rfc.http :no-redirect #f の時に、リクエストメッセージの Host ヘッダフィールドがおかしくなる場合があります(trunk@6267)

takeshi(2008/06/25 10:17:08 PDT): リダイレクトを辿る場合に、

Host: #<<http-connection> 0xb85db0>

のようになっちゃいます。以下はそうならなくするだけです。

diff --git a/lib/rfc/http.scm b/lib/rfc/http.scm
index 1f85441..77efd1e 100644
--- a/lib/rfc/http.scm
+++ b/lib/rfc/http.scm
@@ -185,7 +185,7 @@
                   (when (or (member uri history)
                             (> (length history) 20))
                     (errorf <http-error> "redirection is looping via ~a" uri))
-                  (loop (cons uri history) (redirect conn new-server) path*)))
+                  (loop (cons uri history) (ref (redirect conn new-server) 'server) path*)))
               (values code headers body)))))))

 ;; Always returns a connection object.

特に動作に影響のないtypo:

enami(2008/06/20 07:25:55 PDT): ソース見ただけで、テストしてないです。

Index: ext/peg/peg-lib.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/ext/peg/peg-lib.scm,v
retrieving revision 1.4
diff -p -u -F^( -r1.4 peg-lib.scm
--- ext/peg/peg-lib.scm 3 Jun 2008 18:38:54 -0000       1.4
+++ ext/peg/peg-lib.scm 9 Jun 2008 01:03:22 -0000
@@ -139,7 +139,7 @@ (define (make-peg-parse-error type objs 
     (match lis
       [() '()]
       [(x) `(,x)]
-      [(x y) `(,x "or" ,y)]
+      [(x y) `(,x " or " ,y)]
       [(x . more) `(,x ", " ,@(or-concat more))]))
   (define (compound-exps exps)
     (match exps
@@ -399,7 +399,7 @@ (define-macro ($do* . clauses)
   (%gen-do-common)
 
   (when (null? clauses)
-    (error "Malformed $do: at least one clause is required."))
+    (error "Malformed $do*: at least one clause is required."))
   (let1 s (gensym)
     `(lambda (,s)
        ,(let loop ((s s) (clauses clauses))
Index: ext/peg/test.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/ext/peg/test.scm,v
retrieving revision 1.2
diff -p -u -F^( -r1.2 test.scm
--- ext/peg/test.scm    27 May 2008 10:30:06 -0000      1.2
+++ ext/peg/test.scm    9 Jun 2008 01:03:22 -0000
@@ -457,11 +457,11 @@ (let* ((spaces ($many ($one-of #[ \t])))
        (unquoted ($many-till anychar ($or comma newline)))
        (field ($or quoted unquoted))
        (record ($sep-by ($->rope field) comma)))
-  (test-succ "CVS" '("a" "b" "c")
+  (test-succ "CSV" '("a" "b" "c")
              record "a,b,c")
-  (test-succ "CVS" '("a" "b" "c")
+  (test-succ "CSV" '("a" "b" "c")
              record "\"a\" , b  , c")
-  (test-succ "CVS" '("a  \" \n" "b" "c")
+  (test-succ "CSV" '("a  \" \n" "b" "c")
              record "\"a  \"\" \n\" , b  , c"))
 
 ;; hand-tuned version
@@ -476,11 +476,11 @@ (let* ((spaces_ ($many_ ($one-of #[ \t])
        (field ($or quoted unquoted))
        (record ($sep-by ($->rope field) comma 1))
        (records ($sep-by record ($string "\r\n"))))
-  (test-succ "CVS 2" '(("a" "b" "c") ("x" "y" "z"))
+  (test-succ "CSV 2" '(("a" "b" "c") ("x" "y" "z"))
              records "a,b,c\r\nx,y,z\r\n")
-  (test-succ "CVS 2" '(("a " "b" "c") ("zzz\nyyy " " w \" "))
+  (test-succ "CSV 2" '(("a " "b" "c") ("zzz\nyyy " " w \" "))
              records "\"a \" , b  , c\r\n\"zzz\nyyy \", \" w \"\" \"\r\n")
-  (test-succ "CVS 2" '(("a  \" \n" "b" "c"))
+  (test-succ "CSV 2" '(("a  \" \n" "b" "c"))
              records "\"a  \"\" \n\" , b  , c"))
 
 ;; Poor-man's XML parser

rfc.json のコードチェック (CVS HEAD)

takeshi(2008/05/28 09:25:33 PDT): glint で拾いました。

diff --git a/lib/rfc/json.scm b/lib/rfc/json.scm
index aeeea61..b70e4db 100644
--- a/lib/rfc/json.scm
+++ b/lib/rfc/json.scm
@@ -91,15 +91,15 @@
                      ($return (string->number (apply string s) 16))))
          (%special-char
           ($do %escape
-               ($or ($do ($char #\") ($return #\"))
-                    ($do ($char #\\) ($return #\\))
-                    ($do ($char #\/) ($return #\/))
-                    ($do ($char #\b) ($return #\b))
-                    ($do ($char #\f) ($return #\f))
-                    ($do ($char #\n) ($return #\n))
-                    ($do ($char #\r) ($return #\r))
-                    ($do ($char #\t) ($return #\t))
-                    ($do ($char #\u) (c %hex4) ($return (ucs->char c))))))
+               ($or ($do (($char #\")) ($return #\"))
+                    ($do (($char #\\)) ($return #\\))
+                    ($do (($char #\/)) ($return #\/))
+                    ($do (($char #\b)) ($return #\b))
+                    ($do (($char #\f)) ($return #\f))
+                    ($do (($char #\n)) ($return #\n))
+                    ($do (($char #\r)) ($return #\r))
+                    ($do (($char #\t)) ($return #\t))
+                    ($do (($char #\u)) (c %hex4) ($return (ucs->char c))))))
          (%unescaped ($none-of #[\"]))
          (%body-char ($or %special-char %unescaped))
          (%string-body ($->rope ($many %body-char))))

typo: lib/gauche/cgen/stub.scm (CVS HEAD)

sakiyama 2008/05/28 04:41:22 PDT

Index: stub.scm
===================================================================
RCS file: /cvsroot/gauche/Gauche/lib/gauche/cgen/stub.scm,v
retrieving revision 1.3
diff -r1.3 stub.scm
184c184
<    (c++-exeption-used? :init-value #f) ; #t if C++ exception has ever been used
---
>    (c++-exception-used? :init-value #f) ; #t if C++ exception has ever been used

マニュアル表記の不統一

(2008/05/17 23:37:19 PDT) : バグというほどのことかわかりませんが、「#fでない」と「偽でない」という二種類の表記を見つけました。この二種類は同じ意味だと思うので表記は統一すべきだと思います。

どちらに統一するべきなのかは判断つきませんが…。

Function: any pred clist1 clist2 …

    [SRFI-1] clist の各要素に pred を適用し、predが偽でない値を返したら直ちにその値を返します。 predが偽でない値を返す前にリストの要素を使いきってしまったら #fが返ります。 
Function: any-pred pred …

    与えられた引数をそれぞれ述語predに適用する手続きを返します。いずれかのpredが#fでない値を返す場合、その値を返します。全てのpredが#fを返す場合、#fを返します。 

シンボリックリンクを辿って降りたディレクトリで make check すると Testing system のテスト一部がフェイルする(CVS_HEAD,MacOS X 10.5.2)

nobsun(2008/05/08 00:54:55 PDT):

  test getcwd, expects "/Users/nobsun/repos/Gauche/src" ==> ERROR: GOT "/Users/nobsun/work/repos/Gauche/src"
  test normalize, expects "/Users/nobsun/repos/Gauche/src/." ==> ERROR: GOT "/Users/nobsun/work/repos/Gauche/src/."
  test normalize, expects "/Users/nobsun/repos/Gauche/src/" ==> ERROR: GOT "/Users/nobsun/work/repos/Gauche/src/"

これは MacOS X 10.5.2 の /bin/pwd が(オプションなしでは)物理パスを返さないために,(get-pwd-via-pwd) と (sys-getcwd) が違う結果を返す場合があるということのようです.(sys-getcwd) が物理絶対パスを返すことを期待しているのでしょうから,Leopard でのテストには /bin/pwd 以外の方法をで物理絶対パスを取得する必要があります.

どうすればいいかはすぐに思いつかないので,報告のみです.

Shiro(2008/05/08 02:31:54 PDT): 結局、darwinの時のみ "/bin/pwd -P" を実行するという アドホックな対応を入れました。

スレッドでのエラーが別スレッドのシグナルマスクに影響を与える (0.8.13, MacOSX Tiger)

ちと大きくなってきたので移動→ Gauche:MacOSX:スレッドとシグナルマスク

SCM_INTERNAL_MUTEX_UNLOCK無しにエラー例外を投げる in ext/charconv/jconv.c (0.8.13)

nekoie(2008/04/19 06:11:41 PDT): まず実害無いと思うんですが、一応。 ext/charconv/jconv.cのjconv()は、ext/charconv/charconv.cからSCM_INTERNAL_MUTEX_LOCK()された状態で呼ばれますが、SCM_UNWIND_PROTECTしてないので、中のScm_Error()はScm_Panic()にした方がいいかも(そもそもがASSERT的コードのようなので)

--- jconv.c.orig        2008-04-19 10:32:07.000000000 +0900
+++ jconv.c     2008-04-19 10:32:25.000000000 +0900
@@ -975,7 +975,7 @@
             *outchars = 1;
             return 1+inoffset;
         default:
-            Scm_Error("internal state of ISO2022-JP -> EUC_JP got messed up (%d).  Implementation error?", cinfo->istate);
+            Scm_Panic("internal state of ISO2022-JP -> EUC_JP got messed up (%d).  Implementation error?", cinfo->istate);
         }
     }
     return ILLEGAL_SEQUENCE;
@@ -1010,7 +1010,7 @@
     case JIS_0212:
         escseq = "\033$(D"; esclen = 4; break;
     default:
-        Scm_Error("something wrong in jis_ensure_state: implementation error?");
+        Scm_Panic("something wrong in jis_ensure_state: implementation error?");
         return 0;               /* dummy */
     }
     OUTCHK(esclen + outbytes);

typo in src/hash.c (0.8.13)

nekoie(2008/04/19 06:11:41 PDT): 全く実害無いです。

--- hash.c.orig 2008-04-19 10:30:22.000000000 +0900
+++ hash.c      2008-04-19 10:30:38.000000000 +0900
@@ -873,7 +873,7 @@
     ScmDictEntry *e = Scm_HashCoreSearch(SCM_HASH_TABLE_CORE(ht),
                                          (intptr_t)key, SCM_DICT_CREATE);
     if (sizeof(intptr_t) != sizeof(void*)) {
-        Scm_Error("[internal] Scm_HashTableGet is obsoleted on this platform.  You should use the new hashtable API.");
+        Scm_Error("[internal] Scm_HashTableAdd is obsoleted on this platform.  You should use the new hashtable API.");
     }
     if (!e->value) (void)SCM_DICT_SET_VALUE(e, value);
     return (ScmHashEntry*)e;
@@ -884,7 +884,7 @@
     ScmDictEntry *e = Scm_HashCoreSearch(SCM_HASH_TABLE_CORE(ht),
                                          (intptr_t)key, SCM_DICT_CREATE);
     if (sizeof(intptr_t) != sizeof(void*)) {
-        Scm_Error("[internal] Scm_HashTableGet is obsoleted on this platform.  You should use the new hashtable API.");
+        Scm_Error("[internal] Scm_HashTablePut is obsoleted on this platform.  You should use the new hashtable API.");
     }
     (void)SCM_DICT_SET_VALUE(e, value);
     return (ScmHashEntry*)e;

integer array too short in Scm__VMParameterTableInit()

enami(2008/03/31 02:50:44 PDT): base != NULL の場合、確保される配列の長さが不十分だと思います。

Index: src/parameter.c
===================================================================
RCS file: /cvsroot/gauche/Gauche/src/parameter.c,v
retrieving revision 1.9
diff -u -2 -r1.9 parameter.c
--- src/parameter.c     2 Mar 2007 07:39:14 -0000       1.9
+++ src/parameter.c     31 Mar 2008 03:52:43 -0000
@@ -79,5 +79,5 @@
     if (base) {
         table->vector = SCM_NEW_ARRAY(ScmObj, base->parameters.numAllocated);
-        table->ids = SCM_NEW_ATOMIC2(int*, PARAMETER_INIT_SIZE*sizeof(int));
+        table->ids = SCM_NEW_ATOMIC2(int*, base->parameters.numAllocated*sizeof(int));
         table->numAllocated = base->parameters.numAllocated;
         table->numParameters = base->parameters.numParameters;

typo in doc/corelib.texi

enami(2008/03/06 15:10:01 PST): lister->folderの置換忘れです。

Index: doc/corelib.texi
===================================================================
RCS file: /cvsroot/gauche/Gauche/doc/corelib.texi,v
retrieving revision 1.164
diff -u -0 -r1.164 corelib.texi
--- doc/corelib.texi    6 Feb 2008 07:55:37 -0000       1.164
+++ doc/corelib.texi    6 Mar 2008 22:56:24 -0000
@@ -12229 +12229 @@
-The meaning of @var{pattern}, @var{separator} and @var{lister}
+The meaning of @var{pattern}, @var{separator} and @var{folder}
@@ -12232 +12232 @@
-@var{pattern}、@var{separator}および@var{lister}の意味を前述のものと同
+@var{pattern}、@var{separator}および@var{folder}の意味を前述のものと同

使われない length の計算

enami(2008/03/06 15:10:01 PST): 動作には問題ないですが、目にとまったので。

Index: src/moplib.stub
===================================================================
RCS file: /cvsroot/gauche/Gauche/src/moplib.stub,v
retrieving revision 1.35
diff -u -0 -r1.35 moplib.stub
--- src/moplib.stub     29 Dec 2007 09:59:11 -0000      1.35
+++ src/moplib.stub     6 Mar 2008 22:56:27 -0000
@@ -80 +80 @@
-               (argc :: int (Scm_Length args)))
+               (argc :: int))

make installでwin-compat.hがインストールされない (0.8.13)

齊藤(2008/03/03 04:25:41 PST): mingw + msys環境でコンパイルした後にmake installしたらwin-compat.hがインストールされていませんでした。

リファレンスではdbm-db-moveとあるが、実装はdbm-db-renameになっている (0.8.13)

yuyam? (2008/03/03 01:34:39 PST): Gauche User's Referenceのdbmの項で、dbmの移動またはリネームはdbm-db-moveと記載されているが、実装はdbm-db-renameとなっている様です。どちらが(本来意図された)正しい名前なのかわかりませんが、既存のプログラム等の事を考慮するとリファレンスの修正が現実的なのでしょうか?

--- gauche-refe.texi.orig       2008-03-03 17:53:50.000000000 +0900
+++ gauche-refe.texi    2008-03-03 17:55:43.000000000 +0900
@@ -26373,7 +26373,7 @@
 @end example
 @end deffn
 
-@deffn {Generic Function} dbm-db-move class from to
+@deffn {Generic Function} dbm-db-rename class from to
 Moves or renames a database of class @var{class} specified by
 @var{from} to @var{to}.
 @end deffn
--- gauche-refj.texi.orig       2008-03-03 17:56:05.000000000 +0900
+++ gauche-refj.texi    2008-03-03 17:56:30.000000000 +0900
@@ -25616,7 +25616,7 @@
 @end example
 @end deffn
 
-@deffn {Generic Function} dbm-db-move class from to
+@deffn {Generic Function} dbm-db-rename class from to
 @var{from}で指定された@var{class}クラスのデータベースを
 @var{to}へ移動、あるいはリネームします。
 @end deffn

util.trieでget-keywordの引数の順序が逆になっている箇所がある (0.8.13)

koguro(2008/03/01 04:37:30 PST): util.trieのcall-with-builderメソッドの実装でget-keywordの引数の順序が逆になっている箇所がありました。

--- util/trie.scm.orig  2008-03-01 21:34:35.000000000 +0900
+++ util/trie.scm       2008-03-01 21:35:11.000000000 +0900
@@ -317,7 +317,7 @@
         (lambda () (next))))
 
 (define-method call-with-builder ((class <trie-meta>) proc . opts)
-  (let1 trie (apply make-trie (get-keyword opts :trie-options '()))
+  (let1 trie (apply make-trie (get-keyword :trie-options opts '()))
     (proc (lambda (val)
             (unless (pair? val)
               (error "pair required to build a trie, but got" val))

util.relationでのシンボルのtypo (0.8.13)

koguro(2008/03/01 04:37:30 PST): util.relationのrelation-column-gettersメソッドでシンボルのtypoがありました。

--- util/relation.scm.orig      2008-03-01 21:32:08.000000000 +0900
+++ util/relation.scm   2008-03-01 21:32:32.000000000 +0900
@@ -147,7 +147,7 @@
 ;; the list of getters, for example.
 (define-method relation-column-getters ((r <relation>))
   (let1 accessor (relation-accessor r)
-    (map (lambda (c) (lambda (row) (acessor row c)))
+    (map (lambda (c) (lambda (row) (accessor row c)))
          (relation-column-names r))))
 
 (define-method relation-column-setters ((r <relation>))

cgen-emit-xtrn (gauche.cgen.literal)の引数名の誤り (0.8.13)

koguro(2008/03/01 04:37:30 PST): まだgauche.cgenモジュールは公開されていないと思いますが、ちょっとソースコードを見たところ、引数とbodyとで引数名の対応がとれていないようです(selfとnode)。

--- gauche/cgen/literal.scm.orig        2008-03-01 21:23:10.000000000 +0900
+++ gauche/cgen/literal.scm     2008-03-01 21:23:55.000000000 +0900
@@ -280,8 +280,8 @@
 
 (define-method cgen-literal-static? (self) #t)
 
-(define-method cgen-emit-xtrn ((self <cgen-literal>))
-  (when (and [@ self'extern?] (cgen-c-name node))
+(define-method cgen-emit-xtrn ((node <cgen-literal>))
+  (when (and [@ node'extern?] (cgen-c-name node))
     (print "extern ScmObj " (cgen-c-name node) ";")))
 
 ;; define-cgen-literal macro

packのテンプレートで大括弧を使うとエラー (0.8.13)

koguro(2008/02/21 05:11:40 PST): packのテンプレートで大括弧を使うと以下のようなエラーが発生します。

gosh> (use binary.pack)
#<undef>
gosh> (pack "x[L]" '(1 2 3))
*** ERROR: wrong number of arguments for #<closure read-until-token> (required 4, got 5)
Stack Trace:
_______________________________________
  0  (read-until-token (make-pack-token (char-complement c)) '() 0 #f # ...
        At line 163 of "/usr/local/share/gauche/0.8.13/lib/binary/pack.scm"
  1  (read-count)
        At line 561 of "/usr/local/share/gauche/0.8.13/lib/binary/pack.scm"
  2  (read-one-packer fixed-len var-len? vlp #f)
        At line 936 of "/usr/local/share/gauche/0.8.13/lib/binary/pack.scm"
  3  (read-packer flen vlen? vlp)
        At line 955 of "/usr/local/share/gauche/0.8.13/lib/binary/pack.scm"
  4  (read-until-token (make-pack-token token) fixed-len var-len? vlp)
        At line 977 of "/usr/local/share/gauche/0.8.13/lib/binary/pack.scm"
  5  (read-all-packers template)
        At line 1024 of "/usr/local/share/gauche/0.8.13/lib/binary/pack.scm"
  6  (make-packer template cached?)
        At line 1033 of "/usr/local/share/gauche/0.8.13/lib/binary/pack.scm"
gosh> 

見たところread-until-tokenの引数が多いようなので、以下のような修正になるのでしょうか(ちょっと自信ない)

--- pack.scm.orig       2008-02-21 22:07:31.000000000 +0900
+++ pack.scm    2008-02-21 22:09:22.000000000 +0900
@@ -162,7 +162,7 @@
              (read-char)
              (let* ((packers (read-until-token (make-pack-token
                                                 (char-complement c))
-                                               '() 0 #f #f))
+                                                0 #f #f))
                     (p (fold pack-merge-folder #f packers)))
                (if (p 'variable-length?)
                  (error "can't use variable length pack format in []")

random-source-make-realsでunitを指定するとエラー (0.8.13)

koguro(2008/02/21 04:56:41 PST): srfi-27のrandom-source-make-realsでunitを指定すると以下のようなエラーが発生します。

gosh> (use srfi-27)
#<undef>
gosh> (define f (random-source-make-reals (make-random-source) 0.5))
f
gosh> (f)
*** ERROR: unbound variable: make-random-integer
Stack Trace:
_______________________________________
  0  (make-random-integer range)
        At line 118 of "/usr/local/share/gauche/0.8.13/lib/srfi-27.scm"
gosh> 

多分make-random-integerはrandom-integerのtypoだと思うので、以下のような修正になるかと思います。

--- srfi-27.scm.orig    2008-02-21 21:51:32.000000000 +0900
+++ srfi-27.scm 2008-02-21 21:51:43.000000000 +0900
@@ -115,7 +115,7 @@
         (let* ((1/unit (/ unit))
                (range (inexact->exact (ceiling 1/unit))))
           (lambda ()
-            (/ (make-random-integer range) 1/unit))))))
+            (/ (random-integer range) 1/unit))))))
 
 ;; Default random generators.
 (define-values (random-integer random-real)

weak.c の typo (0.8.13)

tabe(2008/02/21 03:02:25 PST): typo 2箇所です。ただ2つ目はよく分かりません。

Index: src/weak.c
===================================================================
RCS file: /cvsroot/gauche/Gauche/src/weak.c,v
retrieving revision 1.16
diff -u -r1.16 weak.c
--- src/weak.c  10 Aug 2007 01:19:36 -0000      1.16
+++ src/weak.c  21 Feb 2008 10:54:29 -0000
@@ -147,7 +147,7 @@
 /* ptr points to the target object weakly.
    Registered flag becomes TRUE whenever ptr points to a GC_malloced object,
    thus &wbox->ptr is registered as a disappearing link.
-   Note that we can distinguish a box that contaning NULL pointer, and
+   Note that we can distinguish a box that containing NULL pointer, and
    a box whose target has been GCed and hence ptr is cleared---in the
    former case registered is FALSE, while in the latter case it is TRUE. */
 struct ScmWeakBoxRec {
@@ -260,7 +260,7 @@
         return 0;
     } else {
         u_long k= wh->hashfn(hc, realkey);
-        Scm_Printf(SCM_CURERR, "%Hciuang %ul %S\n", k, realkey);
+        Scm_Printf(SCM_CURERR, "%%Hciuang %ul %S\n", k, realkey);
         return k;
     }
 }

format が文字列終端を出力する (0.8.13)

tabe(2008/02/20 08:01:24 PST): format に不完全な '~' を与えると EOF を出力します。

gosh> (format "~")
"\xff"
gosh> 

以下のパッチは SRFI-28 に準じてエラーを上げます。

Index: src/write.c
===================================================================
RCS file: /cvsroot/gauche/Gauche/src/write.c,v
retrieving revision 1.69
diff -u -r1.69 write.c
--- src/write.c24 Aug 2007 23:55:44 -00001.69
+++ src/write.c20 Feb 2008 15:54:08 -0000
@@ -771,6 +771,9 @@

         for (;;) {                                                                                                                                                                                      
             ch = Scm_GetcUnsafe(fmtstr);                                                                                                                                                                
+            if (ch == EOF) {
+                Scm_Error("incomplete format string: %S", fmt);                                                                                                                                         
+            }
             switch (ch) {
             case '%':
                 Scm_PutcUnsafe('\n', out);                                                                                                                                                             

applyの引数リストがコピーされない場合がある (0.8.13)

Shiro(2008/02/14 04:16:52 PST): 早速ですがバグ発覚。

--- src/vmcall.c        5 Feb 2008 03:00:16 -0000       1.2
+++ src/vmcall.c        14 Feb 2008 12:14:07 -0000
@@ -65,7 +65,10 @@
                 PUSH_ARG(SCM_CAR(p));                                   \
                 p = SCM_CDR(p);                                         \
             }                                                           \
-            if (restarg) PUSH_ARG(p);                                   \
+            if (restarg) {                                              \
+                p = Scm_CopyList(p);                                    \
+                PUSH_ARG(p);                                            \
+            }                                                           \
         }                                                               \
         argc = SP-ARGP;                                                 \
     } while (0)
More ...