Skip to content

Commit 6c9b2bd

Browse files
dvanhorndvanhorn
committed
Revive Outlaw.
1 parent 57c7851 commit 6c9b2bd

37 files changed

Lines changed: 5564 additions & 0 deletions

‎langs/outlaw/Makefile‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
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+
string.o \
16+
io.o \
17+
stdlib.o
18+
19+
default: runtime.o
20+
21+
runtime.o: $(objs)
22+
ld -r $(objs) -o runtime.o
23+
24+
%.run: %.o runtime.o
25+
gcc runtime.o $< -o $@
26+
27+
.c.o:
28+
gcc -fPIC -c -g -o $@ $<
29+
30+
.s.o:
31+
nasm -g -f $(format) -o $@ $<
32+
33+
stdlib.s: stdlib.rkt
34+
racket -t compile-library.rkt -m stdlib.rkt > stdlib.s
35+
36+
%.s: %.rkt
37+
racket -t compile-file.rkt -m $< > $@
38+
39+
clean:
40+
rm *.o *.s *.run
41+
42+
test: example.run
43+
@test "$(shell ./example.run)" = "$(shell racket example.rkt)"

‎langs/outlaw/ast.rkt‎

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
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 Lib = (Lib (Listof Id) (Listof Defn))
8+
(struct Lib (ids ds) #:prefab)
9+
10+
;; type Defn = (Defn Id Lambda)
11+
(struct Defn (f l) #:prefab)
12+
13+
;; type Expr = (Eof)
14+
;; | (Quote Datum)
15+
;; | (Prim Op (Listof Expr))
16+
;; | (If Expr Expr Expr)
17+
;; | (Begin Expr Expr)
18+
;; | (Let Id Expr Expr)
19+
;; | (Var Id)
20+
;; | (Match Expr (Listof Pat) (Listof Expr))
21+
;; | (App Expr (Listof Expr))
22+
;; | Lambda
23+
;; | (Apply Expr (Listof Expr))
24+
;; type Lambda = (Lam Id (Listof Id) Expr)
25+
;; | (LamRest Id (Listof Id) Id Expr)
26+
;; | (LamCase Id (Listof LamCaseClause))
27+
;; type LamCaseClause =
28+
;; | (Lam Id (Listof Id) Expr)
29+
;; | (LamRest Id (Listof Id) Expr)
30+
;; type Datum = Integer
31+
;; | Char
32+
;; | Boolean
33+
;; | String
34+
;; | Symbol
35+
;; | (Boxof Datum)
36+
;; | (Listof Datum)
37+
;; | (Vectorof Datum)
38+
;; type Id = Symbol
39+
;; type Op = Op0 | Op1 | Op2 | Op3
40+
;; type Op0 = 'read-byte
41+
;; type Op1 = 'add1 | 'sub1 | 'zero?
42+
;; | 'char? | 'integer->char | 'char->integer
43+
;; | 'write-byte | 'eof-object?
44+
;; | 'box | 'car | 'cdr | 'unbox
45+
;; | 'empty? | 'cons? | 'box?
46+
;; | 'vector? | 'vector-length
47+
;; | 'string? | 'string-length
48+
;; | 'symbol? | 'symbol->string
49+
;; | 'string->symbol | 'string->uninterned-symbol
50+
;; type Op2 = '+ | '- | '< | '=
51+
;; | 'cons
52+
;; | 'make-vector | 'vector-ref
53+
;; | 'make-string | 'string-ref
54+
;; | 'struct?
55+
;; type Op3 = 'vector-set! | 'struct-ref
56+
;; type OpN = 'make-struct
57+
;; type Pat = (PVar Id)
58+
;; | (PWild)
59+
;; | (PLit Lit)
60+
;; | (PBox Pat)
61+
;; | (PCons Pat Pat)
62+
;; | (PAnd Pat Pat)
63+
;; | (PSymb Symbol)
64+
;; | (PStr String)
65+
;; | (PStruct Id (Listof Pat))
66+
;; type Lit = Boolean
67+
;; | Character
68+
;; | Integer
69+
;; | '()
70+
71+
(struct Eof () #:prefab)
72+
(struct Prim (p es) #:prefab)
73+
(struct If (e1 e2 e3) #:prefab)
74+
(struct Begin (e1 e2) #:prefab)
75+
(struct Let (x e1 e2) #:prefab)
76+
(struct Var (x) #:prefab)
77+
(struct App (e es) #:prefab)
78+
(struct Lam (f xs e) #:prefab)
79+
(struct LamRest (f xs x e) #:prefab)
80+
(struct LamCase (f cs) #:prefab)
81+
(struct Apply (e es el) #:prefab)
82+
(struct Quote (d) #:prefab)
83+
(struct Match (e ps es) #:prefab)
84+
85+
(struct PVar (x) #:prefab)
86+
(struct PWild () #:prefab)
87+
(struct PLit (x) #:prefab)
88+
(struct PBox (p) #:prefab)
89+
(struct PCons (p1 p2) #:prefab)
90+
(struct PAnd (p1 p2) #:prefab)
91+
(struct PSymb (s) #:prefab)
92+
(struct PStr (s) #:prefab)
93+
(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: 114 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,114 @@
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+
(define r9 'r9)
11+
(define r15 'r15)
12+
13+
;; [Listof Defn] -> [Listof Id]
14+
(define (define-ids ds)
15+
(match ds
16+
['() '()]
17+
[(cons (Defn f l) ds)
18+
(cons f (define-ids ds))]))
19+
20+
;; [Listof Defn] GEnv -> Asm
21+
(define (compile-defines ds g)
22+
(match ds
23+
['() (seq)]
24+
[(cons d ds)
25+
(seq (compile-define d g)
26+
(compile-defines ds g))]))
27+
28+
;; Defn GEnv -> Asm
29+
(define (compile-define d g)
30+
(match d
31+
[(Defn f e)
32+
(seq (%%% (symbol->string f))
33+
(Data)
34+
(Label (symbol->label f))
35+
(Dq 0)
36+
(Text)
37+
(compile-e e '() g #f)
38+
(Mov (Offset (symbol->label f) 0) rax))]))
39+
40+
;; [Listof Lam] GEnv -> Asm
41+
(define (compile-lambda-defines ls g)
42+
(match ls
43+
['() (seq)]
44+
[(cons l ls)
45+
(seq (compile-lambda-define l g)
46+
(compile-lambda-defines ls g))]))
47+
48+
;; Lambda GEnv -> Asm
49+
(define (compile-lambda-define l g)
50+
(let ((fvs (fv- l g)))
51+
(match l
52+
[(Lam f xs e)
53+
(let ((env (append (reverse fvs) (reverse xs) (list #f))))
54+
(seq (Label (symbol->label f))
55+
(Cmp r15 (length xs))
56+
(Jne 'raise_error_align)
57+
(Mov rax (Offset rsp (* 8 (length xs))))
58+
(Xor rax type-proc)
59+
(copy-env-to-stack fvs 8)
60+
(compile-e e env g #t)
61+
(Add rsp (* 8 (length env))) ; pop env
62+
(Ret)))]
63+
[(LamRest f xs x e)
64+
(let ((env (append (reverse fvs) (cons x (reverse xs)) (list #f))))
65+
(seq (Label (symbol->label f))
66+
(Cmp r15 (length xs))
67+
(Jl 'raise_error_align)
68+
69+
(Sub r15 (length xs))
70+
(Mov rax val-empty)
71+
(let ((loop (gensym))
72+
(done (gensym)))
73+
(seq (Label loop)
74+
(Cmp r15 0)
75+
(Je done)
76+
(Mov (Offset rbx 0) rax)
77+
(Pop rax)
78+
(Mov (Offset rbx 8) rax)
79+
(Mov rax rbx)
80+
(Or rax type-cons)
81+
(Add rbx 16)
82+
(Sub r15 1)
83+
(Jmp loop)
84+
(Label done)))
85+
(Push rax)
86+
87+
(Mov rax (Offset rsp (* 8 (add1 (length xs)))))
88+
(Xor rax type-proc)
89+
(copy-env-to-stack fvs 8)
90+
(compile-e e env g #t)
91+
(Add rsp (* 8 (length env))) ; pop env
92+
(Ret)))]
93+
[(LamCase f cs)
94+
(seq (%%% "lamcase code")
95+
(Label (symbol->label f))
96+
(compile-fun-case-select cs)
97+
(Jmp 'raise_error_align)
98+
(compile-fun-case-clauses cs g))])))
99+
100+
(define (compile-fun-case-clauses cs g)
101+
(append-map (lambda (c) (compile-lambda-define c g)) cs))
102+
103+
(define (compile-fun-case-select cs)
104+
(append-map compile-fun-case-selector cs))
105+
106+
(define (compile-fun-case-selector c)
107+
(match c
108+
[(Lam f xs e)
109+
(seq (Cmp r15 (length xs))
110+
(Je (symbol->label f)))]
111+
[(LamRest f xs x e)
112+
(seq (Mov r9 (sub1 (length xs)))
113+
(Cmp r9 r15)
114+
(Jl (symbol->label f)))]))

0 commit comments

Comments
 (0)