21 Outlaw: self-hosting

Source code.

The king is dead, long live the king!

21.1 Bootstrapping the compiler

Take stock for a moment of the various language features we’ve built over the course of these notes and assignments: we’ve built a high-level language with built-in data types like booleans, integers, characters, pairs, lists, strings, symbols, vectors, boxes. Users can define functions, including recursive functions. Functions are themselves values and can be constructed anonymously with lambda. We added basic I/O facilities. We added the ability to overload functions based on the number of arguments received using case-lambda, the ability to define variable arity functions using rest arguments, and the ability to call functions with arguments from a list using apply. Users can defined their own structure types and use pattern matching to destructure values. Memory management is done automatically by the run-time system.

It’s a pretty full-featured language and there are lots of interesting programs we could write in our language. One of the programs we could almost write is actually the compiler itself. In this section, let’s bridge the gap between the features of Racket our compiler uses and those that our compiler implements and then explore some of the consequences.

We’ll call it Outlaw.

21.2 Features used by the Compiler

Let’s take a moment to consider all of the language features we use in our compiler source code, but we haven’t yet implemented. Open up the source code for, e.g. Neerdowell: structures, and see what you notice:

• Modules: programs are not monolithic; they are broken into modules in separate files like compile-stdin.rkt, parse.rkt, compile.rkt, etc.

• a86: our compiler relies heavily on the a86: a Little Assembly Language library that provides all of the constructors for a86 instructions and functions like asm-display for printing a86 instructions using NASM syntax.

• Higher-level I/O: at the heart of the front-end of our compiler is the use of Racket’s read function, which reads in an s-expression. We also use things like read-line which reads in a line of text and returns it as a string.

• Lots and lots of Racket functions: our compiler makes use of lots of built-in Racket functions that we haven’t implemented. These are things like length, map, foldr, filter, etc. Even some of the functions we have implemented have more featureful counterparts in Racket which we use. For example, our + primitve takes two arguments, while Racket’s + function can take any number of arguments.

• Primitives as functions: the previous item brings up an important distinction between our language and Racket. For us, things like + are primitives. Primitives are not values. You can’t return a primitive from a function. You can’t make a list of primitives. This means even if we had a map function, you couldn’t pass add1 as an argument, since add1 is not a value. In Racket, there’s really no such thing as a primitive; things like add1, +, cons?, etc. are all just functions.

If we want our compiler to be written in the language it implements we have to deal with this gap in some way. For each difference between what we implement and what we use, we basically only have two ways to proceed:

1. rewrite our compiler source code to not use that feature, or

2. implement it.

Let’s take some of these in turn.

21.3 Punting on Modules

Our compiler currently works by compiling a whole program, which we assume is given all at once as input to the compiler. The compiler source code, on the other hand, is sensibly broken into seperate modules.

We could think about designing a module system for our language. We’d have to think about how seperate compilation of modules would work. At a minimum our compiler would have to deal with resolving module references made through require.

While module systems are a fascinating and worthy topic of study, we don’t really have the time to do them justice and instead we’ll opt to punt on the module system. Instead we can rewrite the compiler source code as a single monolithic source file.

That’s not a very good software engineering practice and it will be a bit of pain to maintain the complete Outlaw source file. As a slight improvement, we can write a little utility program that given a file containing a module will recursively follow all required files and print out a single, require-free program that includes all of the modules that comprise the program.

Let’s see an example of the combine.rkt utility in action.

Suppose we have a program that consists of the following files:

Then we can combine these files into a single program as follows:

shell

> racket -t combine.rkt -m a.rkt > a-whole.rkt

outlaw/a-whole.rkt

#lang racket

;; c.rkt

;; b.rkt

;; a.rkt

;;;;;;;;;;;;

;; c.rkt

#;(provide c)

(define (c x)

(+ x 5))

;;;;;;;;;;;;

;; b.rkt

#;(provide b)

#;(require "c.rkt")

(define (b x)

(add1 (c x)))

;;;;;;;;;;;;

;; a.rkt

#;(provide a)

#;(require "b.rkt")

(define (a x)

(+ (b x) (b x)))

(a 10)

This gives us a rudimentary way of combining modules into a single program that can be compiled with our compiler. The idea will be that we construct a single source file for our compiler by running combine.rkt on compile-stdin.rkt. The resulting file will be self-contained and include everything compile-stdin.rkt depends upon.

It’s worth recognizing that this isn’t a realistic alternative to having a module system. In particular, combining modules in this way breaks usual abstractions provided by modules. For example, it’s common for modules to define their own helper functions or stateful data that are not exported (via provide) outside the module. This ensures that clients of the module cannot access potentially sensitive data or operations or mess with invariants maintained by a module’s exports. Our crude combination tool does nothing to enforce these abstraction barriers.

That’s an OK compromise to make for now. The idea is that combine.rkt doesn’t have to work in general for combining programs in a meaning-preserving way. It just needs to work for one specific program: our compiler.

21.4 Bare-bones a86

Our compiler makes heavy use of the a86: a Little Assembly Language library that provides all of the constructors for a86 instructions and functions like asm-display for printing a86 instructions using NASM syntax. That library is part of the langs package.

The library at its core provides structures for representing a86 instructions and some operations that work on instructions. While the library has a bunch of functionality that provides for good, early error checking when you construct an instruction or a whole a86 program, we really only need the structures and functions of the library.

To make the compiler self-contained we can build our own bare-bones version of the a86 library and include it in the compiler.

For example, here’s the module that defines an AST for a86 instructions:

outlaw/a86/ast.rkt

#lang racket

(provide (all-defined-out))

(struct Text   ())

(struct Data   ())

(struct Global (x))

(struct Label  (x))

(struct Call   (x))

(struct Ret    ())

(struct Mov    (dst src))

(struct Add    (dst src))

(struct Sub    (dst src))

(struct Cmp    (a1 a2))

(struct Jmp    (x))

(struct Je     (x))

(struct Jne    (x))

(struct Jl     (x))

(struct Jle    (x))

(struct Jg     (x))

(struct Jge    (x))

(struct And    (dst src))

(struct Or     (dst src))

(struct Xor    (dst src))

(struct Sal    (dst i))

(struct Sar    (dst i))

(struct Push   (a1))

(struct Pop    (a1))

(struct Lea    (dst x))

(struct Div    (den))

(struct Offset (r i))

(struct Extern (x))

(struct Equ    (x v))

(struct Const  (x))

(struct Dd (x))

(struct Dq (x))

(struct Plus (e1 e2))

;; (U Instruction Asm) ... -> Asm

;; Convenient for sequencing instructions or groups of instructions

(define (seq . xs)

(foldr (λ (x is)

(if (list? x)

(append x is)

(cons x is)))

'()

xs))

(define registers

'(cl eax rax rbx rcx rdx rbp rsp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15))

;; Any -> Boolean

(define (register? x)

(and (memq x registers) #t))

;; Any -> Boolean

(define (exp? x)

(or (Offset? x)

(and (Plus? x)

(exp? (Plus-e1 x))

(exp? (Plus-e2 x)))

(symbol? x)

(integer? x)))

(define offset? Offset?)

;; Any -> Boolean

(define (label? x)

(and (symbol? x)

(not (register? x))))

;; Any -> Boolean

(define (instruction? x)

(ormap (λ (p) (p x))

(list Text? Data? Global? Label? Extern? Call? Ret? Mov?

Add? Sub? Cmp? Jmp? Je? Jne? Jl? Jle? Jg? Jge?

And? Or? Xor? Sal? Sar? Push? Pop? Lea? Div? Equ?

Dd? Dq?)))

And here’s the module that implements the needed operations for writing out instructions in NASM syntax:

outlaw/a86/printer.rkt

#lang racket

(provide asm-string current-shared? asm-display)

(require "ast.rkt")

(define current-shared?

(let ((x (box #f)))

(case-lambda

[() (unbox x)]

[(y) (set-box! x y)])))

;; Any -> Boolean

(define (reg? x)

(register? x))

;; Reg -> String

(define (reg->string r)

(symbol->string r))

;; Label -> String

(define label-symbol->string

(match (system-type)

['macosx

(λ (s) (string-append "_" (symbol->string s)))]

[_ symbol->string]))

;; Label -> String

;; prefix with _ for Mac

(define label-symbol->string/rel

(match (system-type)

['macosx

(λ (s) (string-append "_" (symbol->string s)))]

[_

(λ (s)

(if (current-shared?)

(if (memq s (unbox external-labels))

; hack for ELF64 shared libraries in service of

; calling external functions in asm-interp

(string-append (symbol->string s) " wrt ..plt")

(symbol->string s))

(symbol->string s)))]))

;; (U Label Reg) -> String

(define (jump-target->string t)

(match t

[(? reg?) (reg->string t)]

[(Offset (? reg? r) i)

(string-append "[" (reg->string r) " + " (number->string i) "]")]

[_ (label-symbol->string/rel t)]))

;; Arg -> String

(define (arg->string a)

(match a

[(? reg?) (reg->string a)]

[(? integer?) (number->string a)]

[(Offset (? reg? r) i)

(string-append "[" (reg->string r) " + " (number->string i) "]")]

[(Offset (? label? l) i)

(string-append "[" (label-symbol->string l) " + " (number->string i) "]")]

[(Const l)

(symbol->string l)]

[(? exp?) (exp->string a)]))

;; Exp -> String

(define (exp->string e)

(match e

[(? integer?) (number->string e)]

[(Plus e1 e2)

(string-append "(" (exp->string e1) " + " (exp->string e2) ")")]

[_ (label-symbol->string/rel e)]))

(define tab (make-string 8 #\space))

(define external-labels (box '()))

(define (external-label-shared? x)

(and (label? x)

(current-shared?)

(eq? 'unix (system-type))

(memq x (unbox external-labels))))

(define (mov->string a1 a2)

(match a2

;; to handle loading external data

;; when 1) ELF, 2) building a shared object

[(Offset (? external-label-shared? l) i)

(string-append tab "mov "

(arg->string a1) ", "

"[" (label-symbol->string l) " + " (number->string i) " wrt ..gotpc]\n"

tab "mov "

(arg->string a1) ", "

"[" (arg->string a1) "]")]

;; the usual case

[_

(string-append tab "mov "

(arg->string a1) ", "

(arg->string a2))]))

;; Instruction -> String

(define (instr->string i)

(match i

[(Text)      (string-append tab "section .text")]

[(Data)      (string-append tab "section .data align=8")] ; 8-byte aligned data

[(Ret)       (string-append tab "ret")]

[(Label l)   (string-append (label-symbol->string l) ":")]

[(Global x)  (string-append tab "global "  (label-symbol->string x))]

[(Extern l)  (let ((r (string-append tab "extern " (label-symbol->string l))))

(begin

(set-box! external-labels (cons l (unbox external-labels)))

r))]

[(Mov a1 a2)

(mov->string a1 a2)]

[(Add a1 a2)

(string-append tab "add "

(arg->string a1) ", "

(arg->string a2))]

[(Sub a1 a2)

(string-append tab "sub "

(arg->string a1) ", "

(arg->string a2))]

[(Cmp a1 a2)

(string-append tab "cmp "

(arg->string a1) ", "

(arg->string a2))]

[(Sal a1 a2)

(string-append tab "sal "

(arg->string a1) ", "

(arg->string a2))]

[(Sar a1 a2)

(string-append tab "sar "

(arg->string a1) ", "

(arg->string a2))]

[(And a1 a2)

(string-append tab "and "

(arg->string a1) ", "

(arg->string a2))]

[(Or a1 a2)

(string-append tab "or "

(arg->string a1) ", "

(arg->string a2))]

[(Xor a1 a2)

(string-append tab "xor "

(arg->string a1) ", "

(arg->string a2))]

[(Jmp l)

(string-append tab "jmp "

(jump-target->string l))]

[(Je l)

(string-append tab "je "

(jump-target->string l))]

[(Jne l)

(string-append tab "jne "

(jump-target->string l))]

[(Jl l)

(string-append tab "jl "

(jump-target->string l))]

[(Jle l)

(string-append tab "jle "

(jump-target->string l))]

[(Jg l)

(string-append tab "jg "

(jump-target->string l))]

[(Jge l)

(string-append tab "jge "

(jump-target->string l))]

[(Call l)

(string-append tab "call "

(jump-target->string l))]

[(Push a)

(string-append tab "push "

(arg->string a))]

[(Pop r)

(string-append tab "pop "

(reg->string r))]

[(Lea d (? offset? x))

(string-append tab "lea "

(arg->string d) ", "

(arg->string x))]

[(Lea d x)

(string-append tab "lea "

(arg->string d) ", [rel "

(exp->string x) "]")]

[(Div r)

(string-append tab "div "

(arg->string r))]

[(Equ x c)

(string-append tab

(symbol->string x)

" equ "

(number->string c))]

[(Dd x)

(string-append tab "dd " (arg->string x))]

[(Dq x)

(string-append tab "dq " (arg->string x))]))

(define (instrs->string a)

(match a

['() ""]

[(cons i a)

(string-append (instr->string i) "\n" (instrs->string a))]))

;; Asm -> String

(define (asm-string a)

(begin

(set-box! external-labels '())

;; entry point will be first label

(match (findf Label? a)

[(Label g)

(string-append

tab "global " (label-symbol->string g) "\n"

tab "default rel\n"

tab "section .text\n"

(instrs->string a))]

[_

(instrs->string a)])))

(define (asm-display a)

(begin

(set-box! external-labels '())

;; entry point will be first label

(match (findf Label? a)

[(Label g)

(begin

(write-string

(string-append

tab "global " (label-symbol->string g) "\n"

tab "default rel\n"

tab "section .text\n"))

(asm-display-instrs a))]

[_

(asm-display-instrs a)])))

(define (asm-display-instrs a)

(match a

['() (void)]

[(cons i a)

(begin (write-string (instr->string i))

(write-string "\n")

(asm-display-instrs a))]))

OK, so now we’ve made a86 a self-contained part of the the compiler. The code consists of a large AST definition and some functions that operate on the a86 AST data type. The printer makes use of some Racket functions we haven’t used before, like system-type and number->string, and also some other high-level IO functions like write-string. We’ll have to deal with these features, so while we crossed one item of our list (a86), we added a few more, hopefully smaller problems to solve.

21.5 Racket functions, more I/O, and primitives

We identified three more gaps between our compiler’s implementation language and its implemented language: lots of Racket functions like length, map, etc., more I/O functions that operate at a higher-level than our write-byte and read-byte such as write-string, read, read-line, etc., and finally the issue that primitives are not values.

There are many ways we could proceed from here. We could, for example, spend some time adding new primitives to our compiler that implement all the missing functionality like length, write-string, and others.

Let’s consider adding a length primitive. It’s not terribly difficult. We could add a unary operation called 'length, which would emit the following code:

; assume list is in rax

(let ((done (gensym 'done))

(loop (gensym 'loop)))

(seq (Mov r8 0)                ; count = 0

(Label loop)

(Cmp rax (value->bits '())) ; if empty, done

(Je done)

(assert-cons rax)         ; otherwise, should be a cons

(Xor rax type-cons)

(Mov rax (Offset rax 0))  ; move cdr into rax

(Add r8 (value->bits 1))    ; increment count

(Jmp loop)                ; loop

(Label done)

(Mov rax r8)))            ; return count

We can play around an make sure this assembly code is actually computing the length of the list in 'rax:

Examples

> (require neerdowell/parse            neerdowell/compile-datum            neerdowell/compile-ops            neerdowell/types)

> (require a86)

; Datum -> Natural

; Computes the length of d in assembly

> (define (length/asm d)     (bits->value      (asm-interp       (seq (Global 'entry)            (Label 'entry)            (compile-datum d)            ; assume list is in rax            (let ((done (gensym 'done))                  (loop (gensym 'loop)))              (seq (Mov r8 0)                ; count = 0                   (Label loop)                   (Cmp rax (value->bits '())) ; if empty, done                   (Je done)                   (assert-cons rax)         ; otherwise, should be a cons                   (Xor rax type-cons)                   (Mov rax (Offset rax 0))  ; move cdr into rax                   (Add r8 (value->bits 1))    ; increment count                   (Jmp loop)                ; loop                   (Label done)                   (Mov rax r8)))            ; return count            (Ret)            (Label 'raise_error_align) ; dummy version, returns -1            (Mov rax -1)            (Ret)))))

> (length/asm '())

0

> (length/asm '(1 2 3))

3

> (length/asm '(1 2 3 4 5 6))

6

Looks good.

Alternatively, instead of a primitive, we could add a length function by creating a static function value and binding it to the variable length. The code for the function would essentially be the same as the primitive above:

(seq (Data)

(Label 'length_func) ; the length closure

(Dq 'length_code)    ; points to the length code

(Text)

(Label 'length_code) ; code for length

(Cmp r15 1) ; expects 1 arg

(Jne 'raise_error_align)

(Pop rax)

; ... length code from above

(Add rsp 8) ; pop off function

(Ret))