なんだこれは

はてなダイアリーから移転しました。

gcl latest が intel macでビルドエラーになる件

list,intelMac

gcl

gcl latest が intel macでビルドエラーになる件

gclの最新がリリースされたらしいのでビルドしようとしてみた。

git clone https://git.savannah.gnu.org/git/gcl.git
cd gcl/gcl
./configure --prefix=$HOME/gcl
make

Too many errors

エラーが多い。

o/format.c:1956:3: error: incompatible function pointer types assigning to 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') from 'object (*)(void)' (aka 'union lispunion *(*)(void)') [-Wincompatible-function-pointer-types]
 1956 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:180:19: note: expanded from macro 'fmt_save'
  180 |                         old_fmt_advance=fmt_advance ;   \
      |                                        ^~~~~~~~~~~~
o/format.c:1956:3: error: incompatible function pointer types assigning to 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') from 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 1956 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:181:14: note: expanded from macro 'fmt_save'
  181 |                         old_fmt_lt=fmt_lt ;     \
      |                                   ^~~~~~~
o/format.c:1967:3: error: incompatible function pointer types assigning to 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') from 'object (*)(void)' (aka 'union lispunion *(*)(void)') [-Wincompatible-function-pointer-types]
 1967 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:180:19: note: expanded from macro 'fmt_save'
  180 |                         old_fmt_advance=fmt_advance ;   \
      |                                        ^~~~~~~~~~~~
o/format.c:1967:3: error: incompatible function pointer types assigning to 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') from 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 1967 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:181:14: note: expanded from macro 'fmt_save'
  181 |                         old_fmt_lt=fmt_lt ;     \
      |                                   ^~~~~~~
o/format.c:1980:3: error: incompatible function pointer types assigning to 'object (*)(void)' (aka 'union lispunion *(*)(void)') from 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') [-Wincompatible-function-pointer-types]
 1980 |                 fmt_restore;
      |                 ^~~~~~~~~~~
o/format.c:194:15: note: expanded from macro 'fmt_restore'
  194 |                         fmt_advance=old_fmt_advance ;   \
      |                                    ^~~~~~~~~~~~~~~~
o/format.c:1980:3: error: incompatible function pointer types assigning to 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') from 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 1980 |                 fmt_restore;
      |                 ^~~~~~~~~~~
o/format.c:195:10: note: expanded from macro 'fmt_restore'
  195 |                         fmt_lt=old_fmt_lt ;     \
      |                               ^~~~~~~~~~~
o/format.c:2262:3: error: incompatible function pointer types assigning to 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') from 'object (*)(void)' (aka 'union lispunion *(*)(void)') [-Wincompatible-function-pointer-types]
 2262 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:180:19: note: expanded from macro 'fmt_save'
  180 |                         old_fmt_advance=fmt_advance ;   \
      |                                        ^~~~~~~~~~~~
o/format.c:2262:3: error: incompatible function pointer types assigning to 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') from 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 2262 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:181:14: note: expanded from macro 'fmt_save'
  181 |                         old_fmt_lt=fmt_lt ;     \
      |                                   ^~~~~~~
o/format.c:2282:3: error: incompatible function pointer types assigning to 'object (*)(void)' (aka 'union lispunion *(*)(void)') from 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') [-Wincompatible-function-pointer-types]
 2282 |                 fmt_restore;
      |                 ^~~~~~~~~~~
o/format.c:194:15: note: expanded from macro 'fmt_restore'
  194 |                         fmt_advance=old_fmt_advance ;   \
      |                                    ^~~~~~~~~~~~~~~~
o/format.c:2282:3: error: incompatible function pointer types assigning to 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') from 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 2282 |                 fmt_restore;
      |                 ^~~~~~~~~~~
o/format.c:195:10: note: expanded from macro 'fmt_restore'
  195 |                         fmt_lt=old_fmt_lt ;     \
      |                               ^~~~~~~~~~~
o/format.c:2285:3: error: incompatible function pointer types assigning to 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') from 'object (*)(void)' (aka 'union lispunion *(*)(void)') [-Wincompatible-function-pointer-types]
 2285 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:180:19: note: expanded from macro 'fmt_save'
  180 |                         old_fmt_advance=fmt_advance ;   \
      |                                        ^~~~~~~~~~~~
o/format.c:2285:3: error: incompatible function pointer types assigning to 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') from 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 2285 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:181:14: note: expanded from macro 'fmt_save'
  181 |                         old_fmt_lt=fmt_lt ;     \
      |                                   ^~~~~~~
o/format.c:2310:3: error: incompatible function pointer types assigning to 'object (*)(void)' (aka 'union lispunion *(*)(void)') from 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') [-Wincompatible-function-pointer-types]
 2310 |                 fmt_restore;
      |                 ^~~~~~~~~~~
o/format.c:194:15: note: expanded from macro 'fmt_restore'
  194 |                         fmt_advance=old_fmt_advance ;   \
      |                                    ^~~~~~~~~~~~~~~~
o/format.c:2310:3: error: incompatible function pointer types assigning to 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') from 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 2310 |                 fmt_restore;
      |                 ^~~~~~~~~~~
o/format.c:195:10: note: expanded from macro 'fmt_restore'
  195 |                         fmt_lt=old_fmt_lt ;     \
      |                               ^~~~~~~~~~~
o/format.c:2312:3: error: incompatible function pointer types assigning to 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') from 'object (*)(void)' (aka 'union lispunion *(*)(void)') [-Wincompatible-function-pointer-types]
 2312 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:180:19: note: expanded from macro 'fmt_save'
  180 |                         old_fmt_advance=fmt_advance ;   \
      |                                        ^~~~~~~~~~~~
o/format.c:2312:3: error: incompatible function pointer types assigning to 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') from 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 2312 |                 fmt_save;
      |                 ^~~~~~~~
o/format.c:181:14: note: expanded from macro 'fmt_save'
  181 |                         old_fmt_lt=fmt_lt ;     \
      |                                   ^~~~~~~
o/format.c:2337:4: error: incompatible function pointer types assigning to 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') from 'object (*)(void)' (aka 'union lispunion *(*)(void)') [-Wincompatible-function-pointer-types]
 2337 |                         fmt_save;
      |                         ^~~~~~~~
o/format.c:180:19: note: expanded from macro 'fmt_save'
  180 |                         old_fmt_advance=fmt_advance ;   \
      |                                        ^~~~~~~~~~~~
o/format.c:2337:4: error: incompatible function pointer types assigning to 'volatile void (*)(volatile bool, bool)' (aka 'volatile void (*)(volatile int, int)') from 'void (*)(volatile bool, bool)' (aka 'void (*)(volatile int, int)') [-Wincompatible-function-pointer-types]
 2337 |                         fmt_save;
      |                         ^~~~~~~~
o/format.c:181:14: note: expanded from macro 'fmt_save'
  181 |                         old_fmt_lt=fmt_lt ;     \
      |                                   ^~~~~~~
o/format.c:2345:5: error: incompatible function pointer types assigning to 'object (*)(void)' (aka 'union lispunion *(*)(void)') from 'volatile object (*)(void)' (aka 'union lispunion *volatile (*)(void)') [-Wincompatible-function-pointer-types]
 2345 |                                 fmt_restore;
      |                                 ^~~~~~~~~~~
o/format.c:194:15: note: expanded from macro 'fmt_restore'
  194 |                         fmt_advance=old_fmt_advance ;   \
      |                                    ^~~~~~~~~~~~~~~~
fatal error: too many errors emitted, stopping now [-ferror-limit=]
20 errors generated.

この種類のエラーは単純に明示的にキャストしてOKだろう。

まじめに直す

git branch -C  my-fix
git checkout my-fix
diff --git a/gcl/o/format.c b/gcl/o/format.c
index ceb218c9d..58b805f22 100644
--- a/gcl/o/format.c
+++ b/gcl/o/format.c
@@ -166,7 +166,7 @@ object sSAindent_formatted_outputA;
                        VOL object(*old_fmt_advance)(void) ;    \
                        VOL void (*old_fmt_lt)(volatile bool,bool) ;    \
                         VOL format_parameter *old_fmt_paramp
-#define        fmt_save        old_fmt_stream = fmt_stream; \
+#define        fmt_save        old_fmt_stream = (typeof(old_fmt_stream))fmt_stream; \
                        old_ctl_origin = ctl_origin; \
                        old_ctl_index = ctl_index; \
                        old_ctl_end = ctl_end; \
@@ -177,10 +177,10 @@ object sSAindent_formatted_outputA;
                        old_fmt_jmp_bufp = fmt_jmp_bufp; \
                        old_fmt_indents = fmt_indents; \
                        old_fmt_string = fmt_string ; \
-                       old_fmt_advance=fmt_advance ;   \
-                       old_fmt_lt=fmt_lt ;     \
+                       old_fmt_advance=(typeof(old_fmt_advance))fmt_advance ;  \
+                       old_fmt_lt=(typeof(old_fmt_lt))fmt_lt ; \
                         old_fmt_paramp = fmt_paramp
-#define        fmt_restore     fmt_stream = old_fmt_stream; \
+#define        fmt_restore     fmt_stream =(typeof(fmt_stream)) old_fmt_stream; \
                        ctl_origin = old_ctl_origin; \
                        ctl_index = old_ctl_index; \
                        ctl_end = old_ctl_end; \
@@ -191,8 +191,8 @@ object sSAindent_formatted_outputA;
                        fmt_jmp_bufp = old_fmt_jmp_bufp; \
                        fmt_indents = old_fmt_indents; \
                        fmt_string = old_fmt_string ; \
-                       fmt_advance=old_fmt_advance ;   \
-                       fmt_lt=old_fmt_lt ;     \
+                       fmt_advance=(typeof(fmt_advance))old_fmt_advance ;      \
+                       fmt_lt=(typeof(fmt_lt))old_fmt_lt ;     \
                         fmt_paramp = old_fmt_paramp

 #define        fmt_old1        VOL object old_fmt_stream; \

確認

make

上のエラーが解決した。 一回コミットする。

次のエラー

depbase=`echo o/nfunlink.o | sed 's|[^/]*$|.deps/&|;s|\.o$||'`;\
    gcc -DHAVE_CONFIG_H -I. -I./h  -I h -I /usr/include/tirpc   -fsigned-char -pipe -fcommon -fno-builtin-malloc -fno-builtin-free -fno-PIE -fno-pie -fno-PIC -fno-pic -std=gnu17 -Wall -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign -Wno-unused-but-set-variable -D_FILE_OFFSET_BITS=64 -D_TIME_BITS=64 -Wno-incomplete-setjmp-declaration -m64    -O3 -fomit-frame-pointer -I o  -MT o/nfunlink.o -MD -MP -MF $depbase.Tpo -c -o o/nfunlink.o o/nfunlink.c &&\
    mv -f $depbase.Tpo $depbase.Po
depbase=`echo o/usig.o | sed 's|[^/]*$|.deps/&|;s|\.o$||'`;\
    gcc -DHAVE_CONFIG_H -I. -I./h  -I h -I /usr/include/tirpc   -fsigned-char -pipe -fcommon -fno-builtin-malloc -fno-builtin-free -fno-PIE -fno-pie -fno-PIC -fno-pic -std=gnu17 -Wall -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign -Wno-unused-but-set-variable -D_FILE_OFFSET_BITS=64 -D_TIME_BITS=64 -Wno-incomplete-setjmp-declaration -m64    -O3 -fomit-frame-pointer -I o  -MT o/usig.o -MD -MP -MF $depbase.Tpo -c -o o/usig.o o/usig.c &&\
    mv -f $depbase.Tpo $depbase.Po
o/usig.c:237:36: error: incompatible pointer to integer conversion initializing 'fixnum' (aka 'long') with an expression of type 'object' (aka 'union lispunion *') [-Wint-conversion]
  237 |   ifuncall3(sSfloating_point_error,FPE_CODE(i,v),FPE_ADDR(i,v),FPE_CTXT(v));
      |                                    ^~~~~~~~~~~~~
./h/config.h:176:25: note: expanded from macro 'FPE_CODE'
  176 | #define FPE_CODE(i_,v_) make_fixnum(FFN(fSfpe_code)(*(fixnum *)&UC(v_)->uc_mcontext->__fs.__fpu_fsw,UC(v_)->uc_mcontext->__fs.__fpu_mxcsr))
      |                         ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
./h/../h/fixnum.h:36:44: note: expanded from macro 'make_fixnum'
   36 | #define make_fixnum(a_)  ({register fixnum _q1=(a_);register object _q3;\
      |                                            ^   ~~~~
1 error generated.
make[1]: *** [o/usig.o] Error 1
make: *** [all] Error 2

このエラーは関数の引数の型が宣言と呼出しで合っていないというエラー。ただこのコードを読むと最後がマクロになっている。マクロを読むと最後の値が object型のようになってはいるんだが、うーん。

#define make_fixnum(a_)  ({register fixnum _q1=(a_);register object _q3;\
                          _q3=is_imm_fix(_q1) ? make_imm_fixnum(_q1) : make_fixnum1(_q1);_q3;})
#define CMPmake_fixnum(a_) make_fixnum(a_)/*FIXME*/

Qt5 と Qt6 がはいっていた

macOS,QT

SELECT

Qt5 と Qt6 がはいっていた

きがつくと homebrew で qt5 と qt6 がはいっていた。qt6 だけでいいと思うんだけど、 ビルドするときなどでなぜか qt5 の方を見つけて qt5 は古いからダメとエラーがでる。

TL; DR

export QT_SELECT=qt6 # or QT_SELECT=qt6 <コマンド>

エラー例

CMake Warning at cmake/findDependencies.cmake:27 (message):
  Building with Qt5 is deprecated (it went EOL in May 2023) and will be
  removed in a future release - please use Qt6 instead
Call Stack (most recent call first):
  CMakeLists.txt:18 (include)

qt のバージョン

homebrew だと qt 6.7.2 でいうのになんで？

brew list --versions qt #-> qt 6.7.2

qt はどこ？

ls -d /usr/local/opt/qt*
/usr/local/opt/qt   /usr/local/opt/qt5  /usr/local/opt/qt6  /usr/local/opt/qt@5 /usr/local/opt/qt@6

個人的なはまりポイント

いろいろ調べると、3 つくらいみつかった。

qtchooser は macOS では動かない？みたいな話があったのと、PATH 環境変数はもうややこしくなっていることから、QT_SELECT の方法を選んだ。

gauche で gzip archive

lisp,scheme,c

Gauche で gzip archive

Intel Mac の gauche で gzip 圧縮されたファイルを解凍

TL; DR

こう書いて

(use rfc.zlib)

(define (gz->raw gz-file raw-file)
  (call-with-input-file gz-file
    (lambda (in-port)
      (call-with-output-file raw-file
      (lambda (out-port)
          (copy-port 
              (open-inflating-port in-port :window-bits 47)
              out-port))))))

こう

(gz->raw "NOTICE.xml.gz" "NOTICE.xml")

個人的なはまりポイント

gauche の zlib って gzip アーカイブもいけるんだすごいって始めたんだけど、なんだかできないなぁって、なせかエラーでるしどうしたんだろう。そうだ AI に聞いてみようとかいろいろしていた。

zipinfo NOTICE.xml.gz したらフォーマットがおかしい。zip じゃなくないみたいにいわれた。そらそうだ。

それで、一回放置して、しばらくしてから、もう一回見なおしたら、単純に (open-inflating-port in-port :window-bits 47) の :window-bits をタイプミスしていたっぽい。するっとうまくいってしまった。

どこではまったんだろう。クリアするともうわからない。

古の do..while(0)

C 言語のマクロで複数行にまたがるものは do と while(0) で囲む。これは例えば、#define swap(type,a,b) type _c;_c=a;a=b;b=_c;みたいな、場合を考える。

そうなると swap(int,x,y) でint型の変数のx,yを交換できそうに見えるかもしれない。しかし、cの if 文の then else 節を中括弧で囲まなかった場合に一部だけが分離して考えられるからである。

しかし、現代ではもう inline 関数があるのでこのような場合はマクロではなく、 inline 関数でいいのだった。

gauche で gzip archive

lisp, scheme

Gauche で gzip archive

Intel Mac の gauche で gzip 圧縮されたファイルを解凍

TL; DR

こう書いて

(use rfc.zlib)

(define (gz->raw gz-file raw-file)
  (call-with-input-file gz-file
    (lambda (in-port)
      (call-with-output-file raw-file
      (lambda (out-port)
          (copy-port 
              (open-inflating-port in-port :window-bits 47)
              out-port))))))

こう

(gz->raw "NOTICE.xml.gz" "NOTICE.xml")

個人的なはまりポイント

gauche の zlib って gzip アーカイブもいけるんだすごいって始めたんだけど、なんだかできないなぁって、なせかエラーでるしどうしたんだろう。そうだ AI に聞いてみようとかいろいろしていた。

zipinfo NOTICE.xml.gz したらフォーマットがおかしい。zip じゃなくないみたいにいわれた。そらそうだ。

それで、一回放置して、しばらくしてから、もう一回見なおしたら、単純に (open-inflating-port in-port :window-bits 47) の :window-bits をタイプミスしていたっぽい。するっとうまくいってしまった。

どこではまったんだろう。クリアするともうわからない。

Emacs 31

Emacs,macOS

Emacs 31

mac port を更新したら emacs-app-devel が Emacs-31 になった

sudo port sync 、 sudo port upgrade outdated を実行して更新したら emacs-app-devel が emacs-app-devel @20240623_0+nativecomp+rsvg+treesitter になった。これは Emacs-31 のようだ。

(emacs-version) で設定ファイルを分岐している人は注意しましょう。

hatena blog を再開します

Book

Blog再開

hatena blog を再開します

思うところがあって fu7mu4 は hatena blog を再開します。

南海ちゃんの新しいお仕事 階段落ち人生 を読んだ

新井素子の南海ちゃんの新しいお仕事 階段落ち人生 を読みました。

ISBN:9784758446105

久し振りの新井素子でした。 「南海ちゃんの新しいお仕事 階段落ち人生」なんですが、通勤帰宅向けの電車で読みふけってしまい自宅最寄り駅をとおりすぎて次の駅についてしまった。あ、ああやってしまった。作者は喜ぶかもしれないが、単純に凹んだ。そう、電車の中で話の中にどっぷりとはまりこんでしまった私がいけないのです。

そういえば、新井素子もどこかの文庫のあとがきに、歯痛止めのクスリを飲んでから星新一を読む話がありましたね。

Common Lisp でマルチスレッド

Lisp

どうしよう、超奔放凶暴な本性を

Common Lisp でマルチスレッド

仕事で、後輩がマルチスレッドの勉強することになったらしい。その話はもちろん、Common Lisp ではなく、C言語の話だったらしいが。

さて帰宅しながら、Common Lispでのマルチスレッドはどうだったかなと復習をすることにした。

もちろん、手抜きなので、Common Lisp Cockbookのプロセス を眺めることにする。 面白いのは、Lispがあまりにも古い言語なので、実装によってはスレッドをプロセスと呼んでいるとあることでしたね。 私はCommon Lispの実装にはよく、ClozureCL を使っているのですが、 Clozure CL Documentationのスレッド概要 に APIの名前には process が残っている みたいに書いてあるのはそういうことなんですね。

Wherever possible, I'll try to use the term "thread" to denote a lisp thread, even though many of the functions in the API have the word "process" in their name. https://ccl.clozure.com/manual/chapter7.1.html#Threads-overview

環境

  • ClozureCL
  • quicklisp
    • bordeaux-threads

準備

Common Lisp の REPL で quciklisp で bt-semaphore をいれればいいらしいです。

CL-USER> (ql:quickload "bt-semaphore")

これで T が返ればスレッドがサポートできるらしいです。

CL-USER> bt:*supports-threads-p*
T

全てのスレッドを取得する手続き

(bt:all-threads)

スレッドを作る(即実行)

bt:make-thread の第一引数に引数を取らないラムダを渡してやればいいらしい。そしてスレッドを作成すると即実行できるとのこと。

(bt:make-thread (lambda () body))

注意点 format

別スレッドの中からは、(format t ...)でトップレベルの標準出力に出力できないらしい。そのため、トップレベルの *standard-output* をシンボルにバインドしておくか、その環境を渡すとよいとのこと。

(defun print-message-top-level-fixed ()
  (let ((top-level *standard-output*))
    (bt:make-thread
       (lambda ()
          (format top-level "Hello from thread!"))
       :name "hello"))
  nil)

例

メイン以外のスレッドから *counter* を更新する例

(defparameter *counter* 0)

(defun reset () (setf *counter* 0))

(defun test-update-global-variable ()
  (bt:make-thread
   (lambda ()
     (sleep 1)
     (incf *counter*)))
  *counter*)

別々のスレッドから *counter* を更新する例

これは、ロックがないから、結果がめちゃくちゃになる例。そういえば、sleep の引数は秒単位だけど、整数でなくてもよいのだった。

(defun countup ()
    (incf *counter*))
(defun countdown ()
    (decf *counter*))

(defun updown (name &optional (stream *standard-output*) )
  (format stream "task ~a counter ~a ~%" name *counter*)
  (countup)
  (sleep 0.01)
  (countdown))

(defun task1 (name &optional (stream *standard-output*) )
  (loop repeat 1000 do (updown name stream))
  (format stream "task: ~a , counter: ~a ~%" name *counter*))

(defun task-runner (name)
  (let ((stream *standard-output*))
    (format t "start taks name: ~a ~%" name)
    (bt:make-thread (lambda () (task1 name stream)))))

(defun multithread-task-runner ()
  (task-runner 1)
  (task-runner 2)
  (task-runner 3)
  (task-runner 4)
  (task-runner 5)
  (format t "TOTAL : ~a ~%" *counter*)
  )

ロックをいれてみる例

(bt:make-lock) で ロックを作成して、ロックを使う箇所を(bt:with-lock-held (<ロック>) ... ) のように包めばいいのね。

(defvar *lock* (bt:make-lock))

(defun countup ()
  (bt:with-lock-held (*lock*) (incf *counter*)))
  
(defun countdown ()
  (bt:with-lock-held (*lock*) (decf *counter*)))