Informal Methods

Fun with Lisp: Programming the NES

2012-02-06T19:52:24Z

"Low-level programming is good for the programmer's soul." -John Carmack

When the complexity of modern computing gets fatiguing, I look back to the simpler machines of my childhood. I grew up surrounded by various 8-bit and 16-bit machines (most of them already a few years outdated at the time), but my favorite of the bunch is the Nintendo Entertainment System. It's a small machine, even by '80s standards:

6502 CPU at 1.79 MHz
2 Kilobytes of RAM for the CPU
2 Kilobytes of RAM for the PPU (video)

This tiny RAM was augmented by relatively massive amounts of ROM (and sometimes additional RAM) in each cartridge. Typical software ranged in size from 40KB (Super Mario Bros.) to 384 KB (Super Mario Bros. 3), with a few outliers on each end.

When the mood strikes, I'll variously elect to work on my emulator or tinker with EPROM carts and code. The siren call of 6502 assembly language beckoned, so I dusted off the assembler I'd written in Lisp a few years prior. After a little time spent polishing the code, I wanted to write something cool to show it off; so far, I'd mostly written fairly boring experiments and tests such as the following:

I can do better than that.

The 6502 is a great processor to write an assembler for, with a compact and regularly-encoded instruction set. Simple hardware and no external constraints (as might be imposed by operating systems, library code, compilers, coworkers, etc.) make an ideal playground to do your own thing. My assembler is minimalistic, but not minimal: 570 lines at the core, split evenly between infrastructure and definitions of the 6502 architecture. It's embedded in CL, rather than operating as a standalone language processor, so typical assembly source code is really a series of lisp function calls, each emitting an instruction. I'll say a little more about the design.

The job of an assembler is simple enough: to translate a description of data and machine instructions to an output file (an executable, object file, or raw binary data) which can be loaded in memory on the target machine. Machine code is just another kind of data, for which mnemonic assembly language is syntactic sugar, and so knowledge of a particular instruction set can be considered a layer of drudgery built on top of a very simple foundation, with three essential tasks:

Accumulate an output vector.
Remember the current assembly position, in terms of the target's address space.
Maintain a mapping of symbolic names to locations so that self-referential structures can be assembled, including forward references.

My assembler bundles these responsibilities into an object I'll call the assembly context, implementing the following protocol:

(defgeneric context-emit (context vector)
  (:documentation "Emit a vector of bytes into the assembly context"))

(defgeneric context-address (context)
  (:documentation "Returns current virtual address of the context"))

(defgeneric (setf context-address) (address context)
  (:documentation "Set the current virtual address of the context"))

(defgeneric context-find-label (context symbol)
  (:documentation "Returns the address of a label, or nil."))

(defgeneric context-set-label (context symbol &optional address)
  (:documentation "Set the address of a label. If not supplied, the current address is used."))

(defgeneric context-emit-instruction (context vector)
  (:documentation "Emit an instruction into the assembly context. This
  is a hint, for contexts which want to handle instructions
  specially (e.g. cycle counting).")
  (:method (context vector) (context-emit context vector)))

(defgeneric link (context)
  (:documentation "Prepare and return final, assembled output."))

Handling forward references is the only tricky bit. Assemblers take various approaches to this. Using delayed evaluation (in the fashion of force / delay) seemed the simplest way to me - if an expression (such as a call or branch target) involves a label that is not yet defined, a promise object is emitted into the output vector. When LINK is called on the context at the end of assembly, promises are forced to evaluate. If they still can't be resolved, the problems are collected and presented as an error.

For brevity, the context is dynamically bound to the variable *context*. Instruction emitters use this implicitly, as do a number of functions which provide a friendlier user interface to the assembler:

;;;; User interface:

(defvar *context* nil "Current assembly context")
(define-symbol-macro *origin* (context-address *context*))

(defun emit (bytes) (context-emit *context* bytes))

(defun db (&rest bytes)
  (dolist (byte bytes) (context-emit *context* (encode-byte byte))))

(defun dw (&rest words)
  (dolist (word words) (context-emit *context* (encode-word word))))

(defun advance-to (offset &optional (fill-byte #xFF))
  (let ((delta (- offset (context-address *context*))))
    (when (< offset 0)
      (error "Cannot advance to ~X, it is less than the current assembly address (~X)"
             offset (context-address *context*)))
    (context-emit *context* (make-array delta :initial-element fill-byte))))

(defun align (alignment &optional (fill-byte #xFF))
  (advance-to (* alignment (ceiling (context-address *context*) alignment)) fill-byte))

(defun label (name &key (offset 0) (context *context*))
  (assert (not (null context)))
  (delay name (offset)
    (+ offset
       (or (context-find-label context name)
           (error 'resolvable-condition
                  :path (format nil "Label ~A is undefined" name))))))

(defun set-label (name &optional (context *context*))
  (context-set-label context name)
  name)

You could define the simplest instruction emitters as follows:

(defun nop () (db #xEA))
(defun rti () (db #x40))
(defun rts () (db #x60))
...

This leaves open the question of how to handle the more complicated instructions which take an operand and support multiple addressing modes. One possibility would be to indicate the addressing mode in the function name, yielding lda.imm, lda.zp, lda.mem, etc. I opted for a different approach, where each addressing mode corresponds to a class, and the instruction encoder can select the opcode according to operand type. Worst case, you could define a generic function per instruction mnemonic, with a method for each addressing mode. This would be easy enough, but there's a better way.

The 6502/65C02/65C816 Instruction Set Decoded describes how the 6502 instruction set can be partitioned into three groups. Within each group, addressing modes are expressed consistently by certain patterns of bits within the opcode. With a handful of supporting definitions, the assembler can exploit this knowledge to minimize the manual labor required. For instance, my assembler defines the first group of instructions as follows, with an extra defmethod to handle the lone exception to the pattern:

;;; Group 1:
;;;        ORA     AND     EOR     ADC     STA     LDA     CMP     SBC
;;; (zp,X)  01      21      41      61      81      A1      C1      E1
;;; zp      05      25      45      65      85      A5      C5      E5
;;; #       09      29      49      69              A9      C9      E9
;;; abs     0D      2D      4D      6D      8D      AD      CD      ED
;;; (zp),Y  11      31      51      71      91      B1      D1      F1
;;; zp,X    15      35      55      75      95      B5      D5      F5
;;; abs,Y   19      39      59      79      99      B9      D9      F9
;;; abs,X   1D      3D      5D      7D      9D      BD      DD      FD

(defun group-1-addr-code (x)
  (typecase x
    (idxi #b000)  ;   (zero page,X)
    (zp   #b001)  ;   zero page
    (imm  #b010)  ;   #immediate
    (mem  #b011)  ;   absolute
    (indi #b100)  ;   (zero page),Y
    (zpx  #b101)  ;   zero page,X
    (aby  #b110)  ;   absolute,Y
    (abx  #b111)  ;   absolute,X
    (t (invalid-operand-error nil x))))

(defun group-1-asm (parameter opcode)
  (join-masks
   (join-masks (ash opcode 5)
               (ash (group-1-addr-code parameter) 2))
   #b01))

(def6502 ORA  group-1-asm #b000)
(def6502 ANDA group-1-asm #b001)
(def6502 EOR  group-1-asm #b010)
(def6502 ADC  group-1-asm #b011)
(def6502 STA  group-1-asm #b100)
(def6502 LDA  group-1-asm #b101)
(def6502 CMP  group-1-asm #b110)
(def6502 SBC  group-1-asm #b111)

(defmethod choose-opcode ((instruction (eql 'sta)) (operand imm))
  ;; One exception: STA with immediate destination makes no sense.
  (invalid-operand-error instruction operand))

With an assembler in Lisp, it's easy to define higher level control structures. Here I define a conditional ASIF and a simple looping macro, AS/UNTIL (the AS prefix is chosen to distinguish them from Lisp control structures, just as the AND and OR instructions are renamed to ANDA and ORA above to avoid collision with the CL operators of the same name):

(defmethod condition-to-branch ((condition symbol))
  (or
   (cdr
    (assoc condition
           '((:positive    . bmi)
             (:negative    . bpl)
             (:carry       . bcc)
             (:no-carry    . bcs)
             (:zero        . bne)
             (:not-zero    . beq)
             (:equal       . bne)
             (:not-equal   . beq)
             (:overflow    . bvc)
             (:no-overflow . bvs))))
   (error "Unknown condition ~A" condition)))

(defun assemble-if (branch-compiler then-compiler &optional else-compiler)
  (let ((else-sym    (gensym "ELSE"))
        (finally-sym (gensym "FINALLY")))
    (funcall branch-compiler (rel else-sym))
    (funcall then-compiler)
    (when else-compiler (jmp (mem (label finally-sym))))
    (set-label else-sym)
    (when else-compiler (funcall else-compiler))
    (set-label finally-sym)))

(defmacro asif (condition &body statements)
  (let ((then statements)
        (else nil)
        (part (position :else statements)))
    (when part
      (setf then (subseq statements 0 part)
            else (subseq statements (1+ part) nil)))
    `(assemble-if
      ',(condition-to-branch condition)
      (lambda () ,@then)
      ,(and else `(lambda () ,@else)))))

(defmacro as/until (condition &body body)
  (let ((sym (gensym)))
    `(with-label ,sym
       ,@body
       (funcall (condition-to-branch ',condition) (rel ',sym)))))

Another way to extend the assembler is by defining new types of contexts. One obvious thing you'd want is a local-context with its own symbol table, for defining nested scopes. Using this, you can define a cute procedure macro, defining its name in the surrounding context but enclosing the body in a local context:

(defmacro procedure (name &body body)
  `(progn
     (set-label ',name)
     (let ((*context* (make-instance 'local-context :parent *context*)))
       ,@body)))

A cooler trick is to define a cycle-counting-context: by specializing a method on context-emit-instruction, we can peek at each assembled instruction and tally up the number of cycles used in a block of straight-line code:

(defclass cycle-counting-context (delegate-code-vector
                                  delegate-symbol-lookup)
  ((cycle-count :initform 0 :accessor cycle-count :initarg :cycle-count)
   (precise-p   :initform t :accessor precise-p   :initarg :precise-p)))

(defmethod context-note-cycles ((context cycle-counting-context) num-cycles)
  (incf (cycle-count context) num-cycles))

(defmethod context-emit-instruction ((context cycle-counting-context) vector)
  (multiple-value-bind (cycles variable) (opcode-cycles (aref vector 0))
    (when variable (setf (precise-p context) nil))
    (if cycles
        (context-note-cycles context cycles)
        (warn "Don't know number of cycles for opcode ~X" (aref vector 0)))
    (call-next-method)))

(defmacro counting-cycles (&body body)
  `(let ((*context* (make-instance 'cycle-counting-context :parent *context*)))
     ,@body
     (cycle-count *context*)))

Coupled with a utility function emit-delay, this enables a macro called timed-section which can time a block of code and pad it out to consume a specific number of cycles, for precise cycle-timed loops. Here's a simple example from my test cart, using timed-section to produce a sawtooth wave through the 7-bit DAC, timing the loop by dividing the clock rate of the system by the target frequency (220 Hz) and the number of steps in the waveform (128):

(subprogram (sawtooth-220 "Sawtooth 220")
  (poke 0 +ppu-cr1+)                ; Disable NMI
  (poke 0 +ppu-cr2+)                ; Disable display
  (poke 0 +papu-control+)           ; Silence audio
  (ldy (imm 0))
  (timed-section ((round (/ +ntsc-clock-rate+ 220 128)) :loop t)
    (sty (mem +dmc-dac+))
    (iny)))

I'll confess that emit-delay and/or counting-cycles aren't 100% accurate, as I discovered when trying to wrap raster effect kernels with them, but they work well enough for calibrating the pitch of various audio hacks - most notably music-demo.lisp, which streams a surprisingly high quality loop of music. I should improve these.

Most of my test programs were using character ROMs from commercial games (appropriately, as my first MMC3 devcart still had the original CHR ROM soldered to the board). Before uploading those to github, I wanted to strip the graphics out. Since virtually all of the tools for editing NES graphics run on Windows, I threw together some basic functions for converting between GIF files (using the SKIPPY library) and 2-bit NES characters. This initiated a sequence of events culminating in a nifty little graphics demo, which you can watch on Youtube.

With my newfound ability to convert graphics and display them on the NES, I searched out a graphic online I could turn into another simple example to put under the assembler's hacks directory. Typing the name of the first artist I could think of into Google, I settled on Mark Ryden's "Fur Girl" - I hope he doesn't mind. I wanted to run this on my real NES using the EPROM cart I made from an old Gyromite board a few weeks ago, which constrained me to 32 KB for program data - more than enough - but only 8 KB graphics.

8 KB is enough for half a screen of unique graphics, but the NES divides the ROM into two 4 KB pages, typically one for background and another for sprites. I elected to fill the height of the screen and tile the image horizontally, alternating the coloring. To use both pages of ROM for background graphics, I have to hit one of the PPU control registers ($2000) at the right time mid-frame to switch pages. One glaring design flaw in the NES is the lack of a dedicated scanline counter or horizontal blank interrupt. Some cartridges rectify this with additional hardware that cleverly monitors the PPU address lines, but the basic NROM board I used had no such hardware. There are other techniques you might try, but the most basic and broadly applicable solution is a delay loop after some reference point (such as the beginning of the vertical blank) that spins until the necessary time has elapsed.

On top of the scrolling background image, I called the 64 sprites of the NES into play. I believe the demoscene refers to these as "sinebobs". Each sprite has a separate X and Y angle, indexing into a sine table to determine its X/Y screen coordinates. These are initialized to form a circle, and different methods of incrementing the angle variables produce different patterns of motion on screen. For instance, the effect of the circle splitting into four pieces and recombining is achieved by the following code, which increments the X angle only for every other group of 16 sprites:

(procedure split-by-4
  (jsr 'framestep)
  (ldx (imm 63))
  (as/until :negative
    (inc (abx table-y))
    (txa)
    (anda (imm 16))
    (lsr)
    (lsr)
    (lsr)
    (clc)
    (adc (abx table-x))
    (sta (abx table-x))
    (dex))
  (rts))

Looking at the girl's hair in the image, I thought it would be cool to try a wavy raster effect. This is done by reprogramming the scroll/address registers during the horizontal blanking period between scanlines, and is subject to the same timing constraints as changing the character ROM bank mid-frame. In fact, the timing for this must be tighter, because the visual glitch if you miss the timing window here is much more visible. I don't manage to get it 100% right, but in practice it looks pretty good. I do have a good excuse: nearly all of the processing each frame occurs before the mid-frame split point and must be written to execute in a constant number of CPU cycles. Even so, there are a number of factors that complicate CPU/PPU sychronization. Reading Consistent frame synchronization on the Nesdev wiki might make your head explode.

Timing all this caused a big problem for doing music: before coding the wavy effect, I'd brought in some music I'd written several years ago using the MML/MCK toolchain, calling the playback routine each frame after the screen split. At the time, there was nothing left to do after the split but wait for the vertical blank interrupt, so it was a perfect place to put the music and anything else that might take a variable number of CPU cycles. After adding the wavy effect, there was zero time left before the vertical blank. I ended up turning the screen off a few scanlines early (necessary, otherwise you'd notice the wave effect stop before reaching the bottom) and using that time to update the sprite positions and run the code controlling the overall sequence of patterns. There was no room there for the music.

There's a neat trick you can do on the NES to eyeball (literally) the amount of time a piece of code takes during the frame, by toggling the color emphasis bits in register $2001 before and after. Before removing the music, I timed the player in this way, illustrating its wildly variable execution time - from virtually none upward to perhaps 20 scanlines per frame. If it had taken only a few scanlines to execute, I'd have been okay turning the display off a little earlier to make time, but reserving enough time to accomodate the longest spikes would've seriously cut into the image.

There were two mid-frame delay loops (before and after the screen split) which could be shortened to provide plenty of time for music, if the player routine executes in a fixed number of machine cycles. It took a couple days of head scratching and feet dragging before I reduced my ambitions to nearly the simplest design imaginable - compile the music all the way down to a sequence of sound register writes. I defined a music 'frame' as sixteen address/value pairs (a reasonable upper bound), and with the assumption that particular frames would recur frequently, merged the duplicates and stored the song as an array of pointers, one per 60 Hz tick, to the sixteen memory writes performed for each frame.

I realize now that I could've written the music using any of the existing tools, easily converting it by modifying my emulator to log all the sound register writes during playback. I'd spent enough time initially considering more complicated player designs that the idea of having to invent my own tools had already stuck. No matter, I'd have probably done it this way regardless.

I built a miniature embedded language for composing the music based on the same ideas I used in my previous post playing with audio synthesis: the ability to repeat and combine audio sequentially and in parallel. This time around, rather than mixing audio samples, the basic building blocks combine lists of sound register writes:

(defun register (address value) (list value address))
(defun nop-write ()  (register #x0D 0)) ; Dummy write to unused register.

(defun pad-list (list padding desired-length)
  (assert (<= (length list) desired-length))
  (append list (loop repeat (- desired-length (length list)) collect padding)))

(defun pad-frame (frame)
  (pad-list frame (nop-write) 16))

(defun para (&rest args)
  (apply #'mapcar #'append
         (mapcar (lambda (x)
                   (pad-list x nil (reduce #'max args :key #'length)))
                 args)))

(defun seq (&rest args)
  (apply #'concatenate 'list args))

(defun repeat (n &rest args)
  (apply #'seq (mapcan #'copy-list (loop repeat n collect args))))

(defun segment (length list)
  (if (< (length list) length)
      (pad-list list nil length)
      (subseq list 0 length)))

(defun measure (&rest args)
  (segment 128 (apply 'para args)))

(defun rst (length) (segment length nil))    ; "Rest"

I then defined functions to control each sound channel. For instance, the NOISE function encodes its arguments as a set of writes to the noise channel registers, upon which I've defined several percussive sounds:

(defun noise (length duration period &key short loop (env t) (vol 15))
  (check-type duration (integer 0 31))
  (check-type vol (integer 0 15))
  (check-type period (integer 0 15))
  (segment length
    (list
     (list
      (register #xC (logior (if loop #x20 0)
                            (if env 0 #x10)
                            vol))
      (register #xE (logior (if short #x80 0)
                            period))
      (register #xF (ash (translate-length duration) 3))))))

(defun kick (length)
  (noise length 8 15 :vol 1))

(defun snare (length &optional (variation 0))
  (noise length 8 (+ 10 variation) :vol 1))

(defun hat (length &optional (variation 0))
  (noise length 4 (+ variation 1) :vol 1))

To make certain it's clear, I'll give an example. Here I evaluate (snare 8), meaning I want a snare sound that consumes 8 frames (or 8/60 = 0.13s) of time:

CL-USER> (write (dollhouse-demo::snare 8) :base 16)
(((1 C) (A E) (48 F)) NIL NIL NIL NIL NIL NIL NIL)

The outermost list is of length 8: each element is a list of memory writes to be performed on a particular frame, in the form (value address). Here, writes occur on the first frame, and the subsequent frames (empty lists) pad the sequence out to the desired length. In this way, rhythms can be built by concatenation. The address is taken relative to $4000, where the NES sound registers begin. Comparing with the list of noise channel registers, the first frame of writes can be interpreted as follows:

Store $1 to $400C: Set envelope length.
Store $A to $400E: Set shift register period.
Store $48 to $400F: Load note length counter and play.

I began building the song up as a series of local function definitions. The seq function combines its inputs sequentially. Here are three half-bar phrases, swagger, stagger, and jagger, which I combine in different orders to form all the drum patterns:

(swagger ()
  (seq
    (kick 16)
    (hat 8)
    (hat 8)
    (snare 16)
    (hat 8)
    (hat 8 4)))

(stagger ()
  (seq
    (hat 8)
    (kick 8)
    (hat 8)
    (hat 8)
    (snare 16)
    (rst 16)))

(jagger ()
  (seq
    (shaker 8 15)
    (shaker 8 4)
    (shaker 8 8)
    (shaker 8 12)
    (shaker 8 15)
    (shaker 8 5)
    (shaker 8 11)
    (shaker 8 14)))

Along with a thump achieved by sweeping the pitch of the triangle channel, specific drum patterns are built up by combining pieces in series and parallel. The measure function combines its arguments in parallel, ensuring the resulting length is one measure (128 frames) exactly. The drum patterns used in the first half of the music are defined as follows:

(four-on-the-floor ()
  (repeat 4 (thump 32 (et -24))))

(intro-beat ()
  (measure
    (four-on-the-floor)
    (seq
      (swagger)
      (swagger))))

(intro-fill-1 ()
  (measure
    (four-on-the-floor)
    (seq (swagger)
         (stagger))))

(intro-fill-2 ()
  (measure
    (four-on-the-floor)
    (seq (jagger)
         (jagger))))

Finally, I've built up to defining the music. Here, the para (parallel) operator combines its two inputs: a four measure drum pattern, constructed in an AAAB pattern from intro-beat and intro-fill-1, and a sequence of four arpeggiated chords, each one measure long. This defines the first four measures of the music:

(para
  (phrase-aaab
    (intro-beat)
    (intro-fill-1))
  (seq
    (measure (fat-arp 128 '(0.00   0  3  7 11) :rate 4 :volume (volramp  8 -1/22)))
    (measure (fat-arp 128 '(0.00   0  2  5  8) :rate 4 :volume (volramp  8 -1/22)))
    (measure (fat-arp 128 '(0.00  -2  7  8 12) :rate 4 :volume (volramp  9 -1/20)))
    (measure (fat-arp 128 '(0.00  -1  2  3  7) :rate 4 :volume (volramp 10 -1/18)))))

My arpeggiator functions burn through a lot of space in the ROM, so I was only able to fit a little over 30 seconds of music (which is just fine with me, because I was getting impatient to finish this). You could compress the music substantially, but I wasn't willing to complicate the playback routine (including doing anything requiring conditionals, for which I didn't feel like balancing the timing of both branches). The short music loop is appropriate to the repetitive visuals. Everything came together quickly, and I'm pleased with the result.

One idea I'm disappointed didn't work out was to gradually shift the tuning of the music downward, so that at the end it could appear to modulate upward to a higher key, but actually return to where it started. I'd need a longer loop of music for this to work well. I found I could only shift the tuning by one semitone over a thirty second loop without it being distracting. I'm particularly disappointed because the implementation was cute. Since the music is constructed and concatenated piece by piece, the individual units have no knowledge of where in the final timeline they will appear. This is a problem, because if I'm shifting the tuning continually, pitch becomes an implicit function of time. Since the pitches get encoded into bitfields written to the hardware, it wasn't reasonable to just do a final pass over the fully assembled music, shifting the pitches down.

I solved this by abusing the assembler's delayed evaluation mechanism, modifying the function translating equal tempered pitch to frequency, returning a promise object rather than an actual number. This promise will only resolve if the *tuning-root* is bound in the dynamic environment. After assembling the music, a final pass walks each frame of music, binding the *tuning-root* and forcing the promises to resolve (with a hack to the delayed evaluation framework to stop it from memoizing results of promises, in case a passage is repeated). This was relatively unobtrusive - since CL doesn't transparently support delayed evaluation, you do have to thread support through code that could operate on a promise value - but that only touched the pitch translation and a few sound register functions. I'd like to revisit this idea. It's the sort of neat trick that's usually too much hassle to bother with when you're using conventional MIDI and DAW software. The remains of the idea still exist in the music-test.lisp sandbox, but I stripped it out of the final demo source code.

Anyway, this stuff is a lot of fun.

Links:

6502 Assembler [github]
Dollhouse Demo [.lisp] [.nes] [youtube]
Music Demo [.lisp] [.nes]
NES Hacklets [.lisp] [.nes]

Piddling Plugins

2012-01-23T12:15:37Z

The Shuffletron music player, in various branches, has accumulated some neat features (particularly last.fm scrobbling in Brit Butler's branch) that deserve merging, and ought to be cleanly separated from the core of the program. Leslie Polzer sent me a novel implementation early on which used generic functions for extensibility, adding/removing methods via the MOP as plugins load/unload. Clever as that was (and I'm impressed how little code is required, rereading the patch now), I wasn't comfortable with it, and the lack of a pressing need for a plugin interface let me put it off for a good long while.

Building extensibility around generic functions seemed the right thing to do though, and a slightly different idea, of writing plugins in the style of mixins and calling CHANGE-CLASS to enable them at runtime, stuck in the back of my head until (with some prodding) I was motivated to try it out. It's hardly a new idea (both Gsharp and McCLIM contain implementations of similar ideas, as does the AMOP book, just to name a few examples), and a minimal implementation doesn't take much code at all:

(defvar *configurations* (make-hash-table :test 'equal))

(defun configuration (plugins)
  (or (gethash plugins *configurations*)
      (setf (gethash plugins *configurations*)
            (make-instance 'standard-class
                           :name (format nil "MY-APPLICATION~{/~A~}" plugins)
                           :direct-superclasses (cons (find-class 'my-application)
                                                      (mapcar #'find-class plugins))))))

(defun reconfigure (application plugins &rest initargs)
  (apply #'change-class application (configuration plugins) initargs))

(defun active-plugins (instance)
  (mapcar #'class-name (rest (sb-mop:class-direct-superclasses (class-of instance)))))

(defun enable-plugin (application plugin &rest initargs)
  (apply #'reconfigure application (adjoin plugin (active-plugins application)) initargs))

(defun disable-plugin (application plugin)
  (reconfigure application (remove plugin (active-plugins application))))

(defun make-application (&rest initargs)
  (apply 'make-instance (configuration '()) initargs))

This isn't an ideal implementation, and there's a limit to how good it's going to get when CLOS doesn't fully support anonymous classes. However, a more serious attempt should work on arbitrary classes, provide a place to hang init/shutdown code for plugins, and the ability to list which plugins are enabled within an instance.

Piddling Plugins

Piddling-plugins adds these features using only slightly more code than above, along with some superfluous macro magic for writing defun-style definitions that are extensible by plugins. I've made light use of it in a branch of Shuffletron, confirming to myself that it's a good fit.

The code is tiny and self-explanatory, so I'll just post the examples from the README file for fun.

Examples

Imagine we have written a music player, looking something like this deliberately simplified code:

(defclass music-player () ())

(defun run-music-player ()
  ;; You need to set or bind *application* to your application instance
  ;; if you use defun-extensible. It's a good idea even if you don't.
  (let ((*application* (make-instance 'music-player)))
    (init-audio)
    (init-library *application*)
    (loop (execute-command (read-line)))))

Functions extensible by plugins can be defined using DEFUN-EXTENSIBLE. This is just syntactic sugar for defining a generic function specialized on the application object, with a wrapper that passes in the value of *APPLICATION*.

(defun-extensible execute-command (command)
  ...)

(defun-extensible play-song (song)
  ...)

(defun-extensible song-finished (song)
  ...)

Plugins extend the behavior of the application by defining methods on the extensible functions (or rather the generic functions defined behind the scenes, which are prefixed by "EXTENDING-"):

(defclass scrobbler ()
  ((auth-token :accessor auth-token)))

(defmethod plugin-enabled (app (plugin-name (eql 'scrobbler)) &key &allow-other-keys)
  (setf (auth-token app) (get-auth-token))
  (format t "~&Scrobbler enabled.~%"))

(defmethod plugin-disabled (app (plugin-name (eql 'scrobbler)))
  (format t "~&Scrobbler disabled.~%"))

(defmethod extending-song-finished :after ((plugin scrobbler) song)
  (scrobble song (auth-token plugin)))

(defclass status-bar () ())

(defmethod extending-play-song :after ((plugin status-bar) song)
  (redraw-status-bar))

(defmethod extending-execute-command :after ((plugin status-bar) command-line)
  (declare (ignore command-line))
  (redraw-status-bar))

To enable a plugin:

(enable-plugin *application* NAME [INITARGS...])

To disable a plugin:

(disable-plugin *application* NAME)

To set precisely which plugins are enabled:

(reconfigure *application* LIST-OF-PLUGINS [INITARGS...])

References

Strandh R., Hamer J., Baumann G. "Using Stealth Mixins to Achieve Modularity" (2007)
- Implentation in Gsharp: http://common-lisp.net/cgi-bin/gitweb.cgi?p=projects/gsharp/gsharp.git;a=blob;f=utilities.lisp
"Modes" implementation in McCLIM's ESA framework (formerly part of Climacs)
- http://git.boinkor.net/gitweb/mcclim.git/blob/HEAD:/ESA/utils.lisp#l446
Throwaway classes (comp.lang.lisp): http://groups.google.com/group/comp.lang.lisp/browse_thread/thread/78ef4a5fcd6a1661?pli=1
The Art of the Metaobject Protocol, Section 2.4
- http://www.foldr.org/~michaelw/lisp/amop-programmatic-class.lisp
ContextL - http://common-lisp.net/project/closer/contextl.html
Dynamic Classes - http://common-lisp.net/project/dynamic-classes/

Fun with Lisp: Just Intonation and Microtonality

2012-01-17T08:18:57Z

If you're interested in Lisp, audio/music hacking, just intonation, or microtonality, then this is the sort of thing you're interested in.

First, we'll need a way to play audio. In the past, I dumped the raw audio out to a file in /tmp and played it by shelling out to SoX. These days I can just play it out of an array in memory using my Mixalot library (of which this code requires the latest version, having only recently added support for playback of floating point vectors).

Audio playback through Mixalot is straightforward:

(defparameter *mixer* (mixalot:create-mixer))

(defgeneric play (this))

(defun normalize (vector)
  (let ((rescale (/ (reduce #'max vector :key #'abs :initial-value 0.0d0))))
    (map-into vector (lambda (x) (* x rescale 0.8d0)) vector)))

(defmethod play ((this vector))
  (mixalot:mixer-add-streamer
   *mixer*
   (mixalot:make-vector-streamer-mono-double-float
    (normalize this))))

Next, synthesis - we'll need some audio to play. I'll define a function of frequency called TONE that produces a buffer of audio:

(defparameter *len* 1 "Note length")

(deftype buffer () '(simple-array double-float 1))
(defun make-buffer (size) (make-array size :element-type 'double-float :adjustable nil :fill-pointer nil))

;;; Generate an audible tone.
(defun tone (freq &key (duration 40000) (len *len*))
  (declare (optimize (speed 3)))
  (loop with nsamples = (round (* duration len))
        with output = (the buffer (make-buffer nsamples))
        with decay-rate = (expt 0.07 1/65000)
        with omega = (float (/ (* freq 2.0d0 pi) 44100.0d0) 0.0d0)
        for amp of-type double-float = 1.0d0 then (* amp decay-rate)
        for phase of-type double-float = 0.0d0 then (+ phase omega)
        for n from 0 below nsamples
        do (setf (aref output n)
                 (* amp
                    ;; A simple FM (PM) oscillator. Tweaking the magic
                    ;; numbers produces a variety of mostly chime-like
                    ;; timbres.
                    (sin (+ phase (* 1.5 (expt amp 2) (sin (* phase 5)))))))
        finally (return output)))

Next I'll define a simple language for constructing musical phrases from the output of this function. There are two fundamental building blocks:

1. Sequencing of events serially in time:

(defun seq (&rest args) (apply #'concatenate 'buffer args))

..of which repetition is a special case:

(defun repeat (n &rest args) (apply #'seq (mapcan #'copy-list (loop repeat n collect args))))

2. Events in parallel:

(defun para (&rest args)
  (reduce (lambda (out in) (declare (type buffer out in)) (map-into out #'+ out in))
          args :initial-value (make-buffer (reduce #'max args :key #'length))))

Originally I wrote a simpler definition for this:

(defun para (&rest args) (apply #'map '(simple-array double-float 1) #'+ args))

This defintion has the disadvantage of truncating the output length to that of the shortest component. Also, using SBCL, it's much slower. (apply #'map ...) is a hairy expression that defied optimization by the compiler, whereas it can inline the map-into operation. Combined with the type declaration, it expands to a nice fast addition loop.

Here's some syntactic sugar to make the pieces fit together more nicely, and print some useful information to the REPL:

(defmacro chord (properties &body body) `(let ,properties (print :chord) (para ,@body)))

(defparameter *tonic* 261.0d0)          ; Middle C.

(defmacro just (numerators denominators &rest args)
  `(progn
     ;; It's useful to see the both reduced fraction and its decimal representation:
     (print (list ',numerators ',denominators
                  (* ,@numerators (/ 1 ,@denominators))
                  (float (* ,@numerators (/ 1 ,@denominators)))))
     (tone (* *tonic* ,@numerators (/ 1 ,@denominators)) ,@args)))

Now, to combine these tools to some musical end. First test: start with a major chord, invert the intervals each way we can, then resolve down to an inversion of the original chord. Note the two different senses of "invert".

(play
 (seq
  (chord ()
   (just (1) (1))                       ; Root
   (just (5) (4))                       ; Major 3rd - 5:4
   (just (3) (2)))                      ; Fifth - 3:2
  (chord ()
   (just (1) (1))
   (just (4) (5))                       ; 5:4 becomes 4:5 - The major 3rd is reflected about the octave.
   (just (3) (2)))
  (chord ()
   (just (1) (1))
   (just (5) (4))
   (just (2) (3)))                      ; This time, the fifth.
  (chord ()
   (just (1) (1))
   (just (4) (5))                       ; - Now both are reflected.
   (just (2) (3)))                      ; -
  (chord ()                             ; Resolve down..
   (just (1) (1))
   (just (5) (4 2))
   (just (3) (2 2)))))

Here's a pair of chords used by Harry Partch (see http://en.wikipedia.org/wiki/Tonality_flux):

(let ((*tonic* 196.0)
      (*len* 3))
 (play
  (repeat 2
   (seq
    (chord ()
     (just (8)  (7))
     (just (10) (7))
     (just (12) (7)))
    (chord ()
     (just (7) (6))
     (just (7) (5))
     (just (7) (4)))))))

See what he did there? The major chord, built starting 8/7 above the tonic, is reflected around the octave. I find it clearer to consider the minor chord first, built upon an interval of 7/6 above the tonic, then interpret the major as as built symmetrically downward from the next octave.

It's clearer after rewriting the fractions without simplification to separate the 8:7 and octave components from the intervals of the chord:

(let ((*tonic* 196.0)
      (*len* 3))
 (play
  (repeat 2
   (seq
    (chord ()
     (just   (8 1) (1 7))               ;  8/7
     (just   (8 5) (4 7))               ; 10/7
     (just   (8 3) (2 7)))              ; 12/7
    (chord ()
     (just (2 7 1) (1 8 1))             ; 7/4, i.e. (2*7*1)/(1*8*1), if it isn't clear.
     (just (2 7 4) (5 8 1))             ; 7/5
     (just (2 7 2) (3 8 1)))))))        ; 7/6

Applying that construction under equal temperament, the middle notes of the chords would be the same. Since this is just-intoned, the frequencies differ by about a third of a semitone, and we find ourselves in the uncanny valley of microtonal voice leading.

I've never developed an ear for microtonal music, so I'll run with the idea of this pivoting around the octave and try something conventional. Take the same two chords, add a minor chord on the tonic (without the 8/7 offset) before, and its reflection around the next octave after. Then tack on a little ending to make a more satisfying musical snippet: move down by a fourth, then back, with a couple added notes for color.

(let ((*tonic* 196.0)
      (*len* 2))
  (play
   (seq
    (chord ()                           ; 1
      (just (1) (1))
      (just (6) (5))
      (just (3) (2)))
    (chord ()                           ; 2
      (just (8  ) (  7))
      (just (8 5) (4 7))
      (just (8 3) (2 7)))
    (chord ()                           ; 3: Built downward from next octave, symmetric with 2.
      (just (2 7 2) (3 8))
      (just (2 7 4) (5 8))
      (just (2 7 1) (1 8)))
    (chord ()                           ; 4: Built downward from next octave, symmetric with 1.
      (just (2  ) (1))
      (just (2 5) (6))
      (just (2 2) (3)))

    ;; Build and release tension.
    (chord ((*len* 3))
      (just (2 3  ) (  4))
      (just (2 3 4) (3 4))
      (just (2 3 3) (2 4)))
    (chord ((*len* 1))
      (just (2 3  )   (    4))
      (just (2 3 4)   (  3 4))
      (just (2 3 3)   (  2 4))
      (just (2 3 4 4) (3 3 4)))         ; 4/3*4/3, let's call it a dominant seventh.
    (chord ((*len* 4))
      (just (1) (1))
      (just (6) (5))
      (just (3) (2))
      (just (2) (1))
      (just (3) (1))))))                ; ..and that's a ninth. The 7th resolved here.

Stacking fourths:

(let ((*tonic* 262.0)
      (*len* 2))
  (play
   (seq
    (chord ()
      (just (1) (1))
      (just (4) (3)))
    (chord ()
      (just (   ) (   ))                ; Did I mention the ones are optional?
      (just (4  ) (  3))
      (just (4 4) (3 3)))
    (chord ()
      (just (     ) (     ))
      (just (4    ) (    3))
      (just (4 4  ) (  3 3))
      (just (4 4 4) (3 3 3)))
    (chord ()
      (just (       ) (       ))
      (just (4      ) (      3))
      (just (4 4    ) (    3 3))
      (just (4 4 4  ) (  3 3 3))
      (just (4 4 4 4) (3 3 3 3)))
    (chord ()
      (just (         ) (         ))
      (just (4        ) (        3))
      (just (4 4      ) (      3 3))
      (just (4 4 4    ) (    3 3 3))
      (just (4 4 4 4  ) (  3 3 3 3))
      (just (4 4 4 4 4) (3 3 3 3 3))))))

Stacking fifths and fourths:

(let ((*tonic* 262.0)
      (*len* 1))
  (play
   (seq
    (chord ()
      (just (   ) (   ))
      (just (3  ) (  2))
      (just (3 4) (3 2)))
    (chord ()
      (just (   ) (   ))
      (just (4  ) (  3))
      (just (4 4) (3 3)))
    (chord ((*len* 2))
      (just (     ) (     ))
      (just (3    ) (    2))
      (just (3 3  ) (  4 2))
      (just (3 3 4) (3 4 2)))
    (chord ()
      (just (     ) (     ))
      (just (4    ) (    3))
      (just (4 4  ) (  3 3))
      (just (4 4 4) (3 3 3)))
    (chord ()
      (just (     ) (     ))
      (just (3    ) (    2))
      (just (3 4  ) (  3 2))
      (just (3 4 4) (3 3 2)))
    (chord ((*len* 4))
      (just (     ) (     ))
      (just (4    ) (    3))
      (just (4 3  ) (  2 3))
      (just (4 3 4) (3 2 3))))))

Various ways to express the a major triad:

(play
 (seq
  (chord ()                             ; Three separate notes.
    (just (1) (1))
    (just (5) (4))
    (just (3) (2)))
  (chord ()
    (just (1    ) (    1))
    (just (1 5  ) (  4 1))              ; A major 3rd..
    (just (1 5 6) (5 4 1)))             ; ..and a minor 3rd on top of that.
  (chord ()
    (just (1    ) (    1))
    (just (1 3  ) (  2 1))              ; Or, you could nest the third inside
    (just (1 3 5) (6 2 1)))))           ; the fifth by a downward interval.

The Tristan Chord (in equal temperament)

(play
 (chord ((*tonic* 349.0)                ; F
         (*len* 3))
   (tone (* *tonic* (print (expt 2.0  0/12))))
   (tone (* *tonic* (print (expt 2.0  6/12))))
   (tone (* *tonic* (print (expt 2.0 10/12))))
   (tone (* *tonic* (print (expt 2.0 15/12))))))

Assume we're in A minor, and the chord is inverted such that the root is B. The tritone between B and F is problematic. It's an unnatural interval in just-intonation, and there are various ways to interpret it relative to the other notes.

(play
 (chord ((*tonic* 440.0)
         (*len* 3))
   (just (9    ) (    8))               ; B
   (just (9 5  ) (  4 8))               ; B * 5/4 = D#
   (just (9 5 4) (3 4 8))               ; D * 4/3 = G#

   ;; Now we need that F. Three ways to get there spring to mind:

   ;; 1. Two intervals of 3/4 downward from D#. Yields intervals of
   ;; 45/64, 9/16, and 27/64 versus the other notes in the chord, and
   ;; an ungainly 405/512 versus the tonic. The ratios are ugly, but
   ;; the sound is quite close.
   ;; (just (9 5 9) (16 4 8))

   ;; 2. An intervals of 5/9 downward from D# yields intervals of
   ;; 25/36, 5/9, and 5/12 versus the rest of the chord, and 25/32
   ;; against the tonic. The pitch ratios within the chord are mostly
   ;; nice and simple, but the F sounds oddly flat.
   ;; (just (9 5 5) (9 4 8))

   ;; 3. An interval of 7/10 downward from the root, yielding
   ;; intervals of 7/10, 14/25, and 21/50 versus the rest of the
   ;; chord, and 63/80 against the tonic. Constructing the F relative
   ;; to the root of the chord seems preferable, even if it introduces
   ;; a new factor of 7 into the ratios, which make the intervals
   ;; against D# and G# odd. Overall, I prefer the sound of this
   ;; one. The F is slightly flat compared to the equal-tempered
   ;; chord, but not unpleasantly so.
   (just (9 7) (10 8))))

When you uncomment more than one of the above versions of 'F', they're slightly detuned and beat against each other. This could be a cool compositional device to highlight shifts in the tonality. I'll try it with the two Partch chords:

(let ((*tonic* 196.0)
      (*len* 3))
 (play
  (repeat 2
    (seq
     (chord ()
       (just   (8 1) (1 7))
       (just   (8 5) (4 7))
       (just   (8 3) (2 7)))
     (chord ()
       (just   (8 1) (1 7))
       (just   (8 5) (4 7))
       (just (2 7 4) (5 8 1))           ; Presages the following chord..
       (just   (8 3) (2 7)))
     (chord ()
       (just (2 7 1) (1 8 1))
       (just (2 7 4) (5 8 1))
       (just (2 7 2) (3 8 1)))
     (chord ()
       (just (2 7 1) (1 8 1))
       (just (2 7 4) (5 8 1))
       (just   (8 5) (4 7))             ; And again..
       (just (2 7 2) (3 8 1)))))))

That suggests a more subtle trick. Rather than playing both tones to mark the shift, replace one with the similar tone from the next chord.

(let ((*tonic* 196.0)
      (*len* 3))
 (play
  (repeat 2
    (seq
     (chord ()
       (just   (8 1) (1 7))
       (just   (8 5) (4 7))
       (just   (8 3) (2 7)))
     (chord ()
       (just   (8 1) (1 7))
       (just (2 7 4) (5 8 1))           ; Replaced (8 5) (4 7) to lead into the next chord.
       (just   (8 3) (2 7)))
     (chord ()
       (just (2 7 1) (1 8 1))
       (just (2 7 4) (5 8 1))
       (just (2 7 2) (3 8 1)))
     (chord ()
       (just (2 7 1) (1 8 1))
       (just   (8 5) (4 7))             ; Likewise, replaced (2 7 4) (5 8 1)
       (just (2 7 2) (3 8 1)))))))

That's all for now. I've published the code on Github here.

Incidentally, I've concluded my world tour (my Thailand visa having expired, and an additional season of leisure and international intrigue being financially unwise), so if you're looking for a versatile young Lisp/C/C++ hacker with a background in computer/network security and an equal penchant for spiffy user interfaces and gritty low-level trawling around in debuggers and disassemblers, you could do worse than to get in touch.

Lispm archaeology: Compiler Protocols

2012-01-09T11:45:57Z

Skimming through the Genera source just now, I enjoyed this description of the compiler structure (from sys2/compiler_protocol.lisp), which precedes a very modern-feeling definition of the interface in terms of classes (or rather Flavors) and generic functions. I wonder who wrote it.

;;; This file defines the base flavors for compiler objects and their protocols.
;;;
;;; The function of a compiler object is fairly simple: it must translate some
;;; program source into an appropriate object representation, and put that representation
;;; somewhere.
;;;
;;; A compiler object is made up of several components, which may be inter-related:
;;; - The Language Parser, which differentiates between various dialects of Lisp
;;; - The Target Architecture on which the object representation should run
;;; - The Compilation Environment
;;; - The Intermediate-Representation Optimizer
;;; - The Compilation Target, which actually disposes of the object representation
;;; (e.g. load it into virtual memory, or store it in a file)
;;;
;;; A Language Parser is responsible for all of the steps required to translate
;;; the source into an intermediate representation, including all source-to-source
;;; and source-to-pseudo-source transformations. [By pseudo-source we mean constructs
;;; which are similar in syntax to those of the source language, but which may not be
;;; understood correctly by an interpreter of the source language - "compiler-only forms",
;;; to put it another way.] The Language Parser may make use of the Target Architecture,
;;; and will certainly make use of the Compilation Environment.
;;;
;;; The task of the Target Architecture is to translate the program from its intermediate
;;; representation into an object representation that corresponds to the Instruction-Set
;;; Architecture of the machine on which the target is to be run. [Note that a "machine"
;;; can be a software emulation as well as a physical computer.] As previously stated, the
;;; Target Architecture may also be used by the Language Parser in the source-to-intermediate
;;; translation step. The Target Architecture may also interact with the
;;; Intermediate-Representation Optimizer, as described below.
;;;
;;; The Compilation Environment contains an evaluator and definitions that are needed at
;;; compile-time. Its main function is to support macroexpansion and compile-time
;;; error-checking.
;;;
;;; The Intermediate-Representation Optimizer does just what its name implies. It bases its
;;; decisions on advise from the user (e.g. the CL OPTIMIZE declaration). It may interact
;;; with the Target Architecture when the optimization is more easily implemented or disabled
;;; at this level, rather than during the intermediate-to-object translation.
;;;
;;; The Compilation Target's reponsibility is to put the object representation somewhere.
;;; This could either be the local Lisp virtual memory, a remote Lisp, either running on
;;; another piece of hardware or in a software emulation, or a file of some kind.

McPixel, a frivolous lisp hack.

2010-01-31T07:26:03Z

Yesterday, I had the idea that it would be easy and entertaining to hack together a toy application for drawing and animating pixel art. Some hours later, McPixel was born. It provides an editable grid of pixels, a color palette, and allows you to string sequences of images together into animations. It's a toy, but someone might find it amusing. Obligatory screenshot:

Features:

80's retro McCLIM user interface.
No documentation or online help.
Maximally frustrating color sliders, using IHS colorspace.
Intuitive modeless drawing UI, achieved by including only a pencil tool.
Saves/loads files only in its own format, based on unportable s-expressions.
Requires X11 and SBCL with threads, to keep out the riffraff.
User-editable brush shape.
Remap Color and Silhouette commands, for tracing previous frames.
Realtime animated preview plays while you work.

I'm not sure I'll ever put this to productive use, if a productive use for such a thing even exists, but there you have it.

Update: I've added the ability to export an animated GIF file, using Xach Beane's Skippy library. Here's the "turtle.anim" example file, exported as a GIF:

Adventures in Lisp application deployment

2009-07-05T11:28:41Z

Previously I mentioned my simple music player in CL, Shuffletron. Shuffletron uses save-lisp-and-die on SBCL or save-application on CCL to create a standalone executable, and is launched by a wrapper script that invokes it with rlwrap when available. It depends on several foreign libraries (more than I expected, in fact), and there were an alarming number of problems with the binaries I'd originally posted, all related to these library dependencies. I think I've solved them, though not necessarily in an optimal way.

The first problem, observed and fixed before the publically released binaries, was an issue where cffi-grovel (on behalf of Osicat) created a shared library with some auto-generated C wrappers for various functions, which the saved executable now expected to reopen at startup. I didn't realize this until my first user reported it dying at startup with an error about not finding /home/hefner/clbuild/source/osicat/posix/wrappers.so, followed by "a lot of lisp-looking gook." One solution would have been to include the library with the program and install it where SBCL could find it, but at the time I was opposed to including extra libraries with the program, so instead I took the C source to this library and linked it into SBCL's runtime executable. This has the unfortunate consequence that I have to build the binaries from a customized SBCL, but it solved the immediate problem.

The next problem was simple - on machines without the libc6 development package installed, the program failed at startup, unable to load librt. This was a simple matter of Osicat not using the best choice of name by which to load the library, a problem which has since been fixed. To be doubly certain, I modified the build script to close this library before saving the executable, because I wasn't using any functions from it anyway.

The most aggravating problems I encountered were with the libmpg123 library. Some users reported "undefined alien function" errors whenever they tried to play a song. Others reported a scary error about stack alignment as soon as the problem started. To some extent I haven't solved these (in the sense that Mixalot users and people building from source may still get bitten by them) so much as hacked around them for the sake of the binary release. There were two basic problems:

On 32-bit Linux, with newer versions of libmpg123 than my Debian-running laptop happens to have, the compile-time choice of large file support breaks binary compatibility with the libmpg123 library, wreaking havoc with the FFI bindings. Specifically, if large file support is enabled, a number of symbols change names, e.g., mpg123_open becomes mpg123_open_64. This is irritating and not how I'd have done it (for instance, I don't think the version number of the shared library changes to indicate the break in compatibility), but I could've easily worked around it in mpg123-ffi by detecting which version is present at the time the library is initialized. I very nearly did so, were it not for the following problem:

On 32-bit Linux, due to the desire to have properly aligned data when using SSE instructions, recent versions of GCC provide support for aligning stack frames along larger boundaries, such as 16 bytes. The mpg123 developers seem to take this support as sufficient justification to ignore the platform ABI, introducing dubious stack alignment checks at every entry point to the library. This is not something I know how to work around from the CFFI binding in a reasonable fashion, so for the time being I've given up on adapting to such hostile versions of the library. Fortunately, I've absorbed enough trivia eavesdropping on the SBCL hackers on IRC to know that Darwin uses 16 byte alignment for precisely the same reason, so SBCL must support it, and after a few minutes searching I hacked the align-stack-pointer macro in SBCL's x86 backend to enable the 16 byte alignment on Linux as well, which appears to work around the problem (at the cost of my build environment getting even stranger). I also rebuilt the libmpg123 library with --disable-largefile and, just to be thorough, --disable-aligncheck, and set my CFLAGS to -mstackrealign, two measures which I think should've sufficed to solve the issue even without a hacked SBCL.

The 32-bit Linux/x86 binary now includes a rebuilt version of libmpg123, renamed libmixalot-mpg123, with these changes. The 64-bit binary doesn't have any of these problems, and should Just Work, but you have to provide your own libmpg123 as before. My mistake, of course, was using libmpg123, but I wasn't aware of libmad when I made that choice, and I'm not enthusiastic about rewriting otherwise perfectly working code on account of these issues (although I probably will, sooner or later). My current binaries, in conjunction with Shuffletron 0.0.3 (featuring various minor improvements), should be free of these problems, but still haven't been as widely tested as I'd like. The lesson to me, obvious in retrospect, is to test these things on a more diverse set of configurations than my own machines (particularly when they all run the same release of Debian), even when it seems so simple that nothing could go wrong.

Miscellaneous Lisp Hackery

2009-07-01T07:09:24Z

Here's a few things I've been working on lately which may be of broader interest:

Bordeaux-FFT is a small library for computing the FFT/IFFT on complex data, originally written by Robert Strandh (and/or Sylvain Marchand and Martin Raspaud), with contributions by Paul Khuong and myself. Last summer I did some audio processing experiments, originally using the FFT code from Sapaclisp. Robert helpfully volunteered his FFT implementation, which I cleaned up slightly and have been cheerfully employing in various audio hacks ever since. Several versions have changed hands through email, lisppaste, and my web server, so I've finally come around to collecting the changes, writing a brief manual, and tarring up a release. It's surprisingly fast, particularly with Paul Khuong's recent work on SBCL, although I don't know how it stacks up against some of the highly tuned assembly language implementations out there. I use it along with my fledgling task queuing code to grind out batches of FFTs across four CPU cores.

Shuffletron is a simple music player in CL, with a few interesting features. I've been running this program full time for several weeks now as my preferred music player. It snuck on to the lisp subreddit before I really announced it, and I'm sure folks on IRC are already sick of hearing about it, so I won't say much. I began with plans for a much more ambitious player, with a fancy graphical interface, and wrote the first version of this one Saturday realizing I needed something simple to put the audio code through its paces while I wrote the full player, intending to include this one as an example program with Mixalot. It worked better than expected, so I ended up fleshing out the feature set instead and decided that it was really all I needed. The code is lean and mean.

I've had a number of problems trying to produce redistributable binaries of this which I believe I've finally solved (although new binaries are forthcoming). I hope to write about these later.

Mixalot is the audio back-end of Shuffletron, factored into its own system(s) because it might be useful for other purposes. It includes a mixer which pulls audio from any number of streamer objects and outputs them to ALSA. It also includes FFI definitions for libmpg123 with some helpers for decoding MP3 files and reading ID3 tags, and a streamer class for decoding and playing MP3 files in real time. The libmpg123 portions are usable independently of the audio mixing/output code.

Interval sequences

2008-08-19T06:11:45Z

Lately I've done some programming in Factor, and one feature I've grown fond of is that integers are considered sequences, usable with map and other combinators. As an excuse to take the extensible sequences protocol for a spin, I implemented this in CL (or really SBCL, since I don't think any other implementations have implemented extensible sequences).

The extensible sequences protocol requires that sequences be subtypes of the SEQUENCE class. I didn't like this at first, wanting to implement sequences directly on integers, but soon decided that wrapping things up in a class wasn't so bad - I can just write (below n) instead of n, and it suggested that I go a little further and implement intervals as sequences. Using the constructors below and interval, I can write the following:

(map 'vector 'list #(a b c d e) (below 3)) => #((A 0) (B 1) (C 2))
(map 'list '1+ (interval 20 25)) => (21 22 23 24 25)

Only a few definitions are needed to make this work:


;;; Interval sequence class

(defclass interval-sequence (sequence standard-object)
  ((minimum :reader minimum :initform 0 :initarg :minimum)
   (length  :reader sequence:length :initarg :length)))

;;; Constructors
  
(defun below (n)
  (unless (>= n 0)
    (error 'type-error
           :datum n
           :expected-type '(integer 0)))
  (make-instance 'interval-sequence :length n))

(defun interval (min max)
  (unless (<= min max)
    (error "Interval minimum must be less than or equal to maximum"))
  (make-instance 'interval-sequence :minimum min :length (- max min)))

;;; Core sequence protocol

(defmethod sequence:elt ((interval interval-sequence) index)
  (with-slots (minimum length) interval
    (unless minimum
      (error "Attempt to read from an uninitialized interval"))
    (when (or (< index 0) (>= index length))
      (error 'type-error
             :datum index
             :expected-type `(integer 0 ,(1- length))))
    (+ index minimum)))

(defmethod (setf sequence:elt) (new-value
                                (interval interval-sequence)
                                index)
  (with-slots (minimum length) interval
    (cond
      ((or (< index 0) (>= index length))
       (error 'type-error
              :datum index
              :expected-type `(integer 0 ,(1- length))))
      ((null minimum)
       (setf minimum (- new-value index))
       new-value)
      ((/= new-value (+ minimum index))
       (error "Incompatible setf of interval element - expected ~A, got ~A"
              (+ minimum index) new-value))
      (t new-value))))

(defmethod sequence:adjust-sequence ((interval interval-sequence) length 
                                     &key initial-element initial-contents)
  (declare (ignore interval length initial-element initial-contents))
  (error "Interval sequences are immutable"))

(defmethod sequence:make-sequence-like 
    ((interval interval-sequence) length
     &key (initial-element nil iep) (initial-contents nil icp))
  (declare (ignore initial-element initial-contents))
  (when (or iep icp)
    (error "Can't create intervals using initial-element/initial-contents."))
  (make-instance 'interval-sequence :minimum nil :length length))

An odd bit above is the notion of uninitialized sequences (where length is known, but not the minimum) and the behavior of (setf elt). Intervals are considered immutable, but (setf elt) is permitted provided it would not change the sequence. It is also permitted when minimum is unset, in which case it completes initialization by setting minimum to (- newvalue index). Intended to support initialization of intervals by map, this allows a neat trick:

(map 'interval-sequence (lambda (x) (+ x 7)) (below 5)) => #<INTERVAL-SEQUENCE [7,12)>

I thought there was some chance that remove would just work in the case where the element is on an end of the interval. It doesn't. The reason is that generic remove is implementing by calling delete on a copy of the sequence. As there is no way to distinguish destructive operations on a full copy during initialization from any other time, it seems like any immutable sequence has a bit more work to do in implementing the (non-destructive) utility functions.

I've filed my implementation away here in case anyone is interested.

user-homedir-pathname

2008-07-09T22:04:42Z

CL-USER> (defun ~ (name) (merge-pathnames name (user-homedir-pathname)))
~
CL-USER> (~ "foo")
#P"/home/hefner/foo"
CL-USER> (~"cl/foo/myhack.lisp")
#P"/home/hefner/cl/foo/myhack.lisp"
CL-USER>

Not as nice as Zach Beane's approach, of course.

Fascinating.

2008-05-30T06:26:05Z

Ruby continues to close the gap with lisp - Dwemthy's Array combines the taste and sophistication of defclass* with the clarity and convenience of MOP hackery (and a touch of the exuberant insanity evident in Casting SPELs in Lisp). Spotted on Planet Smalltalk, where Nicholas Chen inexpicably plays along.

McCLIM and subpixels

2008-05-13T21:29:06Z

I'm not a big fan of subpixel antialiased text, but it is technically neat and not difficult to implement, so for fun I started adding it to McCLIM's mcclim-truetype package. Since mcclim-truetype doesn't do hinting, the fonts are considerably more blurry, albeit less distorted, than what you get from libfreetype (and consequently mcclim-freetype). I thought subpixel AA might be of particular help due to this.

I hacked up a quick version which rendered the glyphs at 3x the normal horizontal resolution, filtered the resulting alpha mask to reduce color fringing, then combined triplets of pixels into a component alpha mask to use with Xrender. This didn't look bad - softer but more clearly defined.

Shortly thereafter I encountered this page suggesting that the subpixels of an LCD panel are not evenly spaced, but instead grouped together with a slight gap between the RGB triplets. If that's true, such a display must distort the image compared to my expectations, pinching together the triplets of subpixels. I tried to verify this on my Thinkpad's display - I think the grouping is visible, but my camera lens wasn't really up to it.

This suggests we do things slightly differently:

With that in mind, I hacked in a second mode which renders at 4x the original width, filters the result, and maps the first three of every four alpha pixels to an LCD subpixel (discarding the fourth). This should (I hope) provide less distortion in the mapping from the coordinate system of our glyphs to the physical display. This approach also looks pretty good, and it's sharper than the previous approach due to the filter width effectively shrinking by 3/4 on account of the higher resolution. I can't say either approach is clearly better.

Here are all three for comparison:

For whatever reason, the character spacing gets thrown a bit out of whack (in addition to our already not bothering to use the kerning tables). Figuring this out is next on the agenda.

In remembrance of bindings past

2008-05-10T20:06:22Z

While grepping my way around cl-opengl to write some simple test code, I've stopped to reflect on the various CL OpenGL bindings over the years. There have been at least three, not including the GLX protocol implementation in telent CLX, each with slightly different interfaces.

Ages ago (2002), I used a set of OpenGL bindings for CMUCL, converted from Allegro, with a dubious non-commercial use license. A simple function to draw a white circle might look like the following:

(gl:glClearColor 0.3 0.0 0.0 0.3)
(gl:glClear gl:GL_COLOR_BUFFER_BIT)
(gl:glColor3f 1.0 1.0 1.0)
(gl:glBegin gl:GL_TRIANGLE_FAN)
(loop for theta from 0.0 by (/ pi 0.5 64)
      repeat 64
      do (gl:glVertex2f (float (+ -1.0 (* 2.0 x) (* radius (sin theta))) 0.0f0)
                        (float (+ 1.0 (* -2.0 y) (* radius (cos theta))) 0.0f0)))
(gl:glEnd)

..Although given the name prefixes, I could've imported the GL package with no worries.

Several years later, I played around with CL-SDL, which includes its own GL package. It named things a bit differently, making them slightly lispier without really deviating from the C API. Translated for these bindings, the snippet above should look something like this:

(gl:clear-color 0.3 0.0 0.0 0.3)
(gl:clear gl:+color-buffer-bit+)
(gl:color-3f 1.0 1.0 1.0)
(gl:begin gl:+triangle-fan+)
(loop for theta from 0.0 by (/ pi 0.5 64)
      repeat 64
      do (gl:vertex-2f (float (+ -1.0 (* 2.0 x) (* radius (sin theta))) 0.0f0)
                       (float (+ 1.0 (* -2.0 y) (* radius (cos theta))) 0.0f0)))
(gl:end)

I've never used the GL support provided by CLX, but it looks like the above would work there too. I'm not sure if there was any conscious effort to model one after the other - which came first?

In 2008 we have cl-opengl. It provides a considerably lispier interface, handling the argument types itself, and using keywords in place of bitmasks (with compiler macros to optimize the helpfulness away).

(gl:clear-color 0.3 0.0 0.0 0.3)
(gl:clear :color-buffer-bit)
(gl:color 1.0 1.0 1.0)
(gl:begin :triangle-fan)
(loop for theta from 0.0 by (/ pi 0.5 64)
      repeat 64
      do (gl:vertex (+ -1.0 (* 2.0 x) (* radius (sin theta)))
                    (+ 1.0 (* -2.0 y) (* radius (cos theta)))))
(gl:end)

Hopefully this is the last set of OpenGL bindings I'll have to learn. I'm not sure which style I prefer - cl-opengl is undeniably more pretty, while the old Allegro/CMUCL bindings have a nice 1:1 mapping with C code (you shouldn't ever have to grep around to verify what things are named), and the clx/cl-sdl style is somewhere in the middle.

A comparison of the half dozen or so Gtk bindings might be more interesting, since Gtk is considerably more intricate.

Incidentally, does anyone know the origin of the term "binding" for such a library interface?

file / (setf file)

2008-04-01T07:04:45Z

Found this lying around..

(defun file (filename)
  (with-open-file (in filename)
    (with-standard-io-syntax ()
      (let ((*read-eval* nil))
        (read in)))))

(defsetf file (filename) (object)
 `(with-open-file (out ,filename 
                       :direction :output 
                       :if-exists :supersede
                       :if-does-not-exist :create)
    (with-standard-io-syntax ()
     (pprint ,object out))))

If I put this in my init file, what are the odds I'll use it more than once?