Skip to content

Commit 9cce681

Browse files
dvanhorndvanhorn
committed
Outlaw baseline.
1 parent 2dceee1 commit 9cce681

39 files changed

Lines changed: 3973 additions & 0 deletions

‎langs/outlaw/Makefile‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
UNAME := $(shell uname)
2+
.PHONY: test
3+
4+
ifeq ($(UNAME), Darwin)
5+
format=macho64
6+
else
7+
format=elf64
8+
endif
9+
10+
objs = \
11+
main.o \
12+
values.o \
13+
print.o \
14+
symbol.o \
15+
io.o
16+
17+
default: runtime.o
18+
19+
runtime.o: $(objs)
20+
ld -r $(objs) -o runtime.o
21+
22+
%.run: %.o runtime.o
23+
gcc runtime.o $< -o $@
24+
25+
.c.o:
26+
gcc -fPIC -c -g -o $@ $<
27+
28+
.s.o:
29+
nasm -g -f $(format) -o $@ $<
30+
31+
%.s: %.rkt
32+
racket -t compile-file.rkt -m $< > $@
33+
34+
clean:
35+
rm *.o *.s *.run
36+
37+
test: example.run
38+
@test "$(shell ./example.run)" = "$(shell racket example.rkt)"

‎langs/outlaw/ast.rkt‎

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
#lang racket
2+
(provide (all-defined-out))
3+
4+
;; type Prog = (Prog (Listof Defn) Expr)
5+
(struct Prog (ds e) #:prefab)
6+
7+
;; type Defn = (Defn Id (Listof Id) Expr)
8+
(struct Defn (f xs e) #:prefab)
9+
10+
;; type Expr = (Eof)
11+
;; | (Quote Datum)
12+
;; | (Prim Op (Listof Expr))
13+
;; | (If Expr Expr Expr)
14+
;; | (Begin Expr Expr)
15+
;; | (Let Id Expr Expr)
16+
;; | (Var Id)
17+
;; | (Match Expr (Listof Pat) (Listof Expr))
18+
;; | (App Expr (Listof Expr))
19+
;; | (Lam Id (Listof Id) Expr)
20+
;; type Datum = Integer
21+
;; | Char
22+
;; | Boolean
23+
;; | String
24+
;; | Symbol
25+
;; | (Boxof Datum)
26+
;; | (Listof Datum)
27+
;; | (Vectorof Datum)
28+
;; type Id = Symbol
29+
;; type Op = Op0 | Op1 | Op2 | Op3
30+
;; type Op0 = 'read-byte
31+
;; type Op1 = 'add1 | 'sub1 | 'zero?
32+
;; | 'char? | 'integer->char | 'char->integer
33+
;; | 'write-byte | 'eof-object?
34+
;; | 'box | 'car | 'cdr | 'unbox
35+
;; | 'empty? | 'cons? | 'box?
36+
;; | 'vector? | 'vector-length
37+
;; | 'string? | 'string-length
38+
;; | 'symbol? | 'symbol->string
39+
;; | 'string->symbol | 'string->uninterned-symbol
40+
;; type Op2 = '+ | '- | '< | '=
41+
;; | 'cons
42+
;; | 'make-vector | 'vector-ref
43+
;; | 'make-string | 'string-ref
44+
;; | 'struct?
45+
;; type Op3 = 'vector-set! | 'struct-ref
46+
;; type OpN = 'make-struct
47+
;; type Pat = (PVar Id)
48+
;; | (PWild)
49+
;; | (PLit Lit)
50+
;; | (PBox Pat)
51+
;; | (PCons Pat Pat)
52+
;; | (PAnd Pat Pat)
53+
;; | (PSymb Symbol)
54+
;; | (PStr String)
55+
;; | (PStruct Id (Listof Pat))
56+
;; type Lit = Boolean
57+
;; | Character
58+
;; | Integer
59+
;; | '()
60+
61+
(struct Eof () #:prefab)
62+
(struct Prim (p es) #:prefab)
63+
(struct If (e1 e2 e3) #:prefab)
64+
(struct Begin (e1 e2) #:prefab)
65+
(struct Let (x e1 e2) #:prefab)
66+
(struct Var (x) #:prefab)
67+
(struct App (e es) #:prefab)
68+
(struct Lam (f xs e) #:prefab)
69+
(struct Quote (d) #:prefab)
70+
(struct Match (e ps es) #:prefab)
71+
72+
(struct PVar (x) #:prefab)
73+
(struct PWild () #:prefab)
74+
(struct PLit (x) #:prefab)
75+
(struct PBox (p) #:prefab)
76+
(struct PCons (p1 p2) #:prefab)
77+
(struct PAnd (p1 p2) #:prefab)
78+
(struct PSymb (s) #:prefab)
79+
(struct PStr (s) #:prefab)
80+
(struct PStruct (n ps) #:prefab)

‎langs/outlaw/char.c‎

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
#include <stdio.h>
2+
#include <inttypes.h>
3+
#include "types.h"
4+
5+
void print_codepoint(int64_t);
6+
7+
void print_char (int64_t v) {
8+
int64_t codepoint = v >> char_shift;
9+
printf("#\\");
10+
switch (codepoint) {
11+
case 0:
12+
printf("nul"); break;
13+
case 8:
14+
printf("backspace"); break;
15+
case 9:
16+
printf("tab"); break;
17+
case 10:
18+
printf("newline"); break;
19+
case 11:
20+
printf("vtab"); break;
21+
case 12:
22+
printf("page"); break;
23+
case 13:
24+
printf("return"); break;
25+
case 32:
26+
printf("space"); break;
27+
case 127:
28+
printf("rubout"); break;
29+
default:
30+
print_codepoint(v);
31+
}
32+
}
33+
34+
void print_codepoint(int64_t v) {
35+
int64_t codepoint = v >> char_shift;
36+
// Print using UTF-8 encoding of codepoint
37+
// https://en.wikipedia.org/wiki/UTF-8
38+
if (codepoint < 128) {
39+
printf("%c", (char) codepoint);
40+
} else if (codepoint < 2048) {
41+
printf("%c%c",
42+
(char)(codepoint >> 6) | 192,
43+
((char)codepoint & 63) | 128);
44+
} else if (codepoint < 65536) {
45+
printf("%c%c%c",
46+
(char)(codepoint >> 12) | 224,
47+
((char)(codepoint >> 6) & 63) | 128,
48+
((char)codepoint & 63) | 128);
49+
} else {
50+
printf("%c%c%c%c",
51+
(char)(codepoint >> 18) | 240,
52+
((char)(codepoint >> 12) & 63) | 128,
53+
((char)(codepoint >> 6) & 63) | 128,
54+
((char)codepoint & 63) | 128);
55+
}
56+
}
57+

‎langs/outlaw/compile-datum.rkt‎

Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
#lang racket
2+
(provide compile-datum)
3+
(require "types.rkt"
4+
"utils.rkt"
5+
a86/ast)
6+
7+
;; Registers used
8+
(define rax 'rax) ; return
9+
10+
;; Datum -> Asm
11+
(define (compile-datum d)
12+
(cond
13+
[(string? d) (seq (Lea rax (load-string d)))]
14+
[(symbol? d) (seq (Lea rax (load-symbol d)))]
15+
[(compound? d) (compile-compound-datum d)]
16+
[else (compile-atom d)]))
17+
18+
(define (load-symbol s)
19+
(Plus (symbol->data-label s) type-symb))
20+
21+
(define (load-string s)
22+
(Plus (symbol->data-label (string->symbol s)) type-str))
23+
24+
;; Value -> Asm
25+
(define (compile-atom v)
26+
(seq (Mov rax (imm->bits v))))
27+
28+
;; Datum -> Boolean
29+
(define (compound? d)
30+
(or (box? d)
31+
(cons? d)
32+
(vector? d)))
33+
34+
;; Datum -> Asm
35+
(define (compile-compound-datum d)
36+
(match (compile-quoted d)
37+
[(cons l is)
38+
(seq (Data)
39+
is
40+
(Text)
41+
(Lea rax l))]))
42+
43+
;; Datum -> (cons AsmExpr Asm)
44+
(define (compile-quoted c)
45+
(cond
46+
[(vector? c) (compile-datum-vector (vector->list c))]
47+
[(box? c) (compile-datum-box (unbox c))]
48+
[(cons? c) (compile-datum-cons (car c) (cdr c))]
49+
[(symbol? c) (cons (load-symbol c) '())]
50+
[(string? c) (cons (load-string c) '())]
51+
[else (cons (imm->bits c) '())]))
52+
53+
;; Datum -> (cons AsmExpr Asm)
54+
(define (compile-datum-box c)
55+
(match (compile-quoted c)
56+
[(cons l1 is1)
57+
(let ((l (gensym 'box)))
58+
(cons (Plus l type-box)
59+
(seq (Label l)
60+
(Dq l1)
61+
is1)))]))
62+
63+
;; Datum Datum -> (cons AsmExpr Asm)
64+
(define (compile-datum-cons c1 c2)
65+
(match (compile-quoted c1)
66+
[(cons l1 is1)
67+
(match (compile-quoted c2)
68+
[(cons l2 is2)
69+
(let ((l (gensym 'cons)))
70+
(cons (Plus l type-cons)
71+
(seq (Label l)
72+
(Dq l2)
73+
(Dq l1)
74+
is1
75+
is2)))])]))
76+
77+
;; [Listof Datum] -> (cons AsmExpr Asm)
78+
(define (compile-datum-vector ds)
79+
(match ds
80+
['() (cons type-vect '())]
81+
[_
82+
(let ((l (gensym 'vector))
83+
(cds (map compile-quoted ds)))
84+
(cons (Plus l type-vect)
85+
(seq (Label l)
86+
(Dq (length ds))
87+
(map (λ (cd) (Dq (car cd))) cds)
88+
(append-map cdr cds))))]))

‎langs/outlaw/compile-define.rkt‎

Lines changed: 69 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
#lang racket
2+
(provide (all-defined-out))
3+
(require "ast.rkt"
4+
"types.rkt"
5+
"fv.rkt"
6+
"utils.rkt"
7+
"compile-expr.rkt"
8+
a86/ast)
9+
10+
;; [Listof Defn] -> [Listof Id]
11+
(define (define-ids ds)
12+
(match ds
13+
['() '()]
14+
[(cons (Defn f xs e) ds)
15+
(cons f (define-ids ds))]))
16+
17+
;; [Listof Defn] -> Asm
18+
(define (compile-defines ds)
19+
(match ds
20+
['() (seq)]
21+
[(cons d ds)
22+
(seq (compile-define d)
23+
(compile-defines ds))]))
24+
25+
;; Defn -> Asm
26+
(define (compile-define d)
27+
(match d
28+
[(Defn f xs e)
29+
(compile-lambda-define (Lam f xs e))]))
30+
31+
;; Defns -> Asm
32+
;; Compile the closures for ds and push them on the stack
33+
(define (compile-defines-values ds)
34+
(seq (alloc-defines ds 0)
35+
(init-defines ds (reverse (define-ids ds)) 8)
36+
(add-rbx-defines ds 0)))
37+
38+
;; Defns Int -> Asm
39+
;; Allocate closures for ds at given offset, but don't write environment yet
40+
(define (alloc-defines ds off)
41+
(match ds
42+
['() (seq)]
43+
[(cons (Defn f xs e) ds)
44+
(let ((fvs (fv (Lam f xs e))))
45+
(seq (Lea rax (symbol->label f))
46+
(Mov (Offset rbx off) rax)
47+
(Mov rax rbx)
48+
(Add rax off)
49+
(Or rax type-proc)
50+
(Push rax)
51+
(alloc-defines ds (+ off (* 8 (add1 (length fvs)))))))]))
52+
53+
;; Defns CEnv Int -> Asm
54+
;; Initialize the environment for each closure for ds at given offset
55+
(define (init-defines ds c off)
56+
(match ds
57+
['() (seq)]
58+
[(cons (Defn f xs e) ds)
59+
(let ((fvs (fv (Lam f xs e))))
60+
(seq (free-vars-to-heap fvs c off)
61+
(init-defines ds c (+ off (* 8 (add1 (length fvs)))))))]))
62+
63+
;; Defns Int -> Asm
64+
;; Compute adjustment to rbx for allocation of all ds
65+
(define (add-rbx-defines ds n)
66+
(match ds
67+
['() (seq (Add rbx (* n 8)))]
68+
[(cons (Defn f xs e) ds)
69+
(add-rbx-defines ds (+ n (add1 (length (fv (Lam f xs e))))))]))

0 commit comments

Comments
 (0)