Tenerife Skunkworks

Grand Central Dispatch

2010-04-21T19:55:00+02:00

Now that Grand Central Dispatch is part of iPhone OS 4.0, I would like to showcase its unique benefits for inter-thread communication.

Passing data from one thread to another is normally a royal pain on the Mac, something involving the use of Mach ports, something I’d rather not talk about. Ever! Assuming that your threads use Core Foundation or Cocoa, your threads have a run loop and you can shuffle bits of data back and forth with no trouble whatsoever. You can even do it in C++.

We will look at running a code block in another thread and waiting for it to finish (synchronous execution), as well as running a block in another thread and having it run a callback that we supply (asynchronous execution).

Let’s grab a few required header files and get started!

#include <tr1/memory>
#include <iostream>
#include <vector>

#include <Block.h>
#include <dispatch/dispatch.h>

This is the chunk of data we will be throwing around. Feel free to expand it as you see fit.

class Data
{
public:
  Data() {}
};

We want to be good memory managers and collect more than a few bits of data.

typedef std::tr1::shared_ptr<Data> DataRef;
typedef std::vector<DataRef> BitsOfData;

A block type is different from a function pointer in that it uses a ‘hat’ (⁾ instead of a ‘star’ (*). We want to know how our operation went so we return an integer error code.

// Custom block
typedef int (^OurBlock)(void);

We need a callback type for asynchronous execution. Once or block runs on some other thread, it will invoke our callback and pass the error code from the operation (block) that we just executed. Note that our callback is also a block.

// Generic callback     
typedef void (^OurCallback)(int status);

We are using C++ so let’s make another callback, one that takes both the status from the block we just executed and the bits of data we collected in the process.

// Data bits callback    
typedef void (^DataBitsCallback)(int status, BitsOfData& bits);

We will assume that there’s a single thread that we want to talk to, running somewhere, all lonely. There is nothing preventing you from passing the run loop as an argument, though. You do need to have a reference to the run loop, though, no way around it!

// Run loop for the thread we want to talk to    
extern CFRunLoopRef __TheOtherRunLoop;

Synchronous execution of a block uses a semaphore for synchronization. We want to tell the other thread to run the block for us and we want to sit quietly until we are told that the block has finished executing.

// Run synchronously

int RunSync(OurBlock block)
{
  // use an error code to capture the result of the operation

  __block int status = 0;

  // and a semaphore to wait until the operation has completed

  dispatch_semaphore_t sema = dispatch_semaphore_create(0);

  // enqueue the block on the target run loop

  CFRunLoopPerformBlock(__TheOtherRunLoop, kCFRunLoopDefaultMode, ^{

    // run the block we created previously

    status = block();

    // and signal that we are done

    dispatch_semaphore_signal(sema);

  });

  // wake up the target run loop 

  CFRunLoopWakeUp(__TheOtherRunLoop);

  // hold on until we are done above

  dispatch_semaphore_wait(sema, DISPATCH_TIME_FOREVER);

  // dispose of the semaphore 

  dispatch_release(sema);

  // and return the error code

  return status;
}

Note that we both wait forever on the semaphore and give the run loop of the target thread a gentle bump to remind it that there’s work to do.

Running a block asynchronously is conceptually simple: we tell the other thread to run the block, the other thread tells us to run the callback once it’s done. There are no semaphores and no waiting.

// Run asynchronously

void RunAsync(OurBlock block, OurCallback callback)
{
  // callback will run in the caller thread 
  // and use the caller's run loop 

  CFRunLoopRef callbackRunLoop = CFRunLoopGetCurrent();

  // enqueue a block on the target run loop 

  CFRunLoopPerformBlock(__TheOtherRunLoop, kCFRunLoopDefaultMode, ^{

    // do the work

    int status = block();

    // enqueue a block on the caller's run loop 

    CFRunLoopPerformBlock(callbackRunLoop, kCFRunLoopDefaultMode, ^{

      // and make the block invoke the callback and pass the status code

      callback(status);

    });

    // wake up the caller's run loop 

    CFRunLoopWakeUp(callbackRunLoop);
  });

  // wake up the target run loop

  CFRunLoopWakeUp(__TheOtherRunLoop);
}

This is what a sample operation (block) look like. Note that we need to allocate the block on the heap rather than the stack (default). This is where Block_copy comes in. We want nothing more than to collect a few bits of data into a vector, making sure no exceptions excape the block. We will not need to change the block code for synchronous and asynchronous execution. Hurray for code reuse!

OurBlock MakeCollectBits(BitsOfData& bits)
{
  // allocate block on the heap

  return Block_copy(^{

    int status = 0;

    cout << "We right here!" << endl;

    // no exceptions can excape the block!

    try
    {
      DataRef bit1(new Data);
      bits.push_back(ref1);
    }
    catch (...)
    {
      cout << "Unknown exception" << endl;
      status = -1;
    }

    return status;
  });
}

Here is what synchronous collection of bits looks like. Note that we need to use deallocate a block and release its resources once we no longer need it. This is where Block_release comes in.

// Synchronous gathering of data bits

int CollectBits(BitsOfData& bits)
{
  // create the block and "capture" bits 

  OurBlock block = MakeCollectBits(bits);

  // run the block synchronously

  int status = RunSync(block);

  // release memory allocated to the block

  Block_release(block);

  // we are done

  return status;
}

Running asynchronously requires us to run a given callback after we are done. We also must release the block we were asked to run. We work around this by creating a callback on the fly that first releases the block and then runs the callback we were given.

// Asynchronous gathering of data bits

void CollectBitsAsync(BitsOfData& bits, DataBitsCallback callback)
{
  // create a closure as before

  OurBlock block = MakeCollectBits(bits);

  // run asynchronously and trigger a callback created on the fly

  RunAsync(block, ^(int status) {

    // we are inside "OurCallback" here and need to clean up 
    // the bit collection block first and foremost

    Block_release(block);

    // invoke the data bits callback, 
    // giving it what we have collected

    callback(status, bits);
  });
}

Let me know if you have any questions!

Tracking IO Patterns in Memory-mapped Dynamic Libraries

2009-11-02T19:06:00+01:00

The Mac OSX dynamic linker uses mmap to load dynamic libraries into memory. The memory range occupied by the libraries is then backed by a set of virtual memory pages, chunks of 4096 bytes each.

Using mmap is efficient because pages are lazily loaded from disk as needed and the virtual memory pager is free to evict them behind the scenes when memory is needed for something else.

Each page is filled with code for functions that live in the dynamic library and pages are fetched from disk when a call is made to a function in the dynamic library.

Pages should be accessed sequentially for best performance but how do you find out if this is the case? The only way to find out is to plug into the virtual memory manager and track when pages backing a particular dynamic library are paged-in from disk.

This is doable but a tad complicated as it requires access to internal kernel structures. As always, DTrace comes to the rescue! Note that the following DTrace script will only work on Snow Leopard. Let’s take it apart and see how it works…

First we define a an alias for an internal kernel type. This is not necessary but saves on typing.

typedef struct nameidata* nameidata_t;

A dynamic library is usually opened with a call to dlopen. The first argument (arg0) is the library path.

pid$target::dlopen:entry
/arg0/
{
 self->ppath = arg0;
 self->dylib = 1;
}

The Mac OSX dynamic linker (dyld) does not use dlopen on dynamic libraries, though, so we need to do different.

pid$target::dyld??loadPhase5*:entry,
pid$target::dyld??loadPhase4*:entry
/!self->dylib && arg0/
{
 self->path = copyinstr(arg0);
 self->func = probefunc;
 self->dylib = 1;
}

We want to trigger subsequent probes only if we entered via one of the two entry points above. We need to reset the flag once we return and this is what we do below.

pid$target::dlopen:return
{
 self->dylib = 0;
}

pid$target::dyld??loadPhase5*:return,
pid$target::dyld??loadPhase4*:return
/self->func != 0 && self->func == probefunc/
{
 self->dylib = 0;
}

It often happens that memory we want to access in DTrace is not available at the function entry point. This is what happens sometimes with the dlopen entry probe. The open call is triggered by dlopen so we can copy the file path into kernel space using the self->ppath pointer we saved earlier.

/* file name memory should be wired in by now */

pid$target::open:entry
/self->dylib && self->ppath && self->path == 0/
{
 self->path = copyinstr(self->ppath);
}

The Mac OSX virtual memory manager identifies a file by its virtual node (vnode) in the virtual filesystem (VFS) layer. We need to somehow match up the dynamic library name with its vnode and this is where the vn_open_auth entry probe comes in.

Note that unlike the DTrace pid$target provider we used before, we use the Function Boundary Tracing (FBT) provider since the virtual filesystem layer lives in the kernel.

fbt::vn_open_auth:entry
{
 self->ndp = (nameidata_t)arg0;
}

This clause is not absolutely necessary but I’m populating self->curpath as a shortcut, to be used a few times in later probes.

/* wait to make sure ndp and vnode are fully populated */

fbt::vn_open_auth:return
/self->path != 0/
{
 self->curpath = stringof((self->ndp)->ni_pathbuf);
}

It’s not obvious how to best match up a vnode with a file name so I cheated and studied the XNU kernel source code which Apple makes available. The vnode is not populated until vn_open_auth returns so we have to wait until it happens fo fetch the path.

We are almost done with our task, just need to save the library name and library path to vnode mappings if our library names match.

/* make sure we are opening the same file */

fbt::vn_open_auth:return
/self->curpath != 0 && self->path == self->curpath/
{
 this->vp = (vnode_t)(self->ndp)->ni_vp;
 this->lib = stringof((this->vp)->v_name);
 self->lib[this->lib] = self->path;
 self->vnode[this->lib] = this->vp; 
}

We do need to clean up sometime and so we do.

fbt::vn_open_auth:return
{
 self->path = 0;
 self->ppath = 0;
 self->curpath = 0;
 self->ndp = 0;
 self->func = 0;
 self->dylib = 0;
}

We use the same function boundary tracing (fbt) DTrace provider to track pageins. We print the file offset of the data we are paging in, as well as the size.

fbt::vnode_pagein:entry
{
 self->v_name = stringof(((vnode_t)arg0)->v_name);
}

/* vnode pointers should match but v_name seems more secure */

fbt::vnode_pagein:entry
/self->lib[self->v_name] != 0/
{
 printf("vnode_pagein: %s, offset: %u, size: %u\n", 
   self->v_name, arg3, arg4);
}

It does look from the output that we are loading multiple pages at the same time, e.g. size 1019904 corresponds to 249 pages. Page access looks quite random, though, which is killing us.

Now that we know what the access pattern is, we should try to first identify the symbols that are being accessed in each set of pages and then make the linker rearrange the code such that page access is more sequential and less random.

Note that you are not likely to see page-ins when running this DTrace script unless you have just restarted your Mac and are running Firefox for the first time. This is because the dynamic libraries will be stored in the Unified Buffer Cache (UBC) after first access and there won’t be any subsequent disk access until they are evicted from the cache.

I wrote about hacking the Unified Buffer Cache before but the same technique does not work with mmap-ed data since the virtual manager and the cache are the same thing. Evicting the libraries would involve allocating at at least twice as much virtual memory as there’s RAM and then touching each page to make sure it’s cached. This is unlikely to correspond to normal use of Firefox, though.

Firefox Startup: Where Does Time Go?

2009-08-28T20:08:00+02:00

The dyld shared cache lives in /var/db/dyld/. The two files of interest are dyld_shared_cache_i386.map (for x86-32) and shared_region_roots/Applications.paths. Both are regular text files. The former shows the contents of the shared cache for the i386 architecture and the latter is what update_dyld_shared_cache inspects.

There’s no prebinding on newer versions of Mac OSX and the dyld shared cache is automatically updated as needed. Tracing Safari disk activity during startup reveals that basically all its dynamic libraries are pulled from the dyld shared cache.

It’s possible to add Firefox (…/Firefox.app/Contents/MacOS/firefox-bin) to Applications.paths and the change will persist across reboots. Unfortunately, only a handful of libraries that Firefox uses are pulled into the cache by update_dyld_shared_cache. I’m speculating that this may have something to do with @executable_path/XUL and friends (otool -L …/firefox-bin).

Safari uses absolute paths to frameworks in /System/Library/Frameworks so I speculate that relative paths are what is preventing XUL and others from going into the cache.

It’s possible to fix relative library paths in a given library, e.g. fix.sh XUL where fix.sh looks like this

#!/bin/bash 

function dylibs () {
  otool -L $1 |grep executable_path|awk '{print $1}'|cut -d"/" -f2
}

for i in `dylibs $1`
do
        install_name_tool -change @executable_path/$i `pwd`/$i $1
done

install_name_tool -id `pwd`/$1 $1

Firefox has to be recompiled with LDFLAGS=-header-pad_max_install_names__ in MOZCONFIG_ to make this happen since new library paths are greater than the space allocated in the Mach-O binary. See the man page for install_name_tool for details.

It’s possible to force dynamic libraries into the cache by putting dynamic library paths into shared_region_roots/Applications.paths instead of executables. I wasn’t successful in caching XUL, though, regardless of what I did. XUL is the Firefox dynamic library, it doesn’t even have a dylib extension.

In the end it doesn’t seem to matter since there’s a baffling lack of difference between Firefox and Safari cold stats, despite Safari pulling everything from the cache and Firefox using a large number of non-cached dylibs.

Here are the cold startup stats for Safari

sync && purge && DYLD_PRINT_STATISTICS=1 /Applications/Safari.app/Contents/MacOS/Safari
total time: 696.9 milliseconds (100.0%)
total images loaded:  116 (114 from dyld shared cache, 114 needed no fixups)
total segments mapped: 5, into 30 pages with 10 pages pre-fetched
total images loading time: 204.9 milliseconds (29.4%)
total rebase fixups:  1,298
total rebase fixups time: 0.1 milliseconds (0.0%)
total binding fixups: 2,476
total binding symbol lookups: 234, average images searched per symbol: 1.6
total binding fixups time: 80.5 milliseconds (11.5%)
total bindings lazily fixed up: 3 of 901
total init time time: 411.3 milliseconds (59.0%)
total images with weak exports:  1

and Firefox

total time: 731.2 milliseconds (100.0%)
total images loaded:  106 (93 from dyld shared cache, 56 needed no fixups)
total segments mapped: 49, into 5903 pages with 684 pages pre-fetched
total images loading time: 235.3 milliseconds (32.1%)
total rebase fixups:  149,011
total rebase fixups time: 3.7 milliseconds (0.5%)
total binding fixups: 24,932
total binding symbol lookups: 797, average images searched per symbol: 2.3
total binding fixups time: 149.9 milliseconds (20.5%)
total bindings lazily fixed up: 45 of 19,109
total init time time: 342.2 milliseconds (46.8%)
total images with weak exports:  3

Notice a large and significant difference? Me neither.

The other thing that I cannot explain at the moment is where the rest of the startup time goes, e.g.

./cold.sh startup.d
Total: 10001.723521ms

So it took less than 1 second to dynamically link Firefox but where did the other 9 seconds of startup go?

cold.sh is rather simple

#!/bin/bash

cmd="./Minefield.app/Contents/MacOS/firefox-bin -no-remote -foreground -P 2"

sync && purge && dtrace -x dynvarsize=64m -x evaltime=exec -c "$cmd" -wZs $1

and the startup.d script doesn’t do much either

#pragma D option quiet

BEGIN
{
 start = timestamp;
}

/* stop tracing here */

mozilla$target:::main-entry
{
 exit(0);
}

END
{
 this->total = timestamp - start;
 printf("Total: %u.%06ums\n", this->total / 1000000, this->total % 1000000);
}

main-entry is my static probe, built into the Firefox source code. It fires once the main Firefox function, XRE_main, is entered.

I don’t have an explanation yet but 9 seconds is a very large difference but it just may be DTrace because of similar cold startup timings for Safari and Firefox.

Creating Mac Binaries on Any Platform

2009-01-26T20:12:00+01:00

I’m in love with Forth but there are no commercial Forth environments for Mac OSX. GForth is a free, fast and portable implementation of ANS Forth but it requires GCC and does not allow for binary distribution of code that uses foreign functions.

There are two excellent commercial implementations of ANS Forth and both run on Linux. I asked one of the companies if I could port their Forth to the Mac and promptly ended up with a tarball on my lap. There were no C or assembler files, it was all Forth source code.

The proper bootstrapping approach turned out to generate a Mac kernel on Linux, copy it over to the Mac and use it to compile the rest of the Forth environment. It’s called cross-compiling!

This required me to investigate how Mac binaries are laid out and how I could generate them without using gcc or a linker.

I would like to explain how I did it. Let’s start with a simple C program and feel free to browse the full source code.

#include <stdio.h>
#include <stdlib.h>

int main(int argc, char **argv)
{
  printf("Hello world!\n");
  exit(0);
}

It can’t get any simpler!

gcc hello.c -o hello
./hello
Hello world!

What does it look like in assembler, though?

.cstring
LC0:
.ascii "Hello world!\0"
.text
.globl _main
_main:
pushl  %ebp
movl   %esp, %ebp
pushl  %ebx
subl   $20, %esp
call   L3
"L00000000001$pb":
L3:
popl   %ebx
leal   LC0-"L00000000001$pb"(%ebx), %eax
movl   %eax, (%esp)
call   L_puts$stub
movl   $0, (%esp)
call   L_exit$stub
.section __IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5
L_exit$stub:
.indirect_symbol _exit
hlt ; hlt ; hlt ; hlt ; hlt
L_puts$stub:
.indirect_symbol _puts
hlt ; hlt ; hlt ; hlt ; hlt
.subsections_via_symbols

The IMPORT section is where gcc allocates stubs for external functions. The dynamic linker will replace these with a jump to the real printf once libc is loaded.

What the code above does not include is proper alignment of the stack before the calls to printf and exit. This is required according to the Mac OSX ABI IA-32 Function Calling Conventions. It’s a slight of hand on the part of gcc which inserts a prolog before invoking our main function.

This prolog sets up the stack and gets hold of our program arguments, i.e. argc, argv and envp.

Breakpoint 1, 0x00001f6c in start ()
(gdb) disas
Dump of assembler code for function start:
0x00001f68 <start+00>:  push   $0x0
0x00001f6a <start+02>:  mov    %esp,%ebp
0x00001f6c <start+04>:  and    $0xfffffff0,%esp ; <-- stack alignment
0x00001f6f <start+07>:  sub    $0x10,%esp  ; <-- and here too!
0x00001f72 <start+10>:  mov    0x4(%ebp),%ebx
0x00001f75 <start+13>:  mov    %ebx,0x0(%esp)
0x00001f79 <start+17>:  lea    0x8(%ebp),%ecx
0x00001f7c <start+20>:  mov    %ecx,0x4(%esp)
0x00001f80 <start+24>:  add    $0x1,%ebx
0x00001f83 <start+27>:  shl    $0x2,%ebx
0x00001f86 <start+30>:  add    %ecx,%ebx
0x00001f88 <start+32>:  mov    %ebx,0x8(%esp)
0x00001f8c <start+36>:  mov    (%ebx),%eax
0x00001f8e <start+38>:  add    $0x4,%ebx
0x00001f91 <start+41>:  test   %eax,%eax
0x00001f93 <start+43>:  jne    0x1f8c <start+36>
0x00001f95 <start+45>:  mov    %ebx,0xc(%esp)
0x00001f99 <start+49>:  call   0x1fca <main>
0x00001f9e <start+54>:  mov    %eax,0x0(%esp)
0x00001fa2 <start+58>:  call   0x3000 <dyld_stub_exit>
0x00001fa7 <start+63>:  hlt
End of assembler dump.

Let’s tidy things up into a single NASM file. It’s less verbose than GAS and I much prefer it.

bits  32

section .text

GLOBAL start
extern _printf, _exit

start:
  and esp, 0xFFFFFFF0
  sub esp, 0x10
  mov dword [esp], hello.msg
  call _printf
  add esp, 0x10
  mov eax, 0          ; set return code
  call _exit
  hlt

section .data

hello.msg db 'Hello, World!', 0x0a, 0x00

The stubs are taken care of by nasm in Mach-O mode (-f macho below) and the code still works.

nasm -f macho hello.asm -o hello.o
ld hello.o -o hello -lc

./hello
Hello, World!

otool is indispensable for any sort of involved Mac forensics and the Mach-O file format is very well explained by Apple.

otool -l hello
hello:
Load command 0
      cmd LC_SEGMENT
  cmdsize 56
  segname __PAGEZERO
   vmaddr 0x00000000
   vmsize 0x00001000
  fileoff 0
 filesize 0
  maxprot 0x00000000
 initprot 0x00000000
   nsects 0
    flags 0x0
...
Load command 8
     cmd LC_UUID
 cmdsize 24
   uuid 0xce 0x2c 0xd0 0xae 0xbb 0x29 0xb4 0xc5
        0xba 0x70 0x39 0x06 0x18 0x30 0x42 0x7b
Load command 9
        cmd LC_UNIXTHREAD
    cmdsize 80
     flavor i386_THREAD_STATE
      count i386_THREAD_STATE_COUNT
      eax 0x00000000 ebx    0x00000000 ecx 0x00000000 edx 0x00000000
      edi 0x00000000 esi    0x00000000 ebp 0x00000000 esp 0x00000000
      ss  0x00000000 eflags 0x00000000 eip 0x00001fd0 cs  0x00000000
      ds  0x00000000 es     0x00000000 fs  0x00000000 gs  0x00000000
Load command 10
          cmd LC_LOAD_DYLIB
      cmdsize 52
         name /usr/lib/libSystem.B.dylib (offset 24)
   time stamp 2 Thu Jan  1 01:00:02 1970
      current version 111.1.3
compatibility version 1.0.0

The Mach-O header is normally generated by the compiler and the linker (GCC & LD) but I’m using neither so I have to generate the header by hand. It’s doable, as long as NASM is instructed to simply dump a binary image to disk (-f bin) and it actually works!

nasm -f bin hello1.asm -o hello1
chmod +x hello1
./hello1
Hello, World!

Note that this can be done on any platform NASM runs on. I did it on Linux but assume it will work just as well on Windows.

Now, let’s take a good look at the code…

We need to tell NASM we are in 32-bit mode and that program code starts on the second VM page (0x1000 or 4096). The first page (PAGEZERO) is there to catch null pointer references.

;;; File: hello1.asm
;;; Build: nasm -f bin -o hello1 hello1.asm && chmod +x hello1

bits  32
org   0x1000

The header specifies that this is an x86-32 binary and a full-fledged executable file and that there are 10 load commands in the header.

mhdr:
   dd 0xFEEDFACE  ; magic
   dd 7           ; cputype
   dd 3           ; cpusubtype
   dd 2           ; filetype
   dd 10          ; ncmds
   dd sizeofcmds  ; sizeofcmds
   dd 0x85        ; flags

PAGEZERO is where you end up when dereferencing a 0 pointer. This page is protected from reading and writing so any access to it causes a page fault and a memory access violation. This segment does not take any space in the file so its filesize is set to 0.

;;; Load command #0

pagezero:
   dd 1              ; LC_SEGMENT
   dd _pagezero      ; size
   db '__PAGEZERO'   ; segname
   times 6 db 0      ; padding to 16 chars
   dd 0              ; vmaddr
   dd 0x1000         ; vmsize
   dd 0              ; fileoff
   dd 0              ; filesize
   dd 0              ; maxprot
   dd 0              ; initprot
   dd 0              ; nsects
   dd 0              ; flags
_pagezero equ $-pagezero

The text segment is where our code lives. It’s readable and executable (initprot). The load commands that form part of the Mach-O header itself need to be loaded somewhere. Here, they are part of the text segment which is why the segment starts at the beginning of the file (fileoff 0).

;;; Load command #1

code:
   dd 1              ; LC_SEGMENT
   dd _code          ; size
   db '__TEXT'       ; segname
   times 10 db 0     ; padding to 16 chars
   dd 0x1000         ; vmaddr
   dd 0x1000         ; vmsize
   dd 0              ; fileoff
   dd 0x1000         ; filesize
   dd 7              ; maxprot
   dd 5              ; initprot
   dd 1              ; nsects
   dd 0              ; flags

sect1:               ; section 0
   db '__text'       ; sectname
   times 10 db 0     ; padding to 16 chars
   db '__TEXT'       ; segname
   times 10 db 0     ; padding to 16 chars
   dd start          ; addr
   dd codesize       ; size
   dd start-$$       ; offset
   dd 0              ; align on 2^0
   dd 0              ; reloff
   dd 0              ; nreloc
   dd 0x80000400     ; flags
   dd 0              ; reserved1
   dd 0              ; reserved2
_code equ $-code

The data segment holds our “Hello world!” string.

;;; Load command #2

data:
   dd 1              ; LC_SEGMENT
   dd _data          ; size
   db '__DATA'       ; segname
   times 10 db 0     ; padding to 16 chars
   dd 0x2000         ; vmaddr
   dd 0x1000         ; vmsize
   dd 0x1000         ; fileoff
   dd 0x1000         ; filesize
   dd 7              ; maxprot
   dd 3              ; initprot
   dd 1              ; nsects
   dd 0              ; flags

sect2:               ; section 0
   db '__const'      ; sectname
   times 9 db 0      ; padding to 16 chars
   db '__DATA'       ; segname
   times 10 db 0     ; padding to 16 chars
   dd 0x2000         ; addr
   dd 15             ; size, our string
   dd 4096           ; offset
   dd 0              ; align on 2^0
   dd 0              ; reloff
   dd 0              ; nreloc
   dd 0              ; flags
   dd 0              ; reserved1
   dd 0              ; reserved2
_data equ $-data

The IMPORT segment holds our jump table, the stubs for printf and exit. The dynamic linker will fill in the stubs for us with a jump to printf and exit in libc. This segment needs to be readable, writable and executable (initprot).

;;; Load command #3

stubs:
   dd 1              ; LC_SEGMENT
   dd _stubs         ; size
   db '__IMPORT'     ; segname
   times 8 db 0      ; padding to 16 chars
   dd 0x3000         ; vmaddr
   dd 0x1000         ; vmsize
   dd 0x2000         ; fileoff
   dd 0x1000         ; filesize
   dd 7              ; maxprot
   dd 7              ; initprot
   dd 1              ; nsects
   dd 0              ; flags

sect3:               ; section 0
   db '__jump_table' ; sectname
   times 4 db 0      ; padding to 16 chars
   db '__IMPORT'     ; segname
   times 8 db 0      ; padding to 16 chars
   dd 0x3000         ; addr
   dd 10             ; size, two stubs
   dd 0x2000         ; offset
   dd 6              ; align on 2^6
   dd 0              ; reloff
   dd 0              ; nreloc
   dd 0x04000008     ; flags
   dd 0              ; reserved1
   dd 5              ; reserved2, stub size
_stubs equ $-stubs

The LINKEDIT segment holds the symbol table.

;;; Load command #4

linkage:
   dd 1              ; LC_SEGMENT
   dd _linkage       ; size
   db '__LINKEDIT'   ; link table
   times 6 db 0      ; padding
   dd 0x4000         ; vmaddr
   dd 0x1000         ; vmsize
   dd symbols-$$     ; fileoff
   dd _symbols       ; filesize
   dd 7              ; maxprot
   dd 1              ; initprot
   dd 0              ; nsects
   dd 0              ; flags
_linkage equ $-linkage

This segment describes our symbol table, including where the symbols and the strings naming them are located. I believe it’s mostly for the benefit of the debugger.

;;; Load command #5

symtab:
   dd 2              ; LC_SYMTAB
   dd _symtab        ; size
   dd symbols-$$     ; symoff
   dd 4              ; nsyms
   dd strings-$$     ; stroff
   dd _strings       ; strsize
_symtab equ $-symtab

This load command describes the dynamic symbol table. This is how the dynamic linker knows to plug the stubs (indirect).

;;; Load command #6

dysymtab:
   dd 0x0b           ; LC_DYSYMTAB
   dd _dysymtab      ; size
   dd 0              ; ilocalsym
   dd 1              ; nlocalsym
   dd 1              ; iextdefsym
   dd 2              ; nextdefsym
   dd 2              ; iundefsym
   dd 2              ; nundefsym
   dd 0              ; tocoff
   dd 0              ; ntoc
   dd 0              ; modtaboff
   dd 0              ; nmodtab
   dd 0              ; extrefsymoff
   dd 0              ; nextrefsyms
   dd indirect-$$    ; indirectsymoff
   dd 2              ; nindirectsyms
   dd 0              ; extreloff
   dd 0              ; nextrel
   dd 0              ; locreloff
   dd 0              ; nlocrel
_dysymtab equ $-dysymtab

My guess is as good as yours here. I’m not ready to use a dynamic linker of my own but this is a distinct possibility! This load command clearly provides for it.

;;; Load command #7

dylinker:
   dd 0x0e           ; LC_LOAD_DYLINKER
   dd _dylinker      ; size
   dd 12             ; nameoff
   db '/usr/lib/dyld', 0
   align 4
_dylinker equ $-dylinker

This load command specifies the contents of the registers at startup. I haven’t seen anything other than EIP populated, though. The program will not run unless this load command is present!

;;; Load command #8

thrstate:
   dd 0x5            ; LC_UNIXTHREAD
   dd _thrstate      ; size
   dd 0x01           ; i386_THREAD_STATE
   dd 0x10           ; i386_THREAD_STATE_COUNT
   times 10 dd 0x00  ; cpu thread state
   dd start          ; eip
   times 05 dd 0x00  ;
_thrstate equ $-thrstate

We can have as many dylib segments as dynamic libraries we would like to use. I’m only using libc since that’s where printf and exit live. I could have created stubs for dlopen, dlclose, dlsym and dlerror and used them to load libc and pull out printf and exit. Why bother, though, when the dynamic linker can do it for us?

;;; Load command #9

dylib:
   dd 0x0c           ; LC_LOAD_DYLIB
   dd _dylib         ; size
   dd 0x18           ; nameoff
   dd 0x02           ; timestamp
   dd 0x006F0103     ; currentver
   dd 0x00010000     ; compatver
   db '/usr/lib/libSystem.B.dylib', 0
   align 4
_dylib equ $-dylib

It was a long road through the Mach-O header but we can finally relax and get some work done. There isn’t much to do apart from printing hello world and exiting but note the alignment of the stack on a 16-byte boundary, before each function call.

I’m taking the easy way out and aligning the stack one extra time, at the beginning of the program. This makes the rest of the alignment work much easier!

All values in the stack are 32-bit values. We are pushing a single argument which requires us to pad the stack with 12 more bytes (sub esp, 0x10). We pop arguments and padding right after the call to printf.

GLOBAL start

start:

  and esp, 0xFFFFFFF0
  sub esp, 0x10
  mov dword [esp], hello.msg
  call _printf
  add esp, 0x10
  mov eax, 0          ; set return code
  call _exit
  hlt

codesize equ $-start

Data and stubs are easy. Note the alignment to a page boundary. A jump to a 32-bit address takes 5 bytes, thus 5 halt instructions are used for each stub.

;;; Data

align 4096

hello.msg db 'Hello, World!', 0x0a, 0x00

;;; Stubs

align 4096

_printf:
  times 5 hlt

_exit:
  times 5 hlt

The symbol table has a well-defined format and each symbol needs to be described in excruciating detail!

;;; Linkage

align 4096

symbols:           ; symbol table

; hello.msg

dd str01off    ; nstrx
db 0x0e        ; type
db 0x02        ; sect
dw 0x00        ; desc
dd hello.msg   ; value

; start

dd str02off    ; nstrx
db 0x0f        ; type
db 0x01        ; sect
dw 0x00        ; desc
dd start       ; value

; _printf

dd str03off    ; nstrx
db 0x01        ; type N_EXT
db 0x00        ; sect
dw 0x0101      ; desc
dd _printf     ; value

; _exit

dd str04off    ; nstrx
db 0x01        ; type N_EXT
db 0           ; sect
dw 0x0101      ; desc
dd _exit       ; value

The indirect symbol table tells the dynamic linker that elements 2 and 3 of the symbol table need to be looked up and their stubs plugged.

indirect:         ; indirect symbol table

   dd 0x02        ; _printf
   dd 0x03        ; _exit

The string table names the symbols above.

strings:          ; string table

      db 0x20, 0x00

str01 db 'hello.msg', 0x00
str02 db 'start', 0x00
str03 db '_printf', 0x00
str04 db '_exit', 0x00

str01off equ str01 - strings
str02off equ str02 - strings
str03off equ str03 - strings
str04off equ str04 - strings

_strings equ $-strings
_symbols equ $-symbols

I don’t expect you to generate Mac binaries by hand on Linux or Windows but I hope this tutorial will be of help if you ever decide to try!

Hacking the Mac OSX Unified Buffer Cache

2008-03-04T19:52:00+01:00

Files read and written get cached in the Unified Buffer Cache (UBC) on Mac OSX.

The UBC was hindering me because I was processing a huge file in chunks but throwing out each chunk, never to be reused again, after writing out the processed chunk. I would see gigabytes of memory get eaten away by the UBC until the system started swapping and became unresponsive.

UBC cannot be limited to a given maximum amount of memory.

UBC cannot be inspected programmatically.

UBC can be cleared by running ‘purge’ which allocates a lot of memory to force the cache to clear. The following bit of code can be used turn caching off for a particular file:

fcntl(fd, F_GLOBAL_NOCACHE, 1);

This can be done in any process and the file can be closed after. The setting persists through out the lifetime of the file. If the file is removed and re-created then the setting is lost.

How can you tell if the setting took hold and the file is indeed NOT being cached?

dd if=/db1/cdr.csv bs=1m count=1024 of=/dev/null
1073741824 bytes transferred in 12.030688 secs (89250242 bytes/sec)

dd if=/db1/cdr.csv bs=1m count=1024 of=/dev/null
1073741824 bytes transferred in 11.867947 secs (90474101 bytes/sec)

dd if=/db1/cdr.csv bs=1m count=1024 of=/dev/null
1073741824 bytes transferred in 12.037562 secs (89199278 bytes/sec)

Tried reading the file three times. Speed is about the same.

What about a regular file that’s cached by default?

dd if=/db1/cdr1.csv bs=1m count=1024 of=/dev/null
1073741824 bytes transferred in 11.505857 secs (93321325 bytes/sec)

dd if=/db1/cdr1.csv bs=1m count=1024 of=/dev/null
1073741824 bytes transferred in 0.500468 secs (2145475416 bytes/sec)

Notice that reading from the cache is much faster the second time around.

Kudos to Dominic Giampaolo from Apple for explaining all this to me!

Writing a Mac OSX USB Device Driver That Implements SCSI Pass-through

2008-02-04T19:41:00+01:00

I’ve been on a coding tear since the beginning of this year, when I decided to dump Erlang and focus on all things low-level. I’ve been much happier since, although not much richer. Do you need a Mac OSX device driver written? Talk to me!

In this post I will explain how I wrote a Mac OSX USB device driver for the IntellaSys 24-core CPU on a thumbstick, also known as FORTHdrive. I will skip the parts that are reasonably clear from Apple documentation and focus on the bits I had trouble with. I will also leave two-machine driver and kernel debugging over FireWire for another post.

It will be helpful for you to first read about IOKit fundamentals, as well as Mass storage device driver programming and the SCSI device architecture model device interface. SCSI in particular is how I started down this slippery slope.

Introduction

The USB flash drive format is popular with hardware vendors. It’s possible to buy security tokens on a thumb stick and even 24-core Forth processors. The stick will most likely have a small disk partition that will house the vendor development kit or tools. It will look like a regular flash drive to the operating system (OS) and the OS will use SCSI over USB to access the data.

The manufacturer will implement vendor-specific SCSI commands to give you access the core functionality of the device such as the encryption API of a security token or storing and fetching data from a custom CPU. The OS will let you send custom SCSI commands to a SCSI device, this is called SCSI pass-through. You can use SGIO for SCSI pass-through on Linux. This boils down to a series of ioctl calls from your application and all is well… except on Mac OSX.

In its infinite wisdom, Apple decided to disable SCSI pass-through lest you send a format command to an attached device or do something equally evil. Apple [really really wants you to go through official and established channels] to talk to devices under Mac OSX, particularly SCSI devices. Apple did not and cannot establish channels for every custom device out there, which means that the hard work to implement SCSI pass-through on Mac OSX falls squarely on your shoulders.

Writing a Mac OSX device driver is not particularly hard. It took me all of about a week to get my driver ready and working. There’s definitely a dearth of information on writing Mac OSX device drivers and existing examples are too simple to be of much use.

I hunted far and wide (and way back in time!) through various Apple driver development lists to collect the information I needed and I’m summarizing it for you here, as well as providing full working source code to my driver.

Did I mention that Mac OSX drivers are written in C++? Not C, not Objective-C but C++! The original IOKit used to be called DriverKit and was written in Objective-C. Apple, apparently, felt C++ would be easier on third-party driver writers. Say what you want but C++ does simplify reuse. You don’t need to re-implement the full driver, you can subclass and change or add tiny bits and pieces.

Fundamentals

Your application lives in user land whereas the driver lives in kernel land. The two cannot talk to one another, except through a Mach port. Normally, your application would first locate the driver in the I/O registry.The SimpleUserClient and VendorSpecificType00 examples that Apple provides for developers show you how this is done.

Once you get a handle to your driver (service), you can open a connection to it like this

io_connect_t connect;
kern_return_t kernResult = IOServiceOpen(service, mach_task_self(), 0, &connect);

This gets you a handle that you can use to access your driver in kernel land.

User client

Once you get through the Mach port, you land in something called the user client. The user client mechanism is designed to allow calls from a user process to be dispatched to any IOService-based object in the kernel. Your driver would normally be a subclass of IOService but you would not access it directly. You would create a series of “adapter” functions that verify and perhaps massage the data and then pass it to your driver.

You can invoke user client functions that are set up via the external method dispatch table. This is a series of structures that describe each method of your user client, including the function pointer, number of integer arguments that the method takes in, number of integer values it returns and the same for structures. The table will look like this

const IOExternalMethodDispatch UserClientClassName::Methods[kNumberOfMethods] =
{
  { // kS24ClientOpen
    (IOExternalMethodAction) &UserClientClassName::sOpenUserClient,
    0,
    0,
    0,
    0
  },
  ...
}

The SimpleUserClient example shows you how to set up and use various external method configurations.

Your user land method invocation will end up in externalMethod below. This is where you will look up your method using the selector to index your method table.

IOReturn UserClientClassName::externalMethod(uint32_t selector, IOExternalMethodArguments* arguments,
    IOExternalMethodDispatch* dispatch, OSObject* target, void* reference)

{
    IOLog("%s[%p]::%s(%d, %p, %p, %p, %p)\n", getName(), this, __FUNCTION__,
        selector, arguments, dispatch, target, reference);

    if (selector < (uint32_t) kNumberOfMethods)
    {
        dispatch = (IOExternalMethodDispatch *) &Methods[selector];

        if (!target)
     target = this;
  }

A lot of methods in the user client are boilerplate but you do not want to miss initWithTask! This is the method where you should take owningTask and save it. This is the Mach task of your user land application and you will need it to map memory buffers from user space to kernel space. owningTask here will correspond to mach_task_self() in the call to IOServiceOpen above.

bool UserClientClassName::initWithTask(task_t owningTask, void* securityToken, UInt32 type)
{
    bool success = super::initWithTask(owningTask, securityToken, type);

  // This IOLog must follow super::initWithTask because getName relies on the superclass initialization.
  IOLog("%s[%p]::%s(%p, %p, %ld)\n", getName(), this, __FUNCTION__, owningTask, securityToken, type);

    fTask = owningTask;
    fProvider = NULL;

    return success;
}

Methods in your dispatch table will be static and you will need a way to map those to methods of your user client class. Fortunately, every method has a target argument just for this purpose.

IOReturn UserClientClassName::sInit(UserClientClassName* target, void* reference, IOExternalMethodArguments* arguments)
{
    return target->S24IO(NULL, 0, 0, 0, kIODirectionNone);
}

The code above does not use any of the external arguments but this method does

IOReturn UserClientClassName::sRead(UserClientClassName* target, void* reference, IOExternalMethodArguments* arguments)
{
    return target->S24IO(
        arguments->scalarInput[0],
        arguments->scalarInput[1],
        arguments->scalarInput[2],
        0,
        kIODirectionIn
        );
}

Simply pull your values from external method arguments and pass them to a method in your user client class, e.g. S24IO. fprovider is our driver handle that we set up in the start method, invoked as a result of us calling IOService open in our user land application.

Talking to the user client

To talk to the driver’s user client from your application you will invoke methods like IOConnectCallScalarMethod and friends. The SimpleUserClient example shows how this is done.

Passing buffers into the kernel

Apple has guidelines for how to allocate and share memory with user space from an I/O kit driver but what do you do if you need to pass a buffer from user space into the kernel? Simple! The kernel works with I/O memory descriptors and we need to create one for our user space buffer like so

IOMemoryDescriptor *iomd = IOMemoryDescriptor::withAddress(
      (vm_address_t)buffer,
      size,
      direction,
      fTask
    );

See IOMemoryDescriptor documentation for more details.

Note fTask and direction above. You must tell the kernel which task this memory pointer belongs to so that the kernel can properly translate this address into physical memory. You also must tell the kernel whether you are going to be reading from this memory buffer or writing to it. This is what direction is for.

This is by no means conclusive documentation for _IOMemoryDescriptor__. Please read about IOBufferMemoryDescriptor and feel free to poker around further.

We are still in driver adapter and glue code here but we are getting close to the driver itself.

Driver

The salient points here are the InitializeDeviceSupport method and the way to send SCSI commands to the device.

Use InitializeDeviceSupport if you need to send SCSI commands to your device during driver initialization. Do not use the probe method for this since the command gate (don’t ask!) will not be allocated yet and you will panic the kernel.

Here I’m initializing my device by sending it the vendor-specific initialization command in S24Init().

bool com_wagerlabs_driver_SEAforth24::InitializeDeviceSupport(void)
{
    bool result = false;

    result = super::InitializeDeviceSupport();

    if ( result == true )
        result = (S24Init() == kIOReturnSuccess);

    return result;
}

The S24SyncIO method is the heart and soul of my driver. Your driver will look different but things are easy and downhill from this point on since you have everything you need to send any kind of SCSI command to your device. You just need to go through a few more steps before you are done.

1) You get hold of a SCSI task.

req = GetSCSITask();

require(req != NULL, ErrorExit);

2) You populate the SCSI Command Descriptor Block (CDB) according to your vendor’s instructions.

switch (kind)
{
    case kS24Write:
        direction = kSCSIDataTransfer_FromInitiatorToTarget;
        b1 = 0xFB;
        b2 = 0x00;
        break;
    case kS24WriteLast:
        direction = kSCSIDataTransfer_FromInitiatorToTarget;
        b1 = 0xFB;
        b2 = 0x02;
        break;
    case kS24Read:
        direction = kSCSIDataTransfer_FromTargetToInitiator;
        b1 = 0xFB;
        b2 = 0x01;
        break;
    default: // kS24Init
        direction = kSCSIDataTransfer_NoDataTransfer;
        b1 = 0xFA;
        b2 = 0x00;
}

SetCommandDescriptorBlock(req, 0x20, b1, b2, 0x00, 0x00, 0x00, 0x00, hi, lo, 0x00);

3) You set a timeout for completion of your SCSI request and the data transfer direction.

SetTimeoutDuration(req, 10000);
SetDataTransferDirection(req, direction);

4) Mac OSX uses virtual memory which means that at the time of your SCSI command your buffer may be paged out to disk and not in physical memory. It’s crucial that you tell Mac OSX to prepare your memory buffer by mapping it back into memory and do any necessary housekeeping for your driver to be able to access your memory.

Other than that, don’t forget to tell the SCSI task to use your buffer and tell it how many bytes you are looking to transfer. It’s not necessary to set the direction of the transfer (from driver to device or vise versa) if this has already been set in the I/O memory descriptor (which is what we did).

if (buffer != NULL)
{
    buffer->prepare();
    SetDataBuffer(req, buffer);
    SetRequestedDataTransferCount(req, buffer->getLength());
}

5) Finally, send the command to the device and tell Mac OSX that your are done using your memory buffer for direct memory access (DMA) by invoking the complete method of the I/O memory descriptor. You will also want to check the status of your SCSI request, the number of bytes transferred and you may also want to use the “SCSI Request Sense command”:http://en.wikipedia.org/wiki/SCSI_Request_Sense_Command if your request was unsuccessful.

serviceResponse = SendCommand(req, 10000);

if (buffer != NULL)
{
    buffer->complete();
}

That’s it folks! Let me know if I have omitted something crucial and I’ll try to expand this post as time allows.

Parsing Text and Binary Files With Erlang

2008-02-03T19:22:00+01:00

Erlang originated in the telecommunications industry where one of the major tasks is conversion of text and binary data from one format to another. This is a task that Erlang excels at!

Parsing text and binary data is something that you will be doing very often in the course of writing your super-scalable internet servers so lets take a look at some efficient approaches to parsing text and binary data.

Strings vs binaries

Erlang does not have a built-in string data type. Strings are simulated on top of lists of integers. In a 32-bit Erlang virtual machine (VM) an integer is 4 bytes and we need 4 more bytes for a pointer to the next element of the list, for a total of 8 bytes per “character”. In 64-bit VM this number doubles.

Why should you care?

Each network connection to your servers will require certain amount of memory to send and receive data. A lot of protocols used on the internet, such as XML, are text and quite verbose at that. Imagine receiving a 10 kilobyte XML message, for example. Converting this message to a string for processing will inflate its size to 80K or 160K respectively.

When network connections to your server number in the thousands, it becomes necessary to minimize the amount of memory each connection requires for processing data that is sent and received. Any received message will also become garbage once it’s converted to an Erlang data structure and this garbage will need to be collected. The less garbage we generate, the less work the garbage collector has to do and the more responsive our server will become.

Lets keep binary data we receive from the network as binary data and avoid converting it to strings. Parsing of binary data is specially fast and convenient with special syntax for constructing binaries and matching binary patterns as well as bit strings and binary comprehensions. String processing enjoys no such advantage.

Remember that all Erlang input and output functions can deal with binary data. Any program that sticks to binary data processing will work much faster than a similar program that converts binary data to strings for processing!

That said, lets hammer a final nail into the Erlang string coffin and look at how we can process text as binary data.

Processing text files as binaries

Suppose we have a comma-delimited text file to parse. We need to split each line into a list of fields and collect our lines into a list. The file is not too large so we can afford to load it into memory in one fell swoop. This is our code in a nutshell.

-module(act).
-compile([export_all]).

parse(Filename) when is_list(Filename) ->
    {ok, Bin} = file:read_file(Filename),
    parse(Bin).

parse(Bin) when is_binary(Bin) ->
    parse(Bin, [], [], []).

Note that the empty lists are the initial values for our accumulators. Field is the list of characters that represents the current field we are processing. Line is the list of fields we have gathered while processing the current line. Finally, Acc is the list of lines we have gathered while processing our file.

We also have two functions named parse here: one that takes a Filename string (a list of integers) and another that takes a binary. Keeping the function name the same and using guards is strictly a matter of taste. I could have just as well called the second parse function parse1 or do_parse.

Erlang functions are distinguished based on their number of arguments and there’s a special fun_name/num_args notation to reflect that. Our parse function above would be written as parse/1. When the number of arguments is the same, the functions are distinguished based on guards such as is_list or is_binary above.

It’s good coding practice to present a neat interface to the outside world. parse/1 above would serve that purpose and parse/4 below would not. parse/1 takes just one argument whereas parse/4 clutters the interface with three extra arguments. As a user of the parsing module I would not know the purpose of the Field, Line and Acc arguments to parse/4 below.

parse(<<$\,, Rest/binary>>, Field, Line, Acc) ->
    parse(Rest, [], [lists:reverse(Field)|Line], Acc);

$_, matches the tab character and Rest matches the rest of the binary. It’s quite fast to add to the beginning of the list but the accumulated list needs to be reversed when we are done. Also, we almost certainly have accumulated a field by the time we hit the tab. This is why we reverse the field accumulator, prepend it to the accumulated list of fields and start our next iteration (recurse) with an empty field accumulator.

parse(<<$\r, Rest/binary>>, Field, Line, Acc) ->
    parse(Rest, Field, Line, Acc);

Just in case we have been given a file produced on Windows, we skip the carriage return character ($\r) and start on our next recursive iteration.

parse(<<$\n, Rest/binary>>, Field, Line, Acc) ->
    Field1 = lists:reverse(Field),
    FieldList = [Field1|Line],
    parse(Rest, [], [], [FieldList|Acc]);

A new line ($\n) means that we have hit the end of our current line and need to start processing a new one. We start this processing with empty field and line accumulators and prepend the list of fields to the lines accumulator Acc.

parse(<<Char, Rest/binary>>, Field, Line, Acc) ->
    parse(Rest, [Char|Field], Line, Acc);

We prepend any character not matching our field or line delimiters to the field accumulator and keep going.

parse(<<>>, [], [], Acc) ->
    {ok, lists:reverse(Acc)};

We do run out of binary data to process at some point in time and detect this fact by matching the empty binary <<>>. If our field and line accumulators are empty then we are done. We do need to reverse the list of lines that we have accumulated to return them in their original order.

parse(<<>>, Field, Line, Acc) ->
    parse(<<$\n>>, Field, Line, Acc).

What do we do if our accumulators are not empty by the time we are done processing? We can add custom processing code, of course, but wouldn’t it be better to leverage code that we have already written? We already go through the proper motions when we find a new line so to make our job easier we make it look like we found one. We continue parsing by creating a small fake binary with a single new line character.

Processing binary data the hard way

You did not misread it! Yes, the customary way of processing Erlang binaries is the hard way. It’s low level and involves lots of typing and a good deal of code duplication. It’s also the fastest and most efficient way.

I will show you a less efficient but more structured way to process binary data later in this chapter. We need to learn to walk before we learn to run so lets take a look at how you normally process binary data in Erlang.

Here’s a chunk of the binary protocol that my OpenPoker server uses.

Packet format:

0  1   2        N
+--+---+--- ... +
| Size | Body   |
+------+--- ... +

Body:

0      1           N
+------+--- ... ---+
| Type | Arguments |
+------+--- ... ---+

Each packet starts with a 2-byte packet size then a 1-byte packet type and the data payload. The body of a NOTIFY_JOIN command will then look like this:

0    1     5     9      10    12
+----+-----+-----+-------+-----+
| 21 | GID | PID | Seat# | Seq |
+----+-----+-----+-------+-----+

GID and PID are 4-byte integers, the seat number is a byte and the sequence number a 2-byte integer. We need one function to read this command from a binary packet and return something easy to deal with, e.g. a tuple.

read(<<?PP_NOTIFY_JOIN, GID:32, PID:32, SeatNum, Seq:16>>) ->
    {21, GID, PID, SeatNum, Seq};

To send the command out through the socket, we first need to convert the tuple to a binary.

write({21, GID, Player, SeatNum, Seq})
when is_number(GID),
     is_pid(Player),
     is_number(SeatNum),
     is_number(Seq) ->
    PID = gen_server:call(Player, 'ID'),
    <<21, GID:32, PID:32, SeatNum, Seq:16>>;

There are scores of commands in the OpenPoker protocol and the number will grow as new functionality is added. I did write code like the above for each and every command in the OpenPoker protocol and I wish I knew a way that enabled more code reuse.

What you should walk away with here is that reading and writing binary data in Erlang is simple and straightforward.

Pickler combinators

The OpenPoker protocol handling code is quite verbose. The protocol is also very much flat as it does not involve nested data structures. There is a way to describe reading and writing of structured data and generally save ourselves time and typing.

Andrew Kennedy coined the term pickler combinator in his 2004 ‘Functional Pearl of the same name. He wrote that

The tedium of writing pickling and unpickling functions by hand is relieved using a combinator library similar in spirit to the well-known parser combinators. Picklers for primitive types are combined to support tupling, alternation, recursion, and structure sharing.

Andrew Kennedy’s implementation used SML and is an Erlang book. We are still still functional programmers, though, so let’s see what we can do…

-module(pickle).

-export([pickle/2, unpickle/2, test/0]).
-export([byte/0, short/0, sshort/0,
   int/0, sint/0, long/0, slong/0]).
-export([list/2, choice/2, optional/1, wrap/2,
   tuple/1, record/2, binary/1, wstring/0]).

-compile([export_all]).

Let’s design and implement a pickling module that will save us a lot of typing down the road. The goal is to save us a lot of typing and enable us to describe our packet formats in terms of bytes, words and strings, as opposed to bits and binaries.

%%% Pickle and unpickle. We accumulate into a list.

pickle({Pickler, _}, Value) ->
    lists:reverse(Pickler([], Value)).

unpickle({_, Pickler}, Bin) ->
    element(1, Pickler(Bin)).

pickle and unpickle are responsible for doing the work for us and like a good manager they delegate the bulk of the work to their underlings. Note that the pickler combinator is represented by a two-element tuple where the first element is the function used for pickling and the second element for unpickling.

To pickle any Erlang term, we give pickle the tuple representing the pickler combinator as well as the value. Binaries, while convenient, don’t lend themselves to accumulating values so we accumulate the pickled data into a list. Fortunately for us, the Erlang input/output system can take lists and convert them to binaries for us.

To unpickle a binary we invoke the un-pickler on it and take the first element of the resulting tuple. Why does the unpickler return a tuple? We may have data left over from processing and it needs to be stored somewhere. The first element of the tuple stores the result of the unpickle operation and the second stores the remainder of the data.

Without further ado lets implement a pickler combinator for serializing byte data.

%%% Byte

byte() ->
    {fun write_byte/2, fun read_byte/1}.

write_byte(Acc, Byte) ->
    [<<Byte:8>>|Acc].

read_byte(Bin) ->
    <<Byte:8, Rest/binary>> = Bin,
    {Byte, Rest}.

byte is the name of the combinator and byte/0 simply returns a tuple of the pickler and unpickler functions. This is the pattern that we will be using over and over again. Also, picklers take the list serving as accumulator as their fist argument and the Erlang value as their second argument.

To pickle a byte we simply tell Erlang to prepend the binary representation of the byte <<Byte:8>> to the accumulator list. To unpickle a byte, read_byte/1 splits the binary into the byte itself and the remainder of the data and returns both as a tuple.

Simple, isn’t it?

A pickler combinator for unsigned short values stored in little-endian format looks like this.

%%% Unsigned short

short() ->
    {fun write_short/2, fun read_short/1}.

write_short(Acc, Word) ->
    [<<Word:16/little>>|Acc].

read_short(Bin) ->
    <<Word:16/little, Rest/binary>> = Bin,
    {Word, Rest}.

Signed short is implemented similarly, the only difference is that we use little-signed instead of little.

%%% Signed short

sshort() ->
    {fun write_sshort/2, fun read_sshort/1}.

write_sshort(Acc, Word) ->
    [<<Word:16/little-signed>>|Acc].

read_sshort(Bin) ->
    <<Word:16/little-signed, Rest/binary>> = Bin,
    {Word, Rest}.

I will skip the implementation of signed and unsigned integers and long integers. You can find the full code at the end of this book. It’s much more interesting to ponder the design of a list combinator.

%%% List. We supply a pickler for list length 
%%% as well as a pickler for list elements.

list(Len, Elem) ->
    {fun(Acc, List) -> write_list(Len, Elem, Acc, List) end,
     fun(Bin) -> read_list(Len, Elem, Bin) end }.

To pickle and unpickle a list we need to pickle the length of the list and then pickle each element of the list in sequence. The only requirement for the picker and unpickler functions is to take certain arguments and return values in the format that the library expects.

list/2 returns a tuple of anonymous functions that follow this convention. The functions that are ultimately invoked look a bit different.

write_list({Len, _}, {Elem, _}, Acc, List) ->
    Acc1 = Len(Acc, length(List)),
    Fun = fun(A, Acc2) -> Elem(Acc2, A) end,
    lists:foldr(Fun, Acc1, List).

write_list/4 takes both the pickler for the length of the list and the pickler for each element. Remember that each pickler returns a list of pickled binary chunks. The length pickler itself is primed with the list of previously pickled chunks given to write_list/4 (Acc). Acc1 is the list of binary chunks resulting from the pickling of the list length (Len) together with the list of chunks accumulated before the call to write_list/4.

I won’t be explaining lists:foldr/3 but we are creating an anonymous function (Fun) that will be invoked for each element of the to-be-pickled list we are given (List). This anonymous function will then invoke the list element pickler and return the list of binary chunks we have pickled so far, to prime list:foldr/3 on its next iteration.

Reading a pickled list aka unpickling is, again, a two step operation.

read_list({_, Len}, {_, Elem}, Bin) ->
    {N, Bin1} = Len(Bin),
    read_list(N, [], Elem, Bin1).

First we unpickle the list length. This gives us both the number of elements to read and the remainder of our binary data. We then proceed to unpickle the list itself using the data that was left over.

read_list(0, Acc, _, Bin) -> {Acc, Bin};
read_list(N, Acc, Elem, Bin) ->
    {E, Bin1} = Elem(Bin),
    read_list(N - 1, [E|Acc], Elem, Bin1).

There are no for loops in Erlang but they are easily emulated with recursion. We unpickle each element of the list, accumulate it and proceed to unpickle the next element after decrementing the number of elements read. We finish once we have reached 0.

Often, we will need to store different data depending on some flag. This requires us to both store the value of the flag and store the data. The choice combinator implements this alternative selection.

%%% Alternative selection. This could probably use some
%%% deeper thinking. Otherwise, we take a pickler for the tag
%%% as well as a tuple of two functions. The first one
%%% returns the tag value and a pickler based on the supplied
%%% value. The second one selects a pickler based on a tag value.

choice(Tag, Choice) ->
    {fun(Acc, Value) -> write_choice(Tag, Choice, Acc, Value) end,
     fun(Bin) -> read_choice(Tag, Choice, Bin) end }.

There’s not much to say about choice itself. It looks a lot like the list combinator that we have just implemented.

write_choice({Tag, _}, {Choice, _}, Acc, Value)
  when is_function(Tag),
       is_function(Choice) ->
    {T, {Pickler, _}} = Choice(Value),
    Acc1 = Tag(Acc, T),
    Pickler(Acc1, Value).

The choice helper function (selector) analyzes the data we are pickling and returns both a tag to store and the combinator to use for the data. We serialize the tag and the value right after it.

read_choice({_, Tag}, {_, Choice}, Bin)
  when is_function(Tag),
       is_function(Choice) ->
    {T, Bin1} = Tag(Bin),
    {_, Pickler} = Choice(T),
    Pickler(Bin1).

We work in the opposite direction to unpickle. We first unpickle the tag and let the choice function (selector) give us the combinator to use for the data. We use this combinator to unpickle the data.

%%% Optional value. Use 'none' to indicate no value.

optional(Pickler) ->
    {fun(Acc, Value) -> write_optional(Pickler, Acc, Value) end,
     fun(Bin) -> read_optional(Pickler, Bin) end}.

write_optional(_, Acc, none) ->
    [<<0>>|Acc];

write_optional({Pickler, _}, Acc, Value) ->
    Pickler([<<1>>|Acc], Value).

read_optional({_, Pickler}, Bin) ->
    <<Opt:8, Bin1/binary>> = Bin,
    case Opt of
      0 -> {none, Bin1};
      _ -> Pickler(Bin1)
    end.

To serialize optional values (i.e. value or nothing) we pickle 0 when there’s no value and 1 otherwise.

The value of the wrapper combinator may not be readily apparent but bear with me, it will come in handy to implement serialization of enumerations!

%%% Wrapper. Take a pickler and a wrapper tuple of two functions
%%% where the first one is used to convert the value before 
%%% pickling and the second one after unpickling.

wrap(Wrap, Pickler) ->
    {fun(Acc, Value) -> write_wrap(Wrap, Pickler, Acc, Value) end,
     fun(Bin) -> read_wrap(Wrap, Pickler, Bin) end}.

write_wrap({Wrap, _}, {Pickler, _}, Acc, Value) ->
    Pickler(Acc, Wrap(Value)).

read_wrap({_, Wrap}, {_, Pickler}, Bin) ->
    {Value, Bin1} = Pickler(Bin),
    {Wrap(Value), Bin1}.

This combinator resembles the list combinator we implemented previously but instead of taking a combinator used to serialize the list length, it takes a helper function used to transform the data before pickling and after unpickling.

Erlang does not support enumerations but I want to have enumerations where values increase sequentially such as {cow, sheep, horse}. I also want to be able to explicitly assign a value to each element of the enumeration, e.g. [{cow, 10}, {sheep, 100}]. Finally, the whole point of the exercise is to be able to marshal these enumerations back and forth.

We will assume that enumerated values given as a tuple start from 1.

enum(Enum, Pickler) ->
    wrap(wrap_enum(Enum), Pickler).

The enum/2 combinator takes both the format of the enumeration (list or tuple) as well as the pickler for the enumeration value. It’s clear in its simplicity but it’s also clear that it’s hiding something!

What is wrap_enum/1 and why do we need it?

wrap_enum(Enum)
  when is_tuple(Enum) ->
    wrap_enum_1(prep_enum_tuple(Enum));

wrap_enum(Enum)
  when is_list(Enum) ->
    wrap_enum_1(prep_enum_list(Enum)).

Recall that the format of our enumeration can be given both as a tuple and a list. We will pre-process the enumeration format to convert it to a list when it’s given to us as a tuple.

prep_enum_tuple(Enum)
  when is_tuple(Enum) ->
    prep_enum_tuple(Enum, size(Enum), [], []).

prep_enum_tuple(_, 0, Acc1, Acc2) ->
    {Acc1, Acc2};

prep_enum_tuple(Enum, N, Acc1, Acc2) ->
    prep_enum_tuple(Enum, N - 1,
        [{element(N, Enum), N}|Acc1],
        [{N, element(N, Enum)}|Acc2]).

The above will convert {cow, sheep, horse} into a pair (tuple of two elements) of lists [{cow, 1}, {sheep, 2}, {horse, 3}] and [{1, cow}, {2, sheep}, {3, horse}]. We need the regular list to convert cow into 1 for pickling and the inverted list to convert 1 back into cow.

prep_enum_list(Enum)
  when is_list(Enum) ->
    % expect a list of {tag, #value} pairs
    Inv = fun({Key, Val}) -> {Val, Key} end,
    InvEnum = lists:map(Inv, Enum),
    {Enum, InvEnum}.

The only thing we need to do when the format of the enumeration is a list is to create the inverted list of pairs. The anonymous function Inv swaps {cow, 100} for {100, cow}. We use lists:map/2 to apply our anonymous function to each element of the enumeration specification list, thus inverting each element.

And here’s the ultimate wrapper, the function that we spent so much time gearing up to!

wrap_enum_1({List1, List2}) ->
    F = fun(A, B) -> A < B end,
    %% gb_trees needs an ordered list
    Dict1 = lists:sort(F, List1),
    Dict2 = lists:sort(F, List2),
    Tree1 = gb_trees:from_orddict(Dict1),
    Tree2 = gb_trees:from_orddict(Dict2),
    {fun(Key) -> gb_trees:get(Key, Tree1) end,
     fun(Key) -> gb_trees:get(Key, Tree2) end}.

The gb_trees module implements a lightweight hash table using Erlang tuples. We order our enumeration lists and convert them to gb_trees to make lookups simple. We save two trees, one to look up cow using one and another to look one up using cow.

This completes our processing of enumerations. There’s one last hill to climb and then I promise you that we will be in combinator nirvana! But first we need to handle serialization of tuples and Erlang records.

%%% Tuple. Uses a tuple of picklers of the same size.

tuple(Picklers)
  when is_tuple(Picklers) ->
    wrap({fun tuple_to_list/1,
    fun list_to_tuple/1},
   tuple_0(tuple_to_list(Picklers))).

We reuse the wraping code we just develop to ensure that each tuple is pickled as a list and that each list is converted back to a tuple after we deserialize it.

record(Tag, Picklers)
  when is_tuple(Picklers) ->
    wrap({fun(Record) -> record_to_list(Tag, Record) end,
    fun(List) -> list_to_record(Tag, List) end},
   tuple_0(tuple_to_list(Picklers))).

We rely on Erlang records being tuples and just add the record tag as the first element when unpickling the record.

write_tuple_0([], Acc, _) ->
    Acc;

write_tuple_0([{Pickler, _}|Rest], Acc, [Value|Tuple]) ->
    write_tuple_0(Rest, Pickler(Acc, Value), Tuple).

read_tuple_0(Picklers, Bin) ->
    read_tuple_0(Picklers, Bin, []).

read_tuple_0([], Bin, Acc) ->
    {lists:reverse(Acc), Bin};

read_tuple_0([{_, Pickler}|Rest], Bin, Acc) ->
    {Value, Bin1} = Pickler(Bin),
    read_tuple_0(Rest, Bin1, [Value|Acc]).

We serialize a tuple by requiring a tuple of combinators of the same length.We then convert the tuple of combinators to a list to simplify processing. We pickle and unpickle recursively, using the accumulator idiom.

%%% It's convenient to be able to convert the tuple
%%% to a list first as there's no erlang:prepend_element/2.

tuple_0(Picklers)
  when is_list(Picklers) ->
    {fun(Acc, Value) -> write_tuple_0(Picklers, Acc, Value) end,
     fun(Bin) -> read_tuple_0(Picklers, Bin) end}.

record_to_list(Tag, Record)
  when is_atom(Tag) ->
    lists:nthtail(1, tuple_to_list(Record)).

list_to_record(Tag, List)
  when is_atom(Tag),
       is_list(List) ->
    list_to_tuple([Tag|List]).

Erlang records are regular tuples where the first element of the tuple is the record tag. When pickling a record we convert the record to a list and drop the first element (tag). When unpickling we prepend the tag. We never store the tag itself since the record combinator knows it.

We’ll skip the implementation of the binary combinator since it’s nothing fancy. You can find the full code at the end of the book.

Testing

Now is a good time to tackle testing.

Erlang macro facilities could definitely be better but they are also nothing to sneeze at! Lets define a couple of macros to help us with writing our unit tests.

-define(error1(Expr, Expected, Actual),
  io:format("~s is ~w instead of ~w at ~w:~w~n",
      [??Expr, Actual, Expected, ?MODULE, ?LINE])).

-define(match(Expected, Expr),
        fun() ->
    Actual = (catch (Expr)),
    case Actual of
        Expected ->
      {success, Actual};
        _ ->
      ?error1(Expr, Expected, Actual),
      erlang:error("match failed", Actual)
    end
  end()).

We will be using match/2 a lot to make sure that whatever we pickle matches whatever we get after unpickling.

check(Pickler, Value) ->
    X = pickle(Pickler, Value),
    Bin = list_to_binary(X),
    unpickle(Pickler, Bin).

This little function is our testing workhorse. It takes a pickler combinator and a value and proceed to pickle a value and unpicle it using the same combinator.

test1() ->
    X = 16#ff,
    ?match(X, check(byte(), X)).

test3() ->
    X = -1,
    ?match(X, check(sshort(), X)).

This is what our tests look like. We give check a combinator and a value and use our match macro to check results. I’ll skip a few non-essential tests since you have the full source code at the end of the book. I do want to spend time on other tests, though, since these tests server as the manual and documentation for our pickler combinator library.

test8() ->
    X = "Wazzup!",
    ?match(X, check(list(int(), byte()), X)).

We serialize the length of the list as an integer and each elment as a byte. Erlang strings are nothing but lists of integers but ASCII character values fit within a byte. There’s nothing preventing you from using the int combinator to serialize elements of the list, though.

value2tag(Action)
  when is_list(Action) ->
    {0, list(byte(), byte())};

We want to serialize either a list of bytes where the length of the list is also stored as a byte or a long value. We use 0 as a tag for the list.

value2tag(_) ->
    {1, long()}.

And store 1 when the following value is a long.

tag2value(0) ->
    list(byte(), byte());

tag2value(1) ->
    long().

We reverse things when unpickling. If a tag value of 0 is found then we return the list combinator and otherwise return the long one.

selector() ->
    {fun value2tag/1, fun tag2value/1}.

selector simply combines the above tag convertors together.

test9() ->
    X1 = "Just testing",
    X2 = 16#ffff,
    ?match(X1, check(choice(byte(), selector()), X1)),
    ?match(X2, check(choice(byte(), selector()), X2)).

We need to make sure that pickling and unpickling both the string (list) and the long value works. And it does!

test10() ->
    X1 = none,
    X2 = 55,
    ?match(X1, check(optional(byte()), X1)),
    ?match(X2, check(optional(byte()), X2)).

We use none to stand for no value.

test11() ->
    %% tuple enum
    Enum1 = {cow, sheep, horse},
    {FROM1, TO1} = wrap_enum(Enum1),
    ?match(1, FROM1(cow)),
    ?match(2, FROM1(sheep)),
    ?match(3, FROM1(horse)),
    ?match(cow, TO1(1)),
    ?match(sheep, TO1(2)),
    ?match(horse, TO1(3)),
    %% list enum
    Enum2 = [{cow, 20}, {sheep, 30}, {horse, 40}],
    {FROM2, TO2} = wrap_enum(Enum2),
    ?match(20, FROM2(cow)),
    ?match(30, FROM2(sheep)),
    ?match(40, FROM2(horse)),
    ?match(cow, TO2(20)),
    ?match(sheep, TO2(30)),
    ?match(horse, TO2(40)).

Personally, I found the enumeration combinator the most tedious to describe, probably because there’s so much supporting code. That supporting code needs to be tested and we do it here. wrap_enum works like a charm!

test12() ->
    Enum1 = {cow, sheep, horse},
    Enum2 = [{cow, 20}, {sheep, 30}, {horse, 40}],
    ?match(cow, check(enum(Enum1, byte()), cow)),
    ?match(sheep, check(enum(Enum2, byte()), sheep)).

Once we know our supporting code works, we can proceed with the rest. Here we test enumerations given as a tuple and a list of key/value pairs. Farm animals galore!

test13() ->
    Tuple = {"Joel", 16#ff00, none},
    Spec = {list(byte(),byte()), short(), optional(byte())},
    ?match(Tuple, check(tuple(Spec), Tuple)).

Tuple combinators, remember those? We use a tuple of combinators to pickle a tuple of values. The size of both tuples must be the same but the values can be anything. Here we use a string, a short and an optional byte.

-record(foo, { a, b }).
-record(bar, { c, d }).
-record(baz, { e, f }).

Records are important to an Erlang programmer, even though they are syntactic sugar on top of tuples. I would be quickly left without hair to tear out, if I always had to use element/2 to access tuple elements by number.

We define some records for the purposes of testing.

test14() ->
    R = #baz{ e = 30, f = "Enough nesting!" },
    R1 = #foo{ a = 10, b = #bar{ c = 20, d = R }},
    Pickler = record(foo, {
           byte(),
           record(bar, {
        int(),
        record(baz, {
           sshort(),
           list(byte(), byte())
          })
             })
          }),
    ?match(R1, check(Pickler, R1)).

Here’s the mother of all tests where we pickle a bunch of nested records with mixed values and restore them back to their original glory. This concludes our presentation of pickler combinators. Please feel free to use them as you see fit and don’t forget to send me any ideas for improvement!

The last thing to note is that the pickler combinator approach is definitely less efficient than processing binaries directly. Still, it is suitable for lots of applications where programming productivity is more important than ultimate efficiency.

Full pickler combinator source code is available.

Transparency and Masking in Lispworks CAPI

2008-01-21T19:15:00+01:00

CAPI is a good cross-platform GUI toolkit and has been used to write apps like Prime Trader. Your apps will have a native look on each platform and you won’t have to do anything special to make it happen. Still, bits of platform speific code are still required and one example is alpha-blending.

There’s no support for alpha-blending in CAPI. You can do masking but specifying a transparent color in your images but this is way too basic to render a poker room so I have to resort to platform-specific code to make it happen.

The poker room is a composite image where most of the elements, save for the carpet, have a greyscale mask in a separate file. A greyscale (0-255) mask lets you specify translucency and simulate shading. This is how the shade cast by the table and chairs is done. The carpet is drawn first, two to ten chairs go next, the table is sandwiched on top and finally the cards, chips, buttons, etc. are drawn.

I should be able to make the poker room a pinboard layout, set the composite poker room image as the background and make dynamic objects such as cards, chips and buttons into pinboard objects.

Alpha-blending is key to this project and is surprisingly easy to simulate even for images formats that do not support an alpha channel. I’m storing most of the images as JPEGs with some BMPs mixed in and the format for each picture is chosen to save space while preserving image quality. A carpet is just 360K as a JPEG, for example, while over 1.1Mb when stored as a PNG without the alpha channel.

The formula to use for alpha-compositing is

displayColor = sourceColor * alpha / 255 + backgroundColor * (255 - alpha) / 255

which requires you to retrieve the values of each pixel in 3 images and store the target pixel back after multiplication. LispWorks color components are float values from 0 to 1 so the formula will look slightly different.

The kosher way to accomplish the blending with LispWorks is to load the images, create image access handles, load the pixel data into the image access structures and then retrieve pixels in a loop. Pixel values need to be converted into a color spec before individual color components can be retrieved. This is the naive way of doing it:

(defun blend (pane target-file source-file mask-file) (let* ((source (gp:load-image pane source-file :cache t)) (target (gp:load-image pane target-file :cache t)) (mask (gp:load-image pane mask-file :cache t)) (source-access (gp:make-image-access pane source)) (target-access (gp:make-image-access pane target)) (mask-access (gp:make-image-access pane mask))) (unwind-protect (progn (gp:image-access-transfer-from-image source-access) (gp:image-access-transfer-from-image target-access) (gp:image-access-transfer-from-image mask-access) (dotimes (y (gp:image-access-height target-access)) (dotimes (x (gp:image-access-width target-access)) (let* ((scolor (color:unconvert-color pane (gp:image-access-pixel source-access x y))) (tcolor (color:unconvert-color pane (gp:image-access-pixel target-access x y))) (mcolor (color:unconvert-color pane (gp:image-access-pixel mask-access x y)))) (setf (gp:image-access-pixel target-access x y) (color:convert-color pane (color:make-rgb ;; red (+ (* (color:color-red scolor) (color:color-red mcolor)) (* (color:color-red tcolor) (- 1 (color:color-red mcolor)))) ;; green (+ (* (color:color-green scolor) (color:color-green mcolor)) (* (color:color-green tcolor) (- 1 (color:color-green mcolor)))) ;; blue (+ (* (color:color-blue scolor) (color:color-blue mcolor)) (* (color:color-blue tcolor) (- 1 (color:color-blue mcolor)))) )))))) (gp:image-access-transfer-to-image target-access)) (progn (gp:free-image-access source-access) (gp:free-image-access target-access) (gp:free-image-access mask-access))) target))

This is also a very slow way of doing it as it takes 11-12 seconds to blend three 794x538 JPEG images (carpet, table, mask) on my Powerbook G4 1.25Gz.

I did some digging around at the beginning of the year to be able to load image data into OpenGL textures. I’m not using OpenGL this time but I need to assign the bitmap data back to the image after modifying it.

Getting the Cocoa image handle is done by calling (image-ns-image image), assuming that image was the result of (gp:load-image …). Bitmap data can be retrieved like this:

(defun cocoa-get-image-bytes (image) (let ((bitmap (objc:invoke (objc:invoke "NSBitmapImageRep" "alloc") "initWithData:" (objc:invoke image "TIFFRepresentation")))) (if bitmap (let ((data (objc:invoke-into '(:pointer (:unsigned :char)) bitmap "bitmapData"))) (values bitmap data)) nil))) ;;; Free image data (defun cocoa-free-image-bytes (bitmap) (objc:invoke bitmap "release"))

and blending is just an optimized array loop:

;;; Blend a masked source image with a target (defun cocoa-blend (target source mask offset size) (declare #.*optimize* (type fixnum size offset) (inline fli:dereference (setf fli:dereference))) (loop for i fixnum from offset below (the fixnum (+ offset size)) for j fixnum from 0 below size do (let ((dst (fli:dereference target :index i :type '(:unsigned :char))) (src (fli:dereference source :index j :type '(:unsigned :char))) (alpha (fli:dereference mask :index j :type '(:unsigned :char)))) (declare (type fixnum dst src alpha)) (when (> alpha 0) (setf (fli:dereference target :index i :type '(:unsigned :char)) (the fixnum (truncate (/ (+ (* src alpha) (* dst (- 255 alpha))) 255)))) ))))

There’s one last bit that needs to be done before the image data is updated. It took me a whole evening of poking around and googling before I finally found my answer.

TIFFRepresentation returns a copy of the bitmap data and the easiest way to update the image is to remove the returned representation and to add it right back with code like this:

;; retrieve raw image data (multiple-value-bind (background-bitmap background-data) (cocoa-get-image-bytes ns-background) (multiple-value-bind (image-bitmap image-data) (cocoa-get-image-bytes ns-image) (multiple-value-bind (mask-bitmap mask-data) (cocoa-get-image-bytes ns-mask) (cocoa-blend background-data image-data mask-data offset size) (objc:invoke ns-background "removeRepresentation:" (objc:invoke (objc:invoke ns-background "representations") "objectAtIndex:" 0)) (objc:invoke ns-background "addRepresentation:" background-bitmap)

Voila! It takes less than a second to blend three large images together. Problem solved. I will still need to poke around to get appropriate code under Windows and Linux.

HiPE for Mac X86

2006-10-01T18:45:00+02:00

It started innocently enough with my wondering why High-performance Erlang (HiPE) was not available on my shiny new MacBook Pro. This turned into a long but awesome email exchange and culminated in victory, and my port of HiPE to Mac Intel, less than two weeks later.

I learned a fair number of things about the Mac OSX kernel, the FPU, floating-point exceptions, Intel 32-bit architecture and SSE2 along the way. I also had an awesome time with assembler code.

I could not have done it without the mach_override library and numerous tips from Mikael Pettersson as well as other folks on the Erlang Questions mailing list. I will be shipping my patches to the HiPE team this week.