Skip to content

Commit 3a365b2

Browse files
dvanhorndvanhorn
committed
Slight representation change and clean-up of Hustle.
1 parent 0853dba commit 3a365b2

3 files changed

Lines changed: 123 additions & 63 deletions

File tree

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@
3434
[l (string-append (label->string l) ":\n")]))
3535

3636
(define (opcode2? x)
37-
(memq x '(mov add sub cmp imul movzx sal or xor and)))
37+
(memq x '(mov add sub cmp imul movzx sal sar or xor and)))
3838

3939
(define (opcode1? x)
4040
(memq x '(sete)))

‎www/notes/hustle/compile.rkt‎

Lines changed: 50 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,33 @@
11
#lang racket
22
(provide (all-defined-out))
33

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
4+
;; An immediate is anything ending in #b0000
5+
;; All other tags in mask #b111 are pointers
6+
7+
(define result-shift 3)
8+
(define result-type-mask (sub1 (arithmetic-shift 1 result-shift)))
9+
(define type-imm #b000)
10+
(define type-box #b001)
11+
(define type-pair #b010)
12+
13+
(define imm-shift (+ 3 result-shift))
14+
(define imm-type-mask (sub1 (arithmetic-shift 1 imm-shift)))
15+
(define imm-type-int (arithmetic-shift #b000 result-shift))
16+
(define imm-type-true (arithmetic-shift #b001 result-shift))
17+
(define imm-type-false (arithmetic-shift #b010 result-shift))
18+
(define imm-type-empty (arithmetic-shift #b011 result-shift))
19+
(define imm-type-char (arithmetic-shift #b100 result-shift))
1320

1421
;; Allocate in 64-bit (8-byte) increments, so pointers
15-
;; end in #b000 and we tag with #b001 for pairs, etc.
22+
;; end in #b000 and we tag with #b001 for boxes, etc.
1623

1724
;; type CEnv = (Listof (Maybe Variable))
1825

1926
;; Expr -> Asm
2027
(define (compile e)
2128
`(entry
29+
(sar rdi 4) ;; align on quad boundary
30+
(sal rdi 4)
2231
(add rdi 16)
2332
,@(compile-e e '())
2433
ret
@@ -30,20 +39,19 @@
3039
;; Expr CEnv -> Asm
3140
(define (compile-e e c)
3241
(match e
33-
[''() `((mov rax ,empty-tag))]
42+
[''() `((mov rax ,imm-type-empty))]
3443
[`(box ,e0)
3544
(let ((c0 (compile-e e0 c)))
3645
`(,@c0
3746
(mov (offset rdi 0) rax)
3847
(mov rax rdi)
39-
(or rax ,box-tag)
40-
(add rdi 8) ; bump by 8 bytes
41-
))]
48+
(or rax ,type-box)
49+
(add rdi 8)))] ; allocate 8 bytes
4250
[`(unbox ,e0)
4351
(let ((c0 (compile-e e0 c)))
4452
`(,@c0
4553
;; assert box
46-
(xor rax ,box-tag)
54+
(xor rax ,type-box)
4755
(mov rax (offset rax 0))))]
4856
[`(cons ,e0 ,e1)
4957
(let ((c0 (compile-e e0 c))
@@ -55,44 +63,44 @@
5563
(mov rax (offset rsp ,(- (add1 (length c)))))
5664
(mov (offset rdi 1) rax)
5765
(mov rax rdi)
58-
(or rax ,pair-tag)
66+
(or rax ,type-pair)
5967
(add rdi 16)))]
6068
[`(car ,e0)
6169
(let ((c0 (compile-e e0 c)))
6270
`(,@c0
6371
;; assert pair
64-
(xor rax ,pair-tag)
72+
(xor rax ,type-pair)
6573
(mov rax (offset rax 1))))]
6674
[`(cdr ,e0)
6775
(let ((c0 (compile-e e0 c)))
6876
`(,@c0
6977
;; assert pair
70-
(xor rax ,pair-tag)
78+
(xor rax ,type-pair)
7179
(mov rax (offset rax 0))))]
7280
[(? integer? i)
73-
`((mov rax ,(* i 2)))]
81+
`((mov rax ,(arithmetic-shift i imm-shift)))]
7482
[(? boolean? b)
75-
`((mov rax ,(if b true-tag false-tag)))]
83+
`((mov rax ,(if b imm-type-true imm-type-false)))]
7684
[`(add1 ,e0)
7785
(let ((c0 (compile-e e0 c)))
7886
`(,@c0
7987
,@assert-integer
80-
(add rax 2)))]
88+
(add rax ,(arithmetic-shift 1 imm-shift))))]
8189
[`(sub1 ,e0)
8290
(let ((c0 (compile-e e0 c)))
8391
`(,@c0
8492
,@assert-integer
85-
(sub rax 2)))]
93+
(sub rax ,(arithmetic-shift 1 imm-shift))))]
8694
[`(zero? ,e0)
8795
(let ((c0 (compile-e e0 c))
8896
(l0 (gensym))
8997
(l1 (gensym)))
9098
`(,@c0
9199
,@assert-integer
92100
(cmp rax 0)
93-
(mov rax ,false-tag) ; #f
101+
(mov rax ,imm-type-false)
94102
(jne ,l0)
95-
(mov rax ,true-tag) ; #t
103+
(mov rax ,imm-type-true)
96104
,l0))]
97105
[`(if ,e0 ,e1 ,e2)
98106
(let ((c0 (compile-e e0 c))
@@ -101,10 +109,10 @@
101109
(l0 (gensym))
102110
(l1 (gensym)))
103111
`(,@c0
104-
(cmp rax ,false-tag) ; compare to #f
105-
(je ,l0) ; jump to c2 if #f
112+
(cmp rax ,imm-type-false)
113+
(je ,l0)
106114
,@c1
107-
(jmp ,l1) ; jump past c2
115+
(jmp ,l1)
108116
,l0
109117
,@c2
110118
,l1))]
@@ -138,6 +146,20 @@
138146
,@assert-integer
139147
(sub rax (offset rsp ,(- (add1 (length c)))))))]))
140148

149+
;; code for "abc"
150+
'((mov (offset rdi 0)
151+
(integer->bits 3))
152+
(mov (offset rdi 1)
153+
(compile-char #\a))
154+
(mov (offset rdi 1)
155+
(char->bits #\b))
156+
(mov (offset-rdi 2)
157+
(char->bits #\c))
158+
(mov rdi rax)
159+
(or rax ,str-tag))
160+
161+
162+
141163

142164
;; Variable CEnv -> Natural
143165
(define (lookup x cenv)
@@ -150,6 +172,6 @@
150172

151173
(define assert-integer
152174
`((mov rbx rax)
153-
(and rbx 1)
175+
(and rbx ,imm-type-mask)
154176
(cmp rbx 0)
155177
(jne err)))

‎www/notes/hustle/main.c‎

Lines changed: 72 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -2,37 +2,31 @@
22
#include <stdlib.h>
33
#include <inttypes.h>
44

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
5+
#define result_shift 3
6+
#define result_type_mask ((1 << result_shift) - 1)
7+
#define type_imm 0
8+
#define type_box 1
9+
#define type_pair 2
10+
11+
#define imm_shift (3 + result_shift)
12+
#define imm_type_mask ((1 << imm_shift) - 1)
13+
#define imm_type_int (0 << result_shift)
14+
#define imm_type_true (1 << result_shift)
15+
#define imm_type_false (2 << result_shift)
16+
#define imm_type_empty (3 << result_shift)
17+
#define imm_type_char (4 << result_shift)
2618

2719
// in bytes
2820
#define heap_size 1000000
2921

3022
int64_t entry(void *);
3123
void print_result(int64_t);
24+
void print_pair(int64_t);
25+
void print_immediate(int64_t);
3226

3327
int main(int argc, char** argv) {
3428
void * heap = malloc(heap_size);
35-
int64_t result = entry(heap);
29+
int64_t result = entry(heap);
3630
print_result(result);
3731
printf("\n");
3832
return 0;
@@ -43,19 +37,63 @@ void error() {
4337
exit(1);
4438
}
4539

40+
void internal_error() {
41+
printf("internal-error");
42+
exit(1);
43+
}
44+
4645
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) {
46+
switch (result_type_mask & a) {
47+
case type_imm:
48+
print_immediate(a);
49+
break;
50+
case type_box:
5651
printf("#&");
5752
print_result (*((int64_t *)(a ^ type_box)));
58-
} else if ((ptr_mask & a) == type_pair) {
59-
printf("(pair)");
60-
}
53+
break;
54+
case type_pair:
55+
printf("(");
56+
print_pair(a);
57+
printf(")");
58+
break;
59+
default:
60+
internal_error();
61+
}
6162
}
63+
64+
void print_immediate(int64_t a) {
65+
switch (imm_type_mask & a) {
66+
case imm_type_int:
67+
printf("%" PRId64, a >> imm_shift);
68+
break;
69+
case imm_type_true:
70+
printf("#t");
71+
break;
72+
case imm_type_false:
73+
printf("#f");
74+
break;
75+
case imm_type_empty:
76+
printf("()");
77+
break;
78+
default:
79+
break;
80+
internal_error();
81+
}
82+
}
83+
84+
void print_pair(int64_t a) {
85+
int64_t car = *((int64_t *)((a + 8) ^ type_pair));
86+
int64_t cdr = *((int64_t *)((a + 0) ^ type_pair));
87+
print_result(car);
88+
if ((imm_type_mask & cdr) == imm_type_empty) {
89+
// nothing
90+
} else if ((result_type_mask & cdr) == type_pair) {
91+
printf(" ");
92+
print_pair(cdr);
93+
} else {
94+
printf(" . ");
95+
print_result(cdr);
96+
}
97+
}
98+
99+

0 commit comments

Comments
 (0)