NASA is underfunding planetary exploration relative to recommendations made by the National Academies Decadal Survey report, resulting in mission delays and cancelations.

The habitable zone is a useful concept in astrobiology, but it can sometimes paint an over-simplified picture of planetary habitability.

The Planetary Society and Lerner Publishing Group have teamed up to bring young readers an engaging series of books that make space science fun and accessible.

China is in the early stages of planning a huge space observatory to help answer the matter of whether we are alone in the galaxy.

Looking to the past to guide the search for life.

NASA is preparing to launch its flagship mission to explore Jupiter’s moon Europa. Launching sometime in October 2024 and arriving in 2030, the mission will explore the icy world with a subsurface ocean that scientists think could have conditions favorable to life.

The European Space Agency (ESA) is preparing to launch a mission to study the aftermath of DART's impact on the asteroid moonlet Dimorphos.

The European Space Agency’s Hera spacecraft launched on Oct. 7, 2024, from Cape Canaveral, Florida. It will travel to the Didymos-Dimorphos asteroid system to study the aftermath of the first-ever field test of an asteroid deflection technique.

An overview of what U.S. space policy might look like under a Trump or a Harris administration.

 

A Dwarf king and his elite guard take to the field.

 Amongst the Eagle helms of the shield wall is the kings champion himself. Nothing must get to the king and the champions blue axe, will see that nothing does.

I could use this base for King Balin when he tries to retake Moria. A future project of mine.
The King points out floors in the enemies formation to the chief engineer.
The Dragon standard flies over head echoing the Kings mighty dragon helm.
This base has been created for the upcoming Hobbit battle, replacing Dain's base in the ranks. This allows Dain to roam freely as a character on the field.

 The figures are beautiful old sculpts from Asgard and Citadel. There has been a bit of tweaking on a couple of them, like the axe and the standard.

The last Dwarf base done just in time for the big weekend. It's the Other Partizan show this weekend and I'll be there with my armies. So if you fancy seeing a massive Hobbit battle...pop along.

The battle will be fought using the new Midguard rules by James Morris. It proves to be a great Sunday especially if you're a Tolkien fan.

Today I have collect everything together and pack it as best I can to stop any travel casualties. I have always painted my figures to play at home so have never magnetised them onto metal sheets.Finally the two meet, Bolg and bigger Beorn.
My old Beorn figure is dwarfed by the new addition. The new bear has a lot more presence to him and should look the part on Sunday.

well...what a bloody marvellous couple of days I've just had. Taking all my figures to a show for the first time was a little nerve racking, but the effort really paid off. I had an excellent time and met some great new friends too in the process.
The board and mountain were excellent too, crafted by the talented James Morris. I had never deployed my whole army in one go before, so what better time to do it than on a set up like this. Everything seemed to come together perfectly.
I started my battle with the orcs at the bottom of the hill advancing across the mountain river. However, due to my terrible dice rolling and the luck of the Elves, I was cut and shot to pieces. It wasn't long before my tattered ranks were tumbling back through the freezing water. The Elves just had time to redress their lines before another dark wave of Goblin folk arrived.
I love the walled up gate that James made, the little gaps in the stonework were perfect. It really reminded me of one of Alan Lees illustrations. Also a very clever use of silver fabric for the river...very effective!

The Eagles arrived later in the game and swept the Goblins from the mountain sides. The game was masterfully run by David Hunter, who made sure the flo was just right.
My Eagles looked very realistic on the slopes of the mountain too, better than I had hoped for. The extra poses were well worth collecting over the last ten years. The flying ones on stands were a very recent purchase and they really stood out.
The game in full flo, it drew a big crowd and it was great to talk figures with people. A lot of people wanted to know where I got my Orcs from and of course the answer was...everywhere. Also the amount of plastic model kits used was very hard to calculate. Just about every Dark age and Fantasy box set all mashed up and mixed together.



I love my Wood elves after lovingly creating each one individually and got a huge buzz from seeing them in action. I didn't really care they were cutting my forces to ribbons, just seeing them used in anger was enough for me.
Hordes of Goblins still plagued the mountainside, their numbers were too much even for the Eagles.
Thorin was cut down by Bolg's bodyguard as he tried to cut through their great shields. Bard of Laketown too, fell to the hacking Goblin blades. Dain of the Iron hills was holding his own but was badly wounded. At last it seemed like the Free people's luck had run out. 
Then with a roar like a thunderclap Beorn burst onto the scene. He tore through the Goblin ranks and made his way to Bolg. Approaching the rear of Bolg's bodyguard he shattered their formation.

It was at this point the Orc's morale was lost and the game was called. The rules were James' new Midguard ones and were perfect for this Dark age epic clash of men and monsters.

I had a great couple of days and it was a real treat to get out and do something exciting like this. To my amazement I didn't suffer any spear snaps of breakages and everything survived intacted. I was expecting a few casualties and had even taken a little repair kit but didn't need it.

Dain's Iron hills Dwarves push the Goblins from the ridge, supported by a group of Lake men.
An earlier shot of the swirl of battle.
The nine Black riders with their Dark lord 
My beloved Silvan elves holding their own against ravaging wolf packs.

I said it once, I'll say it again, what a bloody marvellous couple of days!

 I'm sure I'll have some more pictures soon to post on here of the day...
 

 Here's a shot of James Morris' Lonely mountain with the only missing element...thousands of blood drinking bats. 

The men of Lord Hastings' Retinue struggle through the mud of Tewkesbury.

Vallejo thick mud was the perfect solution for the grim battle conditions of the war. Adding snow to this layer would look fantastic but would rather limit the battles. I think a generic muddy field is a good all rounder for this brutal conflict.

I broke my usual 69x60mm basing after seeing a friend's and decided to copy it. Partly because the cheapness of plastics allows for bigger units. I also have quite a few old Perry miniatures from the old days of Foundry. These old lead figures are great for sprinkling amongst the ranks to add character. The above photo shows the effect of these old sculpts. They have to be mounted on plastic bases etc to bring them up to the height of the newer plastics. The mud is great for covering these and making everyone level.
As the Vallejo mud was drying, I cut up some thin brush bristles and pushed them into the mixture. These make for great arrows and really helps to give the bases a War of the Roses look and feel.
The mud is also great for splashing up the legs and clothes of the soldiers. It's quite subtle but helps to  set them in the scene.


The mud isn't quite dry yet and there are a couple more things to do before they are finished. Layers of 'Rutted field' from Luke's APS should look good over the mud, as well as patches of static grass. Also the arrows will need some white goose fletching on them.


 These new bases are 80x60mm and give a more realistic look to a unit. I got a bit carried away with these bases and they grew to 10 men per base.

The figures In these units are a mix of old Foundry, Perry's plastics and Forlorn Hope metal figures. They all mix together well and make for characterful formations.

I'm a sucker for sage advice much as anyone else, and Kernighan is certainly right on money in the epigraph. Alas there comes a time in programmer's career when you just end up there despite the warning. It could be that you were indeed too clever for your own good, or maybe the code isn't quite yours anymore after each of your colleague's take on it over the years. Or just sometimes, the problem is indeed so hard that it strains your capacity as a coder.

It would usually start with a reasonable idea made into first iteration code. The solution looks fundamentally sound but then as you explore the problem space further it begins to seep nuance, either as manifestation of some real world complexity or your lack of foresight. When I run into this my first instinct is to instrument the code. If the problem is formidable you got to respect it: flailing around blindly modifying things or ugh, doing a rewrite at this stage is almost guaranteed to be a waste of time. It helps to find a promising spot, chisel it, gain a foothold in the problem, and repeat until you crack it. Comfortable debugging tools here can really help to erode the original Kernighan coefficient from 2 to maybe 1.6 or 1.4 where you can still have a chance.

Lisp users are fortunate with the options of interactive debugging, and one facility I reach often for is the plain BREAK. It's easy enough to wrap it into a conditional for particular matches you want to debug. However sometimes you want it to trigger after a particular sequence of events across different positions in code has taken place. While still doable it quickly becomes cumbersome and this state machine starts to occupy too much mental space which is already scarce. So one day, partly as a displacement activity from being intimidated by a Really Hard Problem I wrote down my debugging patterns as a handful of macros.

Enter BRAKE. Its features reflect my personal preferences so are not necessarily your cup of tea but it could be a starting point to explore in this direction. Things it can do:

• act as a simple BREAK with no arguments (duh)
• wrap an s-expression, passing through its values upon continuing
• trigger sequentially based on the specified position for a common tag
• allow for marks that don't trigger the break but mark the position as reached
• provide conditional versions for the expressions above
• print traces of tagged breakpoints/marks

If you compile functions with debug on you hopefully should be able to see the wrapped sexpr's result values.

(use-package '(brake))

(defun fizzbuzz ()
  (loop for n from 100 downto 0
	for fizz = (zerop (mod n 3))
	for buzz = (zerop (mod n 5)) do
	(format t "~a "
		(if (not (or fizz buzz))
		    (format nil "~d" n)
		  (brake-when (= n 0)
			      (concatenate 'string
					   (if fizz "Fizz" "")
					   (if buzz "Buzz" "")))))))

These macros try to detect common cases for tagged sequences being either aborted via break or completed to the last step, resetting them after to the initial state. However it is possible for a sequence to end up "abandoned", which can be cleaned up by a manual command.

Say in the example below we want to break when the two first branches were triggered in a specific order. The sequence of 1, 3, 4 will reinitialize once the state 4 is reached, allowing to trigger continuously. At the same time if we blow our stack it should reset to initial when aborting.

(defun ack (m n)
  (cond ((zerop m) (mark :ack 3 (1+ n)))
        ((zerop n) (mark :ack 1 (ack (1- m) 1)))
        (t (brake :ack 4 (ack (1- m) (ack m (1- n)))))))

In addition there are a few utility functions to report on the state of brakepoints, enable or disable brakes based on tags and turn tracing on or off. Tracing isn't meant to replace the semantics of TRACE but to provide a souped up version of debug by print statements everyone loves.

CL-USER> (report-brakes)
Tag :M is DISABLED, traced, with 3 defined steps, current state is initial
Tag :F is DISABLED with 2 defined steps, current state is 0
Tag :ACK is ENABLED with 3 defined steps, current state is initial

Disabling breakpoints without recompilation is really handy and something I find using all the time. The ability to wrap a sexpr was often sorely missed when using BREAK in constructs without implicit body.

Sequencing across threads is sketchy as the code isn't guarded but in many cases it can work, and the appeal of it in debugging races is clear. One of those days I hope to make it more robust while avoiding potential deadlocks but it isn't there yet. Where it already shines tho is in debugging complex iterations, mutually recursive functions and state machines.

Table of Contents

1. Thread Local storage exhausted
2. The layer of indirection
3. I can fix her
4. Let's write some tests!
5. Summary

Thread Local storage exhausted

In the last post I've described a technique to use dynamic variables by value instead of the name by utilizing the operator PROGV. Apparently it works fine on all Common Lisp implementations I've tried except from SBCL, where the number of thread local variables is by default limited to something below 4000. To add salt to the injury, these variables are not garbage collected.

Try the following code to crash into LDB:

(defun foo ()
  (loop for i from 0 below 4096 do
    (when (zerop (mod i 100))
      (print i))
    (progv (list (gensym)) (list 42)
      (values))))
(foo)

This renders our new technique not very practical given SBCL popularity. We need to either abandon the idea or come up with a workaround.

The layer of indirection

Luckily for us we've already introduced a layer of indirection. Operators to access dynamic variables are called DLET, DSET and DREF. This means, that it is enough to provide a kludge implementation for SBCL with minimal changes to the remaining code.

The old code works the same as previously except that instead of SYMBOL-VALUE we use the accessor DYNAMIC-VARIABLE-VALUE, and the old call to PROGV is now DYNAMIC-VARIABLE-PROGV. Moreover DYNAMIC-EFFECTIVE-SLOT used functions BOUNDP and MAKUNBOUND, so we replace these with DYNAMIC-VARIABLE-BOUND-P and DYNAMIC-VARIABLE-MAKUNBOUND. To abstract away things further we also introduce the constructor MAKE-DYNAMIC-VARIABLE

(defpackage "EU.TURTLEWARE.BLOG/DLET"
  (:local-nicknames ("MOP" #+closer-mop "C2MOP"
                           #+(and (not closer-mop) ecl) "MOP"
                           #+(and (not closer-mop) ccl) "CCL"
                           #+(and (not closer-mop) sbcl) "SB-MOP"))
  (:use "CL"))
(in-package "EU.TURTLEWARE.BLOG/DLET")

(eval-when (:compile-toplevel :execute :load-toplevel)
  (unless (member :bordeaux-threads *features*)
    (error "Please load BORDEAUX-THREADS."))
  (when (member :sbcl *features*)
    (unless (member :fake-progv-kludge *features*)
      (format t "~&;; Using FAKE-PROGV-KLUDGE for SBCL.~%")
      (push :fake-progv-kludge *features*))))

(defmacro dlet (bindings &body body)
  (flet ((pred (binding)
           (and (listp binding) (= 2 (length binding)))))
    (unless (every #'pred bindings)
      (error "DLET: bindings must be lists of two values.~%~
                Invalid bindings:~%~{ ~s~%~}" (remove-if #'pred bindings))))
  (loop for (var val) in bindings
        collect var into vars
        collect val into vals
        finally (return `(dynamic-variable-progv (list ,@vars) (list ,@vals)
                           ,@body))))

(defmacro dset (&rest pairs)
  `(setf ,@(loop for (var val) on pairs by #'cddr
                 collect `(dref ,var)
                 collect val)))

(defmacro dref (variable)
  `(dynamic-variable-value ,variable))

;;; ...

(defmethod mop:slot-boundp-using-class
    ((class standard-class)
     object
     (slotd dynamic-effective-slot))
  (dynamic-variable-bound-p (slot-dvar object slotd)))

(defmethod mop:slot-makunbound-using-class
    ((class standard-class)
     object
     (slotd dynamic-effective-slot))
  (dynamic-variable-makunbound (slot-dvar object slotd)))

With these in place we can change the portable implementation to conform.

#-fake-progv-kludge
(progn
  (defun make-dynamic-variable ()
    (gensym))

  (defun dynamic-variable-value (variable)
    (symbol-value variable))

  (defun (setf dynamic-variable-value) (value variable)
    (setf (symbol-value variable) value))

  (defun dynamic-variable-bound-p (variable)
    (boundp variable))

  (defun dynamic-variable-makunbound (variable)
    (makunbound variable))

  (defmacro dynamic-variable-progv (vars vals &body body)
    `(progv ,vars ,vals ,@body)))

I can fix her

The implementation for SBCL will mediate access to the dynamic variable value with a synchronized hash table with weak keys. The current process is the key of the hash table and the list of bindings is the value of the hash table. For compatibility between implementations the top level value of the symbol will be shared.

The variable +FAKE-UNBOUND+ is the marker that signifies, that the variable has no value. When the list of bindings is EQ to +CELL-UNBOUND+, then it means that we should use the global value. We add new bindings by pushing to it.

#+fake-progv-kludge
(progn
  (defvar +fake-unbound+ 'unbound)
  (defvar +cell-unbound+ '(no-binding))

  (defclass dynamic-variable ()
    ((tls-table
      :initform (make-hash-table :synchronized t :weakness :key)
      :reader dynamic-variable-tls-table)
     (top-value
      :initform +fake-unbound+
      :accessor dynamic-variable-top-value)))

  (defun make-dynamic-variable ()
    (make-instance 'dynamic-variable))

  (defun dynamic-variable-bindings (dvar)
    (let ((process (bt:current-thread))
          (tls-table (dynamic-variable-tls-table dvar)))
      (gethash process tls-table +cell-unbound+)))

  (defun (setf dynamic-variable-bindings) (value dvar)
    (let ((process (bt:current-thread))
          (tls-table (dynamic-variable-tls-table dvar)))
      (setf (gethash process tls-table +cell-unbound+) value))))

We define two readers for the variable value - one that simply reads the value, and the other that signals an error if the variable is unbound. Writer for its value either replaces the current binding, or if the value cell is unbound, then we modify the top-level symbol value. We use the value +FAKE-UNBOUND+ to check whether the variable is bound and to make it unbound.

#+fake-progv-kludge
(progn
  (defun %dynamic-variable-value (dvar)
    (let ((tls-binds (dynamic-variable-bindings dvar)))
      (if (eq tls-binds +cell-unbound+)
          (dynamic-variable-top-value dvar)
          (car tls-binds))))

  (defun dynamic-variable-value (dvar)
    (let ((tls-value (%dynamic-variable-value dvar)))
      (when (eq tls-value +fake-unbound+)
        (error 'unbound-variable :name "(unnamed)"))
      tls-value))

  (defun (setf dynamic-variable-value) (value dvar)
    (let ((tls-binds (dynamic-variable-bindings dvar)))
      (if (eq tls-binds +cell-unbound+)
          (setf (dynamic-variable-top-value dvar) value)
          (setf (car tls-binds) value))))

  (defun dynamic-variable-bound-p (dvar)
    (not (eq +fake-unbound+ (%dynamic-variable-value dvar))))

  (defun dynamic-variable-makunbound (dvar)
    (setf (dynamic-variable-value dvar) +fake-unbound+)))

Finally we define the operator to dynamically bind variables that behaves similar to PROGV. Note that we PUSH and POP from the thread-local hash table DYNAMIC-VARIABLE-BINDINGS, so no synchronization is necessary.

#+fake-progv-kludge
(defmacro dynamic-variable-progv (vars vals &body body)
  (let ((svars (gensym))
        (svals (gensym))
        (var (gensym))
        (val (gensym)))
    `(let ((,svars ,vars))
       (loop for ,svals = ,vals then (rest ,svals)
             for ,var in ,svars
             for ,val = (if ,svals (car ,svals) +fake-unbound+)
             do (push ,val (dynamic-variable-bindings ,var)))
       (unwind-protect (progn ,@body)
         (loop for ,var in ,svars
               do (pop (dynamic-variable-bindings ,var)))))))

Let's write some tests!

But of course, we are going to also write a test framework. It's short, I promise. As a bonus point the API is compatibile with fiveam, so it is possible to drop tests as is in the appropriate test suite.

(defvar *all-tests* '())

(defun run-tests ()
  (dolist (test (reverse *all-tests*))
    (format *debug-io* "Test ~a... " test)
    (handler-case (funcall test)
      (serious-condition (c)
        (format *debug-io* "Failed: ~a~%" c))
      (:no-error (&rest args)
        (declare (ignore args))
        (format *debug-io* "Passed.~%")))))

(defmacro test (name &body body)
  `(progn
     (pushnew ',name *all-tests*)
     (defun ,name () ,@body)))

(defmacro is (form)
  `(assert ,form))

(defmacro pass ())

(defmacro signals (condition form)
  `(is (block nil
         (handler-case ,form
           (,condition () (return t)))
         nil)))

(defmacro finishes (form)
  `(is (handler-case ,form
         (serious-condition (c)
           (declare (ignore c))
           nil)
         (:no-error (&rest args)
           (declare (ignore args))
           t))))

Now let's get to tests. First we'll test our metaclass:

(defclass dynamic-let.test-class ()
  ((slot1 :initarg :slot1 :dynamic nil :accessor slot1)
   (slot2 :initarg :slot2 :dynamic t   :accessor slot2)
   (slot3 :initarg :slot3              :accessor slot3))
  (:metaclass class-with-dynamic-slots))

(defparameter *dynamic-let.test-instance-1*
  (make-instance 'dynamic-let.test-class
                 :slot1 :a :slot2 :b :slot3 :c))

(defparameter *dynamic-let.test-instance-2*
  (make-instance 'dynamic-let.test-class
                 :slot1 :x :slot2 :y :slot3 :z))

(test dynamic-let.1
  (let ((o1 *dynamic-let.test-instance-1*)
        (o2 *dynamic-let.test-instance-2*))
    (with-slots (slot1 slot2 slot3) o1
      (is (eq :a slot1))
      (is (eq :b slot2))
      (is (eq :c slot3)))
    (with-slots (slot1 slot2 slot3) o2
      (is (eq :x slot1))
      (is (eq :y slot2))
      (is (eq :z slot3)))))

(test dynamic-let.2
  (let ((o1 *dynamic-let.test-instance-1*)
        (o2 *dynamic-let.test-instance-2*))
    (signals error (slot-dlet (((o1 'slot1) 1)) nil))
    (slot-dlet (((o1 'slot2) :k))
      (is (eq :k (slot-value o1 'slot2)))
      (is (eq :y (slot-value o2 'slot2))))))

(test dynamic-let.3
  (let ((o1 *dynamic-let.test-instance-1*)
        (exit nil)
        (fail nil))
    (flet ((make-runner (values)
             (lambda ()
               (slot-dlet (((o1 'slot2) :start))
                 (let ((value (slot2 o1)))
                   (unless (eq value :start)
                     (setf fail value)))
                 (loop until (eq exit t) do
                   (setf (slot2 o1) (elt values (random (length values))))
                   (let ((value (slot2 o1)))
                     (unless (member value values)
                       (setf fail value)
                       (setf exit t))))))))
      (let ((r1 (bt:make-thread (make-runner '(:k1 :k2))))
            (r2 (bt:make-thread (make-runner '(:k3 :k4))))
            (r3 (bt:make-thread (make-runner '(:k5 :k6)))))
        (sleep .1)
        (setf exit t)
        (map nil #'bt:join-thread (list r1 r2 r3))
        (is (eq (slot2 o1) :b))
        (is (null fail))))))

Then let's test the dynamic variable itself:

(test dynamic-let.4
  "Test basic dvar operators."
  (let ((dvar (make-dynamic-variable)))
    (is (eql 42 (dset dvar 42)))
    (is (eql 42 (dref dvar)))
    (ignore-errors
     (dlet ((dvar :x))
       (is (eql :x (dref dvar)))
       (error "foo")))
    (is (eql 42 (dref dvar)))))

(test dynamic-let.5
  "Test bound-p operator."
  (let ((dvar (make-dynamic-variable)))
    (is (not (dynamic-variable-bound-p dvar)))
    (dset dvar 15)
    (is (dynamic-variable-bound-p dvar))
    (dynamic-variable-makunbound dvar)
    (is (not (dynamic-variable-bound-p dvar)))))

(test dynamic-let.6
  "Test makunbound operator."
  (let ((dvar (make-dynamic-variable)))
    (dset dvar t)
    (is (dynamic-variable-bound-p dvar))
    (finishes (dynamic-variable-makunbound dvar))
    (is (not (dynamic-variable-bound-p dvar)))))

(test dynamic-let.7
  "Test locally bound-p operator."
  (let ((dvar (make-dynamic-variable)))
    (is (not (dynamic-variable-bound-p dvar)))
    (dlet ((dvar 15))
      (is (dynamic-variable-bound-p dvar)))
    (is (not (dynamic-variable-bound-p dvar)))))

(test dynamic-let.8
  "Test locally unbound-p operator."
  (let ((dvar (make-dynamic-variable)))
    (dset dvar t)
    (is (dynamic-variable-bound-p dvar))
    (dlet ((dvar nil))
      (is (dynamic-variable-bound-p dvar))
      (finishes (dynamic-variable-makunbound dvar))
      (is (not (dynamic-variable-bound-p dvar))))
    (is (dynamic-variable-bound-p dvar))))

(test dynamic-let.9
  "Stress test the implementation (see :FAKE-PROGV-KLUDGE)."
  (finishes                              ; at the same time
    (let ((dvars (loop repeat 4096 collect (make-dynamic-variable))))
      ;; ensure tls variable
      (loop for v in dvars do
        (dlet ((v 1))))
      (loop for i from 0 below 4096
            for r = (random 4096)
            for v1 in dvars
            for v2 = (elt dvars r) do
              (when (zerop (mod i 64))
                (pass))
              (dlet ((v1 42)
                     (v2 43))
                (values))))))

(test dynamic-let.0
  "Stress test the implementation (see :FAKE-PROGV-KLUDGE)."
  (finishes                             ; can be gc-ed
    (loop for i from 0 below 4096 do
      (when (zerop (mod i 64))
        (pass))
      (dlet (((make-dynamic-variable) 42))
        (values)))))

All that is left is to test both dynamic variable implementations:

BLOG/DLET> (lisp-implementation-type)
"ECL"
BLOG/DLET> (run-tests)
Test DYNAMIC-LET.1... Passed.
Test DYNAMIC-LET.2... Passed.
Test DYNAMIC-LET.3... Passed.
Test DYNAMIC-LET.4... Passed.
Test DYNAMIC-LET.5... Passed.
Test DYNAMIC-LET.6... Passed.
Test DYNAMIC-LET.7... Passed.
Test DYNAMIC-LET.8... Passed.
Test DYNAMIC-LET.9... Passed.
Test DYNAMIC-LET.0... Passed.
NIL

And with the kludge:

BLOG/DLET> (lisp-implementation-type)
"SBCL"
BLOG/DLET> (run-tests)
Test DYNAMIC-LET.1... Passed.
Test DYNAMIC-LET.2... Passed.
Test DYNAMIC-LET.3... Passed.
Test DYNAMIC-LET.4... Passed.
Test DYNAMIC-LET.5... Passed.
Test DYNAMIC-LET.6... Passed.
Test DYNAMIC-LET.7... Passed.
Test DYNAMIC-LET.8... Passed.
Test DYNAMIC-LET.9... Passed.
Test DYNAMIC-LET.0... Passed.
NIL

Summary

In this post we've made our implementation to work on SBCL even when there are more than a few thousand dynamic variables. We've also added a simple test suite that checks the basic behavior.

As it often happens, after achieving some goal we get greedy and achieve more. That's the case here as well. In the next (and the last) post in this series I'll explore the idea of adding truly thread-local variables without a shared global value. This will be useful for lazily creating context on threads that are outside of our control. We'll also generalize the implementation so it is possible to subclass and implement ones own flavor of a dynamic variable.

Table of Contents

1. The protocol
2. Control operators
3. Synchronized hash tables with weakness
4. First-class dynamic variables
   1. STANDARD-DYNAMIC-VARIABLE
   2. SURROGATE-DYNAMIC-VARIABLE
5. Thread-local variables
   1. The protocol
   2. The implementation
6. Thread-local slots
7. What can we use it for?

In the previous two posts I've presented an implementation of first-class dynamic variables using PROGV and a surrogate implementation for SBCL.

Now we will double down on this idea and make the protocol extensible. Finally we'll implement a specialized version of dynamic variables where even the top level value of the variable is thread-local.

The protocol

Previously we've defined operators as either macros or functions. Different implementations were protected by the feature flag and symbols collided. Now we will introduce the protocol composed of a common superclass and functions that are specialized by particular implementations.

Most notably we will introduce a new operator CALL-WITH-DYNAMIC-VARIABLE that is responsible for establishing a single binding. Thanks to that it will be possible to mix dynamic variables of different types within a single DLET statement.

(defclass dynamic-variable () ())

(defgeneric dynamic-variable-bindings (dvar))
(defgeneric dynamic-variable-value (dvar))
(defgeneric (setf dynamic-variable-value) (value dvar))
(defgeneric dynamic-variable-bound-p (dvar))
(defgeneric dynamic-variable-makunbound (dvar))
(defgeneric call-with-dynamic-variable (cont dvar &optional value))

Moreover we'll define a constructor that is specializable by a key. This design will allow us to refer to the dynamic variable class by using a shorter name. We will also define the standard class to be used and an matching constructor.

(defparameter *default-dynamic-variable-class*
  #-fake-progv-kludge 'standard-dynamic-variable
  #+fake-progv-kludge 'surrogate-dynamic-variable)

(defgeneric make-dynamic-variable-using-key (key &rest initargs)
  (:method (class &rest initargs)
    (apply #'make-instance class initargs))
  (:method ((class (eql t)) &rest initargs)
    (apply #'make-instance *default-dynamic-variable-class* initargs))
  (:method ((class null) &rest initargs)
    (declare (ignore class initargs))
    (error "Making a dynamic variable that is not, huh?")))

(defun make-dynamic-variable (&rest initargs)
  (apply #'make-dynamic-variable-using-key t initargs))

Control operators

Control operators are the same as previously, that is a set of four macros that consume the protocol specified above. Note that DYNAMIC-VARIABLE-PROGV expands to a recursive call where each binding is processed separately.

(defmacro dlet (bindings &body body)
  (flet ((pred (binding)
           (and (listp binding) (= 2 (length binding)))))
    (unless (every #'pred bindings)
      (error "DLET: bindings must be lists of two values.~%~
              Invalid bindings:~%~{ ~s~%~}" (remove-if #'pred bindings))))
  (loop for (var val) in bindings
        collect var into vars
        collect val into vals
        finally (return `(dynamic-variable-progv (list ,@vars) (list ,@vals)
                           ,@body))))

(defmacro dset (&rest pairs)
  `(setf ,@(loop for (var val) on pairs by #'cddr
                 collect `(dref ,var)
                 collect val)))

(defmacro dref (variable)
  `(dynamic-variable-value ,variable))

(defun call-with-dynamic-variable-progv (cont vars vals)
  (flet ((thunk ()
           (if vals
               (call-with-dynamic-variable cont (car vars) (car vals))
               (call-with-dynamic-variable cont (car vars)))))
    (if vars
        (call-with-dynamic-variable-progv #'thunk (cdr vars) (cdr vals))
        (funcall cont))))

(defmacro dynamic-variable-progv (vars vals &body body)
  (let ((cont (gensym)))
    `(flet ((,cont () ,@body))
       (call-with-dynamic-variable-progv (function ,cont) ,vars ,vals))))

Synchronized hash tables with weakness

Previously we've used SBCL-specific options to define a synchronized hash table with weak keys. This won't do anymore, because we will need a similar object to implement the thread-local storage for top level values.

trivial-garbage is a portability layer that allows to define hash tables with a specified weakness, but it does not provide an argument that would abstract away synchronization. We will ensure thread-safety with locks instead.

(defclass tls-table ()
  ((table :initform (trivial-garbage:make-weak-hash-table
                     :test #'eq :weakness :key))
   (lock :initform (bt:make-lock))))

(defun make-tls-table ()
  (make-instance 'tls-table))

(defmacro with-tls-table ((var self) &body body)
  (let ((obj (gensym)))
    `(let* ((,obj ,self)
            (,var (slot-value ,obj 'table)))
       (bt:with-lock-held ((slot-value ,obj 'lock)) ,@body))))

First-class dynamic variables

STANDARD-DYNAMIC-VARIABLE

Previously in the default implementation we've represented dynamic variables with a symbol. The new implementation is similar except that the symbol is read from a STANDARD-OBJECT that represents the variable. This also enables us to specialize the function CALL-WITH-DYNAMIC-VARIABLE:

(defclass standard-dynamic-variable (dynamic-variable)
  ((symbol :initform (gensym) :accessor dynamic-variable-bindings)))

(defmethod dynamic-variable-value ((dvar standard-dynamic-variable))
  (symbol-value (dynamic-variable-bindings dvar)))

(defmethod (setf dynamic-variable-value) (value (dvar standard-dynamic-variable))
  (setf (symbol-value (dynamic-variable-bindings dvar)) value))

(defmethod dynamic-variable-bound-p ((dvar standard-dynamic-variable))
  (boundp (dynamic-variable-bindings dvar)))

(defmethod dynamic-variable-makunbound ((dvar standard-dynamic-variable))
  (makunbound (dynamic-variable-bindings dvar)))

(defmethod call-with-dynamic-variable (cont (dvar standard-dynamic-variable)
                                       &optional (val nil val-p))
  (progv (list (dynamic-variable-bindings dvar)) (if val-p (list val) ())
    (funcall cont)))

SURROGATE-DYNAMIC-VARIABLE

The implementation of the SURROGATE-DYNAMIC-VARIABLE is almost the same as previously. The only difference is that we use the previously defined indirection to safely work with hash tables. Also note, that we are not add the feature condition - both classes is always created.

(defvar +fake-unbound+ 'unbound)
(defvar +cell-unbound+ '(no-binding))

(defclass surrogate-dynamic-variable (dynamic-variable)
  ((tls-table
    :initform (make-tls-table)
    :reader dynamic-variable-tls-table)
   (top-value
    :initform +fake-unbound+
    :accessor dynamic-variable-top-value)))

(defmethod dynamic-variable-bindings ((dvar surrogate-dynamic-variable))
  (let ((process (bt:current-thread)))
    (with-tls-table (tls-table (dynamic-variable-tls-table dvar))
      (gethash process tls-table +cell-unbound+))))

(defmethod (setf dynamic-variable-bindings) (value (dvar surrogate-dynamic-variable))
  (let ((process (bt:current-thread)))
    (with-tls-table (tls-table (dynamic-variable-tls-table dvar))
      (setf (gethash process tls-table) value))))

(defun %dynamic-variable-value (dvar)
  (let ((tls-binds (dynamic-variable-bindings dvar)))
    (if (eq tls-binds +cell-unbound+)
        (dynamic-variable-top-value dvar)
        (car tls-binds))))

(defmethod dynamic-variable-value ((dvar surrogate-dynamic-variable))
  (let ((tls-value (%dynamic-variable-value dvar)))
    (when (eq tls-value +fake-unbound+)
      (error 'unbound-variable :name "(unnamed)"))
    tls-value))

(defmethod (setf dynamic-variable-value) (value (dvar surrogate-dynamic-variable))
  (let ((tls-binds (dynamic-variable-bindings dvar)))
    (if (eq tls-binds +cell-unbound+)
        (setf (dynamic-variable-top-value dvar) value)
        (setf (car tls-binds) value))))

(defmethod dynamic-variable-bound-p ((dvar surrogate-dynamic-variable))
  (not (eq +fake-unbound+ (%dynamic-variable-value dvar))))

(defmethod dynamic-variable-makunbound ((dvar surrogate-dynamic-variable))
  (setf (dynamic-variable-value dvar) +fake-unbound+))


;;; Apparently CCL likes to drop^Helide some writes and that corrupts bindings
;;; table. Let's ensure that the value is volatile.
#+ccl (defvar *ccl-ensure-volatile* nil)
(defmethod call-with-dynamic-variable (cont (dvar surrogate-dynamic-variable)
                                       &optional (val +fake-unbound+))
  (push val (dynamic-variable-bindings dvar))
  (let (#+ccl (*ccl-ensure-volatile* (dynamic-variable-bindings dvar)))
    (unwind-protect (funcall cont)
      (pop (dynamic-variable-bindings dvar)))))

Thread-local variables

We've refactored the previous code to be extensible. Now we can use metaobjects from the previous post without change. We can also test both implementations in the same process interchangeably by customizing the default class parameter.

It is the time now to have some fun and extend dynamic variables into variables with top value not shared between different threads. This will enable ultimate thread safety. With our new protocol the implementation is trivial!

The protocol

First we will define the protocol class. THREAD-LOCAL-VARIABLE is a variant of a DYNAMIC-VARIABLE with thread-local top values.

We specify initialization arguments :INITVAL and :INITFUN that will be used to assign the top value of a binding. The difference is that INITVAL specifies a single value, while INITFUN can produce an unique object on each invocation. INITARG takes a precedence over INTIFUN, and if neither is supplied, then a variable is unbound.

We include the constructor that builds on MAKE-DYNAMIC-VARIABLE-USING-KEY, and macros corresponding to DEFVAR and DEFPARAMETER. Note that they expand to :INITFUN - this assures that the initialization form is re-evaluated for each new thread where the variable is used.

(defclass thread-local-variable (dynamic-variable) ())

(defmethod initialize-instance :after
    ((self thread-local-variable) &key initfun initval)
  (declare (ignore self initfun initval)))

(defparameter *default-thread-local-variable-class*
  #-fake-progv-kludge 'standard-thread-local-variable
  #+fake-progv-kludge 'surrogate-thread-local-variable)

(defun make-thread-local-variable (&rest initargs)
  (apply #'make-dynamic-variable-using-key
         *default-thread-local-variable-class* initargs))

(defmacro create-tls-variable (&optional (form nil fp) &rest initargs)
  `(make-thread-local-variable 
    ,@(when fp `(:initfun (lambda () ,form)))
    ,@initargs))

(defmacro define-tls-variable (name &rest initform-and-initargs)
  `(defvar ,name (create-tls-variable ,@initform-and-initargs)))

(defmacro define-tls-parameter (name &rest initform-and-initargs)
  `(defparameter ,name (create-tls-variable ,@initform-and-initargs)))

Perhaps it is a good time to introduce a new convention for tls variable names. I think that surrounding names with the minus sign is a nice idea, because it signifies, that it is something less than a global value. For example:

DYNAMIC-VARS> (define-tls-variable -context- 
                  (progn
                    (print "Initializing context!")
                    (list :context)))
-CONTEXT-
DYNAMIC-VARS> -context-
#<a EU.TURTLEWARE.DYNAMIC-VARS::STANDARD-THREAD-LOCAL-VARIABLE 0x7f7636c08640>
DYNAMIC-VARS> (dref -context-)

"Initializing context!" 
(:CONTEXT)
DYNAMIC-VARS> (dref -context-)
(:CONTEXT)
DYNAMIC-VARS> (dset -context- :the-new-value)

:THE-NEW-VALUE
DYNAMIC-VARS> (dref -context-)
:THE-NEW-VALUE
DYNAMIC-VARS> (bt:make-thread
               (lambda ()
                 (print "Let's read it!")
                 (print (dref -context-))))
#<process "Anonymous thread" 0x7f7637a26cc0>

"Let's read it!" 
"Initializing context!" 
(:CONTEXT) 
DYNAMIC-VARS> (dref -context-)
:THE-NEW-VALUE

The implementation

You might have noticed the inconspicuous operator DYNAMIC-VARIABLE-BINDINGS that is part of the protocol. It returns an opaque object that represents values of the dynamic variable in the current context:

• for STANDARD-DYNAMIC-VARIABLE it is a symbol
• for SURROGATE-DYNAMIC-VARIABLE it is a thread-local list of bindings

In any case all other operators first take this object and then use it to read, write or bind the value. The gist of the tls variables implementation is to always return an object that is local to the thread. To store these objects we will use the tls-table we've defined earlier.

(defclass thread-local-variable-mixin (dynamic-variable)
  ((tls-table
    :initform (make-tls-table)
    :reader dynamic-variable-tls-table)
   (tls-initfun
    :initarg :initfun
    :initform nil
    :accessor thread-local-variable-initfun)
   (tls-initval
    :initarg :initval
    :initform +fake-unbound+
    :accessor thread-local-variable-initval)))

For the class STANDARD-THREAD-LOCAL-VARIABLE we will simply return a different symbol depending on the thread:

(defclass standard-thread-local-variable (thread-local-variable-mixin
                                         thread-local-variable
                                         standard-dynamic-variable)
  ())

(defmethod dynamic-variable-bindings ((tvar standard-thread-local-variable))
  (flet ((make-new-tls-bindings ()
           (let ((symbol (gensym))
                 (initval (thread-local-variable-initval tvar))
                 (initfun (thread-local-variable-initfun tvar)))
             (cond
               ((not (eq +fake-unbound+ initval))
                (setf (symbol-value symbol) initval))
               ((not (null initfun))
                (setf (symbol-value symbol) (funcall initfun))))
             symbol)))
    (let ((key (bt:current-thread)))
      (with-tls-table (tls-table (dynamic-variable-tls-table tvar))
        (or (gethash key tls-table)
            (setf (gethash key tls-table)
                  (make-new-tls-bindings)))))))

And for the class SURROGATE-THREAD-LOCAL-VARIABLE the only difference from the SURROGATE-DYNAMIC-VARIABLE implementation is to cons a new list as the initial value (even when it is unbound) to ensure it is not EQ to +CELL-UNBOUND+.

(defclass surrogate-thread-local-variable (thread-local-variable-mixin
                                          thread-local-variable
                                          surrogate-dynamic-variable)
  ())

(defmethod dynamic-variable-bindings ((tvar surrogate-thread-local-variable))
  (flet ((make-new-tls-bindings ()
           (let ((initval (thread-local-variable-initval tvar))
                 (initfun (thread-local-variable-initfun tvar)))
             (cond
               ((not (eq +fake-unbound+ initval))
                (list initval))
               ((not (null initfun))
                (list (funcall initfun)))
               (t
                (list +fake-unbound+))))))
    (let ((key (bt:current-thread)))
      (with-tls-table (tls-table (dynamic-variable-tls-table tvar))
        (or (gethash key tls-table)
            (setf (gethash key tls-table)
                  (make-new-tls-bindings)))))))

That's all, now we have two implementations of thread-local variables. Ramifications are similar as with "ordinary" dynamic variables - the standard implementation is not advised for SBCL, because it will crash in LDB.

Thread-local slots

First we are going to allow to defined dynamic variable types with an abbreviated names. This will enable us to specify in the slot definition that type, for example (MY-SLOT :DYNAMIC :TLS :INITFORM 34)

;;; Examples how to add shorthand type names for the dynamic slots:

(defmethod make-dynamic-variable-using-key ((key (eql :tls)) &rest initargs)
  (apply #'make-dynamic-variable-using-key
         *default-thread-local-variable-class* initargs))

(defmethod make-dynamic-variable-using-key ((key (eql :normal-tls)) &rest initargs)
  (apply #'make-dynamic-variable-using-key
         'standard-thread-local-variable initargs))

(defmethod make-dynamic-variable-using-key ((key (eql :kludge-tls)) &rest initargs)
  (apply #'make-dynamic-variable-using-key
         'surrogate-thread-local-variable initargs))

;;; For *DEFAULT-DYNAMIC-VARIABLE* specify :DYNAMIC T.

(defmethod make-dynamic-variable-using-key ((key (eql :normal-dyn)) &rest initargs)
  (apply #'make-dynamic-variable-using-key
         'standard-dynamic-variable initargs))

(defmethod make-dynamic-variable-using-key ((key (eql :kludge-dyn)) &rest initargs)
  (apply #'make-dynamic-variable-using-key
         'surrogate-dynamic-variable initargs))

In order to do that, we need to remember he value of the argument :DYNAMIC. We will read it with DYNAMIC-VARIABLE-TYPE and that value will be available in both direct and the effective slot:

;;; Slot definitions
;;; There is a considerable boilerplate involving customizing slots.
;;;
;;; - direct slot definition: local to a single defclass form
;;;
;;; - effective slot definition: combination of all direct slots with the same
;;;   name in the class and its superclasses
;;;
(defclass dynamic-direct-slot (mop:standard-direct-slot-definition)
  ((dynamic :initform nil :initarg :dynamic :reader dynamic-variable-type)))

;;; The metaobject protocol did not specify an elegant way to communicate
;;; between the direct slot definition and the effective slot definition.
;;; Luckily we have dynamic bindings! :-)
(defvar *kludge/mop-deficiency/dynamic-variable-type* nil)

;;; DYNAMIC-EFFECTIVE-SLOT is implemented to return as slot-value values of the
;;; dynamic variable that is stored with the instance.
;;;
;;; It would be nice if we could specify :ALLOCATION :DYNAMIC for the slot, but
;;; then STANDARD-INSTANCE-ACCESS would go belly up. We could make a clever
;;; workaround, but who cares?
(defclass dynamic-effective-slot (mop:standard-effective-slot-definition)
  ((dynamic :initform *kludge/mop-deficiency/dynamic-variable-type*
            :reader dynamic-variable-type)))

Moreover we specialize the function MAKE-DYNAMIC-VARIABLE-USING-KEY to the effective slot class. The initargs in this method are meant for the instance. When the dynamic variable is created, we check whether it is a thread-local variable and initialize its INITVAL and INITFUN to values derived from INITARGS, MOP:SLOT-DEFINITION-INITARGS and MOP:SLOT-DEFINITION-INITFUN:

(defmethod make-dynamic-variable-using-key
    ((key dynamic-effective-slot) &rest initargs)
  (let* ((dvar-type (dynamic-variable-type key))
         (dvar (make-dynamic-variable-using-key dvar-type)))
    (when (typep dvar 'thread-local-variable)
      (loop with slot-initargs = (mop:slot-definition-initargs key)
            for (key val) on initargs by #'cddr
            when (member key slot-initargs) do
              (setf (thread-local-variable-initval dvar) val))
      (setf (thread-local-variable-initfun dvar)
            (mop:slot-definition-initfunction key)))
    dvar))

The rest of the implementation of DYNAMIC-EFFECTIVE-SLOT is unchanged:

(defmethod mop:slot-value-using-class
    ((class standard-class)
     object
     (slotd dynamic-effective-slot))
  (dref (slot-dvar object slotd)))

(defmethod (setf mop:slot-value-using-class)
    (new-value
     (class standard-class)
     object
     (slotd dynamic-effective-slot))
  (dset (slot-dvar object slotd) new-value))

(defmethod mop:slot-boundp-using-class
  ((class standard-class)
   object
   (slotd dynamic-effective-slot))
  (dynamic-variable-bound-p (slot-dvar object slotd)))

(defmethod mop:slot-makunbound-using-class
  ((class standard-class)
   object
   (slotd dynamic-effective-slot))
  (dynamic-variable-makunbound (slot-dvar object slotd)))

The implementation of CLASS-WITH-DYNAMIC-SLOTS is also very similar. The first difference in that ALLOCATE-INSTANCE calls MAKE-DYNAMIC-VARIABLE-USING-KEY instead of MAKE-DYNAMIC-VARIABLE and supplies the effective slot definition as the key, and the instance initargs as the remaining arguments. Note that at this point initargs are already validated by MAKE-INSTANCE. The second difference is that MOP:COMPUTE-EFFECTIVE-SLOT-DEFINITION binds the flag *KLUDGE/MOP-DEFICIENCY/DYNAMIC-VARIABLE-TYPE* to DYNAMIC-VARIABLE-TYPE.

;;; This is a metaclass that allows defining dynamic slots that are bound with
;;; the operator SLOT-DLET, and, depending on the type, may have thread-local
;;; top value.
;;;
;;; The metaclass CLASS-WITH-DYNAMIC-SLOTS specifies alternative effective slot
;;; definitions for slots with an initarg :dynamic.
(defclass class-with-dynamic-slots (standard-class) ())

;;; Class with dynamic slots may be subclasses of the standard class.
(defmethod mop:validate-superclass ((class class-with-dynamic-slots)
                                    (super standard-class))
  t)

;;; When allocating the instance we initialize all slots to a fresh symbol that
;;; represents the dynamic variable.
(defmethod allocate-instance ((class class-with-dynamic-slots) &rest initargs)
  (let ((object (call-next-method)))
    (loop for slotd in (mop:class-slots class)
          when (typep slotd 'dynamic-effective-slot) do
            (setf (mop:standard-instance-access
                   object
                   (mop:slot-definition-location slotd))
                  (apply #'make-dynamic-variable-using-key slotd initargs)))
    object))

;;; To improve potential composability of CLASS-WITH-DYNAMIC-SLOTS with other
;;; metaclasses we treat specially only slots that has :DYNAMIC in initargs,
;;; otherwise we call the next method.
(defmethod mop:direct-slot-definition-class
    ((class class-with-dynamic-slots) &rest initargs)
  (loop for (key) on initargs by #'cddr
        when (eq key :dynamic)
          do (return-from mop:direct-slot-definition-class
               (find-class 'dynamic-direct-slot)))
  (call-next-method))

(defmethod mop:compute-effective-slot-definition
    ((class class-with-dynamic-slots)
     name
     direct-slotds)
  (declare (ignore name))
  (let ((latest-slotd (first direct-slotds)))
    (if (typep latest-slotd 'dynamic-direct-slot)
        (let ((*kludge/mop-deficiency/dynamic-variable-type*
                (dynamic-variable-type latest-slotd)))
          (call-next-method))
        (call-next-method))))

(defmethod mop:effective-slot-definition-class
    ((class class-with-dynamic-slots) &rest initargs)
  (declare (ignore initargs))
  (if *kludge/mop-deficiency/dynamic-variable-type*
      (find-class 'dynamic-effective-slot)
      (call-next-method)))

Finally the implementation of SLOT-DLET does not change:

;;; Accessing and binding symbols behind the slot. We don't use SLOT-VALUE,
;;; because it will return the _value_ of the dynamic variable, and not the
;;; variable itself.
(defun slot-dvar (object slotd)
  (check-type slotd dynamic-effective-slot)
  (mop:standard-instance-access
   object (mop:slot-definition-location slotd)))

(defun slot-dvar* (object slot-name)
  (let* ((class (class-of object))
         (slotd (find slot-name (mop:class-slots class)
                      :key #'mop:slot-definition-name)))
    (slot-dvar object slotd)))

(defmacro slot-dlet (bindings &body body)
  `(dlet ,(loop for ((object slot-name) val) in bindings
                collect `((slot-dvar* ,object ,slot-name) ,val))
     ,@body))

Finally we can define a class with slots that do not share the top value:

DYNAMIC-VARS> (defclass c1 ()
                  ((slot1 :initarg :slot1 :dynamic nil :accessor slot1)
                   (slot2 :initarg :slot2 :dynamic t   :accessor slot2)
                   (slot3 :initarg :slot3 :dynamic :tls :accessor slot3))
                  (:metaclass class-with-dynamic-slots))
#<The EU.TURTLEWARE.DYNAMIC-VARS::CLASS-WITH-DYNAMIC-SLOTS EU.TURTLEWARE.DYNAMIC-VARS::C1>
DYNAMIC-VARS> (with-slots (slot1 slot2 slot3) *object*
                (setf slot1 :x slot2 :y slot3 :z)
                (list slot1 slot2 slot3))
(:X :Y :Z)
DYNAMIC-VARS> (bt:make-thread
               (lambda ()
                 (with-slots (slot1 slot2 slot3) *object*
                   (setf slot1 :i slot2 :j slot3 :k)
                   (print (list slot1 slot2 slot3)))))

#<process "Anonymous thread" 0x7f76424c0240>

(:I :J :K) 
DYNAMIC-VARS> (with-slots (slot1 slot2 slot3) *object*
                (list slot1 slot2 slot3))
(:I :J :Z)

What can we use it for?

Now that we know how to define thread-local variables, we are left with a question what can we use it for. Consider having a line-buffering stream. One possible implementation could be sketched as:

(defclass line-buffering-stream (fancy-stream)
  ((current-line :initform (make-adjustable-string)
                 :accessor current-line)
   (current-ink :initform +black+
                :accessor current-ink)))

(defmethod stream-write-char ((stream line-buffering-stream) char)
  (if (char= char #
ewline)
      (terpri stream)
      (vector-push-extend char (current-line stream))))

(defmethod stream-terpri ((stream line-buffering-stream))
  (%put-line-on-screen (current-line stream) (current-ink stream))
  (setf (fill-pointer (current-line stream)) 0))

If this stream is shared between multiple threads, then even if individual operations and %PUT-LINE-ON-SCREEN are thread-safe , we have a problem. For example FORMAT writes are not usually atomic and individual lines are easily corrupted. If we use custom colors, these are also a subject of race conditions. The solution is as easy as making both slots thread-local. In that case the buffered line is private to each thread and it is put on the screen atomically:

(defclass line-buffering-stream (fancy-stream)
  ((current-line
    :initform (make-adjustable-string)
    :accessor current-line
    :dynamic :tls)
   (current-ink
    :initform +black+
    :accessor current-ink
    :dynamic :tls))
  (:metaclass class-with-dynamic-slots))

Technique is not limited to streams. It may benefit thread-safe drawing, request processing, resource management and more. By subclassing DYNAMIC-VARIABLE we could create also variables that are local to different objects than processes.

I hope that you've enjoyed reading this post as much as I had writing it. If you are interested in a full standalone implementation, with tests and system definitions, you may get it here. Cheers!

 .

The kind people at Reactor Magazine have posted my two latest Mongolian Wizard stories, one yesterday and the other today. Thursday's "Halcyon Afternoon" took place during a rare moment of peace for Franz-Karl Ritter. But in today's "Dragons of Paris," it's warfare as usual. 

 .

Leaf-writing season is over. By a small coincidence, a leaf has surfaced on the nightstand by my bed. I have a vague memory of writing this, but the date I'd written on it is gone, along much of my name. 

It reads:

               The leaf came in the mail with a message:

               "Preserve Me and I'll Preserve Thee."

                Some obeyed and prospered. Some

                did not and were not.

I am of two minds on this. One says it wouldn't hurt and might help to preserve it. The other says that I should never give in to a superstition I have coined myself.

 

Above: Anyone looking for the link to the complete text of All Souls Night need only to scroll back to yesterday's post.

*

The Wolf Hour



View Comic!

Was it always there



View Comic!

The implication of that



View Comic!

1. Melania Trump's 'I am the most bullied person' video viral as she 'rejects' Jill Biden's tea invite  The Times of India
2. Melania Trump declines invite to meet Jill Biden over Mar-a-Lago raids when FBI ’snooped through her wardrobe’  Mint
3. Jimmy Kimmel again mocks Donald Trump for Melania's ‘interesting’ decision to…  Hindustan Times
4. Biden Invites Trump To White House, But Why Is Melania Refusing To Go?  News18
5. Melania Trump To Skip White House Meeting With Jill Biden: Report  NDTV

1. Chennai doctor stabbed by assilants posing as patients  The Times of India
2. Chennai Doctor Stabbed 7 Times By Son Of Woman Who Had Cancer  NDTV
3. Doctor stabbed by patient’s attendant at Kalaignar Centenary Super Speciality Hospital in Chennai  The Hindu
4. Patient's son stabs doctor 7 times in Chennai hospital, arrested  India Today
5. Doctor stabbed multiple times in Tamil Nadu government hospital by patient’s relative  Deccan Herald

Full Article