13 Iniquity: function definitions and calls

13.1 Functions

With Hustle: heaps and lists, we removed a major computational shortcoming by adding the ability to use inductively defined data. Doing so gives programmers the ability to represent arbitrarily large pieces of information.

And yet, the language remains hamstrung. It has no mechanism to compute with such data. Sure, a programmer could compute the sum of the first n elements of a list, for some fixed n. But the size of this program would be proportional to the size of n. Want to compute the sum of a billion element list? You’ll need (at least) a billion expressions. Want to compute the sum of a larger list? Write a longer program! But if you want to compute the sum of any list, regardless of its size? You’ll need an arbitrarily long program. Of course programs are always of some fixed size, since after all, you have to write them down and at some point you have to stop writing. This means the expressiveness of our language is still severely restricted.

The solution is to bring in the computational analog of inductive data. When you have arbitrarily large data, you need arbitrarily long running computations to process them. Crucially, these arbitrarily long running computations need to be described by finite sized programs. The analog of inductive data are recursive functions.

So let’s now remove the computational shackles by incorporating functions, and in particular, recursive functions, which will allow us to compute over arbitrarily large data with finite-sized programs.

Let’s call it Iniquity.

We will extend the syntax by introducing a new syntactic category of programs, which have the shape:

(begin

(define (f0 x0 ...) e0)

(define (f1 x1 ...) e1)

...

e)

And the syntax of expressions will be extended to include function calls:

(fi e0 ...)

where fi is one of the function names defined in the program.

Note that functions can have any number of parameters and, symmetrically, calls can have any number of arguments. A program consists of zero or more function definitions followed by an expression.

13.2 An Interpreter for Functions

Writing an interpreter for Inquity is not too hard. The main idea is that the interpretation of expression is now parameterized by a set of function definitions from the program. It serves as a second kind of environment that gets passed around and is used to resolve function definitions when interpreting function calls.

The way a function call is interpreted is to first interpret all of the arguments, building up a list of results. Then the definition of the function being called is looked up. If the function has the same number of parameters as there are arguments in the call, the body of the function is interpreted in an enviorment that maps each parameter to to the corresponding argument. That’s it.

iniquity/interp.rkt

#lang racket

(provide interp interp-env interp-prim1)

(require "ast.rkt"

"env.rkt"

"interp-prims.rkt")

;; type Answer = Value | 'err

;; type Value =

;; | Integer

;; | Boolean

;; | Character

;; | Eof

;; | Void

;; | '()

;; | (cons Value Value)

;; | (box Value)

;; type REnv = (Listof (List Id Value))

;; type Defns = (Listof Defn)

;; Prog Defns -> Answer

(define (interp p)

(match p

[(Prog ds e)

(interp-env e '() ds)]))

;; Expr Env Defns -> Answer

(define (interp-env e r ds)

(match e

[(Int i)  i]

[(Bool b) b]

[(Char c) c]

[(Eof)    eof]

[(Empty)  '()]

[(Var x)  (lookup r x)]

[(Prim0 'void) (void)]

[(Prim0 'read-byte) (read-byte)]

[(Prim0 'peek-byte) (peek-byte)]

[(Prim1 p e)

(match (interp-env e r ds)

['err 'err]

[v (interp-prim1 p v)])]

[(Prim2 p e1 e2)

(match (interp-env e1 r ds)

['err 'err]

[v1 (match (interp-env e2 r ds)

['err 'err]

[v2 (interp-prim2 p v1 v2)])])]

[(If p e1 e2)

(match (interp-env p r ds)

['err 'err]

[v

(if v

(interp-env e1 r ds)

(interp-env e2 r ds))])]

[(Begin e1 e2)

(match (interp-env e1 r ds)

['err 'err]

[_ (interp-env e2 r ds)])]

[(Let x e1 e2)

(match (interp-env e1 r ds)

['err 'err]

[v (interp-env e2 (ext r x v) ds)])]

[(App f es)

(match (interp-env* es r ds)

[(list vs ...)

(match (defns-lookup ds f)

[(Defn f xs e)

; check arity matches

(if (= (length xs) (length vs))

(interp-env e (zip xs vs) ds)

'err)])]

[_ 'err])]))

;; (Listof Expr) REnv Defns -> (Listof Value) | 'err

(define (interp-env* es r ds)

(match es

['() '()]

[(cons e es)

(match (interp-env e r ds)

['err 'err]

[v (cons v (interp-env* es r ds))])]))

;; Defns Symbol -> Defn

(define (defns-lookup ds f)

(findf (match-lambda [(Defn g _ _) (eq? f g)])

ds))

(define (zip xs ys)

(match* (xs ys)

[('() '()) '()]

[((cons x xs) (cons y ys))

(cons (list x y)

(zip xs ys))]))

A couple of things to note:

• since the function definition environment is passed along even when interpreting the body of function definitions, this interpretation supports recursion, and even mutual recursion.

• functions are not values (yet). We cannot bind a variable to a function. We cannot make a list of functions. We cannot compute a function. The first position of a function call is a function name, not an arbitrary expression. Nevertheless, we have significantly increased the expressivity of our language.

We can try it out:

Examples

> (interp (parse '(begin (define (double x) (+ x x))                          (double 5))))

10

We can see it works with recursive functions, too. Here’s a recursive function for computing triangular numbers:

Examples

> (interp (parse '(begin (define (tri x)                            (if (zero? x)                                0                                (+ x (tri (sub1 x)))))                          (tri 9))))

45

We can even define mutually recursive functions such as even? and odd?:

Examples

> (interp (parse '(begin (define (even? x)                            (if (zero? x)                                #t                                (odd? (sub1 x))))                          (define (odd? x)                            (if (zero? x)                                #f                                (even? (sub1 x))))                          (even? 101))))

#f

13.3 Compiling a Call

Turning to compilation, let’s start small by supposing we have a single, pre-defined function and we add to the language the ability to call this function.

A function in assembly has an entry point (a label), followed by a sequence of instruction, ending with the ’ret instruction. A very common approach for passing arguments to a function, which we will use here, is to pass arguments via the stack, this way you don’t have to worry as much about which registers may or may not be used (at the cost of performance).

(seq (Push rax)    ; argument is now at rsp

(Call 'double)

(Add 'rax 1)) ; rax now holds 11

So far, so good! Now we can look at what the code for the double might look like:

(seq (Label 'double)

(Mov (Offset 'rsp 0) 5)

(Add 'rax 'rax)

(Ret))

This function takes one argument from the stack, adds it to itself, leaving the result in 'rax when it returns.

The Ret instruction works in concert with the Call instruction, which can be given a label, designating which function to call.

So if we wanted to call double with an argument of 5, we’d push 5 on the stack, then issue the (Call 'double) instruction.

The double code is reading from offset 0 from 'rsp, seems to make sense, since we are pushing the argument right before executing the Call instruction.

The problem is here is that the Call instruction works by modifying the 'rsp register!

The Call instruction advances 'rsp to the next word of memory and writes the location of the instruction that occurs after the Call instruction. This is a return pointer. It then jumps to the beginning of the instruction sequence after the label that is the argument of Call. Those instruction execute and when we get to Ret, the return instruction reads that address stored in (Offset 'rsp 0), moves 'rsp back one word, and jumps to the instruction pointed to by the return pointer.

The problem with the function call we wrote above is that we put the argument in (Offset 'rsp 0), but then the Call advances (by decrementing) the 'rsp register and writes the return point in (Offset 'rsp 0), so now the relative offset from 'rsp would be 8, not 0!

The solution then, is to make sure that the function knows that it’s arguments have been “shifted” by one slot.

(seq (Label 'double)

(Mov (Offset 'rsp 8) 5)

(Add 'rax 'rax)

(Ret))

We’re not out of the woods yet. What we’ve described above would work, on an idealized machine. However, the System V x86_64 calling convention adds one more constraint on us: rsp must be aligned to 16-bytes when a function call is performed. This requires us to do some calculating before we can determine whether we need to pad that stack. This requires us to know how many things are currently on our stack, luckily we already have an environment on hand, which provides this information. So for double, it would look like the following:

This will work if the program consists only of a call to double, however it doesn’t work in general.

It’s easy to generalize this code to call any given function name:

(define (compile-double-call e c)

; determine whether stack is 16-byte aligned

; based on the number of things on the stack + our argument

(if (even? (add1 (length c)))

; Stack will be 16-byte aligned:

(seq (compile-es e c)        ; generate code for the argument

(Call 'double)

(Add rsp 8))            ; pop argument

; Stack will _not_ be 16-byte aligned

; We need to pad the stack

(seq (Sub rsp 8)                  ; pad stack

(compile-es es (cons #f c))  ; generate code for the argument

; taking the pad into account

(Call 'double)

(Add rsp 16))))              ; pop args and pad

If we want accept any number of arguments, we have to do a little more work.

We rely on the following helpful function for compiling a list of expressions and saving the results on the stack:

; (Listof Expr) CEnv -> Asm

(define (compile-es es c)

(match es

['() '()]

[(cons e es)

(seq (compile-e e c)

(Push rax)

(compile-es es (cons #f c)))]))

So to compile a call with any number of arguments:

(define (compile-app f es c)

(if (even? (+ (length es) (length c)))

(seq (compile-es es c)

(Call f)

(Add rsp (* 8 (length es))))            ; pop args

(seq (Sub rsp 8)                             ; adjust stack

(compile-es es (cons #f c))

(Call f)

(Add rsp (* 8 (add1 (length es)))))))   ; pop args and pad

Notice that in the ‘else’ branch we call compile-es in an extended static environment, that has one addition slot used. This will bump the location of all the argument results by one, which is necessary for the 16-byte alignment.

13.4 Compiling a Function Definition

Now that we can compile calls, we just need to be able to compile function definitions such as:

(define (double x)

(+ x x))

The idea here is pretty simple. The compiler needs to emit a label for the function, such as 'double, followed by the instructions for the body of the function.

The body of the function has a single free variable, x. We can compile the expression in a static environement '(x) so that it resolves this variable to the first position on the stack, which, thanks to the code we emit for calls, will hold the argument value.

After the instructions for the body, a (Ret) instruction is emitted so that control transfers back to the caller.

What about functions that take zero or more arguments? That’s easy, just compile the body in an appropriate static environment.

; Defn -> Asm

(define (compile-define d)

(match d

[(Defn f xs e)

(seq (Label f)

(compile-e e (parity (cons #f (reverse xs))))

(Ret))]))

(Note that we reverse the parameter list due to the order in which arguments are added to the stack.)

The parity function is there to manage alignment appropriately. Because we know that the Call instruction must be executed with 'rsp being 16-byte aligned, and that Call pushes the return pointer on the stack, we have to make sure that the environment accurately portrays the stack as not 16-byte aligned at the beginning of the function’s code. To do this we add a dummy value to the end of the environment if it has an even number of items (even would imply that we are 16-byte aligned, when we know that we are not).

(define (parity c)

(if (even? (length c))

(append c (list #f))

c))

13.5 On Names and Labels

There is one final wrinkle, which is that identifiers in our language include many things which are not valid labels for the Nasm assembler. Hence compiling a function like:

(define (^weird% x) x)

will cause the assembler to reject the emitted code since '^weird% is not a valid label name. Labels must consist only of letters, numbers, _, $, ?, @, ~, and ?.

We solve this problem by using a function that maps arbitrary Racket symbols to valid Nasm labels (represented as symbols). The function has the property distinct symbols always map to distinct labels.

Examples

> (symbol->label '^weird%)

'label__weird__c3e020e4e5471e4

Using this function, we can touch up our code:

; Id (Listof Expr) CEnv -> Asm

(define (compile-app f es c)

(if (even? (+ (length es) (length c)))

(seq (compile-es es c)

(Call (symbol->label f))

(Add rsp (* 8 (length es))))            ; pop args

(seq (Sub rsp 8)                             ; adjust stack

(compile-es es (cons #f c))

(Call (symbol->label f))

(Add rsp (* 8 (add1 (length es)))))))   ; pop args and pad

; Defn -> Asm

(define (compile-define d)

(match d

[(Defn f xs e)

(seq (Label (symbol->label f))

(compile-e e (parity (cons #f (reverse xs))))

(Ret))]))

13.6 A Compiler for Iniquity

The last piece of the puzzle is the function for emitting code for a complete program:

; Prog -> Asm

(define (compile p)

(match p

[(Prog ds e)

(prog (Extern 'peek_byte)

(Extern 'read_byte)

(Extern 'write_byte)

(Extern 'raise_error)

(Label 'entry)

(Mov rbx rdi) ; recv heap pointer

(compile-e e '(#f))

(Mov rdx rbx) ; return heap pointer in second return register

(Ret)

(compile-defines ds))]))

It relies on a helper compile-defines for compiling each function definition and flattening the assembly instructions into a single list:

; [Listof Defn] -> Asm

(define (compile-defines ds)

(match ds

['() (seq)]

[(cons d ds)

(seq (compile-define d)

(compile-defines ds))]))

Here’s an example of the code this compiler emits:

Examples

> (displayln    (asm-string     (compile      (parse '(begin (define (double x) (+ x x)) (double 5))))))

global entry         default rel         section .text         extern peek_byte         extern read_byte         extern write_byte         extern raise_error entry:         mov rbx, rdi         mov rax, 80         push rax         call label_double_6334fa372629b92         add rsp, 8         mov rdx, rbx         ret label_double_6334fa372629b92:         mov rax, [rsp + 8]         push rax         mov rax, [rsp + 16]         pop r8         mov r9, r8         and r9, 15         cmp r9, 0         jne raise_error         mov r9, rax         and r9, 15         cmp r9, 0         jne raise_error         add rax, r8         ret

And we can confirm running the code produces results consistent with the interpreter:

Examples

> (current-objs '("runtime.o"))

> (define (run e)     (asm-interp (compile (parse e))))

> (run '(begin (define (double x) (+ x x))                (double 5)))

'(#<cpointer> . 160)

> (run '(begin (define (tri x)                  (if (zero? x)                      0                      (+ x (tri (sub1 x)))))                (tri 9)))

'(#<cpointer> . 720)

> (run '(begin (define (even? x)                  (if (zero? x)                      #t                      (odd? (sub1 x))))                (define (odd? x)                  (if (zero? x)                      #f                      (even? (sub1 x))))                (even? 101)))

'(#<cpointer> . 56)

The complete compiler code:

iniquity/compile.rkt

#lang racket

(provide (all-defined-out))

(require "ast.rkt" "types.rkt" a86/ast)

;; Registers used

(define rax 'rax) ; return

(define rbx 'rbx) ; heap

(define rdx 'rdx) ; return, 2

(define r8  'r8)  ; scratch in +, -

(define r9  'r9)  ; scratch in assert-type

(define rsp 'rsp) ; stack

(define rdi 'rdi) ; arg

;; type CEnv = [Listof Variable]

;; Prog -> Asm

(define (compile p)

(match p

[(Prog ds e)

(prog (Extern 'peek_byte)

(Extern 'read_byte)

(Extern 'write_byte)

(Extern 'raise_error)

(Label 'entry)

(Mov rbx rdi) ; recv heap pointer

(compile-e e '(#f))

(Mov rdx rbx) ; return heap pointer in second return register

(Ret)

(compile-defines ds))]))

;; [Listof Defn] -> Asm

(define (compile-defines ds)

(match ds

['() (seq)]

[(cons d ds)

(seq (compile-define d)

(compile-defines ds))]))

;; Defn -> Asm

(define (compile-define d)

(match d

[(Defn f xs e)

(seq (Label (symbol->label f))

(compile-e e (parity (cons #f (reverse xs))))

(Ret))]))

(define (parity c)

(if (even? (length c))

(append c (list #f))

c))

;; Expr CEnv -> Asm

(define (compile-e e c)

(seq (match e

[(Int i)            (compile-value i)]

[(Bool b)           (compile-value b)]

[(Char c)           (compile-value c)]

[(Eof)              (compile-value eof)]

[(Empty)            (compile-value '())]

[(Var x)            (compile-variable x c)]

[(App f es)         (compile-app f es c)]

[(Prim0 p)          (compile-prim0 p c)]

[(Prim1 p e)        (compile-prim1 p e c)]

[(Prim2 p e1 e2)    (compile-prim2 p e1 e2 c)]

[(If e1 e2 e3)      (compile-if e1 e2 e3 c)]

[(Begin e1 e2)      (compile-begin e1 e2 c)]

[(Let x e1 e2)      (compile-let x e1 e2 c)])))

;; Value -> Asm

(define (compile-value v)

(seq (Mov rax (imm->bits v))))

;; Id CEnv -> Asm

(define (compile-variable x c)

(let ((i (lookup x c)))

(seq (Mov rax (Offset rsp i)))))

;; Op0 CEnv -> Asm

(define (compile-prim0 p c)

(match p

['void      (seq (Mov rax val-void))]

['read-byte (seq (pad-stack c)

(Call 'read_byte)

(unpad-stack c))]

['peek-byte (seq (pad-stack c)

(Call 'peek_byte)

(unpad-stack c))]))

;; Op1 Expr CEnv -> Asm

(define (compile-prim1 p e c)

(seq (compile-e e c)

(match p

['add1

(seq (assert-integer rax)

(Add rax (imm->bits 1)))]

['sub1

(seq (assert-integer rax)

(Sub rax (imm->bits 1)))]

['zero?

(let ((l1 (gensym)))

(seq (assert-integer rax)

(Cmp rax 0)

(Mov rax val-true)

(Je l1)

(Mov rax val-false)

(Label l1)))]

['char?

(let ((l1 (gensym)))

(seq (And rax mask-char)

(Xor rax type-char)

(Cmp rax 0)

(Mov rax val-true)

(Je l1)

(Mov rax val-false)

(Label l1)))]

['char->integer

(seq (assert-char rax)

(Sar rax char-shift)

(Sal rax int-shift))]

['integer->char

(seq assert-codepoint

(Sar rax int-shift)

(Sal rax char-shift)

(Xor rax type-char))]

['eof-object? (eq-imm val-eof)]

['write-byte

(seq assert-byte

(pad-stack c)

(Mov rdi rax)

(Call 'write_byte)

(unpad-stack c)

(Mov rax val-void))]

['box

(seq (Mov (Offset rbx 0) rax)

(Mov rax rbx)

(Or rax type-box)

(Add rbx 8))]

['unbox

(seq (assert-box rax)

(Xor rax type-box)

(Mov rax (Offset rax 0)))]

['car

(seq (assert-cons rax)

(Xor rax type-cons)

(Mov rax (Offset rax 8)))]

['cdr

(seq (assert-cons rax)

(Xor rax type-cons)

(Mov rax (Offset rax 0)))]

['empty? (eq-imm val-empty)])))

;; Op2 Expr Expr CEnv -> Asm

(define (compile-prim2 p e1 e2 c)

(seq (compile-e e1 c)

(Push rax)

(compile-e e2 (cons #f c))

(match p

['+

(seq (Pop r8)

(assert-integer r8)

(assert-integer rax)

(Add rax r8))]

['-

(seq (Pop r8)

(assert-integer r8)

(assert-integer rax)

(Sub r8 rax)

(Mov rax r8))]

['eq?

(let ((l (gensym)))

(seq (Cmp rax (Offset rsp 0))

(Sub rsp 8)

(Mov rax val-true)

(Je l)

(Mov rax val-false)

(Label l)))]

['cons

(seq (Mov (Offset rbx 0) rax)

(Pop rax)

(Mov (Offset rbx 8) rax)

(Mov rax rbx)

(Or rax type-cons)

(Add rbx 16))])))

;; Id [Listof Expr] CEnv -> Asm

;; Here's why this code is so gross: you have to align the stack for the call

;; but you have to do it *before* evaluating the arguments es, because you need

;; es's values to be just above 'rsp when the call is made.  But if you push

;; a frame in order to align the call, you've got to compile es in a static

;; environment that accounts for that frame, hence:

(define (compile-app f es c)

(if (even? (+ (length es) (length c)))

(seq (compile-es es c)

(Call (symbol->label f))

(Add rsp (* 8 (length es))))            ; pop args

(seq (Sub rsp 8)                             ; adjust stack

(compile-es es (cons #f c))

(Call (symbol->label f))

(Add rsp (* 8 (add1 (length es)))))))   ; pop args and pad

;; [Listof Expr] CEnv -> Asm

(define (compile-es es c)

(match es

['() '()]

[(cons e es)

(seq (compile-e e c)

(Push rax)

(compile-es es (cons #f c)))]))

;; Imm -> Asm

(define (eq-imm imm)

(let ((l1 (gensym)))

(seq (Cmp rax imm)

(Mov rax val-true)

(Je l1)

(Mov rax val-false)

(Label l1))))

;; Expr Expr Expr CEnv -> Asm

(define (compile-if e1 e2 e3 c)

(let ((l1 (gensym 'if))

(l2 (gensym 'if)))

(seq (compile-e e1 c)

(Cmp rax val-false)

(Je l1)

(compile-e e2 c)

(Jmp l2)

(Label l1)

(compile-e e3 c)

(Label l2))))

;; Expr Expr CEnv -> Asm

(define (compile-begin e1 e2 c)

(seq (compile-e e1 c)

(compile-e e2 c)))

;; Id Expr Expr CEnv -> Asm

(define (compile-let x e1 e2 c)

(seq (compile-e e1 c)

(Push rax)

(compile-e e2 (cons x c))

(Add rsp 8)))

;; CEnv -> Asm

;; Pad the stack to be aligned for a call with stack arguments

(define (pad-stack-call c i)

(match (even? (+ (length c) i))

[#f (seq (Sub rsp 8) (% "padding stack"))]

[#t (seq)]))

;; CEnv -> Asm

;; Pad the stack to be aligned for a call

(define (pad-stack c)

(pad-stack-call c 0))

;; CEnv -> Asm

;; Undo the stack alignment after a call

(define (unpad-stack-call c i)

(match (even? (+ (length c) i))

[#f (seq (Add rsp 8) (% "unpadding"))]

[#t (seq)]))

;; CEnv -> Asm

;; Undo the stack alignment after a call

(define (unpad-stack c)

(unpad-stack-call c 0))

;; Id CEnv -> Integer

(define (lookup x cenv)

(match cenv

['() (error "undefined variable:" x)]

[(cons y rest)

(match (eq? x y)

[#t 0]

[#f (+ 8 (lookup x rest))])]))

(define (assert-type mask type)

(λ (arg)

(seq (Mov r9 arg)

(And r9 mask)

(Cmp r9 type)

(Jne 'raise_error))))

(define (type-pred mask type)

(let ((l (gensym)))

(seq (And rax mask)

(Cmp rax type)

(Mov rax (imm->bits #t))

(Je l)

(Mov rax (imm->bits #f))

(Label l))))

(define assert-integer

(assert-type mask-int type-int))

(define assert-char

(assert-type mask-char type-char))

(define assert-box

(assert-type ptr-mask type-box))

(define assert-cons

(assert-type ptr-mask type-cons))

(define assert-codepoint

(let ((ok (gensym)))

(seq (assert-integer rax)

(Cmp rax (imm->bits 0))

(Jl 'raise_error)

(Cmp rax (imm->bits 1114111))

(Jg 'raise_error)

(Cmp rax (imm->bits 55295))

(Jl ok)

(Cmp rax (imm->bits 57344))

(Jg ok)

(Jmp 'raise_error)

(Label ok))))

(define assert-byte

(seq (assert-integer rax)

(Cmp rax (imm->bits 0))

(Jl 'raise_error)

(Cmp rax (imm->bits 255))

(Jg 'raise_error)))

;; Symbol -> Label

;; Produce a symbol that is a valid Nasm label

(define (symbol->label s)

(string->symbol

(string-append

"label_"

(list->string

(map (λ (c)

(if (or (char<=? #\a c #\z)

(char<=? #\A c #\Z)

(char<=? #\0 c #\9)

(memq c '(#\_ #\$ #\# #\@ #\~ #\. #\?)))

c

#\_))

(string->list (symbol->string s))))

"_"

(number->string (eq-hash-code s) 16))))