河豚板の作り方

Q: schemeのmapですよね。

(define map-bp
  (map (lambda (h l)
         (let ((diff (- h l)))
           (+ (/ diff 3) l)))
       sbp dbp))

A: 最速のchez schemeで実験しようと思ったら、 Ubuntu版は古く、ベクターの扱いが不透明(楽しようとすると、躓く典型例)だった。 雁首そろえてチャッピー君と、アーでもない、コーでもないと袋小路にはいって しまった。自前でコンパイルした方が確実だよねって結論になったよ。

(https://github.com/cisco/ChezScheme)にソースが有るぞ。

;; --- utilities: list <-> flvector --------------------------------
(optimize-level 3) ;; for speed up
;; list の数値要素を inexact (flonum) にして flvector に詰める
(define (list->flvector lst)
  (let* ((n (length lst))
         (fv (make-flvector n 0.0)))
    (let loop ((i 0) (xs lst))
      (if (null? xs)
          fv
          (begin
            (flvector-set! fv i (exact->inexact (car xs)))
            (loop (+ i 1) (cdr xs)))))))

;; flvector を普通の list に戻す（デバッグ用）
(define (flvector->list fv)
  (let loop ((i 0) (n (flvector-length fv)) (acc '()))
    (if (= i n)
        (reverse acc)
        (loop (+ i 1) n (cons (flvector-ref fv i) acc)))))

;; --- MAP 計算（in-place スタイル。結果は新しい flvector を返す） ---
;; MAP = (SBP - DBP) / 3 + DBP
(define (compute-map-flvector sbp-fl dbp-fl)
  (let ((n (flvector-length sbp-fl)))
    (when (not (= n (flvector-length dbp-fl)))
      (error 'compute-map-flvector "length mismatch"))
    (let ((map-fl (make-flvector n 0.0)))
      (let loop ((i 0))
        (if (= i n)
            map-fl
            (begin
              (let ((h (flvector-ref sbp-fl i))
                    (l (flvector-ref dbp-fl i)))
                ;; 計算はすべて flonum（inexact）で行う（3.0 を使う）
                (flvector-set! map-fl i (+ l (/ (- h l) 3.0))))
              (loop (+ i 1))))))))

;; --- 簡易ベンチマーク用関数 -----------------------------------------
(define (time-thunk thunk)
  (let ((t0 (current-time)))
    (let ((res (thunk)))
      (let ((dt (time-difference (current-time) t0)))
        (values dt res)))))

;; 乱数 flvector を作るヘルパー（0 <= val < upper）
(define (rand-flvector n upper)
  (let ((fv (make-flvector n 0.0)))
    (let loop ((i 0))
      (if (= i n)
          fv
          (begin
            ;; random returns in [0,1). floor を用いて整数化
            (flvector-set! fv i (exact->inexact (floor (* (random 1.0) upper))))
            (loop (+ i 1)))))))

;; --- 実行例（ベンチマーク） ---------------------------------------
;; 注意: 実行環境やコンパイラの最適化フラグで結果は変わります。
(let* ((N 1000000)                    ; 要素数
       (sbp (rand-flvector N 60))      ; 例: 0..59 を乱数とする（調整可）
       (dbp (rand-flvector N 40)))     ; 例: 0..39
  (display "warming up ...") (newline)
  ;; JIT/コンパイラ最適化を期待して一回実行（ウォームアップ）
  (compute-map-flvector sbp dbp)

  (newline)
  (let-values (((dt1 res1) (time-thunk (lambda () (compute-map-flvector sbp dbp)))))
    (display "compute-map-flvector elapsed: ") (display dt1) (newline)
    ;; 結果の最初の要素だけ表示
    (display "first results: ") (display (car (flvector->list res1))) (newline)))

sakae@lu:tmp$ scheme flvec.ss
Chez Scheme Version 10.4.0-pre-release.1
Copyright 1984-2025 Cisco Systems, Inc.

warming up ...

compute-map-flvector elapsed: #<time-duration 0.025397236>
first results: 21.666666666666668

Chez Schemeは、scheme界隈では爆速なんだけど、numpyには勝てないな。

guile-3.0も入っていたので、コンペに参加。ベクターを使うには、

(use-modules (srfi srfi-4))
(make-f64vector n 0.0)

の様にモジュールをロードしてから、ベクターの型を明示する。

sakae@lu:tmp$ guile-3.0 -l flvec.ss
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling /tmp/flvec.ss
;;; /tmp/flvec.ss:44:17: warning: possibly unbound variable `time-difference'
;;; compiled /home/sakae/.cache/guile/ccache/3.0-LE-8-4.6/tmp/flvec.ss.go
warming up ...
GNU Guile 3.0.9
Copyright (C) 1995-2023 Free Software Foundation, Inc.

scheme@(guile-user)> ,time (compute-map-flvector sbp dbp)
$1 = #t
;; 0.020962s real time, 0.020939s run time.  0.000000s spent in GC.

replに時間計測用のコマンドが有ったので、それを有効利用。計算が主体の 関数だと、chezと甲乙つけがたいな。

;; 0.157273s real time, 0.157037s run time.  0.000000s spent in GC.

同じ事を河豚板でやったら、こうなった。何故こんな違いが出るの？

河豚板の起動スクリプトrcの最初と最後が、こうなっている。

mount -w /dev/rd0a /
: > /boottmp/boot_starts

# 色々な仕事を実行

date > /boottmp/boot_livecd_rc_ends

#========================================
# chain original /etc/rc
#

exec /bin/ksh /etc/rc "$init_args"

boot_starts と boot_libcd_rc_end の時間情報から、スクリプトの実行時間が 分るんだな。

fu$ cd /boottmp/
fu$ cat boot_livecd_rc_ends
Sun Nov 23 05:23:33 JST 2025
fu$ stat boot_starts
4352 112 -rw-r--r-- 1 root wheel 0 0 "Nov 23 05:22:23 2025" "Nov 23 05:22:23 2025" "Nov 23 05:22:23 2025" 4096 0 0 boot_starts

boot_starts の時は、まだdateが使えないんで、ファイルのコンテンツとしては 何も無い。しょうがないのでstatでファイルのタイムスタンプを取り出す。この時間差の主要成分は、 過去の情報をRAMに転送してる時間だ。時間差の計算ってめんどいな。何処でもpythonか。 grok.comとChatGPT.comで競演させてみた。前者は汎用的な長いコードを提示。 後者は改造に便利な短いコードを提示してきた。オイラーの昔からの習慣でスッキリな 方を採用する。

from datetime import datetime

date_str1 = "Sat Nov 22 22:28:33 JST 2025"
date_str2 = "Sun Nov 23 06:10:41 JST 2025"

date_format = "%a %b %d %H:%M:%S JST %Y"
dt1 = datetime.strptime(date_str1, date_format)
dt2 = datetime.strptime(date_str2, date_format)

time_difference = dt2 - dt1
print(f"時間差: {time_difference}")
print(f"時間差（秒単位）: {time_difference.total_seconds()}秒")

statとdateの時間フォーマットが、微妙に違うじゃん。主に人様向けのdateは、冗長に なってるな。stat -x すれば、人間用に態度を改めてくれた。不便な事が有ったらman してみろってのは、生活の知恵だな。

このカーネルがファイルシステムを内蔵してる事を確認してみる。 sysmedia(sd1a)が見えないので、強制マウントして、それを取り出す。

fu$ cp /mnt/bsd-fi.mp bsd-fi.gz
fu$ gzip -d bsd-fi.gz
fu$ doas rdsetroot -dx bsd-fi > mini.img
rd_root_size_off: 0x9f0
rd_root_image_off: 0xa00
rd_root_size  val: 0x400000 (8192 blocks)
copying root image...
...copied 4194304 bytes

gzip -d する時サフィックスが付いていないと文句を言われるので、付ている。

fu$ doas vnconfig vnd0 /home/sakae/mini.img
fu$ doas mount /dev/vnd0a /mnt
fu$ ls -l /mnt
total 49
drwxr-xr-x  2 root  wheel    512 Jun 15 09:52 CVS/
lrwxr-xr-x  1 root  wheel      7 Jun 15 09:52 bin@ -> boottmp
drwxr-xr-x  3 root  wheel   1024 Jun 15 09:53 boottmp/
drwxr-xr-x  6 root  wheel  20480 Jun 15 09:53 dev/
lrwxr-xr-x  1 root  wheel      7 Jun 15 09:52 etc@ -> boottmp
drwxr-xr-x  2 root  wheel    512 Jun 15 09:52 fuguita/
drwxr-xr-x  2 root  wheel    512 Jun 15 09:52 mnt/
drwxr-xr-x  2 root  wheel    512 Jun 15 09:52 ram/
lrwxr-xr-x  1 root  wheel      7 Jun 15 09:52 sbin@ -> boottmp
drwxr-xr-x  2 root  wheel    512 Jun 15 09:52 sysmedia/
drwx------  2 root  wheel    512 Jun 15 09:52 sysmedia-iso/
drwxrwxrwt  2 root  wheel    512 Jun 15 09:52 tmp/
fu$ ls -l /mnt/boottmp/rc
-rw-r--r--  1 root  wheel  42257 Mar 25  2025 /mnt/boottmp/rc

USB memoryに入れた7.7ではrcの実行時間が、1:10 だったのに対し、USB HDDの方は、 5:12 だった。HDDの方は、これでもかと言うぐらいpkgを入れたからなあ。 USB memoryの方は、emacs-noX,firefox,gdbぐらいの輕い構成。これでも、普通に 生活するなら、取り敢えず十分だ。

fu$ cp /sysmedia/bsd-fi.mp bsd.fi.gz
fu$ gzip -d bsd.fi.gz
fu$ doas rdsetroot -dx bsd.fi >mini.img
rd_root_size_off: 0x394d0
rd_root_image_off: 0x394e0
rd_root_size  val: 0x400000 (8192 blocks)
copying root image...
...copied 4194304 bytes

fu$ doas vnconfig vnd0 /home/sakae/mini.img                                         <
fu$ doas mount /dev/vnd0a /mnt
fu$ ls -l /mnt
total 49
drwxr-xr-x  2 root  wheel    512 Oct 29 02:07 CVS/
lrwxr-xr-x  1 root  wheel      7 Oct 29 02:36 bin@ -> boottmp
drwxr-xr-x  3 root  wheel   1024 Oct 29 02:36 boottmp/
drwxr-xr-x  6 root  wheel  20480 Oct 29 02:36 dev/
lrwxr-xr-x  1 root  wheel      7 Oct 29 02:36 etc@ -> boottmp
drwxr-xr-x  2 root  wheel    512 Oct 29 02:36 fuguita/
drwxr-xr-x  2 root  wheel    512 Oct 29 02:36 mnt/
drwxr-xr-x  2 root  wheel    512 Oct 29 02:36 ram/
lrwxr-xr-x  1 root  wheel      7 Oct 29 02:36 sbin@ -> boottmp
drwxr-xr-x  2 root  wheel    512 Oct 29 02:36 sysmedia/
drwx------  2 root  wheel    512 Oct 29 02:36 sysmedia-iso/
drwxrwxrwt  2 root  wheel    512 Oct 29 02:36 tmp/
fu$ ls -l /mnt/boottmp/rc
-rw-r--r--  1 root  wheel  43892 Aug 19 16:12 /mnt/boottmp/rc