Skip to content

Commit 0853dba

Browse files
dvanhorndvanhorn
committed
Rough draft of Hustle compiler.
1 parent cb593e8 commit 0853dba

5 files changed

Lines changed: 340 additions & 0 deletions

File tree

‎www/notes/hustle/Makefile‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
UNAME := $(shell uname)
2+
.PHONY: test
3+
4+
ifeq ($(UNAME), Darwin)
5+
format=macho64
6+
else
7+
format=elf64
8+
endif
9+
10+
%.run: %.o main.o
11+
gcc main.o $< -o $@
12+
13+
main.o: main.c
14+
gcc -c main.c -o main.o
15+
16+
%.o: %.s
17+
nasm -f $(format) -o $@ $<
18+
19+
%.s: %.rkt
20+
racket -t compile-file.rkt -m $< > $@
21+
22+
clean:
23+
rm *.o *.s *.run
24+
25+
test: 42.run
26+
@test "$(shell ./42.run)" = "42"

‎www/notes/hustle/asm/interp.rkt‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
#lang racket
2+
(provide (all-defined-out))
3+
(require "printer.rkt" racket/runtime-path)
4+
(define-runtime-path dir "..")
5+
6+
;; Asm -> Integer
7+
;; Interpret (by assemblying, linking, and exec'ing) x86-64 code
8+
;; Assume: starts with entry point run-time expects
9+
(define (asm-interp a)
10+
(let* ((t.s (make-temporary-file "nasm~a.s"))
11+
(t.run (path-replace-extension t.s #".run")))
12+
(with-output-to-file t.s
13+
#:exists 'truncate
14+
(λ ()
15+
(asm-display a)))
16+
(system (format "(cd ~a && make -s ~a)" dir t.run))
17+
(delete-file t.s)
18+
(with-input-from-string
19+
(with-output-to-string
20+
(λ ()
21+
(system (path->string t.run))
22+
(delete-file t.run)))
23+
read)))

‎www/notes/hustle/asm/printer.rkt‎

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
#lang racket
2+
(provide (all-defined-out))
3+
4+
;; Asm -> String
5+
(define (asm->string a)
6+
(foldr (λ (i s) (string-append (instr->string i) s)) "" a))
7+
8+
;; Instruction -> String
9+
(define (instr->string i)
10+
(match i
11+
[`(,(? opcode2? o) ,a1 ,a2)
12+
(string-append "\t"
13+
(symbol->string o) " "
14+
(arg->string a1) ", "
15+
(arg->string a2) "\n")]
16+
[`(jmp ,l)
17+
(string-append "\tjmp " (label->string l) "\n")]
18+
[`(je ,l)
19+
(string-append "\tje " (label->string l) "\n")]
20+
[`(jne ,l)
21+
(string-append "\tjne " (label->string l) "\n")]
22+
[`ret "\tret\n"]
23+
24+
[`(,(? opcode1? o) ,a1)
25+
(string-append "\t"
26+
(symbol->string o) " "
27+
(arg->string a1) "\n")]
28+
[`(call ,l)
29+
(string-append "\tcall " (label->string l) "\n")]
30+
[`(push ,r)
31+
(string-append "\tpush " (reg->string r) "\n")]
32+
[`(pop ,r)
33+
(string-append "\tpop " (reg->string r) "\n")]
34+
[l (string-append (label->string l) ":\n")]))
35+
36+
(define (opcode2? x)
37+
(memq x '(mov add sub cmp imul movzx sal or xor and)))
38+
39+
(define (opcode1? x)
40+
(memq x '(sete)))
41+
42+
;; Arg -> String
43+
(define (arg->string a)
44+
(match a
45+
[(? reg?) (reg->string a)]
46+
[`(offset ,r ,i)
47+
(string-append "[" (reg->string r) " + " (number->string (* i 8)) "]")]
48+
[(? integer?) (number->string a)]))
49+
50+
;; Any -> Boolean
51+
(define (reg? x)
52+
(and (symbol? x)
53+
(memq x '(rax rbx rsp al eax rdi))))
54+
55+
;; Reg -> String
56+
(define (reg->string r)
57+
(symbol->string r))
58+
59+
;; Label -> String
60+
;; prefix with _ for Mac
61+
(define label->string
62+
(match (system-type 'os)
63+
['macosx
64+
(λ (s) (string-append "_" (symbol->string s)))]
65+
[_ symbol->string]))
66+
67+
;; Asm -> Void
68+
(define (asm-display a)
69+
;; entry point will be first label
70+
(let ((g (findf symbol? a)))
71+
(display
72+
(string-append "\tglobal " (label->string g) "\n"
73+
"\textern " (label->string 'error) "\n"
74+
"\tsection .text\n"
75+
(asm->string a)))))

‎www/notes/hustle/compile.rkt‎

Lines changed: 155 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,155 @@
1+
#lang racket
2+
(provide (all-defined-out))
3+
4+
(define int-tag #b0000) ; 0, 2, 4... integer
5+
(define box-tag #b0001) ; 1 box
6+
(define pair-tag #b0011) ; 3 pairs
7+
(define vect-tag #b0101) ; 5 vectors
8+
(define str-tag #b0111) ; 7 strings
9+
(define true-tag #b1001) ; 9
10+
(define false-tag #b1011) ; 11
11+
(define empty-tag #b1101) ; 13
12+
(define char-tag #b1111) ; 15
13+
14+
;; Allocate in 64-bit (8-byte) increments, so pointers
15+
;; end in #b000 and we tag with #b001 for pairs, etc.
16+
17+
;; type CEnv = (Listof (Maybe Variable))
18+
19+
;; Expr -> Asm
20+
(define (compile e)
21+
`(entry
22+
(add rdi 16)
23+
,@(compile-e e '())
24+
ret
25+
err
26+
(push rbp)
27+
(call error)
28+
ret))
29+
30+
;; Expr CEnv -> Asm
31+
(define (compile-e e c)
32+
(match e
33+
[''() `((mov rax ,empty-tag))]
34+
[`(box ,e0)
35+
(let ((c0 (compile-e e0 c)))
36+
`(,@c0
37+
(mov (offset rdi 0) rax)
38+
(mov rax rdi)
39+
(or rax ,box-tag)
40+
(add rdi 8) ; bump by 8 bytes
41+
))]
42+
[`(unbox ,e0)
43+
(let ((c0 (compile-e e0 c)))
44+
`(,@c0
45+
;; assert box
46+
(xor rax ,box-tag)
47+
(mov rax (offset rax 0))))]
48+
[`(cons ,e0 ,e1)
49+
(let ((c0 (compile-e e0 c))
50+
(c1 (compile-e e1 (cons #f c))))
51+
`(,@c0
52+
(mov (offset rsp ,(- (add1 (length c)))) rax)
53+
,@c1
54+
(mov (offset rdi 0) rax)
55+
(mov rax (offset rsp ,(- (add1 (length c)))))
56+
(mov (offset rdi 1) rax)
57+
(mov rax rdi)
58+
(or rax ,pair-tag)
59+
(add rdi 16)))]
60+
[`(car ,e0)
61+
(let ((c0 (compile-e e0 c)))
62+
`(,@c0
63+
;; assert pair
64+
(xor rax ,pair-tag)
65+
(mov rax (offset rax 1))))]
66+
[`(cdr ,e0)
67+
(let ((c0 (compile-e e0 c)))
68+
`(,@c0
69+
;; assert pair
70+
(xor rax ,pair-tag)
71+
(mov rax (offset rax 0))))]
72+
[(? integer? i)
73+
`((mov rax ,(* i 2)))]
74+
[(? boolean? b)
75+
`((mov rax ,(if b true-tag false-tag)))]
76+
[`(add1 ,e0)
77+
(let ((c0 (compile-e e0 c)))
78+
`(,@c0
79+
,@assert-integer
80+
(add rax 2)))]
81+
[`(sub1 ,e0)
82+
(let ((c0 (compile-e e0 c)))
83+
`(,@c0
84+
,@assert-integer
85+
(sub rax 2)))]
86+
[`(zero? ,e0)
87+
(let ((c0 (compile-e e0 c))
88+
(l0 (gensym))
89+
(l1 (gensym)))
90+
`(,@c0
91+
,@assert-integer
92+
(cmp rax 0)
93+
(mov rax ,false-tag) ; #f
94+
(jne ,l0)
95+
(mov rax ,true-tag) ; #t
96+
,l0))]
97+
[`(if ,e0 ,e1 ,e2)
98+
(let ((c0 (compile-e e0 c))
99+
(c1 (compile-e e1 c))
100+
(c2 (compile-e e2 c))
101+
(l0 (gensym))
102+
(l1 (gensym)))
103+
`(,@c0
104+
(cmp rax ,false-tag) ; compare to #f
105+
(je ,l0) ; jump to c2 if #f
106+
,@c1
107+
(jmp ,l1) ; jump past c2
108+
,l0
109+
,@c2
110+
,l1))]
111+
[(? symbol? x)
112+
(let ((i (lookup x c)))
113+
`((mov rax (offset rsp ,(- (add1 i))))))]
114+
[`(let ((,x ,e0)) ,e1)
115+
(let ((c0 (compile-e e0 c))
116+
(c1 (compile-e e1 (cons x c))))
117+
`(,@c0
118+
(mov (offset rsp ,(- (add1 (length c)))) rax)
119+
,@c1))]
120+
121+
[`(+ ,e0 ,e1)
122+
(let ((c1 (compile-e e1 c))
123+
(c0 (compile-e e0 (cons #f c))))
124+
`(,@c1
125+
,@assert-integer
126+
(mov (offset rsp ,(- (add1 (length c)))) rax)
127+
,@c0
128+
,@assert-integer
129+
(add rax (offset rsp ,(- (add1 (length c)))))))]
130+
131+
[`(- ,e0 ,e1)
132+
(let ((c1 (compile-e e1 c))
133+
(c0 (compile-e e0 (cons #f c))))
134+
`(,@c1
135+
,@assert-integer
136+
(mov (offset rsp ,(- (add1 (length c)))) rax)
137+
,@c0
138+
,@assert-integer
139+
(sub rax (offset rsp ,(- (add1 (length c)))))))]))
140+
141+
142+
;; Variable CEnv -> Natural
143+
(define (lookup x cenv)
144+
(match cenv
145+
['() (error "undefined variable:" x)]
146+
[(cons y cenv)
147+
(match (eq? x y)
148+
[#t (length cenv)]
149+
[#f (lookup x cenv)])]))
150+
151+
(define assert-integer
152+
`((mov rbx rax)
153+
(and rbx 1)
154+
(cmp rbx 0)
155+
(jne err)))

‎www/notes/hustle/main.c‎

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
#include <stdio.h>
2+
#include <stdlib.h>
3+
#include <inttypes.h>
4+
5+
// (define int-tag #b0000) ; 0, 2, 4... integer
6+
// (define box-tag #b0001) ; 1 box
7+
// (define pair-tag #b0011) ; 3 pairs
8+
// (define vect-tag #b0101) ; 5 vectors
9+
// (define str-tag #b0111) ; 7 strings
10+
// (define true-tag #b1001) ; 9
11+
// (define false-tag #b1011) ; 11
12+
// (define empty-tag #b1101) ; 13
13+
// (define char-tag #b1111) ; 15
14+
15+
#define int_mask 1
16+
#define int_shift 1
17+
18+
#define ptr_mask 7
19+
20+
#define type_int 0
21+
#define type_box 1
22+
#define type_pair 3
23+
#define val_true 9
24+
#define val_false 11
25+
#define val_empty 13
26+
27+
// in bytes
28+
#define heap_size 1000000
29+
30+
int64_t entry(void *);
31+
void print_result(int64_t);
32+
33+
int main(int argc, char** argv) {
34+
void * heap = malloc(heap_size);
35+
int64_t result = entry(heap);
36+
print_result(result);
37+
printf("\n");
38+
return 0;
39+
}
40+
41+
void error() {
42+
printf("err");
43+
exit(1);
44+
}
45+
46+
void print_result(int64_t a) {
47+
if ((int_mask & a) == type_int) {
48+
printf("%" PRId64, a >> int_shift);
49+
} else if (a == val_true) {
50+
printf("#t");
51+
} else if (a == val_false) {
52+
printf("#f");
53+
} else if (a == val_empty) {
54+
printf("())");
55+
} else if ((ptr_mask & a) == type_box) {
56+
printf("#&");
57+
print_result (*((int64_t *)(a ^ type_box)));
58+
} else if ((ptr_mask & a) == type_pair) {
59+
printf("(pair)");
60+
}
61+
}

0 commit comments

Comments
 (0)