jolt-burg

In April I posted to the fonc mailing list about my port of Ian Piumarta’s “jolt-burg”.

This is a combination of a simple lisp-like language (“jolt”) and a compiler from a tree of “instruction” objects to native machine code.

My implementation was in Common Lisp and my compiler targeted relocatable ELF object files.

From my post:

Currently I have a compiler that can read sexp input, eg:

(define |main| (lambda ()
        ((call-c |dlsym| 0 "puts") "hello, dynamic world!")))

and then compile it down to a tree of blocks and instruction objects (see instruction.lisp or Instruction.st) 

BLOCK(--- NIL ---)                                                                                                                                                         
| | 0(--- VOID BLOCK --- 369                                                                                                                                               
| | | | | 0(+++ REG CALLI4 ---                                                                                                                                             
| | | | | | 0(+++ REG CNSTP4 --- reloc ---)                                                                                                                                
| | | | | | 0(+++ REG CNSTI4 --- 0)                                                                                                                                        
| | | | | | 0(+++ REG CNSTP4 --- reloc ---))                                                                                                                               
| | | | | 0(+++ REG CNSTP4 --- reloc ---))                                                                                                                                 
| | 0(--- VOID BLOCK --- 369                                                                                                                                               
| | | | | 0(+++ REG CALLI4 EBX                                                                                                                                             
| | | | | | 0(+++ REG CNSTP4 EBX reloc ---)                                                                                                                                
| | | | | | 0(+++ REG CNSTI4 EAX 0)                                                                                                                                        
| | | | | | 0(+++ REG CNSTP4 ECX reloc ---))                                                                                                                               
| | | | | 0(+++ REG CNSTP4 EAX reloc ---))                       

This tree is processed by the burg compiler to emit x86 machine code. (in the diagram we see registers being assigned to the tree nodes)

The last stage is when I collect the machine code generated by the burg compiler and combine it with data and relocation entries to generate an ELF object file.

I can then pass this to the unix linker (ld) to produce an executable.

ld --dynamic-linker=/lib/ld-linux.so.2 state/start.o state/hello.state.o -ldl  -lc -o myhello

Here you can see the disassembled elf object file with relocation entries for the "dlsym" symbol and the "puts" and "hello world" strings.

objdump -d state/hello.state.o -r

Disassembly of section .text:

00000000 
: 0: 55 push %ebp 1: 89 e5 mov %esp,%ebp 3: 53 push %ebx 4: 83 ec 14 sub $0x14,%esp 7: bb 00 00 00 00 mov $0x0,%ebx 8: R_386_32 dlsym c: b8 00 00 00 00 mov $0x0,%eax 11: b9 00 00 00 00 mov $0x0,%ecx 12: R_386_32 _data_286 16: 89 4c 24 04 mov %ecx,0x4(%esp) 1a: 89 04 24 mov %eax,(%esp) 1d: ff d3 call *%ebx 1f: 89 c3 mov %eax,%ebx 21: b8 00 00 00 00 mov $0x0,%eax 22: R_386_32 _data_287 26: 89 04 24 mov %eax,(%esp) 29: ff d3 call *%ebx 2b: 89 c0 mov %eax,%eax 2d: 89 c0 mov %eax,%eax 2f: 83 c4 14 add $0x14,%esp 32: 5b pop %ebx 33: 5d pop %ebp 34: c3 ret

You can view the code at:

http://subvert-the-dominant-paradigm.net/repos/hgwebdir.cgi/bootstrap/

(see the burg directory)

(click files to see the files, or run ‘hg clone <url>’ to get a local copy)

Debian netboot install over PXE

Installing Debian on an ultraportable machine (no FDD, no CD) is fairly easy, but sometimes I get stuck.

To setup the PXE host I installed dhcp3-server and tftpd-hpa.

I used the netboot images at


http://ftp.nl.debian.org/debian/dists/lenny/main/installer-amd64/current/images/netboot/

copying them to /var/lib/tftpboot and unpacking netboot.tar.gz.

I configured /etc/dhcp3/dhcpd.conf for the target machine, using its MAC address. Don’t forget the ‘next-server’ option.


subnet 192.168.2.0 netmask 255.255.255.0 {

}

host cmalu {
 hardware ethernet xa:xa:xa:xa:xa:xa ;
 filename "pxelinux.0";
 next-server 192.168.2.1;
 server-name "name";
 fixed-address 192.168.2.99;
 option routers 192.168.2.1;
 option domain-name-servers 192.168.2.1;
}


I then start tftpd like this:


 /usr/sbin/in.tftpd -v -v -v -l -s /var/lib/tftpboot

it logs to /var/log/daemon.log

The debian installer was looking for pxelinux.cfg/01-xa:xa:xa:xa:xa:xa so I copied pxelinux.cfg/default to that file.

Once the installer starts things are fairly simple.

OMeta in Common Lisp

OMeta is a parsing engine by Ian Piumarta and Alessandro Warth. It combines PEG rules with a syntax for naming matched components and executable actions that can refer to the named parts. A simple OMeta rule looks like this:

ostring ::=     $' (~$' <ochar>)*:s $' => [(coerce  s 'string)]

Here a string is matched starting with a single quote, followed by any character that is not a single quote and ending with a single quote.

The action for this rule turns the list of characters matched into a lisp string.

I created an OMeta implementation in Common Lisp by bootstrapping from the squeak implementation of OMeta.

To do this I first modified the OMeta parser to be able to read lisp forms in the action bodies. Next I modified the OMeta compiler to produce lisp forms instead of smalltalk code.

Using these generated forms in combination with hand-coded primitive rules (ometa-prim.lisp) I was able to use two new grammars ometa-parser.g and ometa-compiler.g to fully bootstrap the system.

My code is available from this mercurial repository:


hg clone http://subvert-the-dominant-paradigm.net/repos/hgwebdir.cgi/ometa/

To run it:


(load "load.lisp")

Then you can parse a grammar file into its AST:


(parser-grammar-file "grammar.g")

To create an executable parser, first declare a subclass of ometa:


(defclass dnaparser (ometa) ())

Next write the production rules in a grammar file:


base ::=
$A | $T | $G | $C^L
dsequence ::=
<base>*:s => [ (coerce s 'string) ]^L

and generate the parser from the grammar:


(generate-parser 'dnaparser "example.g" "example.lisp")

This reads the grammar file “example.g” and produces lisp defmethods for the class ‘dnaparser’. These lisp forms are written to “example.lisp”.

After loading the parser, you can run the productions like this:


CL-USER> (let ((*ometa-class-name* 'dnaparser))
(run-production 'dsequence (coerce "GGCCGGGC" 'list)))
"GGCCGGGC"

As an alternative to generate-parser, you can use install-grammar to load the rules without generating an intermediate file.

The squeak implementation of OMeta supports several extensions that I have not implemented:

– Memoization of previous parse results
– Support for left-recursive rules
– Ability to apply a rule in the super class
– Support for rules that call out to a “foreign” parser during the parse
– An optimizer to remove redundant AND and OR forms produced by the parser

The Farmer, Fox, Chicken and Grain problem (in lisp)

The same problem in lisp. Here you can see how much work has to be done to mimic sets.


(defun safe-p (list)
  (or (member 'farmer list)
      (and (not (and (member 'fox list)
                     (member 'chicken list)))
           (not (and (member 'chicken list)
                     (member 'grain list))))))

(defun permute-state (state)
  (let (result)
    (destructuring-bind (near far) state
      (if (member 'farmer near)
          (let ((others (set-difference near '(farmer))))
            (push (list 'farmer (list others
                                      (cons 'farmer far))) result)
            (loop for item in others
                  do (push (list item (list  (remove item others) (cons item (cons 'farmer far)))) result))
            result)
          ; we just reverse the sides                                                                                                    
          (loop for (move (near far)) in (permute-state (reverse state))
                collect (list move (list far near)))))))

(defvar *history* nil)
(defun solve (initial-state goal-state moves)
  (if (and (null (set-difference (first initial-state) (first goal-state)))
           (null (set-difference (second initial-state) (second goal-state))))
      (progn
        (format t "Found solution~%")
        (loop for move in (reverse moves)
              and direction = 'forward then (if (eq direction 'forward)
                                                'back
                                                'forward)
              do (if (eq move 'farmer)
                     (format t "Farmer crosses ~A~%" direction)
                     (format t "Farmer crosses ~A with ~A~%" direction move)))))
  (loop for (move new-state) in (permute-state initial-state)
        do
        (if (and (not (member (sort  (copy-list (first new-state)) #'string-lessp) *history* :test #'equal))
                 (safe-p (first new-state))
                 (safe-p (second new-state)))
            (progn
              (push (sort (copy-list (first new-state)) #'string-lessp) *history*)
              (solve new-state goal-state (cons move moves))))))

and the output:

CL-USER: (progn (setf *history* nil) (solve '((farmer fox chicken grain) ()) '(() (farmer fox chicken grain)) nil))
Found solution                                                                                                                           
Farmer crosses FORWARD with CHICKEN                                                                                                      
Farmer crosses BACK                                                                                                                      
Farmer crosses FORWARD with GRAIN                                                                                                        
Farmer crosses BACK with CHICKEN                                                                                                         
Farmer crosses FORWARD with FOX                                                                                                          
Farmer crosses BACK                                                                                                                      
Farmer crosses FORWARD with CHICKEN                                                                                                      
NIL
CL-USER:

Space filling curves

Last year I discovered space filling curves, they are shapes that can fill a plane without intersection. They can be used to create a spatial index for data in two (or three) dimensions.

I wrote a small pygtk script that uses cairo to draw some peano iterations:
Peano space filling curve

The drawing routine is quite simple


        def turn(cr):
                cr.rotate( pi / 2)

        def extend(cr):
                cr.rel_line_to(0, -unitsize)

        def flip(cr):
                cr.transform(cairo.Matrix(-1,0,0,1,0,0))

        def draw_piece(cr):
                cr.rel_line_to(0, - unitsize * 2)
                cr.rel_line_to(unitsize, 0)
                cr.rel_line_to(0, 2.0 * unitsize)
                cr.rel_line_to(unitsize, 0)
                cr.rel_line_to(0, unitsize * -2.0)

        def doturn(b):
                if (not (b % 243 == 0)) and (b % 81 == 0):
                        return
                if (not (b % 27 == 0)) and (b % 9 == 0):
                        return
                turn(cr)

        for b in range(1,iterations):
                draw_piece(cr)
                if b % 3 == 0:
                        doturn(b)
                if not (b == iterations - 1):
                        extend(cr)
                if b % 3 == 0:
                        doturn(b)
                flip(cr)

The Farmer, Fox, Chicken and Grain problem (in maude)

In my previous post I solved this problem with prolog. Here I have written a solution using the rewrite logic of the Maude system.


mod FARMER is
        sort GameState .
        sort Bank .
        sort Actor .
        subsort Actor < Bank .

        op state : Bank Bank -> GameState [ ctor ] .
        ops Farmer, Fox, Chicken, Grain : -> Actor [ ctor ] .

        op Empty : -> Bank [ ctor ] .
        op __ : Bank Bank -> Bank [ctor assoc comm id: Empty] .

        op safe : Bank -> Bool .

        vars A1 : Actor .
        vars X Y Z : Bank .
        eq safe( Farmer X ) = true .
        eq safe( Chicken Fox X) = false .
        eq safe( Chicken Grain X) = false .
        eq safe( X ) = true [owise] .

        crl [cross_with] : state((Farmer A1 X),Y) => state(X,(Farmer A1 Y)) if safe(X) .
        crl [cross_alone] : state((Farmer X),Z) => state(X,(Farmer Z)) if safe(X) .
        crl [cross_back_with] : state(X,(Farmer A1 Z)) => state((Farmer A1 X),Z) if safe(Z) .
        crl [cross_back_alone] : state(X,(Farmer Z)) => state((Farmer X),Z) if safe(Z) .
endm

Maude has a built-in search mechanism that allows us to find a solution:


Maude> search state(Farmer Fox Chicken Grain,Empty) =>+ state(Empty, Farmer Grain Chicken Fox) .
search in FARMER : state(Farmer Fox Chicken Grain, Empty) =>+ state(Empty, Farmer Fox Chicken Grain) .

Solution 1 (state 9)
states: 10  rewrites: 43 in 0ms cpu (0ms real) (~ rewrites/second)
empty substitution

No more solutions.
states: 10  rewrites: 50 in 0ms cpu (0ms real) (~ rewrites/second)
Maude> show path 9 .
state 0, GameState: state(Farmer Fox Chicken Grain, Empty)
===[ crl state(Farmer X A1, Y) => state(X, Farmer Y A1) if safe(X) = true [label cross_with] . ]===>
state 1, GameState: state(Fox Grain, Farmer Chicken)
===[ crl state(X, Farmer Z) => state(Farmer X, Z) if safe(Z) = true [label cross_back_alone] . ]===>
state 2, GameState: state(Farmer Fox Grain, Chicken)
===[ crl state(Farmer X A1, Y) => state(X, Farmer Y A1) if safe(X) = true [label cross_with] . ]===>
state 3, GameState: state(Grain, Farmer Fox Chicken)
===[ crl state(X, Farmer Z A1) => state(Farmer X A1, Z) if safe(Z) = true [label cross_back_with] . ]===>
state 5, GameState: state(Farmer Chicken Grain, Fox)
===[ crl state(Farmer X A1, Y) => state(X, Farmer Y A1) if safe(X) = true [label cross_with] . ]===>
state 7, GameState: state(Chicken, Farmer Fox Grain)
===[ crl state(X, Farmer Z) => state(Farmer X, Z) if safe(Z) = true [label cross_back_alone] . ]===>
state 8, GameState: state(Farmer Chicken, Fox Grain)
===[ crl state(Farmer X A1, Y) => state(X, Farmer Y A1) if safe(X) = true [label cross_with] . ]===>
state 9, GameState: state(Empty, Farmer Fox Chicken Grain)

The Farmer, Fox, Chicken and Grain problem

I haven’t had much opportunity to work with logic programming languages, so I attempted this simple planning problem in Prolog:

A farmer is returning to his farm after a long day of working in the fields. He has with him a fox, a chicken, and some grain. He must cross a small stream on his way back to the barn. At the stream, there is a canoe, in which he can transport at most one item across at a time. However, he cannot leave the fox alone with the chicken, or the fox will eat the chicken. Similarly, he cannot leave the chicken alone with the grain because the chicken will eat the grain. Devise a plan (sequence of actions) that the farmer can take to safely bring all of his possessions across the stream and continue on his way home.

I wrote the following solution using gprolog. Both gprolog and the other prolog available on Debian systems, swi-prolog, have really horrible programming environments. I can see why many people would skip over prolog given such poor implementations.


initial(X) :- sort([farmer,fox,chicken,grain],X).

% exclude invalid combinations

check_invalid([chicken, fox]) :- !, fail.
check_invalid([chicken, grain]) :- !, fail.
check_invalid([chicken, fox, grain]) :- !,fail.
check_invalid(_) :- true.

% check if we have reached the goal

find_solution(Goal,Goal,_, Moves,Plan) :-
    reverse(Moves,Plan).

% try to make a move, check whether the result is valid
% and check the history to see if we are repeating a move

find_solution(Initial,Goal,History, Moves, Plan) :-
    cross(Initial,[Near,Far],Move),
    sort(Near,SNear),
    sort(Far,SFar),
    check_invalid(SNear),
    check_invalid(SFar),
    \\+(member([SNear,SFar],History)),
    find_solution([SNear,SFar], Goal, [[SNear,SFar] | History], [ Move | Moves], Plan).

% cross from Near to Far side
cross([Near,Far],Result,Move) :-
    member(farmer, Near),
    cross1([Near,Far],Result, Move, forward).

% cross from Far to Near side
cross([Near,Far],[NN,NF],Move) :-
    member(farmer, Far),
    cross1([Far,Near],[NF,NN], Move, backward).

% let the farmer cross alone
cross1([Near,Far],[NN,NF],Move,Direction) :-
    select(farmer,Near,NN),
    append([farmer],Far, NF),
    Move = [Direction, farmer, []].

% let the farmer cross with one Animal/grain
cross1([Near,Far],[NN,NF],Move,Direction) :-
    select(farmer,Near,RemainingNear),
    member(Animal,RemainingNear),
    select(Animal,RemainingNear,NN),
    append([farmer,Animal],Far, NF),
    Move = [Direction, farmer, [Animal]].

run(Plan) :-
    initial(I),
    find_solution([I,[]],
                  [[],I],
                  [],
                  [],
                  Plan).

metapeg

I was inspired by the metacircular parser written by DV Schorre and Ian Piumarta’s related work in his pepsi/coke project to write a parser generator that can generate itself.

I bootstrapped the parser by using cl-peg to generate lisp code that could eventually generate itself.

I have made several versions of metapeg available, the first two are simple lisp and scheme implementations. The later two are more complex and allow the parser to walk back up the parse tree during the parse to examine the text matched by previous parse nodes. This functionality allows easy implementation of a @tag construct used to implement the indentation rules in languages like haskell, python and yaml (as suggested here) .

As an example I wrote a simple parser for yaml sequences. Here is some sample input:


-
 - 'foo'
 - 'bar'
 - 'yah'
 -
  - 'a'
  - 'b'
  - 'c'

This is the grammar:


program <- seq-element+ 

inset <- @inset ws+
ws <- [ \\t]
nl <- [\\n]
ws_or_nl <- ws/nl

seq-element <- "-" ws* string nl { (third data) } / nested-sequence
nested-sequence <- "-" ws* nl inset seq-element (@inset seq-element)* { 
(cons (fifth data) (zip-second (sixth data))) }

string <- "'" [ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz]+ "'" { 
(char-list-to-string (second data)) }

and the output:

CL-USER> (value (parse "../examples/nested_sequence.yaml" "yaml.lisp"))
(("FOO" "BAR" "YAH" ("A" "B" "C")))

The parsers generated by metapeg do not implement memoization of the parse results, possibly making them unsuitable for large grammars or large inputs.