For a mission that doesn’t aim to find alien life, Europa Clipper may come surprisingly close.

A Martian cloud atlas, LightSail wins big, and multiple missions coast toward launch.

Europa Clipper will soon head for Jupiter's icy, potentially habitable moon. Without the advocacy efforts of The Planetary Society and our members, the mission may never have been possible.

This week we look forward to launches, gaze at glowing auroras, and get creative with glitter.

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.

The Planetary Society is upgrading systems that will offer us many new capabilities and features that will enhance your membership experience.

From logos to policy to mission architectures, if you want to achieve something in space, you’ve got to design it first.

It’s been a great year for space exploration. Now you get to pick the highlights.

How the inclusion of Katie Taylor v Amanda Serrano on the bill legitimises the carnival of Mike Tyson v Jake Paul in Texas

“Court of Ice and Roses” chessboard in shop!

New in the shop — Starry Woods and Tardigrades! scarves.

Christmas serving board in progress.

Learned something new today— resin fidget spinner. ????

We just made the decision to ship the remaining copies of Feast to us. There are about 800 left, out of the original 2000 copy print run. Which is a lot of copies, but given that we were originally scheduled to launch March 2020, and had to cancel an entire summer’s worth of scheduled bookstore […]

I've been messing around adding to the bear to days and trying not to rush myself. I'm so desperate to get some paint on it that I almost started today. However, I stopped myself and just added a bit more fur. This time I also ad buyded some to the bears face and now I'm finally happy with it.




Cheeky!
Some more help turns up to bolster Lake town and just in the nick of time.


Two of these bases are really shoddy militia types. Pitch forks are a great short hand for 'rabble'. I can't imagine they will hold for long against the goblin horde.

Another hero base .

I think he looks angry, ragged and damn right mean now...let's get him painted up.


I've added hints of blue so the whole force will tie together.


 The men start to suffer from the fierce wolf packs.

The men with their long swords and the tough veterans from the Iron hills.

 This is me working out my warband for a Dark age campaign. I can't really get going on it until I have finished my Hobbit armies for an up coming show. So In the meantime time this sketch of the warband will have to do. Out of the hat I got the Black shield Irish.

The rules will be One hour wargames, and it's interesting to see the small size of the warband. Then again it is a skirmish game.

I have an idea of making a few stands of Draugr, the Viking dead. I have bought some nice Colin Pattern sculpts but thought I'd have a go at making some.
I have loads of Viking sprues left over from the Lake town project, these I mixed with some Oathmark undead sprues. I will add some greenstuff to these to make them a little more Viking.


 

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.

Here is Beorn in his full fury. He has been given a Matt varnish that really helped. This proved even more effective once his mouth, eyes and nose was given a coat of gloss varnish. This brought him to life and gave him a sparkle in his eye.

I ended up putting more and more greenstuff on him until he was completely covered. It's good to have him covered in thick, shaggy fur as he looks more wild and rugged.


The Eagles are coming! Eagles and White wolves get their various layers of flock.
A lovely new Reaper miniatures Dwarf joins the latest group of Dwarves. Reaper make great 'hero' figures to adorn any warband. They can be quite large sculpts so it can be a risky business ordering them, this one is perfect though.
Beorn's base has to be 24cm wide for the game I'm playing, so two side bases were made. These bring the base up to the right measurement and allow for more bear carnage.
Beorn with his slobbering maw but cute adorable shiny eyes.
More goblin wreckage. Wargs too have not escaped the Bears fury and lie amongst the fallen. A few goblins still cling to life.
It was fun to sculpt great claw wounds in the orcs clothes and equipment. Everything has been torn and crushed to pieces.
Beorn's base with some Bodyguard of Bolg behind him. I'm not sure I'll have time to finish this big orcs before the weekend.

Bard of Lake town with his new fixed banner. This banner was a bit too tall for the storage box and the spearpoint snapped off, twice!. So using my flattened brush bristle technique, he's got a new much tougher one. The plastic used for brush bristles make them fantastic for super glue!

As Bard needs to be free to roam around, another replacement base was needed. Here is Bard with a fellow command stand. Bard is another Reaper Miniatures figure and is slightly bigger than most. This is fine as he is a hero and it suits his manly character.

More carnage, this poor Warg has been disemboweled. This is pretty grim but I did have fun sculpting it. Facing a giant werebear was never going to end well. Again, a coat of gloss helps bring it to life 
Another shot of the basing production line.
Bard of Esgaroth.

 The blue theme really helped to tie these militia type troops together. I tested the new banner tip and it comes below the storage box height, hopefully it won't get crushed again.

 

It's time to dig out the old stones and compare them. A lot of these previous models had a greenstuff carving in them.

The two weapon shrines. One is a place of worship, the other, sacrifices.


The two stones of the dead. These could be used for any undead project.

I have to say after the mad month of painting for the Partizan show, my painting mojo is well and truly fried. So I thought I would ease back into things with some gentle building and sculpting.

These figures are a One Hour Wargames Rules campaign set in the age of Arthur. I was picked for the Black shield Irish and so bought a couple of plastic boxes.
 

Skirmishers.

I thought a few Celtic blankets and cloaks wouldn't go a miss. The kits come with some cloaks, but I thought I'd have a go at making my own.
The leader and hero figure from Crusader miniatures. The Druid was a purchase from eBay.
These are a mixture of plastic kits from Gripping Beast and Wargames Atlantic. It's always nice to have more heads etc to create variety in the units.

yesterday I popped to Hobbycraft to see if they had any pieces I could use for the new Midgard rules. I couldn't find any goblets but I did track down the beads needed for heroic deeds.

While I was travelling through the bead tray, I saw one that I thought would make a great Celtic shield.

It has a nice wrap around curve to it but more importantly, sports a nice Celtic swirly pattern.

Ancient Irish warriors fight with the sea devils.
It has a good level of detail to make it look well crafted and ornate. Once I sculpt a boss for the centre I think it will look just the ticket. Nice deep grooves that will catch ink and weathering very well. The swirl too is a very Celtic looking design.

 This tub was £4 which is unbelievable for an armies worth of shields. I might end up using these beads as heroic deeds markers too as they won't roll unlike the rounder ones.

You can get a next size up in container to fill with your beads for £8, again for hundreds of shields this isn't bad. The small tub should be enough though.

Here is a small warband of Dark age Irishmen.  They are meant to be the Black shield Irish from the Winter King books. I struggled with just painting black shields as I wanted to paint some designs. I got around this by painting some fancy shields, then painting them black then rubbing off the paint.

This represents the warband painting over their war shields with black. After some heavy campaigning and harsh weather, not to mention dips in the sea, some of the black paint has started to wear off.

There's enough Celtic design underneath to show through.
Not many more to do now, just the druid and four skirmishers.
These are a mix of Crusader, Gripping beast plastic and Wargames Atlantic plastics. They have been very enjoyable to paint too.

 The new rock pools are a perfect setting for Raiding Black shields.

I thought I'd give this a go as I had heard good things about it. I thought the scenic rock pools would be the perfect test subject, as if they dried glossy it wouldn't matter.
The results were good. I sprayed the models after I had added some flock, I thought the lacquer would help seal it.
After the scenic pieces I thought I'd try it on the new Irish figures. I consider this a tough, hard coat. Another layer of super mat varnish will be added with a brush when this first coat is dry.
The rock pools got a layer of flock really nail the realistic look.

 The flock and paint work is all sprayed with the new lacquer, seems to be a winner.

 

Here are my test bases for the French and Indian wars, using the Bonnie Blue Flag rules.
I quite like these bases, they have more character than the single ones for me. Hopefully, these few test bases will inspire me to do a few more and finish the unit.

Galloping Major figures are so nice that you want to do them justice.

These have just been flocked and need a bit of a dusting off.
Mixed herbs make great leaf litter that is a classic look for the ancient Canadian forests.
When painting these figures I used a few coloured fine tip pens to detail the belts and pouches. I also gave them a coat of Dark tone dip from the tin. I was trying to think of a way of speeding up the painting process.
The Huron, allied to the French.

I love the long muskets and rifles.

 Twigs from the garden make for great moss covered logs.

Earlier this year, I started working through the online book Ray Tracing In One Weekend (Book 1). I have been following along with it in Common Lisp, and I have been extending it all from 3-dimensional to n-dimensional.

I reproduced 4-dimensional versions of all of the book images which you can see on my weekend-raytracer github page.

Here is the final image. This is a 250-samples-per-pixel, 640x360x10 image plane of three large hyperspheres (one mirrored, one diffuse, one glass) atop a very large, diffuse hypersphere. Also atop this very large hypersphere are a bunch of smaller hyperspheres of varying colors and materials. The image is rendered with some defocus-blur.

Final image of 4-dimensional scene

Caveat: This depends on a patched version of the policy-cond library that is not in the current Quicklisp distribution but should be in the next.

 New projects: 

• adp-github — ADP extension to generate github markdown files. — MIT
• adp-plain — Add Documentation, Please... using plain text. An extension of ADP to generate files with barely additional features. — MIT
• allioli — Alliolification — MIT
• alternate-asdf-system-connections — Allows for ASDF system to be connected so that auto-loading may occur. This is a fork of asdf-system-connections and incorporates a load-system-driven mechanism for loading dependencies and also loads the dependencies of the connections. — MIT
• cbor — CBOR encoder/decoder — MIT
• charje.documentation — Documentation is an opinionated yet customizable docstring parsing library. — AGPL V3 or any later version
• chipi — House automation bus in Common Lisp — Apache-2
• cl-aseprite — Aseprite file format parser — GPLv3
• cl-astar — A heavily optimized yet flexible A* pathfinding algorithm implementation — MIT
• cl-ceigen-lite — A Common Lisp wrapper around CEIGEN-LITE - which is itself a C wrapper around the C++ Eigen library. — MIT
• cl-cf — Computations using continued fractions — GPL-3
• cl-concord — CONCORD implementation based on Common Lisp — LGPL
• cl-duckdb — CFFI wrapper around the DuckDB C API — MIT License
• cl-fastcgi — FastCGI wrapper for Common Lisp — BSD License
• cl-flx — Rewrite emacs-flx in Common Lisp — MIT
• cl-frugal-uuid — Common Lisp UUID library with zero dependencies — MIT License
• cl-gog-galaxy — A wrapper for the GOG Galaxy SDK — zlib
• cl-lc — List comprehensions — MIT
• cl-naive-ptrees — Functions to make it easier to work with plist(s) and plist trees. Works with plist(s) pairs as units and not as individual list items. — MIT
• cl-qoa — An implementation of the Quite Okay Audio format. — zlib
• cl-reddit — Reddit client api library — BSD
• cl-resvg — An up-to-date bindings library for the resvg SVG rendering library — zlib
• cl-trivial-clock — Common Lisp library to get accurate wall-clock times on multiple platforms — MIT License
• clack-cors — A Clack middleware to set CORS related HTTP headers. — Unlicense
• clack-prometheus — Clack middleware to serve stats in Prometheus format. — Unlicense
• clith — Common Lisp wITH macro. A general WITH macro. — MIT
• clj-arrows — Implements Clojure-styled threading/transformation macros. — MIT
• clos-encounters — A collection of OOP patterns benefiting from the CLOS MOP. — Unlicense
• coalton — An efficient, statically typed functional programming language that supercharges Common Lisp. — MIT
• cocoas — A toolkit library to help deal with CoreFoundation, Cocoa, and objc — zlib
• com.danielkeogh.graph — A fast an reliable graph library. — MIT
• fast-mpsc-queue — Multi-Producer Single-Consumer queue implementation. — MIT
• file-finder — File finder. Enable rapid file search, inspection and manipulation. — GPL3+
• golden-utils — A utility library. — MIT
• hiccl — HTML generator for Common Lisp — MIT
• hsx — Hypertext S-expression — MIT
• hunchentoot-stuck-connection-monitor — Monitors hunchentoot connections and logs the connections stuck in the same state for a long time (due to slow or inactive clients and network stream timeouts that hunchentoot tries to utilize not working properly). Offers an option to shutdown the stuck connections sockets manually or automatically, thus unblocking the connection threads and preventing thread and socket leak. See https://github.com/edicl/hunchentoot/issues/189 — BSD-2-Clause
• incless — A portable and extensible Common Lisp printer implementation (core) — BSD
• inravina — A portable and extensible Common Lisp pretty printer. — MIT
• invistra — A portable and extensible Common Lisp FORMAT implementation — BSD
• knx-conn — KNXnet/IP implementation in Common Lisp — GNU GPL, version 3
• machine-state — Retrieve machine state information about CPU time, memory usage, etc. — zlib
• myweb — simple web server written in common lisp for educational reasons — LGPLv3
• noisy — Perlin noise for arbitrary numbers of dimensions. — MIT
• nontrivial-gray-streams — A compatibility layer for Gray streams including extensions — MIT
• open-with — Open a file in a suitable external program — zlib
• openai-openapi-client — Openai API client — AGPLv3+
• openrpc — CI for Common Lisp OpenRPC library. — BSD
• parse-number-range — Parses LOOP's convenient "for-as-arithmetic" syntax into 5 simple values: from, to, limit-kind (:inclusive, :exclusive or nil if unbounded), by (step) and direction (+ or -)). Further related utilities are provided. Intended for easy implementation of analogous functionality in other constructs. — Public Domain
• precise-time — Precise time measurements — zlib
• pregexp — Portable regular expressions for Common Lisp — MIT-like
• progressons — Display a progress bar on one line. — MIT
• quaviver — A portable and extensible floating point string library — MIT
• quilc — A CLI front-end for the Quil compiler — Apache License 2.0 (See LICENSE.txt)
• qvm — An implementation of the Quantum Abstract Machine. — Apache License 2.0 (See LICENSE.txt)
• random-sampling — Functions to generate random samples with various distributions — zlib
• rs-dlx — Knuth's Algorithm X with dancing links. — Modified BSD License
• scrapycl — The web scraping framework for writing crawlers in Common Lisp. — Unlicense
• smoothers — Statistical methods to create approximating functions that attempt to capture important patterns in the data, while leaving out noise or other fine-scale structures/rapid phenomena. — MS-PL
• trivial-adjust-simple-array — A tiny utility to change array size ensuring it is simple. — MIT
• trivial-system-loader — A system installation/loading abstraction for Common Lisp — MIT
• trivial-toplevel-commands — Trivial Toplevel Commands allows to define toplevel commands available on most implementations in a portable fashion. — BSD-3 Clause
• trivial-toplevel-prompt — Portability library to customize REPL prompts. — BSD-3 Clause
• utf8-input-stream — A UTF-8 string input stream over a binary stream for Common Lisp — MIT
• whereiseveryone.command-line-args — Automatically create a command-line-argument parser for a given Common Lisp function definition. — AGPL v3 or any later version

Updated projects: 3b-bmfont, 3bgl-shader, 3bmd, 3d-math, 3d-spaces, 40ants-asdf-system, 40ants-slynk, access, acclimation, action-list, adhoc, adopt, adp, agnostic-lizard, alexandria, alexandria-plus, anatevka, anypool, april, arc-compat, architecture.builder-protocol, array-utils, arrow-macros, assoc-utils, async-process, atomics, auto-restart, aws-sdk-lisp, babel, bdef, bike, binary-structures, binding-arrows, birch, blackbird, bordeaux-threads, calm, carrier, caveman, ccldoc, cephes.cl, cepl, cerberus, cffi, cffi-object, cffi-ops, chanl, chunga, ci, ci-utils, ciao, cl-6502, cl-algebraic-data-type, cl-all, cl-ansi-term, cl-async, cl-atelier, cl-autowrap, cl-base32, cl-bmas, cl-bmp, cl-bnf, cl-brewer, cl-buchberger, cl-cmark, cl-collider, cl-colors2, cl-confidence, cl-containers, cl-cookie, cl-csv, cl-custom-hash-table, cl-cxx-jit, cl-data-structures, cl-dbi, cl-digraph, cl-dot, cl-enchant, cl-environments, cl-fast-ecs, cl-fbx, cl-fluent-logger, cl-form-types, cl-forms, cl-freetype2, cl-gamepad, cl-github-v3, cl-gltf, cl-gobject-introspection, cl-graph, cl-grip, cl-gserver, cl-hamcrest, cl-hash-util, cl-html-readme, cl-i18n, cl-info, cl-ini, cl-ipfs-api2, cl-kanren, cl-lib-helper, cl-liballegro, cl-liballegro-nuklear, cl-log, cl-markless, cl-marshal, cl-migratum, cl-mixed, cl-modio, cl-mount-info, cl-mpg123, cl-mssql, cl-mustache, cl-mysql, cl-neovim, cl-netpbm, cl-oju, cl-opengl, cl-opensearch-query-builder, cl-opus, cl-patterns, cl-plus-ssl-osx-fix, cl-ppcre, cl-project, cl-protobufs, cl-pslib, cl-pslib-barcode, cl-rashell, cl-readline, cl-sat.minisat, cl-sdl2-image, cl-sdl2-mixer, cl-sdl2-ttf, cl-sendgrid, cl-sentry-client, cl-skkserv, cl-smtp, cl-ssh-keys, cl-steamworks, cl-str, cl-svg, cl-telegram-bot, cl-threadpool, cl-tiled, cl-torrents, cl-tqdm, cl-transducers, cl-transit, cl-unicode, cl-unification, cl-unix-sockets, cl-utils, cl-vectors, cl-vorbis, cl-wavefront, cl-webdriver-client, cl-webkit, cl-webmachine, cl-who, clack, clack-pretend, clad, classimp, clast, clath, clavier, clazy, clerk, clgplot, climacs, clingon, clip, clj-con, clj-re, clobber, clog, clog-ace, clog-collection, clog-plotly, clog-terminal, clohost, closer-mop, clss, cluffer, clunit2, clx, cmd, codata-recommended-values, codex, coleslaw, collectors, colored, com-on, common-lisp-jupyter, commondoc-markdown, compiler-macro-notes, conduit-packages, consfigurator, contextl, croatoan, ctype, cytoscape-clj, damn-fast-priority-queue, dartscluuid, data-frame, data-lens, datafly, dbus, decompress, defenum, definer, definitions, deflate, defmain, deploy, depot, deptree, dexador, dissect, djula, dns-client, doc, docs-builder, dsm, dufy, easter-gauss, easy-audio, easy-macros, easy-routes, eclector, equals, erjoalgo-webutil, erudite, esrap, event-emitter, external-program, external-symbol-not-found, fare-csv, fare-scripts, fast-http, fast-websocket, file-attributes, file-notify, file-select, filesystem-utils, fiveam, fiveam-matchers, flexi-streams, float-features, flow, fn, fset, functional-trees, fuzzy-dates, gadgets, generic-cl, github-api-cl, glfw, glsl-toolkit, harmony, hashtrie, helambdap, http2, hunchentoot, imago, in-nomine, inferior-shell, introspect-environment, ironclad, jose, js, json-mop, jsonrpc, jzon, khazern, lack, lass, lemmy-api, letv, lichat-protocol, lichat-tcp-client, linear-programming, lisp-binary, lisp-chat, lisp-critic, lisp-pay, lisp-stat, lispcord, lla, local-time, log4cl-extras, logging, lru-cache, magicl, maiden, maidenhead, manifolds, math, mcclim, memory-regions, messagebox, method-combination-utilities, mgl-pax, misc-extensions, mito, mk-defsystem, mmap, mnas-package, mnas-string, moira, multiposter, mutility, mutils, named-closure, ndebug, neural-classifier, new-op, nibbles, nibbles-streams, ningle, nodgui, north, numerical-utilities, nytpu.lisp-utils, omglib, ook, open-location-code, openapi-generator, orizuru-orm, overlord, papyrus, parachute, parse-number, pathname-utils, petalisp, phos, picl, plot, plump, plump-sexp, pngload, policy-cond, polymorphic-functions, postmodern, ppath, prometheus-gc, psychiq, purgatory, py4cl, py4cl2, py4cl2-cffi, qlot, qoi, query-fs, quick-patch, quickhull, quri, random-state, reblocks, reblocks-auth, reblocks-file-server, reblocks-lass, reblocks-navigation-widget, reblocks-parenscript, reblocks-prometheus, reblocks-typeahead, reblocks-ui, reblocks-websocket, rove, s-dot2, sandalphon.lambda-list, sb-fastcgi, sc-extensions, sel, select, serapeum, shasht, shop3, si-kanren, sketch, slime, slite, sly, snooze, spinneret, staple, static-vectors, statistics, stepster, stmx, stripe, swank-crew, swank-protocol, sxql, symath, system-locale, taglib, teddy, ten, testiere, tfeb-lisp-hax, tfm, tiny-routes, tooter, trivia, trivial-arguments, trivial-clipboard, trivial-file-size, trivial-gray-streams, trivial-main-thread, trivial-octet-streams, trivial-package-locks, trivial-package-manager, trivial-sanitize, trivial-shell, type-templates, typo, uax-15, uiop, usocket, vellum, vellum-binary, vellum-csv, vellum-postmodern, verbose, vernacular, vom, websocket-driver, winhttp, with-branching, with-contexts, woo, xhtmlambda, xml-emitter, yason, zippy, zpb-ttf.

Removed projects: abstract-arrays, ahungry-fleece, cl-cheshire-cat, cl-darksky, cl-epoch, cl-naive-store, convolution-kernel, dense-arrays, extensible-compound-types, extensible-optimizing-coerce, fast-generic-functions, flac-metadata, freebsd-ffi, listoflist, luckless, one-more-re-nightmare, postmodern-localtime, stumpwm-dynamic-float, stumpwm-sndioctl, unicly.

To get this update, use:

 (ql:update-dist "quicklisp")

Sorry this update took so long. My goal is to resume monthly releases.

Enjoy!

Table of Contents

1. Dynamic Bindings
2. The problem
3. The solution
4. Dynamic slots
5. The context
6. Summary

Dynamic Bindings

Common Lisp has an important language feature called dynamic binding. It is possible to rebind a dynamic variable somewhere on the call stack and downstream functions will see that new value, and when the stack is unwound, the old value is brought back.

While Common Lisp does not specify multi-threading, it seems to be a consensus among various implementations that dynamic bindings are thread-local, allowing for controlling the computing context in a safe way.

Before we start experiments, let's define a package to isolate our namespace:

(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")

Dynamic binding of variables is transparent to the programmer, because the operator LET is used for both lexical and dynamic bindings. For example:

(defvar *dynamic-variable* 42)

(defun test ()
  (let ((*dynamic-variable* 15)
        (lexical-variable 12))
    (lambda ()
      (print (cons *dynamic-variable* lexical-variable)))))

(funcall (test))
;;; (42 . 12)

(let ((*dynamic-variable* 'xx))
  (funcall (test)))
;;; (xx . 12)

Additionally the language specifies a special operator PROGV that gives the programmer a control over the dynamic binding mechanism, by allowing passing the dynamic variable by value instead of its name. Dynamic variables are represented by symbols:

(progv (list '*dynamic-variable*) (list 'zz)
  (funcall (test)))
;;; (zz . 12)

The problem

Nowadays it is common to encapsulate the state in the instance of a class. Sometimes that state is dynamic. It would be nice if we could use dynamic binding to control it. That said slots are not variables, and if there are many objects of the same class with different states, then using dynamic variables defined with DEFVAR is not feasible.

Consider the following classes which we want to be thread-safe:

(defgeneric call-with-ink (cont window ink))

(defclass window-1 ()
  ((ink :initform 'red :accessor ink)))

(defmethod call-with-ink (cont (win window-1) ink)
  (let ((old-ink (ink win)))
    (setf (ink win) ink)
    (unwind-protect (funcall cont)
      (setf (ink win) old-ink))))

(defclass window-2 ()
  ())

(defvar *ink* 'blue)
(defmethod ink ((window window-2)) *ink*)

(defmethod call-with-ink (cont (win window-2) ink)
  (let ((*ink* ink))
    (funcall cont)))

The first example is clearly not thread safe. If we access the WINDOW-1 instance from multiple threads, then they will overwrite a value of the slot INK.

The second example is not good either, because when we have many instances of WINDOW-2 then they share the binding. Nesting CALL-WITH-INK will overwrite the binding of another window.

The solution

The solution is to use PROGV:

(defclass window-3 ()
  ((ink :initform (gensym))))

(defmethod initialize-instance :after ((win window-3) &key)
  (setf (symbol-value (slot-value win 'ink)) 'red))

(defmethod call-with-ink (cont (win window-3) ink)
  (progv (list (slot-value win 'ink)) (list ink)
    (funcall cont)))

This way each instance has its own dynamic variable that may be rebound with a designated operator CALL-WITH-INK. It is thread-safe and private. We may add some syntactic sugar so it is more similar to let:

(defmacro dlet (bindings &body body)
  (loop for (var val) in bindings
        collect var into vars
        collect val into vals
        finally (return `(progv (list ,@vars) (list ,@vals)
                           ,@body))))

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

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

Dynamic slots

While meta-classes are not easily composable, it is worth noting that we can mold it better into the language by specifying that slot itself has a dynamic value. This way CLOS aficionados will have a new tool in their arsenal.

The approach we'll take is that a fresh symbol is stored as the value of each instance-allocated slot, and then accessors for the slot value will use these symbols as a dynamic variable. Here are low-level accessors:

;;; 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)
  (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))

Now we'll define the meta-class. We need that to specialize functions responsible for processing slot definitions and the instance allocation. Notice, that we make use of a kludge to communicate between COMPUTE-EFFECTIVE-SLOT-DEFINITION and EFFECTIVE-SLOT-DEFINITION-CLASS – this is because the latter has no access to the direct slot definitions.

;;; 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)
  (declare (ignore 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))
                  (gensym (string (mop:slot-definition-name slotd)))))
    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 val) on initargs by #'cddr
        when (eq key :dynamic)
          do (return-from mop:direct-slot-definition-class
               (find-class 'dynamic-direct-slot)))
  (call-next-method))

;;; 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-slot-p* nil)
(defmethod mop:compute-effective-slot-definition
    ((class class-with-dynamic-slots)
     name
     direct-slotds)
  (if (typep (first direct-slotds) 'dynamic-direct-slot)
      (let* ((*kludge/mop-deficiency/dynamic-slot-p* t))
        (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-slot-p*
      (find-class 'dynamic-effective-slot)
      (call-next-method)))

Finally we define a direct and an effective slot classes, and specialize slot accessors that are invoked by the instance accessors.

;;; 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-slot-p)))

;;; 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)
  ())

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

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

(defmethod mop:slot-boundp-using-class
  ((class class-with-dynamic-slots)
   object
   (slotd dynamic-effective-slot))
  (boundp (slot-dvar object slotd)))

(defmethod mop:slot-makunbound-using-class
  ((class class-with-dynamic-slots)
   object
   (slotd dynamic-effective-slot))
  (makunbound (slot-dvar object slotd)))

With this, we can finally define a class with slots that have dynamic values. What's more, we may bind them like dynamic variables.

;;; Let there be light.
(defclass window-4 ()
  ((ink :initform 'red :dynamic t :accessor ink)
   (normal :initform 'normal :accessor normal))
  (:metaclass class-with-dynamic-slots))

(let ((object (make-instance 'window-4)))
  (slot-dlet (((object 'ink) 15))
    (print (ink object)))
  (print (ink object)))

ContextL provides a similar solution with dynamic slots, although it provides much more, like layered classes. This example is much more self-contained.

The context

Lately I'm working on the repaint queue for McCLIM. While doing so I've decided to make stream operations thread-safe, so it is possible to draw on the stream and write to it from arbitrary thread asynchronously. The access to the output record history needs to be clearly locked, so that may be solved by the mutex. Graphics state is another story, consider the following functions running from separate threads:

(defun team-red ()
  (with-drawing-options (stream :ink +dark-red+)
    (loop for i from 0 below 50000 do
      (write-string (format nil "XXX: ~5d~%" i) stream))))

(defun team-blue ()
  (with-drawing-options (stream :ink +dark-blue+)
    (loop for i from 0 below 50000 do
      (write-string (format nil "YYY: ~5d~%" i) stream))))

(defun team-pink ()
  (with-drawing-options (stream :ink +deep-pink+)
    (loop for i from 0 below 25000 do
      (case (random 2)
        (0 (draw-rectangle* stream 200 (* i 100) 250 (+ (* i 100) 50)))
        (1 (draw-circle* stream 225 (+ (* i 100) 25) 25))))))

(defun gonow (stream)
  (window-clear stream)
  (time (let ((a (clim-sys:make-process #'team-red))
              (b (clim-sys:make-process #'team-blue))
              (c (clim-sys:make-process #'team-grue)))
          (bt:join-thread a)
          (bt:join-thread b)
          (bt:join-thread c)
          (format stream "done!~%")))  )

Operations like WRITE-STRING and DRAW-RECTANGLE can be implemented by holding a lock over the shared resource without much disruption. The drawing color on the other hand is set outside of the loop, so if we had locked the graphics state with a lock, then these functions would be serialized despite being called from different processes. The solution to this problem is to make graphics context a dynamic slot that is accessed with WITH-DRAWING-OPTIONS.

Summary

I hope that I've convinced you that dynamic variables are cool (I'm sure that majority of readers here are already convinced), and that dynamic slots are even cooler :-). Watch forward to the upcoming McCLIM release!

If you like technical writeups like this, please consider supporting me on Patreon.

Last week I finished a new service written in Common Lisp. It now runs in production© every mornings, and it expands the set of services I offer to clients.

It’s the 4th service of this kind that I developed: - they are not big - but have to be done nonetheless, and the quicker the better (they each amount to 1k to 2k lines of Lisp code), - they are not part of a super advanced domain that requires Common Lisp superpowers - I am the one who benefits from CL during development, - I could have written them in Python - and conversely nothing prevented me from writing them in Common Lisp.

So here lies the goal of this post: illustrate that you don’t need to need a super difficult problem to use Common Lisp. This has been asked many times, directly to me or on social media :)

At the same time, I want to encourage you to write a little something about how you use Common Lisp in the real world. Sharing creates emulation. Do it! If you don’t have a blog you can simply write in a new GitHub repository or in a Gist and come share on /r/lisp. We don’t care. Thanks <3

We’ll briefly see what my scripts do, what libraries I use, how I deploy them, what I did along the way.

Needless to say that I dogfooded my CIEL (beta) meta-library and scripting tool for all those projects.

Table of Contents

• Scripts n°4 and 2 - shaping and sending data - when you can write Lisp on the side
  • SFTP
  • Deploying
  • Script n°2 and simple FTP
• Scripts n°3 and 1 - complementary web apps
• Lasting words
• Links

Scripts n°4 and 2 - shaping and sending data - when you can write Lisp on the side

My latest script needs to read data from a DB, format what’s necessary according to specifications, and send the result by SFTP.

In this case I read a DB that I own, created by a software that I develop and host. So I could have developed this script in the software itself, right? I could have, but I would have been tied to the main project’s versioning scheme, quirks, and deployment. I rather had to write this script on the side. And since it can be done on the side, it can be done in Common Lisp.

I have to extract products and their data (price, VAT...), aggregate the numbers for each day, write this to a file, according to a specification.

To read the DB, I used cl-dbi. I didn’t format the SQL with SxQL this time like in my web apps (where I use the Mito light ORM), but I wrote SQL directly. I’m spoiled by the Django ORM (which has its idiosyncrasies and shortcomings), so I double checked the different kinds of JOINs and all went well.

I had to group rows by some properties, so it was a great time to use serapeum:assort. I left you an example here: https://dev.to/vindarel/common-lisps-group-by-is-serapeumassort-32ma

Dates have to be handled in different formats. I used local-time of course, and I still greatly appreciate its lispy formatter syntax:

(defun date-yymmddhhnnss (&optional date stream)
  (local-time:format-timestring stream
                                (or date (local-time:now))
                                :format
                                '((:year 4)
                                  (:month 2)
                                  (:day 2)
                                  (:hour 2)
                                  (:min 2)
                                  (:sec 2)
                                  )))

the 2 in (:month 2) is to ensure the month is written with 2 digits.

Once the file is written, I have to send it to a SFTP server, with the client’s codes.

I wrote a profile class to encapsulate the client’s data as well as some functions to read the credentials from either environment variables, the file system, or a lisp variable. I had a top-level profile object for ease of testing, but I made sure that my functions formatting or sending data required a profile parameter.

(defun send-stock (profile &key date) ...)
(defun write-stock (profile filename) ...)

Still nothing surprising, but it’s tempting to only use global parameters for a one-off script. Except the program grows and you pay the mess later.

SFTP

To send the result through SFTP, I had to make a choice. The SFTP command line doesn’t make it possible to give a password as argument (or via an environment variable, etc). So I use lftp (in Debian repositories) that allows to do that. In the end, we format a command like this:

lftp sftp://user:****@host  -e "CD I/; put local-file.name; bye"

You can format the command string and run it with uiop:run-program: no problem, but I took the opportunity to release another utility:

• https://github.com/vindarel/lftp-wrapper

First, you create a profile object. This one-liner reads the credentials from a lispy file:

(defvar profile (make-profile-from-plist (uiop:read-file-form "CREDS.lisp-expr"))

then you define the commands you’ll want to run:

(defvar command (put :cd "I/" :local-filename "data.csv"))
;; #<PUT cd: "I/", filename: "data.csv" {1007153883}>

and finally you call the run method on a profile and a command. Tada.

Deploying

Build a binary the classic way (it’s all on the Cookbook), send it to your server, run it.

(during a testing phase I have deployed “as a script”, from sources, which is a bit quicker to pull changes and try again on the server)

Set up a CRON job.

No Python virtual env to activate in the CRON environment...

Add command line arguments the easy way or with the library of your choice (I like Clingon).

Script n°2 and simple FTP

My script #2 at the time was similar and simpler. I extract the same products but only take their quantities, and I assemble lines like

EXTRACTION STOCK DU 11/04/2008
....978202019116600010000001387
....978270730656200040000000991

For this service, we have to send the file to a simple FTP server.

We have a pure Lisp library for FTP (and not SFTP) which works very well, cl-ftp.

It’s a typical example of an old library that didn’t receive any update in years and so that looks abandoned, that has seldom documentation but whose usage is easy to infer, and that does its job as requested.

For example we do this to send a file:

(ftp:with-ftp-connection (conn :hostname hostname
                                   :username username
                                   :password password
                                   :passive-ftp-p t)
      (ftp:store-file conn local-filename filename))

I left you notes about cl-ftp and my SFTP wrapper here:

• https://dev.to/vindarel/ftp-and-sftp-clients-for-common-lisp-1c3b

Scripts n°3 and n°1 - specialized web apps

A recent web app that I’m testing with a couple clients extends an existing stock management system.

This one also was done in order to avoid a Python monolith. I still needed additions in the Python main software, but this little app can be independent and grow on its own. The app maintains its state and communicates it with a REST API.

 

It gives a web interface to their clients (so my clients’ clients, but not all of them, only the institutional) so that they can:

• search for products
• add them in shopping carts
• validate the cart, which sends the data to the main software and notifies the owner, who will work on them.

The peculiarities of this app are that:

• there is no user login, we use unique URLs with UUIDs in the form: http://command.client.com/admin-E9DFOO82-R2D2-007/list?id=1
• I need a bit of file persistence but I didn’t want the rigidity of a database so I am using the clache library. Here also, not a great activity, but it works©. I persist lists and hash-tables. Now that the needs grow and the original scope doesn’t cut it any more, I wonder how long I’ll survive without a DB. Only for its short SQL queries VS lisp code to filter data.

I deploy a self-contained binary: code + html templates in the same binary (+ the implementation, the web server, the debugger...), with Systemd.

I wrote more on how to ship a standalone binary with templates and static assets with Djula templates here:

• https://lisp-journey.gitlab.io/blog/lisp-for-the-web-build-standalone-binaries-foreign-libraries-templates-static-assets/

I can connect to the running app with a Swank server to check and set parameters, which is super helpful and harmless.

It is possible to reload the whole app from within itself and I did it with no hiccups for a couple years, but it isn’t necessary the most reliable, easiest to set up and fastest method. You can do it, but nobody forces you to do this because you are running CL in production. You can use the industry’s boring and best practices too. Common Lisp doesn’t inforce a “big ball of mud” approach. Develop locally, use Git, use a CI, deploy a binary...

Every thing that I learned I documented it along the way in the Cookbook ;)

Another app that I’ll mention but about which I also wrote earlier is my first web app. This one is open-source. It still runs :)

 

In this project I had my friend and colleague contribute five lines of Lisp code to add a theme switcher in the backend that would help him do the frontend. He had never written a line of Lisp before. Of course, he did so by looking at my existing code to learn the existing functions at hand, and he could do it because the project was easy to install and run.

(defun get-template(template &optional (theme *theme*))
  "Loads template from the base templates directory or from the given theme templates directory if it exists."
  (if (and (str:non-blank-string-p theme)
           (probe-file (asdf:system-relative-pathname "abstock" (str:concat "src/templates/themes/" theme "/" template))))
      ;; then
      (str:concat "themes/" theme "/" template)
      ;; else :D
      template))

He had to annotate the if branches :] This passed the code review.

Lasting words

The 5th script/app is already on the way, and the next ones are awaiting that I open their .docx specification files. This one was a bit harder but the Lisp side was done sucessfully with the efficient collaboration of another freelance lisper (Kevin to not name him).

All those tasks (read a DB, transform data...) are very mundane.

They are everywhere. They don’t always need supercharged web framework or integrations.

You have plenty of opportunities to make yourself a favor, and use Common Lisp in the wild. Not counting the super-advanced domains where Lisp excels at ;)

---

Links

• https://lispcookbook.github.io/cl-cookbook/
• awesome-cl
• companies using Common Lisp in production (at least the ones we know)
• Common Lisp course in videos – it helps me, and you ;) I added 9 videos about CLOS last month, and more are coming. It’s 86 minutes of an efficient code-first approach, out of 7+ hours of total content in the course. After this chapter you know enough to read the sources of the Hunchentoot web server or of the Kandria game.

I have done some preliminary Common Lisp exploration prior to this course but had a lot of questions regarding practical use and development workflows. This course was amazing for this! I learned a lot of useful techniques for actually writing the code in Emacs, as well as conversational explanations of concepts that had previously confused me in text-heavy resources. Please keep up the good work and continue with this line of topics, it is well worth the price! [Preston, October of 2024]

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.

A comment on my previous post said,

The most difficult thing when coming to a different language is to leave the other language behind. The kind of friction experienced here is common when transliterating ideas from one language to another. Go (in this case) is telling you it just doesn't like to work like this.

Try writing simple Go, instead of reaching for Lisp idioms. Then find the ways that work for Go to express the concepts you find.

That's not at all how I approach programming.

A friend of mine once paid me a high compliment. He said, “Even your C code looks like Lisp.”

When I write code, I don't think in terms of the language I'm using, I think in terms of the problem I'm solving. I'm a mostly functional programmer, so I like to think in terms of functions and abstractions. I mostly reason about my code informally, but I draw upon the formal framework of Lambda Calculus. Lambda Calculus is a simple, but powerful (and universal) model of computation.

Programming therefore becomes a matter of expressing the solution to a problem with the syntax and idioms of the language I'm using. Lisp was inspired by Lambda Calculus, so there is little friction in expressing computations in Lisp. Lisp is extensible and customizable, so I can add new syntax and idioms as desired.

Other languages are less accommodating. Some computations are not easily expressable in the syntax of the language, or the semantics of the language are quirky and inconsistent. Essentially, every general purpose fourth generation programming language can be viewed as a poorly-specified, half-assed, incomplete, bug-ridden implementation of half of Common Lisp. The friction comes from working around the limitations of the language.

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. 

 .

 

I am always happiest when a story of mine comes into print. Today, I have the joy of introducing you to "Unquiet Graves," a seasonal tale of graveyard misbehavior and betrayal. Oh, and there's nothing supernatural about it at all.

You can read the story here. But if you're like me, you'll just go to Clarkesworld, look over the table of contents, and decide which story you want to read first. Mine by preference, but follow your whim.

 

And for those who like trivia . . .

I came up with the handheld's app many long years ago and it took forever to come up with a story for it. You'll notice that it is left unnamed in the story. That's because its secret name was "The Graveyard Reader." Which is the title of a well-known story by Theodore Sturgeon.  While I was writing the story, I thought of it as "The New Graveyard Reader." But Sturgeon's story and mine go off in totally different directions, and giving mine (or even the app) a title suggesting there was some implicit connection between the two would only cause confusion.

The title I finally came up with was derived from "The Unquiet Grave" by that most prolific of all poets, Anonymous. If you look it up, I suggest you do so after reading my story. It gives away some of the plot.

*

 

.

This year's Halloween story, written on leaves and serialized daily on my blog, one sentence at a time, is done. Every day in October, I added to it, it reached its last words on Halloween.

Funny thing, though. In conversations with two different friends, I learned that neither of them had realized it was a story. They each thought I was just posting random sentences written on leaves. One of them is an artist, and thinks primarily in visual terms, so I thought at first that was a misunderstanding curious to her. The other, however, is a well-known writer and, what's more important, quite a good one. I have no idea what's going on there.

Long story short, at my behest, my son Sean, put all the photos up on Imgur, subtitled. So, if you didn't realize that they told a story... Or if, somehow, you weren't able to hold all the sentences in your head until the story was complete... Now you can find out what was going on. (The stone angels mark the ends of paragraphs.)

You can find it by clicking on the link here.

*

 .

Once again, one of my e-books will briefly be on sale! Vacuum Flowers will be available in the US for only $1.99. Here's the news from Open Road Media:

Hello,

We are pleased to let you know that the following ebook(s) will be featured in price promotions soon.

ISBN13	Title	Author	Promo Type	Country	Start Date	End Date	Promo Price
9781504036504	Vacuum Flowers	Swanwick, Michael	ORM - Portalist NL	US	2024-11-13	2024-11-13	$1.99

Open Road will promote the feature via social media. We hope you can share the deal with your network as well. You can subscribe to the newsletters at the links below so that you will get the direct link to the deal on the day that it appears.

Newsletter	Link
Early Bird Books	Subscribe Now
The Lineup	Subscribe Now
The Portalist	Subscribe Now
Murder & Mayhem	Subscribe Now
A Love So True	Subscribe Now
The Archive	Subscribe Now
The Reader	Subscribe Now

Please let us know if you have any questions. We are thrilled to be part of this promotion; hope you are too!

Best,
The Open Road Editorial Team

And because you've probably wondered . . .

I've been asked this many times, but the answer is no: I don't have a nude drawing of Gardner Dozois hanging in my living room. It's in the upstairs hallway. Anyway, he's wearing a sheet, so much of him is covered.

Robert Walters posed Gardner as the evil genius Jonaman for one of the illos (back when SF magazines had illustrations) that went with the serialization of Vacuum Flowers in Asimov's, way back when.

It's not the sightliest picture. But it is treasured.

*

Drop bears are scary right



View Comic!