# Table of Contents
1. [The protocol](#orgb91d016)
2. [Control operators](#org3ae3a91)
3. [Synchronized hash tables with weakness](#org0b2c083)
4. [First-class dynamic variables](#orgc3768a9)
1. [`STANDARD-DYNAMIC-VARIABLE`](#orgd64b71d)
2. [`SURROGATE-DYNAMIC-VARIABLE`](#orgf390be8)
5. [Thread-local variables](#orga0cee01)
1. [The protocol](#orgf7cd1ce)
2. [The implementation](#org4046586)
6. [Thread-local slots](#org0da68e3)
7. [What can we use it for?](#orgd6a801a)
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.
<a id="orgb91d016"></a>
# 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))
<a id="org3ae3a91"></a>
# 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))))
<a id="org0b2c083"></a>
# 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))))
<a id="orgc3768a9"></a>
# First-class dynamic variables
<a id="orgd64b71d"></a>
## `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)))
<a id="orgf390be8"></a>
## `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)))))
<a id="orga0cee01"></a>
# 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!
<a id="orgf7cd1ce"></a>
## 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
<a id="org4046586"></a>
## 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`.
<a id="org0da68e3"></a>
# 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)
<a id="orgd6a801a"></a>
# 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 #\newline)
(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](https://fossil.turtleware.eu/dynamic-vars). Cheers!