Saturday, October 15, 2011

phosphene: Fractal video feedback as a PC master boot record

A few months ago, I wrote a Julia set fractal renderer for the demo challenge hosted by io.smashthestack.org.

This program runs in 16-bit x86 real mode, without any operating system. It's formatted as a PC master boot record, which is 512 bytes long. Subtracting out space reserved for a partition table, we have only 446 bytes for code and data.

Programming in such a restricted environment is quite a challenge. It's further complicated by real mode's segmented addressing. Indexing an array bigger than 64 kB requires significant extra code — and that goes double for the video frame buffer. With two off-screen buffers and a 640 × 480 × 1 byte video mode, much of my code is devoted to segment juggling.

I spent a long time playing with code compression. In the end, I couldn't find a scheme which justifies the fixed size cost of its own decoder. It seems that 16-bit x86 machine code is actually pretty information-dense. For a bigger demo or 32-bit mode (with bigger immediate operands) I'd definitely want compression.

It's totally feasible to enter 32-bit protected mode within 446 bytes, but there's little gained by doing so. You lose easy access to the PC BIOS, which is the only thing you have that resembles an operating system or standard library.

You can browse the assembly source code or grab the MBR itself. It runs well in QEMU, with or without KVM, and I also tested it on a few real machines via USB boot. With QEMU on Linux it's as simple as

$ qemu -hda phosphene.mbr

Thanks to Michael Rule for the original idea and for tons of help with tweaking the rendering algorithm. His writeup has more information about this project.

Wednesday, October 12, 2011

Slides from "Why learn Haskell?"

Yesterday I gave a talk on the topic of "Why learn Haskell?", and I've posted the slides [PDF]. Thanks to MIT's SIPB for organizing these talks and providing tasty snacks. Thanks also to the Boston Haskell group for lots of useful feedback towards improving my talk.

If you'd like to adapt my slides for your own venue, the source is available under a CC-By-SA license. I rendered the PDF using pandoc and Beamer.

Monday, October 10, 2011

shqq: Embedding shell commands in Haskell code

Shell scripts make it easy to pass data between external commands. But shell script as a programming language lacks features like non-trivial data structures and easy, robust concurrency. These would be useful in building quick solutions to system administration and automation problems.

As others have noted,12345 Haskell is an interesting alternative for these scripting tasks. I wrote the shqq library to make it a little easier to invoke external programs from Haskell. With the sh quasiquoter, you write a shell command which embeds Haskell variables, execute it as an IO action, and get the command's standard output as a String. In other words, it's a bit like the backtick operator from Perl or Ruby.

Here's a small example:

$ ghci -XQuasiQuotes
λ> import System.ShQQ
λ> let x = "/proc/uptime" in [sh| sha1sum $x |]
"337ec3fb998fb3a4650a18e0785f0992762b3cda  /proc/uptime\n"

shqq also handles escaping for you, so that the shell will not interpret special characters from Haskell variables. You can override this behavior when desired.

The big caveat is that shqq refuses to build on GHC 7.0 or earlier, due to a Unicode-handling bug in process-1.0. You'll need GHC 7.2 or later.

Finding duplicate files

As an example, here's a program to find duplicate files in the directory tree rooted at the current working directory.

{-# LANGUAGE QuasiQuotes, TupleSections #-}
import Control.Concurrent.Spawn -- package spawn-0.3
import Data.List.Split -- package split-0.1
import System.ShQQ -- package shqq-0.1
import System.Posix.Files
import qualified Data.Map as M

First, the computation itself. If we pair each file with a key, such as size or checksum, we can find the groups of (potentially) duplicate files.

dupes :: (Ord k) => [(FilePath,k)] -> [[FilePath]]
dupes = filter (not . null . drop 1) . M.elems
. foldr (\(v,k) -> M.insertWith (++) k [v]) M.empty

We want to examine files in parallel, but the operating system will complain if we have too many open files. We limit each pass to have at most 256 tests in progress at once.

inParallel :: (a -> IO b) -> [a] -> IO [b]
inParallel f xs = do p <- pool 256; parMapIO (p . f) xs

For efficiency, we find potential duplicates by size, and then checksum only these files. We use external shell commands for checksumming as well as the initial directory traversal. At the end we print the names of duplicated files, one per line, with a blank line after each group of duplicates.

main :: IO ()
main = do
files <- endBy "\0" `fmap` [sh| find -type f -print0 |]

let getSize f = ((f,) . fileSize) `fmap` getFileStatus f
sizeDupes <- dupes `fmap` inParallel getSize files

let getSha f = ((f,) . head . words) `fmap` [sh| sha1sum $f |]
shaDupes <- dupes `fmap` inParallel getSha (concat sizeDupes)

mapM_ (mapM_ putStrLn . (++[""])) shaDupes

And we run it like so:

$ ghc -O -threaded -rtsopts dupe.hs
$ ./dupe +RTS -N

I included type signatures for clarity, but you wouldn't need them in a one-off script. Not counting imports and the LANGUAGE pragma, that makes 10 lines of code total. I'm pretty happy with the expressiveness of this solution, especially the use of parallel IO for an easy speedup.

Thanks to Dylan Lukes for the original idea for this library.

Tuesday, September 13, 2011

debug-diff: Colorized diffs between Haskell values

Today I uploaded a small library for comparing Haskell values using a textual diff. This has served me well when diagnosing failing tests, or comparing a function with a proposed replacement.

Let's try it on some disassembled x86 code:

$ ghci
λ> :m + Hdis86 Debug.Diff Data.ByteString 
λ> let f = disassemble amd64 . pack 
λ> diff (f [0x31,0xff,0x41,0x5e,0x48,0x89,0xc7]) 
        (f [0x31,0xff,0x41,0x5c,0x48,0x89,0xc7])
--- /tmp/ddiff_x15061   2011-09-13 22:52:13.911842969 -0400 
+++ /tmp/ddiff_y15061   2011-09-13 22:52:13.911842969 -0400 
@@ -1,3 +1,3 @@
 [Inst [] Ixor [Reg (Reg32 RDI), Reg (Reg32 RDI)],
- Inst [Rex] Ipop [Reg (Reg64 R14)], 
+ Inst [Rex] Ipop [Reg (Reg64 R12)], 
  Inst [Rex] Imov [Reg (Reg64 RDI), Reg (Reg64 RAX)]]

This uses groom as a pretty-printer, and shells out to colordiff by default.

Sadly, a textual diff does not always produce usable results. I'm also interested in generic diffs for algebraic data types. There are some packages for this (1, 2) but I haven't yet learned how to use them. This could also be a good application for the new generics support in GHC 7.2.

Saturday, September 3, 2011

Lambda to pi

I gave a talk a while back which included an interpreter for the pi-calculus, and a compiler from the lambda-calculus to it. I didn't really do justice to the material in a few slides, so here's a proper blog post.

This article is available as a Literate Haskell file, which you can load into GHCi directly.

The π-calculus

If the λ-calculus is a minimal functional language, then the π-calculus is a minimal concurrent language. There's basically only three things we can do:

  • Fork a concurrent thread of execution

  • Create message channels and send them through other message channels

  • Loop forever

There's a conventional syntax for the π-calculus, which I don't much care for. Since we're writing an interpreter in Haskell, we'll use Haskell datatypes as our only syntax for the π-calculus.

import Control.Concurrent
(forkIO, Chan, newChan, readChan, writeChan)

import Control.Applicative
import Control.Monad
import Control.Monad.State
import qualified Data.Map as M

Here's the abstract syntax of the π-calculus:

type Name = String

data Pi
= Pi :|: Pi
| Rep Pi
| Nil
| New Name Pi
| Out Name Name Pi
| Inp Name Name Pi
| Embed (IO ()) Pi

Names are bound to message channels, and the only thing we can send through a channel is another channel.

newtype MuChan = Wrap (Chan MuChan)

type Env = M.Map Name MuChan

Repetition and forking are straightforward:

run :: Env -> Pi -> IO ()

run env (Rep p) = forever (run env p)

run env (a :|: b) =
let f = forkIO . run env
in f a >> f b >> return ()

We also have a base-case program that does nothing:

run _ Nil = return ()

And we have three operations on channels. (New bind p) creates a new channel, binds it to the local name bind, then does p:

run env (New bind p) = do
c <- Wrap <$> newChan
run (M.insert bind c env) p

(Out dest msg p) sends the channel msg to the channel dest, then does p:

run env (Out dest msg p) = do
let Wrap c = env M.! dest
writeChan c (env M.! msg)
run env p

(Inp src bind p) reads a channel from src, binds it to the local name bind, then does p:

run env (Inp src bind p) = do
let Wrap c = env M.! src
recv <- readChan c
_ <- forkIO $ run (M.insert bind recv env) p
return ()

Why does Inp invoke forkIO? It's so that Inp under Rep is always available to receive a message, even if a subprogram is blocking on something else. You can think of this as an identity (Rep x)(x :|: Rep x). So we fork a new thread for each "connection", like the UNIX daemons of yore. If we're not under Rep then this is unnecessary but harmless.

Embed is something I threw in so that we can observe our program's execution from its side-effects:

run env (Embed x a) = x >> run env a

Compiling from the λ-calculus

Sending channels through channels is an interesting model, but how many algorithms can we really implement this way? It turns out that the π-calculus can implement any computable function. We'll demonstrate this by writing a compiler from λ-terms to π-terms.

Here's a simple, untyped lambda calculus with effects:

data Lam
= Lam :@: Lam
| Var Name
| Abs Name Lam
| Eff (IO ()) Lam

We'll use a state monad as a source of fresh names. For simplicity, we assume that the input λ-terms do not use any names beginning with '_'.

type M a = State [Name] a

runM :: M a -> a
runM = flip evalState ['_' : show (x :: Integer) | x <- [1..]]

fresh :: M Name
fresh = state (\(x:xs) -> (x,xs))
-- With mtl version 1, use 'State' not 'state'

withFresh :: (Name -> r) -> M r
withFresh f = f <$> fresh

Our compiler will produce π-calculus code which needs to send and receive pairs of values. We can encode a pair as a channel with two values enqueued. mkInp2 and mkOut2 construct functions for receiving and sending pairs, respectively.

mkInp2 :: M (Name -> (Name, Name) -> Pi -> Pi)
mkInp2 = withFresh $ \pair from (bind1, bind2) p ->
Inp from pair $
Inp pair bind1 $
Inp pair bind2 $
p

mkOut2 :: M (Name -> (Name, Name) -> Pi -> Pi)
mkOut2 = withFresh $ \pair dest (from1, from2) p ->
New pair $
Out pair from1 $
Out pair from2 $
Out dest pair $
p

Now we come to the compiler itself. The π-term produced by compile k e should evaluate the λ-term e and send the result to the "continuation channel" named by k.

compile :: Name -> Lam -> M Pi
compile k (Var x) = return (Out k x Nil)
compile k (Eff eff a) = Embed eff <$> compile k a

We implement a function as a concurrent process which receives arguments through a channel, and sends back results. ("Lambda as a Service"?) The channel elements are pairs of (function argument, channel where result should be sent).

compile k (Abs x b) = do
inp2 <- mkInp2
f <- fresh
ret <- fresh
body <- compile ret b
return $
New f $
Out k f $
Rep $
inp2 f (x, ret) body

Note that the compiler allocates a fresh name for ret just once, but this name is bound to a different channel by each request.

A function application compiles according to the usual call-by-value rule: evaluate the function, evaluate the argument, then apply. Actually, these steps happen in three concurrent processes, but the "apply" process demands the argument value before sending it to the function, so we end up implementing strict semantics.

compile k (f :@: x) = do
out2 <- mkOut2
[f_cont, f_val, x_cont, x_val] <- replicateM 4 fresh
f_proc <- compile f_cont f
x_proc <- compile x_cont x
let app_proc
= Inp f_cont f_val $
Inp x_cont x_val $
out2 f_val (x_val, k) Nil
return $
New f_cont $
New x_cont $
(f_proc :|: x_proc :|: app_proc)

At the top level of a program, we still need a continuation channel. But we'll never read from this channel, because we're only running the program for its effects.

lambdaToPi :: Lam -> Pi
lambdaToPi b = runM $ do
k <- fresh
New k <$> compile k b

Testing the compiler

We'll test the compiler by doing some arithmetic on Church numerals.

-- \m n f -> n (m f)
e_mult :: Lam
e_mult = Abs "m" . Abs "n" . Abs "f" $
(Var "n" :@: (Var "m" :@: Var "f"))

-- \f x -> f (f (f (... x)))
e_church :: Int -> Lam
e_church n = Abs "f" . Abs "x" $
foldr (:@:) (Var "x") (replicate n $ Var "f")

-- \n -> n (\x -> trace "S" x) (trace "0" n)
e_shownum :: Lam
e_shownum = Abs "n" $
Var "n" :@: (Abs "x" (Eff (putChar 'S') (Var "x")))
:@: (Eff (putChar '0') (Var "n"))

-- compute 2 times 3
e_test :: Lam
e_test = e_shownum :@: (e_mult :@: e_church 2 :@: e_church 3)

And we run it like so:

GHCi> run M.empty (lambdaToPi e_test)
GHCi> 0SSSSSS

The answer of 6 is printed to the terminal, asynchronously, in unary.

Notes

I thought up this particular scheme for compiling to the π-calculus, but it's probably been documented already.

I'm not sure my π-calculus interpreter is correct. In particular, the term (Rep (x :|: y)) is a forkbomb, when it should be operationally equivalent to (Rep x :|: Rep y). I don't know if fixing this would be easy or hard.

Edward Kmett wrote an interpreter and pretty-printer for the π-calculus, in the style of "Finally Tagless, Partially Evaluated" [PDF] by Carette, Kiselyov, and Shan.

Wednesday, August 31, 2011

New slides and how I made them

New slides

I've posted PDFs of slides from some talks I gave a while ago.

First-Class Concurrency in Haskell covers topics in concurrent imperative programming, such as:

This turned out to be far too much material for a one-hour talk, so the slides are probably more valuable than the talk itself. I'm also thinking of expanding the π-calculus bits into a proper blog post at some point.

High-level FFI in Haskell covers tricks for making bindings to C libraries that feel more like native Haskell libraries. Most of the examples are drawn from my hdis86 library . This includes:

  • Translating C types to idiomatic Haskell types

  • Passing Haskell functions as C function pointers

  • Passing ByteStrings as C buffers

  • Automatic locking and memory management of library state

  • Exposing a C library's state machine as a lazy pure function

  • Bundling a C library with Cabal while also allowing dynamic linking

These slides were available before, in a somewhat strange HTML format. The new PDFs are more portable and I think they look nicer, too.

How I made the slides

I originally wrote the slides in Markdown format and converted them to a S5 slideshow using pandoc. This was a great way to quickly prepare slides, including syntax-highlighted Haskell code. However I ran into a few limitations:

  • Slide layout depends on window size and screen resolution, rendering my obsessive tweaking useless. In some cases the text would run off the edge of the screen or overlap other elements.

  • The slides don't work at all in Chromium, as of the S5 version I used initially. I also got reports of issues with other browsers.

I wanted to switch over to Beamer, as I'd seen some very high-quality slides produced using that package. This would also provide a PDF that renders exactly the same on every machine. Fortunately, pandoc can output LaTeX code suitable for Beamer. I can keep using the lightweight syntax of Markdown, and most of my old slide source code works as-is. Once again pandoc handles a tricky problem with ease.

I followed this scheme with a few modifications. For example, pdflatex was unhappy with slides ("frames") containing verbatim text environments. The solution was to declare all frames as "fragile", whatever that means:

\begin{frame}[fragile]

Recent versions of pandoc accept the --listings option and will use the LaTeX listings package to render nicely-formatted source code. This article was helpful for configuring listings. The default Haskell style has a rather odd definition of what counts as a keyword, so I wrote a custom language definition. I ended up with this LaTeX header, which you can pass to pandoc using -H:

\usepackage{listings}
\usepackage{color}

\lstdefinelanguage{Haskell_mod}{
otherkeywords={.., ::, |, <-, ->, @, ~, =, =>},
morekeywords={
case, class, data, default, deriving, do, else,
foreign, if, import, in, infix, infixl, infixr,
instance, let, module, newtype, of, then, type,
where, _, forall, ccall },
sensitive,
morecomment=[l]--,
morecomment=[n]{\{-}{-\}},
morestring=[b]"
}[keywords,comments,strings]

\lstset{
language=Haskell_mod,
basicstyle=\ttfamily,
keywordstyle=\color[rgb]{0,0,1},
commentstyle=\color[rgb]{0.133,0.545,0.133},
stringstyle=\color[rgb]{0.627,0.126,0.941},
showstringspaces=false,
frame=single
}

The Markdown sources for the slides are available: 1, 2.

My biggest remaining complaint is that I have a lot of explicit spacing commands, e.g. \vspace{1em}. These are used for logical grouping, and so can't be fully inferred, but maybe there's a better (partial?) solution.

Saturday, March 19, 2011

x86 disassembly in Haskell with hdis86

The first serious projects I coded in Haskell were compilers, code analyzers, and the like. I think it's a domain that really plays to the strengths of the language. So it makes sense that we'd want a top-notch disassembler library for Haskell.

udis86 is a fast, complete, flexible disassembler for x86 and x86-64 / AMD64. It provides a clean C API, which was no trouble to import using hsc2hs. But any C API is going to feel clunky next to high-level idiomatic Haskell code. So I built two additional layers of wrapping, to make something that will feel like a natural part of your next Haskell app.

You can download my library hdis86 from Hackage, or browse the source at GitHub. By default, a copy of udis86 is embedded in hdis86. If you already have udis86 installed as a shared library, you can link against that instead.

Getting started

Let's try it out. We'll feed in a ByteString of machine code, and pretty-print the result with groom.

$ ghci
λ> :m + Hdis86 Data.ByteString Text.Groom
λ> let code = pack [0xcc, 0xf0, 0xff, 0x44, 0x9e, 0x0f]
λ> Prelude.putStrLn . groom $ disassemble intel64 code
[Inst [] Iint3 [],
 Inst [Lock] Iinc
   [Mem
      (Memory{mSize = Bits32, mBase = Reg64 RSI, mIndex = Reg64 RBX,
              mScale = 4, mOffset = Immediate{iSize = Bits8, iValue = 15}})]]

If you're not familiar with x86, you might be surprised by the range of simple and complicated instructions. The first instruction is a humble int3, which executes a trap to a debugger. It takes no operands and has no prefixes.

The second instruction is an increment of a 32-bit memory region, whose address is computed by summing the value in register RSI, the value in register RBX times a scale factor of 4, and a fixed offset of 15. This instruction also has a lock prefix, which changes its concurrency semantics. Some prefixes have a direct meaning like this; others (like Rex) will change how the disassembler decodes operands.

We can also ask for Intel-style assembly syntax:

λ> let cfg = intel64 { cfgSyntax = SyntaxIntel }
λ> mapM_ (Prelude.putStrLn . mdAssembly) $ disassembleMetadata cfg code
int3 
lock inc dword [rsi+rbx*4+0xf]

Analyzing instructions

If we're just printing code, showing an Instruction is needlessly verbose. The real point of the Instruction type is machine-code analysis, with the help of Haskell's pattern matching capabilities.

Sometimes two fragments of code will differ only in which registers they use. Perhaps two compilers made different choices during register allocation. We'll write a program to detect this.

import Hdis86
import Text.Groom
import Control.Monad
import qualified Data.Map as M
import qualified Data.ByteString as B

When one code fragment uses register X the same way that another fragment uses register Y, we record a constraint X :-> Y:

data Constraint = Register :-> Register

We compare the two code fragments to produce a list of Constraints, or Nothing if they differ in ways beyond register selection. We'll use this helper function to check a list of Boolean conditions:

(==>) :: [Bool] -> a -> Maybe a
ps ==> x = guard (and ps) >> Just x

We compare operands pairwise. Register operands are easy:

operand :: Operand -> Operand -> Maybe [Constraint]
operand (Reg rx) (Reg ry) = Just [rx :-> ry]

For a memory operand, we need to check that the size, scale, and offset are equal:

-- size, base register, index register, scale, offset
operand (Mem (Memory sx bx ix kx ox)) (Mem (Memory sy by iy ky oy))
= [sx == sy, kx == ky, ox == oy] ==> [bx :-> by, ix :-> iy]

Immediate operands need a similar check for equality, but they don't produce any register constraints:

operand (Ptr   px) (Ptr   py) = [px == py] ==> []
operand (Imm ix) (Imm iy) = [ix == ix] ==> []
operand (Jump ix) (Jump iy) = [ix == iy] ==> []
operand (Const ix) (Const iy) = [ix == iy] ==> []

In all other cases, we have two different operand constructors, which means they don't match:

operand _ _ = Nothing

To check a pair of instructions, we check their prefixes and opcodes, then check operands pairwise:

inst :: Instruction -> Instruction -> Maybe [Constraint]
inst (Inst px ox rx) (Inst py oy ry) = do
guard $ and [px == py, ox == oy, length rx == length ry]
concat `fmap` zipWithM operand rx ry

Once we have a list of Constraints, we need to check it for consistency. If register X maps to Y in one place, it can't map to Z somewhere else:

unify :: [Constraint] -> Maybe (M.Map Register Register)
unify = foldM f M.empty where
f m (rx :-> ry) = case M.lookup rx m of
Nothing -> Just (M.insert rx ry m)
Just ry' -> [ry == ry'] ==> m

Now we put it all together, checking consistency in both directions:

regMap :: [Instruction] -> [Instruction] -> Maybe (M.Map Register Register)
regMap xs ys = do
cs <- concat `fmap` zipWithM inst xs ys
let swap (x :-> y) = (y :-> x)
_ <- unify $ map swap cs
unify cs

main :: IO ()
main = putStrLn . groom $ regMap (f prog_a) (f prog_b) where
f = disassemble intel64

We'll test these two code fragments:

prog_a, prog_b :: B.ByteString
prog_a = B.pack
[ 0x7e, 0x3a -- jle 0x3c
, 0x48, 0x89, 0xf5 -- mov rbp, rsi
, 0xbb, 1, 0, 0, 0 -- mov ebx, 0x1
, 0x48, 0x8b, 0x7d, 0x08 ] -- mov rdi, [rbp+0x8]
prog_b = B.pack
[ 0x7e, 0x3a -- jle 0x3c
, 0x48, 0x89, 0xf3 -- mov rbx, rsi
, 0xbd, 1, 0, 0, 0 -- mov ebp, 0x1
, 0x48, 0x8b, 0x7b, 0x08 ] -- mov rdi, [rbx+0x8]

And the result is:

$ runhaskell regmap.hs 
Just
  (fromList
     [(RegNone, RegNone), (Reg32 RBX, Reg32 RBP),
      (Reg64 RBP, Reg64 RBX), (Reg64 RSI, Reg64 RSI),
      (Reg64 RDI, Reg64 RDI)])

In reality, this analysis is grossly incomplete. Some instructions have implicit register operands, and some pairs of registers overlap, like EBX and RBX. And we have to understand contextual requirements. It's not okay to remap RAX to RBX if some calling code is expecting a return value in RAX.

The complexity of x86 (not to mention the halting problem) means that binary code analysis will never be easy. Hopefully hdis86 can be one of many useful tools in this domain. As always, suggestions or patches are welcome.