直した。

(use eval-sv)
(use gauche.parameter)
(use util.list)
(define-values (eval/sv env) (make-eval/sv :isolate-port? #f))
(define start-size (make-parameter #f))
(define runup-size (make-parameter 0))
(define limit-size (make-parameter #f))

(define (get-used-memory)
  (let1 stat (gc-stat)
    (- (car (assoc-ref stat :total-heap-size))
       (car (assoc-ref stat :free-bytes)))))

(define (sv type symbol expr args return except)
  (define (over?)
    (let ((now-used (- (get-used-memory) (start-size)))
          (old-used (runup-size))
          )
      (< (limit-size) (+ now-used old-used))))

  (unless (start-size)
    (gc)
    (start-size (get-used-memory)))
  (when (over?)
    (gc)
    (when (over?)
      (except "out of memory" (get-used-memory))))
  (apply expr args))

(define (eval/memlimit expr limit)
  ;; 諸事情により、parameterizeは使わずに、自前でparameterを管理する
  ;; (parameterizeだけでは、dynamic-windを抜ける時の処理が出来ないので)
  (let ((current-runup-size 0)
        (original-start-size #f)
        (original-runup-size #f)
        (original-limit-size #f))
    (dynamic-wind
      (lambda ()
        ;; parameterizeする
        (set! original-start-size (start-size))
        (set! original-runup-size (runup-size))
        (set! original-limit-size (limit-size))
        (start-size #f)
        (runup-size current-runup-size)
        (limit-size limit)
        )
      (lambda ()
        (eval/sv expr sv))
      (lambda ()
        (gc)
        ;; current-runup-sizeに、今回の処理で増えたメモリ増分値を足しておく
        ;; (継続再起動時の為に)
        (when (start-size)
          (set! current-runup-size (+ current-runup-size
                                      (- (get-used-memory) (start-size)))))
        ;; unparameterizeする
        (start-size original-start-size)
        (runup-size original-runup-size)
        (limit-size original-limit-size)
        ;; 無駄に参照を握らないように、明示的に解放しておく
        (set! original-start-size #f)
        (set! original-runup-size #f)
        (set! original-limit-size #f)
        ))))

試す。

(eval/memlimit
  `(let baibain ((kuri-manjuh '(1)))
     (display (,start-size))
     (display " ")
     (display (,runup-size))
     (display " ")
     (display (,limit-size))
     (display " ")
     (display (,get-used-memory))
     (display " ")
     (display (length kuri-manjuh))
     (newline)
     (baibain (append kuri-manjuh kuri-manjuh)))
  10)
3670016 0 10 3670016 1
3670016 0 10 3670016 2
3670016 0 10 3670016 4
3670016 0 10 3670016 8
3670016 0 10 3670016 16
3670016 0 10 3670016 32
3670016 0 10 3670016 64
3670016 0 10 3670016 128
3670016 0 10 3670016 256
3670016 0 10 3670016 512
3670016 0 10 3670016 1024
3670016 0 10 3670016 2048
3670016 0 10 3670016 4096
3670016 0 10 3670016 8192
*** ERROR: out of memory 3674112
Stack Trace:
_______________________________________

何回か実行すると、それ以降は何回実行しても、メモリ使用量が変化しなくなった。
大成功。


問題は、かなり大雑把な部分がある事。

  • 複数のevalをコルーチン的に動き回る場合にメモリ使用量が片方にばっかり偏る可能性がある。
  • どうも、4k〜100k単位ずつぐらいでしか判定できないっぽいようだ(不正確)。


また、「○○の用途でevalしたいんだけど、これに対するeval/memlimitの最適値っていくらぐらい?」というのを適切に判断する手段も無い。
(ただ、こっちは適当な値を設定しても、そんなに問題は出ない気もする。)


なんにせよ、これで「安全なeval」に必要な二要素が揃った。
これがあれば、「安全なメタ循環インタープリタ」を作る事が出来る。
実際に作成して、役に立つ事を示したい。
そのうち。