18 Shakedown: Calling functions C functions
18.1 No Man Is An Island
No man is an island, Entire of itself; Every man is a piece of the continent, A part of the main. – John Donne
So far we’ve been creating new languages by adding more sophisticated features to a language we have already implemented. By the time we added lambdas in Loot: lambda the ultimate, our languages are universal in that any computation that can be expressed, is able to be expressed in our languages (modulo constraints on the machine they are run on).
Being able to express any possible computation only gets you so far, however. In order for general purpose languages to be useful in addition to interesting, they must be able to interact with their context. This can take various forms: being able to perform input/output, being able to communicate on a network, etc. Ultimately, it is the host operating system that enables this sort of interaction and communication, via system calls.
We could implement system calls directly, but this approach has a few downsides:
System calls are not portable across different operating systems (and often not portable across different architectures, even with the same OS)
Adding new functionality would often mean changing the compiler in order to implement a new system call
Instead, we can implement a Foreign Function Interface (FFI), a way for our language to communicate with another programming language directly. The question then becomes: which language, and how?
18.2 Pick your Poison
There are a few languages you might choose to implement as a target for an FFI, many languages end up with FFIs that can communicate with a selection of languages. For our FFI, we are going to target C. This is because, for better or worse, C is the lingua franca of computing.
Most non-embedded systems provide C-libraries that provide a wrapper around their system calls, often these libraries will actually provide the same functionality across OSs and machine architectures. The GNU project produces glibc, which is available for most major platforms, and there are projects such as musl which serve a similar purpose through various tradeoffs. By providing a C-FFI, we can access these standard libraries and any other library that provides a C interface.
In addition to the motivating factors above, C is appealing as an FFI target because many languages provide C FFIs, which means that C can be treated as a ‘middle ground’ between two languages.
18.3 Some considerations
An FFI can take several forms. As usual, these forms come with varying tradeoffs. Some FFIs are ‘type aware’, and can do the marshalling (the conversion between data representations in one format to another) automatically. Other FFIs require the programmer to write the marshaling code themselves.
Orthogonally, some languages provide facilities for marshalling data in the language itself (Racket and Haskell do this, for example), while other languages require the programmer to write ‘wrapper’ code in C that performs this functionality (OCaml and Lua do this, for example).
We are going to write an FFI that is not type-aware requiring us to write the marshalling code ourselves, and requires writing C wrapper code. This done so that we can focus on the core new concept, calling conventions, without also having to solve the problems of marshalling data automatically or providing functionality for reasoning about C-types in our language.
18.4 What’s it look like?
Now that we’ve described the high-level shape of our problem, we can take a look at how we might express that in our language:
(ccall function_in_c 3)
This program would call a function written in C, function_in_c, with an integer argument with a value of 3. This raises the following issues that we have to solve:
How do we represent this in our AST?
How does our runtime system know where function_in_c is?
How do we ‘tell’ function_in_c that the argument is 3?
How do we ‘get’ the result from function_in_c?
18.4.1 Representation Matters
In addressing the first issue, we can create a new AST node for FFI calls:
(struct ccall-e (f es))
There are other possible representations (treating it as a primitive, for example), but this representation will make the next step slightly easier.
18.4.2 Who you gonna call?
The second issue is a bit more intricate. It deals with how we link our program. In order to safely call (or jump to) function_is_c we have to convince our assembler (NASM) and our linker that we know where function_in_c is!
Our assembler, nasm, requires that we declare which symbols are not defined locally. This is so that the assembler can catch simple errors, like misspelling the target of a jump. Not all assemblers require this, but because nasm does, we need to address accommodate it.
First we can collect all the uses of the ccall construct that we are introducing. This is a straightforward traversal of the AST, keeping track of the symbols used for a ccall.
; LExpr -> (Listof Symbol) ; Extract all the calls to C Functions (define (ffi-calls e) (match e [(? imm? i) '()] [(var-e v) '()] [(prim-e p es) (apply append (map ffi-calls es))] [(if-e e0 e1 e2) (append (ffi-calls e0) (ffi-calls e1) (ffi-calls e2))] [(let-e (list (binding v def)) body) (append (ffi-calls def) (ffi-calls body))] [(letr-e bs body) (append (apply append (map ffi-calls (get-defs bs))) (ffi-calls body))] [(lam-e xs e0) (ffi-calls e0)] [(lam-t _ xs e0) (ffi-calls e0)] [(ccall-e f es) (cons f (apply append (map ffi-calls es)))] [(app-e f es) (append (ffi-calls f) (apply append (map ffi-calls es)))]))
Once we’ve collected all the uses of ccall we can adapt our compile-entry function so that all of the external symbols are generated in our assembly file:
; Expr -> Asm (define (compile-entry e) `(,@(make-externs (ffi-calls e)) (section text) entry ,@(compile-tail-e e '()) ret ,@(compile-λ-definitions (λs e)) err (push rbp) (call error) ret))
The addition of the (section text) directive is something we were doing in our printer before, as part of the preamble for our generated code. Now that we are adding the extern directives we need make the distinction between the preamble and the code itself (text stands for code in ASM).
The next two points are related by a single concept: Calling Conventions
18.5 Calling Conventions
How functions accept their arguments and provide their results is known as a calling convention. All of our languages since Iniquity: function definitions and calls have had calling conventions, but it’s been mostly up to us (modulo the issue with moving rsp. This has worked because we haven’t had to communicate with any other language, that expects its arguments to be provided in a specific manner.
The calling convention we are using the x86_64 System V Application Binary Interface (ABI) (which means this may not work on Windows systems). The document is quite long (approximately 130 pages), so we will only focus on some of the basics. For every limitation that our implementation, the details on how we might address that limitation will be in that document. For example, we will only deal with integer arguments and results here, but the System V ABI also describes the convention for Floating Point arguments/results.
In short, a calling convention specifies at least the following:
How do you pass arguments?
What things is the caller responsible for keeping track of?
What things is the callee responsible for keeping track of?
Note that there are many ways to solve this coordination problem! The pro and con of using a convention is that it’s not really up to us, instead we just look up what the convention specifies. For Shakedown we’re only going to implement calling C functions with (up to 6) integer arguments. As mentioned above, this is not a restriction from the System V ABI, which desscribes how to pass more than 6 arguments as well as arguments of various types.
The calling convention specifies that the first 6 integer arguments are passed in left to right order in the following registers:
rdi, rsi, rdx, rcx, r8, and r9 |
What this means is that in order to call a C function f(int x, int y), we should put the value of x in rdi and y in rsi, and so on. This means that if you were using any of these registers, you need to save those values elsewhere. Which brings us to the next two concerns: who is in charge of keeping track of what?
18.5.1 Who saves what?
In calling conventions there are caller-save and callee-save registers. This determines which ‘side’ of the function call is responsible for keeping track of what the value stored in a register should be once the call/return cycle of a function call is complete.
Caller-save registers are the ones that a called function can assume they are safe to use, with no consequences. Because of this, if you are calling a function (i.e. you are the caller) and you care about what is stored in one of these registers, it is your responsibility to save it elsewhere (could be on the stack, as long as it’s not in another caller-save register). Callee-save registers are registers that can be used to store information before calling a function. If the function being called (the callee) wants to use any of these registers, it is that function’s responsibility to remember the value in that register in some way (perhaps putting it on the stack) and restoring that register to its original value before returning.
The callee-save registers are the following:
rbp, rbx, and r12-r15 (inclusive) |
All other registers are caller-save. The one exception is the register rsp, which is expected to be used by both the caller and the callee to manage the stack in concert, so it’s not ‘saved’ by either the caller or the callee.
The ‘ownership’ of the various registers is described in Section 3.2.1 of the System V ABI document.
18.5.2 Securing the result
The System V ABI specifies that at the end of the function’s execution it is expected to put the first integer machine word of its result (remember that in in C you can return a struct that contains more than one machine word) in rax. We’ve already been following this part of the convention! In fact, this is how our generated code has communicated its result with the runtime system, we just chose to use rax for the result of all intermediate computations as well.
This is described near the end of Section 3.2.3 (page 22) of the System V ABI document.
18.5.3 But wait, there’s more!
Earlier we mentioned that a calling convention would specify at least the three things above. The System V ABI for x86_64 also specifies that our stack pointer (rsp) should be aligned to 16 bytes! (this is described in Section 3.2.2 of the System V ABI document). We’ve never worried about the alignment of our stack before, so this will also need consideration.
#lang racket (require "syntax.rkt" "ast.rkt") (provide (all-defined-out)) ;; An immediate is anything ending in #b000 ;; All other tags in mask #b111 are pointers (define result-shift 3) (define result-type-mask (sub1 (arithmetic-shift 1 result-shift))) (define type-imm #b000) (define type-box #b001) (define type-pair #b010) (define type-string #b011) (define type-proc #b100) (define imm-shift (+ 2 result-shift)) (define imm-type-mask (sub1 (arithmetic-shift 1 imm-shift))) (define imm-type-int (arithmetic-shift #b00 result-shift)) (define imm-type-bool (arithmetic-shift #b01 result-shift)) (define imm-type-char (arithmetic-shift #b10 result-shift)) (define imm-type-empty (arithmetic-shift #b11 result-shift)) (define imm-val-false imm-type-bool) (define imm-val-true (bitwise-ior (arithmetic-shift 1 (add1 imm-shift)) imm-type-bool)) ;; Allocate in 64-bit (8-byte) increments, so pointers ;; end in #b000 and we tag with #b001 for boxes, etc. ;; type CEnv = (Listof (Maybe Variable)) ;; type Imm = Integer | Boolean | Char | ''() ;; type LExpr = ;; .... ;; | `(λ ,Formals ,Label ,Expr) ;; type Label = (quote Symbol) ;; Prog -> Asm (define (compile p) ; Remove all of the explicit function definitions (match (desugar-prog p) [(prog _ e) (compile-entry (label-λ e))])) ;; Expr -> Asm (define (compile-entry e) `(,@(make-externs (ffi-calls e)) (section text) entry ,@(compile-tail-e e '()) ret ,@(compile-λ-definitions (λs e)) err (push rbp) (call error) ret)) ;; (Listof Symbol) -> Asm (define (make-externs fs) (map (lambda (s) `(extern ,s)) fs)) ;; (Listof Lambda) -> Asm (define (compile-λ-definitions ls) (apply append (map compile-λ-definition ls))) ;; Lambda -> Asm (define (compile-λ-definition l) (match l [(lam-t f xs e0) (let ((c0 (compile-tail-e e0 (reverse (append xs (fvs l)))))) `(,f ,@c0 ret))] [(lam-e _ _) (error "Lambdas need to be labeled before compiling")])) ;; LExpr CEnv -> Asm ;; Compile an expression in tail position (define (compile-tail-e e c) (match e [(var-e v) (compile-variable v c)] [(? imm? i) (compile-imm i)] [(prim-e (? prim? p) es) (compile-prim p es c)] [(if-e p t f) (compile-tail-if p t f c)] [(let-e (list b) body) (compile-tail-let b body c)] [(letr-e bs body) (compile-tail-letrec (get-vars bs) (get-defs bs) body c)] [(app-e f es) (compile-tail-call f es c)] [(lam-t l xs e0) (compile-λ xs l (fvs e) c)])) ;; LExpr CEnv -> Asm ;; Compile an expression in non-tail position (define (compile-e e c) (match e [(var-e v) (compile-variable v c)] [(? imm? i) (compile-imm i)] [(prim-e (? prim? p) es) (compile-prim p es c)] [(if-e p t f) (compile-if p t f c)] [(let-e (list b) body) (compile-let b body c)] [(letr-e bs body) (compile-letrec (get-vars bs) (get-defs bs) body c)] [(ccall-e f es) (compile-ccall f es c)] [(app-e f es) (compile-call f es c)] [(lam-t l xs e0) (compile-λ xs l (fvs e) c)])) ;; Our current set of primitive operations require no function calls, ;; so there's no difference between tail and non-tail call positions (define (compile-prim p es c) (match (cons p es) [`(box ,e0) (compile-box e0 c)] [`(unbox ,e0) (compile-unbox e0 c)] [`(cons ,e0 ,e1) (compile-cons e0 e1 c)] [`(car ,e0) (compile-car e0 c)] [`(cdr ,e0) (compile-cdr e0 c)] [`(add1 ,e0) (compile-add1 e0 c)] [`(sub1 ,e0) (compile-sub1 e0 c)] [`(zero? ,e0) (compile-zero? e0 c)] [`(empty? ,e0) (compile-empty? e0 c)] [`(+ ,e0 ,e1) (compile-+ e0 e1 c)] [_ (error (format "prim applied to wrong number of args: ~a ~a" p es))])) ;; Label (listof Expr) -> Asm (define (compile-ccall f es c) (let* ((c0 (store-caller-save caller-saves c)) (c* (car c0)) (c1 (compile-es-ffi es c* 0)) (c2 (cdr (load-caller-save caller-saves c))) (stack-size (* 8 (length c*)))) ; We don't actually have to do all caller-save (that's a lot!) ; Just the ones that our compiler emits `(,@(cdr c0) ,@c1 (mov r15 rsp) ; Using the fact that r15 is callee save ; change rsp to reflect the top of the stack (sub rsp ,stack-size) ; align rsp to safest 16-byte aligned spot (and rsp -16) ; Actually call the function (call ,f) ; Restore our stack (mov rsp r15) ; Put the caller-saved values back ,@c2))) ;; The registers that we can use to pass arguments to C functions ;; (in the right order) ;; (define arg-regs '(rdi rsi rdx rcx r8 r9)) (define callee-saves '(rbp rbx r12 r13 r14 r15)) (define caller-saves '(rcx rdx rdi rsi r8 r9 r10 r11)) ; Make sure we store every caller-save register that we care about on the stack. ; This is basiclaly a foldMR, but I need to learn more Racket (define (store-caller-save rs c) (match rs ['() (cons c '())] [(cons r rs) (match (store-caller-save rs c) [(cons d asm) (cons (cons #f d) (append asm `((mov (offset rsp ,(- (add1 (length d)))) ,r))))])])) ; Same as above but inverse (define (load-caller-save rs c) (match rs ['() (cons c '())] [(cons r rs) (match (load-caller-save rs c) [(cons d asm) (cons (cons #f d) (append asm `((mov ,r (offset rsp ,(- (add1 (length d))))))))])])) ;; JMCT: I keep 'programming in Haskell in Racket' and I need to stop that... ;; the above is my monadic habits biting me ;; (Listof LExpr) CEnv -> Asm (define (compile-es-ffi es c i) (match es ['() '()] [(cons e es) (let ((c0 (compile-e e c)) (cs (compile-es-ffi es c (add1 i)))) `(,@c0 (sar rax ,imm-shift) (mov ,(list-ref arg-regs i) rax) ; Put the result in the appropriate register ,@cs))])) ;; (Listof Variable) Label (Listof Variable) CEnv -> Asm (define (compile-λ xs f ys c) ; Save label address `((lea rax (offset ,f 0)) (mov (offset rdi 0) rax) ; Save the environment (mov r8 ,(length ys)) (mov (offset rdi 1) r8) (mov r9 rdi) (add r9 16) ,@(copy-env-to-heap ys c 0) ; Return a pointer to the closure (mov rax rdi) (or rax ,type-proc) (add rdi ,(* 8 (+ 2 (length ys)))))) ;; (Listof Variable) CEnv Natural -> Asm ;; Pointer to beginning of environment in r9 (define (copy-env-to-heap fvs c i) (match fvs ['() '()] [(cons x fvs) `((mov r8 (offset rsp ,(- (add1 (lookup x c))))) (mov (offset r9 ,i) r8) ,@(copy-env-to-heap fvs c (add1 i)))])) ;; Natural Natural -> Asm ;; Move i arguments upward on stack by offset off (define (move-args i off) (match i [0 '()] [_ `(,@(move-args (sub1 i) off) (mov rbx (offset rsp ,(- off i))) (mov (offset rsp ,(- i)) rbx))])) ;; LExpr (Listof LExpr) CEnv -> Asm (define (compile-call e0 es c) (let ((cs (compile-es es (cons #f c))) (c0 (compile-e e0 c)) (i (- (add1 (length c)))) (stack-size (* 8 (length c)))) `(,@c0 (mov (offset rsp ,i) rax) ,@cs (mov rax (offset rsp ,i)) ,@assert-proc (xor rax ,type-proc) (sub rsp ,stack-size) (mov rcx rsp) ; start of stack in rcx (add rcx ,(- (* 8 (+ 2 (length es))))) ,@(copy-closure-env-to-stack) (call (offset rax 0)) (add rsp ,stack-size)))) ;; LExpr (Listof LExpr) CEnv -> Asm (define (compile-tail-call e0 es c) (let ((cs (compile-es es (cons #f c))) (c0 (compile-e e0 c)) (i (- (add1 (length c))))) `(,@c0 (mov (offset rsp ,i) rax) ,@cs (mov rax (offset rsp ,i)) ,@(move-args (length es) i) ,@assert-proc (xor rax ,type-proc) (mov rcx rsp) ; start of stack in rcx (add rcx ,(- (* 8 (+ 1 (length es))))) ,@(copy-closure-env-to-stack) ;,@(copy-closure-env-to-stack (length es)) (jmp (offset rax 0))))) ;; -> Asm ;; Copy closure's (in rax) env to stack in rcx (define (copy-closure-env-to-stack) (let ((copy-loop (gensym 'copy_closure)) (copy-done (gensym 'copy_done))) `((mov r8 (offset rax 1)) ; length (mov r9 rax) (add r9 16) ; start of env ,copy-loop (cmp r8 0) (je ,copy-done) (mov rbx (offset r9 0)) (mov (offset rcx 0) rbx) ; Move val onto stack (sub r8 1) (add r9 8) (sub rcx 8) (jmp ,copy-loop) ,copy-done))) ;; (Listof Variable) (Listof Lambda) Expr CEnv -> Asm (define (compile-letrec fs ls e c) (let ((c0 (compile-letrec-λs ls c)) (c1 (compile-letrec-init fs ls (append (reverse fs) c))) (c2 (compile-e e (append (reverse fs) c)))) `(,@c0 ,@c1 ,@c2))) ;; (Listof Variable) (Listof Lambda) Expr CEnv -> Asm (define (compile-tail-letrec fs ls e c) (let ((c0 (compile-letrec-λs ls c)) (c1 (compile-letrec-init fs ls (append (reverse fs) c))) (c2 (compile-tail-e e (append (reverse fs) c)))) `(,@c0 ,@c1 ,@c2))) ;; (Listof Lambda) CEnv -> Asm ;; Create a bunch of uninitialized closures and push them on the stack (define (compile-letrec-λs ls c) (match ls ['() '()] [(cons l ls) (match l [(lam-t lab as body) (let ((cs (compile-letrec-λs ls (cons #f c))) (ys (fvs l))) `((lea rax (offset ,lab 0)) (mov (offset rdi 0) rax) (mov rax ,(length ys)) (mov (offset rdi 1) rax) (mov rax rdi) (or rax ,type-proc) (add rdi ,(* 8 (+ 2 (length ys)))) (mov (offset rsp ,(- (add1 (length c)))) rax) ,@cs))])])) ;; (Listof Variable) (Listof Lambda) CEnv -> Asm (define (compile-letrec-init fs ls c) (match fs ['() '()] [(cons f fs) (let ((ys (fvs (first ls))) (cs (compile-letrec-init fs (rest ls) c))) `((mov r9 (offset rsp ,(- (add1 (lookup f c))))) (xor r9 ,type-proc) (add r9 16) ; move past label and length ,@(copy-env-to-heap ys c 0) ,@cs))])) ;; (Listof LExpr) CEnv -> Asm (define (compile-es es c) (match es ['() '()] [(cons e es) (let ((c0 (compile-e e c)) (cs (compile-es es (cons #f c)))) `(,@c0 (mov (offset rsp ,(- (add1 (length c)))) rax) ,@cs))])) ;; Imm -> Asm (define (compile-imm i) `((mov rax ,(imm->bits i)))) ;; Imm -> Integer (define (imm->bits i) (match i [(int-e i) (arithmetic-shift i imm-shift)] [(char-e c) (+ (arithmetic-shift (char->integer c) imm-shift) imm-type-char)] [(bool-e b) (if b imm-val-true imm-val-false)] [(nil-e) imm-type-empty])) ;; Variable CEnv -> Asm (define (compile-variable x c) (let ((i (lookup x c))) `((mov rax (offset rsp ,(- (add1 i))))))) ;; LExpr CEnv -> Asm (define (compile-box e0 c) (let ((c0 (compile-e e0 c))) `(,@c0 (mov (offset rdi 0) rax) (mov rax rdi) (or rax ,type-box) (add rdi 8)))) ; allocate 8 bytes ;; LExpr CEnv -> Asm (define (compile-unbox e0 c) (let ((c0 (compile-e e0 c))) `(,@c0 ,@assert-box (xor rax ,type-box) (mov rax (offset rax 0))))) ;; LExpr LExpr CEnv -> Asm (define (compile-cons e0 e1 c) (let ((c0 (compile-e e0 c)) (c1 (compile-e e1 (cons #f c)))) `(,@c0 (mov (offset rsp ,(- (add1 (length c)))) rax) ,@c1 (mov (offset rdi 0) rax) (mov rax (offset rsp ,(- (add1 (length c))))) (mov (offset rdi 1) rax) (mov rax rdi) (or rax ,type-pair) (add rdi 16)))) ;; LExpr CEnv -> Asm (define (compile-car e0 c) (let ((c0 (compile-e e0 c))) `(,@c0 ,@assert-pair (xor rax ,type-pair) (mov rax (offset rax 1))))) ;; LExpr CEnv -> Asm (define (compile-cdr e0 c) (let ((c0 (compile-e e0 c))) `(,@c0 ,@assert-pair (xor rax ,type-pair) (mov rax (offset rax 0))))) ;; LExpr CEnv -> Asm (define (compile-empty? e0 c) (let ((c0 (compile-e e0 c)) (l0 (gensym))) `(,@c0 (and rax ,imm-type-mask) (cmp rax ,imm-type-empty) (mov rax ,imm-val-false) (jne ,l0) (mov rax ,imm-val-true) ,l0))) ;; LExpr CEnv -> Asm (define (compile-add1 e0 c) (let ((c0 (compile-e e0 c))) `(,@c0 ,@assert-integer (add rax ,(arithmetic-shift 1 imm-shift))))) ;; LExpr CEnv -> Asm (define (compile-sub1 e0 c) (let ((c0 (compile-e e0 c))) `(,@c0 ,@assert-integer (sub rax ,(arithmetic-shift 1 imm-shift))))) ;; LExpr CEnv -> Asm (define (compile-zero? e0 c) (let ((c0 (compile-e e0 c)) (l0 (gensym)) (l1 (gensym))) `(,@c0 ,@assert-integer (cmp rax 0) (mov rax ,imm-val-false) (jne ,l0) (mov rax ,imm-val-true) ,l0))) ;; LExpr LExpr LExpr CEnv -> Asm (define (compile-if e0 e1 e2 c) (let ((c0 (compile-e e0 c)) (c1 (compile-e e1 c)) (c2 (compile-e e2 c)) (l0 (gensym)) (l1 (gensym))) `(,@c0 (cmp rax ,imm-val-false) (je ,l0) ,@c1 (jmp ,l1) ,l0 ,@c2 ,l1))) ;; LExpr LExpr LExpr CEnv -> Asm (define (compile-tail-if e0 e1 e2 c) (let ((c0 (compile-e e0 c)) (c1 (compile-tail-e e1 c)) (c2 (compile-tail-e e2 c)) (l0 (gensym)) (l1 (gensym))) `(,@c0 (cmp rax ,imm-val-false) (je ,l0) ,@c1 (jmp ,l1) ,l0 ,@c2 ,l1))) ;; Variable LExpr LExpr CEnv -> Asm (define (compile-tail-let b body c) (match b [(binding x def) (let ((c0 (compile-e def c)) (c1 (compile-tail-e body (cons x c)))) `(,@c0 (mov (offset rsp ,(- (add1 (length c)))) rax) ,@c1))])) ;; Variable LExpr LExpr CEnv -> Asm (define (compile-let b body c) (match b [(binding x def) (let ((c0 (compile-e def c)) (c1 (compile-e body (cons x c)))) `(,@c0 (mov (offset rsp ,(- (add1 (length c)))) rax) ,@c1))])) ;; LExpr LExpr CEnv -> Asm (define (compile-+ e0 e1 c) (let ((c1 (compile-e e1 c)) (c0 (compile-e e0 (cons #f c)))) `(,@c1 ,@assert-integer (mov (offset rsp ,(- (add1 (length c)))) rax) ,@c0 ,@assert-integer (add rax (offset rsp ,(- (add1 (length c)))))))) (define (type-pred->mask p) (match p [(or 'box? 'cons? 'string? 'procedure?) result-type-mask] [_ imm-type-mask])) (define (type-pred->tag p) (match p ['box? type-box] ['cons? type-pair] ['string? type-string] ['procedure? type-proc] ['integer? imm-type-int] ['empty? imm-type-empty] ['char? imm-type-char] ['boolean? imm-type-bool])) ;; Variable CEnv -> Natural (define (lookup x cenv) (match cenv ['() (error "undefined variable:" x)] [(cons y cenv) (match (eq? x y) [#t (length cenv)] [#f (lookup x cenv)])])) (define (assert-type p) `((mov rbx rax) (and rbx ,(type-pred->mask p)) (cmp rbx ,(type-pred->tag p)) (jne err))) (define assert-integer (assert-type 'integer?)) (define assert-box (assert-type 'box?)) (define assert-pair (assert-type 'cons?)) (define assert-string (assert-type 'string?)) (define assert-char (assert-type 'char?)) (define assert-proc (assert-type 'procedure?)) ;; Asm (define assert-natural `(,@assert-integer (cmp rax -1) (jle err))) ;; Asm (define assert-integer-codepoint `((mov rbx rax) (and rbx ,imm-type-mask) (cmp rbx 0) (jne err) (cmp rax ,(arithmetic-shift -1 imm-shift)) (jle err) (cmp rax ,(arithmetic-shift #x10FFFF imm-shift)) (mov rbx rax) (sar rbx ,(+ 11 imm-shift)) (cmp rbx #b11011) (je err)))
UNAME := $(shell uname) .PHONY: test ifeq ($(UNAME), Darwin) format=macho64 else ifeq ($(UNAME), Linux) format=elf64 else format=win64 endif %.run: %.o main.o char.o clib.o gcc main.o char.o clib.o $< -o $@ main.o: main.c types.h gcc -c main.c -o main.o char.o: char.c types.h gcc -c char.c -o char.o clib.o: clib.c types.h gcc -c clib.c -o clib.o %.o: %.s nasm -f $(format) -o $@ $< %.s: %.shk racket -t compile-file.rkt -m $< > $@ clean: rm *.o *.s *.run test: 42.run @test "$(shell ./42.run)" = "42"