bernsteinbear.com
this repo has no description
1// vim: set tabstop=2 shiftwidth=2 textwidth=79 expandtab:
2// gcc -O2 -g -Wall -Wextra -pedantic -fno-strict-aliasing
3// assets/code/lisp/compiling-reader.c
4
5// In general: https://course.ccs.neu.edu/cs4410sp20/#%28part._lectures%29
6// https://course.ccs.neu.edu/cs4410sp20/lec_let-and-stack_notes.html#%28part._let._.Growing_the_language__adding_let%29
7
8#define _GNU_SOURCE
9#include <assert.h> // for assert
10#include <stdbool.h> // for bool
11#include <stddef.h> // for NULL
12#include <stdint.h> // for int32_t, etc
13#include <stdio.h> // for getline, fprintf
14#include <string.h> // for memcpy
15#include <sys/mman.h> // for mmap
16#undef _GNU_SOURCE
17
18#include "greatest.h"
19
20#define WARN_UNUSED __attribute__((warn_unused_result))
21
22// Objects
23
24typedef int64_t word;
25typedef uint64_t uword;
26
27// These constants are defined in a enum because the right hand side of a
28// statement like
29// static const int kFoo = ...;
30// must be a so-called "Integer Constant Expression". Compilers are required to
31// support a certain set of these expressions, but are not required to support
32// arbitrary arithmetic with other integer constants. Compilers such as gcc
33// before gcc-8 just decided not to play this game, while gcc-8+ and Clang play
34// just fine.
35// Since this arithmetic with constant values works just fine for enums, make
36// all these constants enum values instead.
37// See https://twitter.com/tekknolagi/status/1328449329472835586 for more info.
38enum {
39 kBitsPerByte = 8, // bits
40 kWordSize = sizeof(word), // bytes
41 kBitsPerWord = kWordSize * kBitsPerByte, // bits
42
43 kIntegerTag = 0x0, // 0b00
44 kIntegerTagMask = 0x3, // 0b11
45 kIntegerShift = 2,
46 kIntegerBits = kBitsPerWord - kIntegerShift,
47
48 kImmediateTagMask = 0x3f,
49
50 kCharTag = 0x0f, // 0b00001111
51 kCharMask = 0xff, // 0b11111111
52 kCharShift = 8,
53
54 kBoolTag = 0x1f, // 0b0011111
55 kBoolMask = 0x80, // 0b10000000
56 kBoolShift = 7,
57
58 kNilTag = 0x2f, // 0b101111
59
60 kErrorTag = 0x3f, // 0b111111
61
62 kPairTag = 0x1, // 0b001
63 kSymbolTag = 0x5, // 0b101
64 kClosureTag = 0x6, // 0b110
65 kHeapTagMask = ((uword)0x7), // 0b000...111
66 kHeapPtrMask = ~kHeapTagMask, // 0b1111...1000
67};
68
69// These are defined as macros because they will not work as static const int
70// constants (per above explanation), and enum constants are only required to
71// be an int wide (per ISO C).
72#define INTEGER_MAX ((1LL << (kIntegerBits - 1)) - 1)
73#define INTEGER_MIN (-(1LL << (kIntegerBits - 1)))
74
75uword Object_encode_integer(word value) {
76 assert(value < INTEGER_MAX && "too big");
77 assert(value > INTEGER_MIN && "too small");
78 return value << kIntegerShift;
79}
80
81word Object_decode_integer(uword value) { return (word)value >> kIntegerShift; }
82
83bool Object_is_integer(uword value) {
84 return (value & kIntegerTagMask) == kIntegerTag;
85}
86
87uword Object_encode_char(char value) {
88 return ((uword)value << kCharShift) | kCharTag;
89}
90
91char Object_decode_char(uword value) {
92 return (value >> kCharShift) & kCharMask;
93}
94
95bool Object_is_char(uword value) {
96 return (value & kImmediateTagMask) == kCharTag;
97}
98
99uword Object_encode_bool(bool value) {
100 return ((uword)value << kBoolShift) | kBoolTag;
101}
102
103bool Object_decode_bool(uword value) { return value & kBoolMask; }
104
105uword Object_true() { return Object_encode_bool(true); }
106
107uword Object_false() { return Object_encode_bool(false); }
108
109uword Object_nil() { return kNilTag; }
110
111uword Object_error() { return kErrorTag; }
112
113uword Object_address(void *obj) { return (uword)obj & kHeapPtrMask; }
114
115// End Objects
116
117// Buffer
118
119typedef unsigned char byte;
120
121typedef enum {
122 kWritable,
123 kExecutable,
124} BufferState;
125
126typedef struct {
127 byte *address;
128 BufferState state;
129 size_t len;
130 size_t capacity;
131} Buffer;
132
133byte *Buffer_alloc_writable(size_t capacity) {
134 byte *result = mmap(/*addr=*/NULL, capacity, PROT_READ | PROT_WRITE,
135 MAP_ANONYMOUS | MAP_PRIVATE,
136 /*filedes=*/-1, /*off=*/0);
137 assert(result != MAP_FAILED);
138 return result;
139}
140
141void Buffer_init(Buffer *result, size_t capacity) {
142 result->address = Buffer_alloc_writable(capacity);
143 assert(result->address != MAP_FAILED);
144 result->state = kWritable;
145 result->len = 0;
146 result->capacity = capacity;
147}
148
149void Buffer_deinit(Buffer *buf) {
150 munmap(buf->address, buf->capacity);
151 buf->address = NULL;
152 buf->len = 0;
153 buf->capacity = 0;
154}
155
156int Buffer_make_executable(Buffer *buf) {
157 int result = mprotect(buf->address, buf->len, PROT_EXEC);
158 buf->state = kExecutable;
159 return result;
160}
161
162byte Buffer_at8(Buffer *buf, size_t pos) { return buf->address[pos]; }
163
164void Buffer_at_put8(Buffer *buf, size_t pos, byte b) { buf->address[pos] = b; }
165
166word max(word left, word right) { return left > right ? left : right; }
167
168void Buffer_ensure_capacity(Buffer *buf, word additional_capacity) {
169 if (buf->len + additional_capacity <= buf->capacity) {
170 return;
171 }
172 word new_capacity =
173 max(buf->capacity * 2, buf->capacity + additional_capacity);
174 byte *address = Buffer_alloc_writable(new_capacity);
175 memcpy(address, buf->address, buf->len);
176 int result = munmap(buf->address, buf->capacity);
177 assert(result == 0 && "munmap failed");
178 buf->address = address;
179 buf->capacity = new_capacity;
180}
181
182void Buffer_write8(Buffer *buf, byte b) {
183 Buffer_ensure_capacity(buf, sizeof b);
184 Buffer_at_put8(buf, buf->len++, b);
185}
186
187void Buffer_write32(Buffer *buf, int32_t value) {
188 for (size_t i = 0; i < 4; i++) {
189 Buffer_write8(buf, (value >> (i * kBitsPerByte)) & 0xff);
190 }
191}
192
193void Buffer_write_arr(Buffer *buf, const byte *arr, word arr_size) {
194 Buffer_ensure_capacity(buf, arr_size);
195 for (word i = 0; i < arr_size; i++) {
196 Buffer_write8(buf, arr[i]);
197 }
198}
199
200// End Buffer
201
202// Emit
203
204typedef enum {
205 kRax = 0,
206 kRcx,
207 kRdx,
208 kRbx,
209 kRsp,
210 kRbp,
211 kRsi,
212 kRdi,
213} Register;
214
215typedef enum {
216 kAl = 0,
217 kCl,
218 kDl,
219 kBl,
220 kAh,
221 kCh,
222 kDh,
223 kBh,
224} PartialRegister;
225
226typedef enum {
227 kOverflow = 0,
228 kNotOverflow,
229 kBelow,
230 kCarry = kBelow,
231 kNotAboveOrEqual = kBelow,
232 kAboveOrEqual,
233 kNotBelow = kAboveOrEqual,
234 kNotCarry = kAboveOrEqual,
235 kEqual,
236 kZero = kEqual,
237 kLess = 0xc,
238 kNotGreaterOrEqual = kLess,
239 // TODO(max): Add more
240} Condition;
241
242typedef struct Indirect {
243 Register reg;
244 int8_t disp;
245} Indirect;
246
247Indirect Ind(Register reg, int8_t disp) {
248 return (Indirect){.reg = reg, .disp = disp};
249}
250
251enum {
252 kRexPrefix = 0x48,
253};
254
255void Emit_mov_reg_imm32(Buffer *buf, Register dst, int32_t src) {
256 Buffer_write8(buf, kRexPrefix);
257 Buffer_write8(buf, 0xc7);
258 Buffer_write8(buf, 0xc0 + dst);
259 Buffer_write32(buf, src);
260}
261
262void Emit_ret(Buffer *buf) { Buffer_write8(buf, 0xc3); }
263
264void Emit_add_reg_imm32(Buffer *buf, Register dst, int32_t src) {
265 Buffer_write8(buf, kRexPrefix);
266 if (dst == kRax) {
267 // Optimization: add eax, {imm32} can either be encoded as 05 {imm32} or 81
268 // c0 {imm32}.
269 Buffer_write8(buf, 0x05);
270 } else {
271 Buffer_write8(buf, 0x81);
272 Buffer_write8(buf, 0xc0 + dst);
273 }
274 Buffer_write32(buf, src);
275}
276
277void Emit_sub_reg_imm32(Buffer *buf, Register dst, int32_t src) {
278 Buffer_write8(buf, kRexPrefix);
279 if (dst == kRax) {
280 // Optimization: sub eax, {imm32} can either be encoded as 2d {imm32} or 81
281 // e8 {imm32}.
282 Buffer_write8(buf, 0x2d);
283 } else {
284 Buffer_write8(buf, 0x81);
285 Buffer_write8(buf, 0xe8 + dst);
286 }
287 Buffer_write32(buf, src);
288}
289
290void Emit_shl_reg_imm8(Buffer *buf, Register dst, int8_t bits) {
291 Buffer_write8(buf, kRexPrefix);
292 Buffer_write8(buf, 0xc1);
293 Buffer_write8(buf, 0xe0 + dst);
294 Buffer_write8(buf, bits);
295}
296
297void Emit_shr_reg_imm8(Buffer *buf, Register dst, int8_t bits) {
298 Buffer_write8(buf, kRexPrefix);
299 Buffer_write8(buf, 0xc1);
300 Buffer_write8(buf, 0xe8 + dst);
301 Buffer_write8(buf, bits);
302}
303
304void Emit_or_reg_imm8(Buffer *buf, Register dst, uint8_t tag) {
305 Buffer_write8(buf, kRexPrefix);
306 Buffer_write8(buf, 0x83);
307 Buffer_write8(buf, 0xc8 + dst);
308 Buffer_write8(buf, tag);
309}
310
311void Emit_and_reg_imm8(Buffer *buf, Register dst, uint8_t tag) {
312 Buffer_write8(buf, kRexPrefix);
313 Buffer_write8(buf, 0x83);
314 Buffer_write8(buf, 0xe0 + dst);
315 Buffer_write8(buf, tag);
316}
317
318void Emit_cmp_reg_imm32(Buffer *buf, Register left, int32_t right) {
319 Buffer_write8(buf, kRexPrefix);
320 if (left == kRax) {
321 // Optimization: cmp rax, {imm32} can either be encoded as 3d {imm32} or 81
322 // f8 {imm32}.
323 Buffer_write8(buf, 0x3d);
324 } else {
325 Buffer_write8(buf, 0x81);
326 Buffer_write8(buf, 0xf8 + left);
327 }
328 Buffer_write32(buf, right);
329}
330
331void Emit_setcc_imm8(Buffer *buf, Condition cond, PartialRegister dst) {
332 Buffer_write8(buf, 0x0f);
333 Buffer_write8(buf, 0x90 + cond);
334 Buffer_write8(buf, 0xc0 + dst);
335}
336
337uint8_t disp8(int8_t disp) { return disp >= 0 ? disp : 0x100 + disp; }
338
339// mov [dst+disp], src
340// or
341// mov %src, disp(%dst)
342void Emit_store_reg_indirect(Buffer *buf, Indirect dst, Register src) {
343 Buffer_write8(buf, kRexPrefix);
344 Buffer_write8(buf, 0x89);
345 Buffer_write8(buf, 0x40 + src * 8 + dst.reg);
346 Buffer_write8(buf, disp8(dst.disp));
347}
348
349// add dst, [src+disp]
350// or
351// add disp(%src), %dst
352void Emit_add_reg_indirect(Buffer *buf, Register dst, Indirect src) {
353 Buffer_write8(buf, kRexPrefix);
354 Buffer_write8(buf, 0x03);
355 Buffer_write8(buf, 0x40 + dst * 8 + src.reg);
356 Buffer_write8(buf, disp8(src.disp));
357}
358
359// sub dst, [src+disp]
360// or
361// sub disp(%src), %dst
362void Emit_sub_reg_indirect(Buffer *buf, Register dst, Indirect src) {
363 Buffer_write8(buf, kRexPrefix);
364 Buffer_write8(buf, 0x2b);
365 Buffer_write8(buf, 0x40 + dst * 8 + src.reg);
366 Buffer_write8(buf, disp8(src.disp));
367}
368
369// mul rax, [src+disp]
370// or
371// mul disp(%src), %rax
372void Emit_mul_reg_indirect(Buffer *buf, Indirect src) {
373 Buffer_write8(buf, kRexPrefix);
374 Buffer_write8(buf, 0xf7);
375 Buffer_write8(buf, 0x60 + src.reg);
376 Buffer_write8(buf, disp8(src.disp));
377}
378
379// cmp left, [right+disp]
380// or
381// cmp disp(%right), %left
382void Emit_cmp_reg_indirect(Buffer *buf, Register left, Indirect right) {
383 Buffer_write8(buf, kRexPrefix);
384 Buffer_write8(buf, 0x3b);
385 Buffer_write8(buf, 0x40 + left * 8 + right.reg);
386 Buffer_write8(buf, disp8(right.disp));
387}
388
389// mov dst, [src+disp]
390// or
391// mov disp(%src), %dst
392void Emit_load_reg_indirect(Buffer *buf, Register dst, Indirect src) {
393 Buffer_write8(buf, kRexPrefix);
394 Buffer_write8(buf, 0x8b);
395 Buffer_write8(buf, 0x40 + dst * 8 + src.reg);
396 Buffer_write8(buf, disp8(src.disp));
397}
398
399// End Emit
400
401// AST
402
403typedef struct ASTNode ASTNode;
404
405typedef struct Pair {
406 ASTNode *car;
407 ASTNode *cdr;
408} Pair;
409
410typedef struct Symbol {
411 word length;
412 char cstr[];
413} Symbol;
414
415bool AST_is_integer(ASTNode *node) {
416 return ((uword)node & kIntegerTagMask) == kIntegerTag;
417}
418
419word AST_get_integer(ASTNode *node) {
420 return Object_decode_integer((uword)node);
421}
422
423ASTNode *AST_new_integer(word value) {
424 return (ASTNode *)Object_encode_integer(value);
425}
426
427bool AST_is_char(ASTNode *node) {
428 return ((uword)node & kImmediateTagMask) == kCharTag;
429}
430
431char AST_get_char(ASTNode *node) { return Object_decode_char((uword)node); }
432
433ASTNode *AST_new_char(char value) {
434 return (ASTNode *)Object_encode_char(value);
435}
436
437bool AST_is_bool(ASTNode *node) {
438 return ((uword)node & kImmediateTagMask) == kBoolTag;
439}
440
441bool AST_get_bool(ASTNode *node) { return Object_decode_bool((uword)node); }
442
443ASTNode *AST_new_bool(bool value) {
444 return (ASTNode *)Object_encode_bool(value);
445}
446
447bool AST_is_nil(ASTNode *node) { return (uword)node == Object_nil(); }
448
449ASTNode *AST_nil() { return (ASTNode *)Object_nil(); }
450
451bool AST_is_error(ASTNode *node) { return (uword)node == Object_error(); }
452
453ASTNode *AST_error() { return (ASTNode *)Object_error(); }
454
455ASTNode *AST_heap_alloc(unsigned char tag, uword size) {
456 // Initialize to 0
457 uword address = (uword)calloc(size, 1);
458 return (ASTNode *)(address | tag);
459}
460
461bool AST_is_heap_object(ASTNode *node) {
462 // For some reason masking out the tag first and then doing the comparison
463 // makes this branchless
464 unsigned char tag = (uword)node & kHeapTagMask;
465 // Heap object tags are between 0b001 and 0b110 except for 0b100 (which is an
466 // integer)
467 return (tag & kIntegerTagMask) > 0 && (tag & kImmediateTagMask) != 0x7;
468}
469
470void AST_pair_set_car(ASTNode *node, ASTNode *car);
471void AST_pair_set_cdr(ASTNode *node, ASTNode *cdr);
472
473ASTNode *AST_new_pair(ASTNode *car, ASTNode *cdr) {
474 ASTNode *node = AST_heap_alloc(kPairTag, sizeof(Pair));
475 AST_pair_set_car(node, car);
476 AST_pair_set_cdr(node, cdr);
477 return node;
478}
479
480bool AST_is_pair(ASTNode *node) {
481 return ((uword)node & kHeapTagMask) == kPairTag;
482}
483
484Pair *AST_as_pair(ASTNode *node) {
485 assert(AST_is_pair(node));
486 return (Pair *)Object_address(node);
487}
488
489ASTNode *AST_pair_car(ASTNode *node) { return AST_as_pair(node)->car; }
490
491void AST_pair_set_car(ASTNode *node, ASTNode *car) {
492 AST_as_pair(node)->car = car;
493}
494
495ASTNode *AST_pair_cdr(ASTNode *node) { return AST_as_pair(node)->cdr; }
496
497void AST_pair_set_cdr(ASTNode *node, ASTNode *cdr) {
498 AST_as_pair(node)->cdr = cdr;
499}
500
501void AST_heap_free(ASTNode *node) {
502 if (!AST_is_heap_object(node)) {
503 return;
504 }
505 if (AST_is_pair(node)) {
506 AST_heap_free(AST_pair_car(node));
507 AST_heap_free(AST_pair_cdr(node));
508 }
509 free((void *)Object_address(node));
510}
511
512Symbol *AST_as_symbol(ASTNode *node);
513
514ASTNode *AST_new_symbol(const char *str) {
515 word data_length = strlen(str) + 1; // for NUL
516 ASTNode *node = AST_heap_alloc(kSymbolTag, sizeof(Symbol) + data_length);
517 Symbol *s = AST_as_symbol(node);
518 s->length = data_length;
519 memcpy(s->cstr, str, data_length);
520 return node;
521}
522
523bool AST_is_symbol(ASTNode *node) {
524 return ((uword)node & kHeapTagMask) == kSymbolTag;
525}
526
527Symbol *AST_as_symbol(ASTNode *node) {
528 assert(AST_is_symbol(node));
529 return (Symbol *)Object_address(node);
530}
531
532const char *AST_symbol_cstr(ASTNode *node) {
533 return (const char *)AST_as_symbol(node)->cstr;
534}
535
536bool AST_symbol_matches(ASTNode *node, const char *cstr) {
537 return strcmp(AST_symbol_cstr(node), cstr) == 0;
538}
539
540int node_to_str(ASTNode *node, char *buf, word size);
541
542int list_to_str(ASTNode *node, char *buf, word size) {
543 if (AST_is_pair(node)) {
544 word result = 0;
545 result += snprintf(buf + result, size, " ");
546 result += node_to_str(AST_pair_car(node), buf + result, size);
547 result += list_to_str(AST_pair_cdr(node), buf + result, size);
548 return result;
549 }
550 if (AST_is_nil(node)) {
551 return snprintf(buf, size, ")");
552 }
553 word result = 0;
554 result += snprintf(buf + result, size, " . ");
555 result += node_to_str(node, buf + result, size);
556 result += snprintf(buf + result, size, ")");
557 return result;
558}
559
560int node_to_str(ASTNode *node, char *buf, word size) {
561 if (AST_is_integer(node)) {
562 return snprintf(buf, size, "%ld", AST_get_integer(node));
563 }
564 if (AST_is_char(node)) {
565 return snprintf(buf, size, "'%c'", AST_get_char(node));
566 }
567 if (AST_is_bool(node)) {
568 return snprintf(buf, size, "%s", AST_get_bool(node) ? "true" : "false");
569 }
570 if (AST_is_nil(node)) {
571 return snprintf(buf, size, "nil");
572 }
573 if (AST_is_pair(node)) {
574 word result = 0;
575 result += snprintf(buf + result, size, "(");
576 result += node_to_str(AST_pair_car(node), buf + result, size);
577 result += list_to_str(AST_pair_cdr(node), buf + result, size);
578 return result;
579 }
580 if (AST_is_symbol(node)) {
581 return snprintf(buf, size, "%s", AST_symbol_cstr(node));
582 }
583 assert(0 && "unknown ast");
584}
585
586char *AST_to_cstr(ASTNode *node) {
587 int size = node_to_str(node, NULL, 0);
588 char *buf = malloc(size + 1);
589 assert(buf != NULL);
590 node_to_str(node, buf, size + 1);
591 buf[size] = '\0';
592 return buf;
593}
594
595// End AST
596
597// Reader
598
599void advance(word *pos) { ++*pos; }
600
601char next(char *input, word *pos) {
602 advance(pos);
603 return input[*pos];
604}
605
606ASTNode *read_integer(char *input, word *pos, int sign) {
607 word result = 0;
608 for (char c = input[*pos]; isdigit(c); c = next(input, pos)) {
609 result *= 10;
610 result += c - '0';
611 }
612 return AST_new_integer(sign * result);
613}
614
615bool starts_symbol(char c) {
616 switch (c) {
617 case '+':
618 case '-':
619 case '*':
620 case '>':
621 case '=':
622 case '?':
623 return true;
624 default:
625 return isalpha(c);
626 }
627}
628
629bool is_symbol_char(char c) { return starts_symbol(c) || isdigit(c); }
630
631const word ATOM_MAX = 32;
632
633ASTNode *read_symbol(char *input, word *pos) {
634 char buf[ATOM_MAX + 1]; // +1 for NUL
635 word length = 0;
636 for (length = 0; length < ATOM_MAX && is_symbol_char(input[*pos]); length++) {
637 buf[length] = input[*pos];
638 advance(pos);
639 }
640 buf[length] = '\0';
641 return AST_new_symbol(buf);
642}
643
644ASTNode *read_char(char *input, word *pos) {
645 char c = input[*pos];
646 if (c == '\'') {
647 return AST_error();
648 }
649 advance(pos);
650 if (input[*pos] != '\'') {
651 return AST_error();
652 }
653 advance(pos);
654 return AST_new_char(c);
655}
656
657char skip_whitespace(char *input, word *pos) {
658 char c = '\0';
659 for (c = input[*pos]; isspace(c); c = next(input, pos)) {
660 ;
661 }
662 return c;
663}
664
665ASTNode *read_rec(char *input, word *pos);
666
667ASTNode *read_list(char *input, word *pos) {
668 char c = skip_whitespace(input, pos);
669 if (c == ')') {
670 advance(pos);
671 return AST_nil();
672 }
673 ASTNode *car = read_rec(input, pos);
674 assert(car != AST_error());
675 ASTNode *cdr = read_list(input, pos);
676 assert(cdr != AST_error());
677 return AST_new_pair(car, cdr);
678}
679
680ASTNode *read_rec(char *input, word *pos) {
681 char c = skip_whitespace(input, pos);
682 if (isdigit(c)) {
683 return read_integer(input, pos, /*sign=*/1);
684 }
685 if (c == '-' && isdigit(input[*pos + 1])) {
686 advance(pos);
687 return read_integer(input, pos, /*sign=*/-1);
688 }
689 if (c == '+' && isdigit(input[*pos + 1])) {
690 advance(pos);
691 return read_integer(input, pos, /*sign=*/1);
692 }
693 if (starts_symbol(c)) {
694 return read_symbol(input, pos);
695 }
696 if (c == '\'') {
697 advance(pos); // skip '\''
698 return read_char(input, pos);
699 }
700 if (c == '#' && input[*pos + 1] == 't') {
701 advance(pos); // skip '#'
702 advance(pos); // skip 't'
703 return AST_new_bool(true);
704 }
705 if (c == '#' && input[*pos + 1] == 'f') {
706 advance(pos); // skip '#'
707 advance(pos); // skip 'f'
708 return AST_new_bool(false);
709 }
710 if (c == '(') {
711 advance(pos); // skip '('
712 return read_list(input, pos);
713 }
714 return AST_error();
715}
716
717ASTNode *Reader_read(char *input) {
718 word pos = 0;
719 return read_rec(input, &pos);
720}
721
722// End Reader
723
724// Env
725
726typedef struct Env {
727 const char *name;
728 word value;
729 struct Env *prev;
730} Env;
731
732Env Env_bind(const char *name, word value, Env *prev) {
733 return (Env){.name = name, .value = value, .prev = prev};
734}
735
736bool Env_find(Env *env, const char *key, word *result) {
737 if (env == NULL)
738 return false;
739 if (strcmp(env->name, key) == 0) {
740 *result = env->value;
741 return true;
742 }
743 return Env_find(env->prev, key, result);
744}
745
746// End Env
747
748// Compile
749
750WARN_UNUSED int Compile_expr(Buffer *buf, ASTNode *node, word stack_index,
751 Env *varenv);
752
753ASTNode *operand1(ASTNode *args) { return AST_pair_car(args); }
754
755ASTNode *operand2(ASTNode *args) { return AST_pair_car(AST_pair_cdr(args)); }
756
757#define _(exp) \
758 do { \
759 int result = exp; \
760 if (result != 0) \
761 return result; \
762 } while (0)
763
764void Compile_compare_imm32(Buffer *buf, int32_t value) {
765 Emit_cmp_reg_imm32(buf, kRax, value);
766 Emit_mov_reg_imm32(buf, kRax, 0);
767 Emit_setcc_imm8(buf, kEqual, kAl);
768 Emit_shl_reg_imm8(buf, kRax, kBoolShift);
769 Emit_or_reg_imm8(buf, kRax, kBoolTag);
770}
771
772// This is let, not let*. Therefore we keep track of two environments -- the
773// parent environment, for evaluating the bindings, and the body environment,
774// which will have all of the bindings in addition to the parent. This makes
775// programs like (let ((a 1) (b a)) b) fail.
776WARN_UNUSED int Compile_let(Buffer *buf, ASTNode *bindings, ASTNode *body,
777 word stack_index, Env *binding_env, Env *body_env) {
778 if (AST_is_nil(bindings)) {
779 // Base case: no bindings. Compile the body
780 _(Compile_expr(buf, body, stack_index, body_env));
781 return 0;
782 }
783 assert(AST_is_pair(bindings));
784 // Get the next binding
785 ASTNode *binding = AST_pair_car(bindings);
786 ASTNode *name = AST_pair_car(binding);
787 assert(AST_is_symbol(name));
788 ASTNode *binding_expr = AST_pair_car(AST_pair_cdr(binding));
789 // Compile the binding expression
790 _(Compile_expr(buf, binding_expr, stack_index, binding_env));
791 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRbp, stack_index),
792 /*src=*/kRax);
793 // Bind the name
794 Env entry = Env_bind(AST_symbol_cstr(name), stack_index, body_env);
795 _(Compile_let(buf, AST_pair_cdr(bindings), body, stack_index - kWordSize,
796 /*binding_env=*/binding_env, /*body_env=*/&entry));
797 return 0;
798}
799
800WARN_UNUSED int Compile_call(Buffer *buf, ASTNode *callable, ASTNode *args,
801 word stack_index, Env *varenv) {
802 if (AST_is_symbol(callable)) {
803 if (AST_symbol_matches(callable, "add1")) {
804 _(Compile_expr(buf, operand1(args), stack_index, varenv));
805 Emit_add_reg_imm32(buf, kRax, Object_encode_integer(1));
806 return 0;
807 }
808 if (AST_symbol_matches(callable, "sub1")) {
809 _(Compile_expr(buf, operand1(args), stack_index, varenv));
810 Emit_sub_reg_imm32(buf, kRax, Object_encode_integer(1));
811 return 0;
812 }
813 if (AST_symbol_matches(callable, "integer->char")) {
814 _(Compile_expr(buf, operand1(args), stack_index, varenv));
815 Emit_shl_reg_imm8(buf, kRax, kCharShift - kIntegerShift);
816 Emit_or_reg_imm8(buf, kRax, kCharTag);
817 return 0;
818 }
819 if (AST_symbol_matches(callable, "char->integer")) {
820 _(Compile_expr(buf, operand1(args), stack_index, varenv));
821 Emit_shr_reg_imm8(buf, kRax, kCharShift - kIntegerShift);
822 return 0;
823 }
824 if (AST_symbol_matches(callable, "nil?")) {
825 _(Compile_expr(buf, operand1(args), stack_index, varenv));
826 Compile_compare_imm32(buf, Object_nil());
827 return 0;
828 }
829 if (AST_symbol_matches(callable, "zero?")) {
830 _(Compile_expr(buf, operand1(args), stack_index, varenv));
831 Compile_compare_imm32(buf, Object_encode_integer(0));
832 return 0;
833 }
834 if (AST_symbol_matches(callable, "not")) {
835 _(Compile_expr(buf, operand1(args), stack_index, varenv));
836 // All non #f values are truthy
837 // ...this might be a problem if we want to make nil falsey
838 Compile_compare_imm32(buf, Object_false());
839 return 0;
840 }
841 if (AST_symbol_matches(callable, "integer?")) {
842 _(Compile_expr(buf, operand1(args), stack_index, varenv));
843 Emit_and_reg_imm8(buf, kRax, kIntegerTagMask);
844 Compile_compare_imm32(buf, kIntegerTag);
845 return 0;
846 }
847 if (AST_symbol_matches(callable, "boolean?")) {
848 _(Compile_expr(buf, operand1(args), stack_index, varenv));
849 Emit_and_reg_imm8(buf, kRax, kImmediateTagMask);
850 Compile_compare_imm32(buf, kBoolTag);
851 return 0;
852 }
853 if (AST_symbol_matches(callable, "+")) {
854 _(Compile_expr(buf, operand2(args), stack_index, varenv));
855 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRbp, stack_index),
856 /*src=*/kRax);
857 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv));
858 Emit_add_reg_indirect(buf, /*dst=*/kRax, /*src=*/Ind(kRbp, stack_index));
859 return 0;
860 }
861 if (AST_symbol_matches(callable, "-")) {
862 _(Compile_expr(buf, operand2(args), stack_index, varenv));
863 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRbp, stack_index),
864 /*src=*/kRax);
865 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv));
866 Emit_sub_reg_indirect(buf, /*dst=*/kRax, /*src=*/Ind(kRbp, stack_index));
867 return 0;
868 }
869 if (AST_symbol_matches(callable, "*")) {
870 _(Compile_expr(buf, operand2(args), stack_index, varenv));
871 // Remove the tag so that the result is still only tagged with 0b00
872 // instead of 0b0000
873 Emit_shr_reg_imm8(buf, kRax, kIntegerShift);
874 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRbp, stack_index),
875 /*src=*/kRax);
876 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv));
877 Emit_mul_reg_indirect(buf, /*src=*/Ind(kRbp, stack_index));
878 return 0;
879 }
880 if (AST_symbol_matches(callable, "=")) {
881 _(Compile_expr(buf, operand2(args), stack_index, varenv));
882 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRbp, stack_index),
883 /*src=*/kRax);
884 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv));
885 Emit_cmp_reg_indirect(buf, kRax, Ind(kRbp, stack_index));
886 Emit_mov_reg_imm32(buf, kRax, 0);
887 Emit_setcc_imm8(buf, kEqual, kAl);
888 Emit_shl_reg_imm8(buf, kRax, kBoolShift);
889 Emit_or_reg_imm8(buf, kRax, kBoolTag);
890 return 0;
891 }
892 if (AST_symbol_matches(callable, "<")) {
893 _(Compile_expr(buf, operand2(args), stack_index, varenv));
894 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRbp, stack_index),
895 /*src=*/kRax);
896 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv));
897 Emit_cmp_reg_indirect(buf, kRax, Ind(kRbp, stack_index));
898 Emit_mov_reg_imm32(buf, kRax, 0);
899 Emit_setcc_imm8(buf, kLess, kAl);
900 Emit_shl_reg_imm8(buf, kRax, kBoolShift);
901 Emit_or_reg_imm8(buf, kRax, kBoolTag);
902 return 0;
903 }
904 if (AST_symbol_matches(callable, "let")) {
905 return Compile_let(buf, /*bindings=*/operand1(args),
906 /*body=*/operand2(args), stack_index,
907 /*binding_env=*/varenv,
908 /*body_env=*/varenv);
909 }
910 }
911 assert(0 && "unexpected call type");
912}
913
914WARN_UNUSED int Compile_expr(Buffer *buf, ASTNode *node, word stack_index,
915 Env *varenv) {
916 if (AST_is_integer(node)) {
917 word value = AST_get_integer(node);
918 Emit_mov_reg_imm32(buf, kRax, Object_encode_integer(value));
919 return 0;
920 }
921 if (AST_is_char(node)) {
922 char value = AST_get_char(node);
923 Emit_mov_reg_imm32(buf, kRax, Object_encode_char(value));
924 return 0;
925 }
926 if (AST_is_bool(node)) {
927 bool value = AST_get_bool(node);
928 Emit_mov_reg_imm32(buf, kRax, Object_encode_bool(value));
929 return 0;
930 }
931 if (AST_is_nil(node)) {
932 Emit_mov_reg_imm32(buf, kRax, Object_nil());
933 return 0;
934 }
935 if (AST_is_pair(node)) {
936 return Compile_call(buf, AST_pair_car(node), AST_pair_cdr(node),
937 stack_index, varenv);
938 }
939 if (AST_is_symbol(node)) {
940 const char *symbol = AST_symbol_cstr(node);
941 word value;
942 if (Env_find(varenv, symbol, &value)) {
943 Emit_load_reg_indirect(buf, /*dst=*/kRax, /*src=*/Ind(kRbp, value));
944 return 0;
945 }
946 return -1;
947 }
948 assert(0 && "unexpected node type");
949}
950
951static const byte kFunctionPrologue[] = {
952 // push rbp
953 0x55,
954 // mov rbp, rsp
955 kRexPrefix,
956 0x89,
957 0xe5,
958};
959
960static const byte kFunctionEpilogue[] = {
961 // pop rbp
962 0x5d,
963 // ret
964 0xc3,
965};
966
967WARN_UNUSED int Compile_function(Buffer *buf, ASTNode *node) {
968 Buffer_write_arr(buf, kFunctionPrologue, sizeof kFunctionPrologue);
969 _(Compile_expr(buf, node, -kWordSize, /*varenv=*/NULL));
970 Buffer_write_arr(buf, kFunctionEpilogue, sizeof kFunctionEpilogue);
971 return 0;
972}
973
974// End Compile
975
976typedef int (*JitFunction)();
977
978// Testing
979
980uword Testing_execute_expr(Buffer *buf) {
981 assert(buf != NULL);
982 assert(buf->address != NULL);
983 assert(buf->state == kExecutable);
984 // The pointer-pointer cast is allowed but the underlying
985 // data-to-function-pointer back-and-forth is only guaranteed to work on
986 // POSIX systems (because of eg dlsym).
987 JitFunction function = *(JitFunction *)(&buf->address);
988 return function();
989}
990
991TEST Testing_expect_function_has_contents(Buffer *buf, byte *arr,
992 size_t arr_size) {
993 size_t total_size =
994 sizeof kFunctionPrologue + arr_size + sizeof kFunctionEpilogue;
995 ASSERT_EQ_FMT(total_size, buf->len, "%ld");
996
997 byte *ptr = buf->address;
998 ASSERT_MEM_EQ(kFunctionPrologue, ptr, sizeof kFunctionPrologue);
999 ptr += sizeof kFunctionPrologue;
1000 ASSERT_MEM_EQ(arr, ptr, arr_size);
1001 ptr += arr_size;
1002 ASSERT_MEM_EQ(kFunctionEpilogue, ptr, sizeof kFunctionEpilogue);
1003 ptr += sizeof kFunctionEpilogue;
1004 PASS();
1005}
1006
1007#define EXPECT_EQUALS_BYTES(buf, arr) \
1008 ASSERT_MEM_EQ(arr, (buf)->address, sizeof arr)
1009
1010#define EXPECT_FUNCTION_CONTAINS_CODE(buf, arr) \
1011 CHECK_CALL(Testing_expect_function_has_contents(buf, arr, sizeof arr))
1012
1013#define RUN_BUFFER_TEST(test_name) \
1014 do { \
1015 Buffer buf; \
1016 Buffer_init(&buf, 1); \
1017 GREATEST_RUN_TEST1(test_name, &buf); \
1018 Buffer_deinit(&buf); \
1019 } while (0)
1020
1021ASTNode *list1(ASTNode *item0) { return AST_new_pair(item0, AST_nil()); }
1022
1023ASTNode *list2(ASTNode *item0, ASTNode *item1) {
1024 return AST_new_pair(item0, list1(item1));
1025}
1026
1027ASTNode *list3(ASTNode *item0, ASTNode *item1, ASTNode *item2) {
1028 return AST_new_pair(item0, list2(item1, item2));
1029}
1030
1031ASTNode *new_unary_call(const char *name, ASTNode *arg) {
1032 return list2(AST_new_symbol(name), arg);
1033}
1034
1035ASTNode *new_binary_call(const char *name, ASTNode *arg0, ASTNode *arg1) {
1036 return list3(AST_new_symbol(name), arg0, arg1);
1037}
1038
1039// End Testing
1040
1041// Tests
1042
1043TEST encode_positive_integer(void) {
1044 ASSERT_EQ(Object_encode_integer(0), 0x0);
1045 ASSERT_EQ(Object_encode_integer(1), 0x4);
1046 ASSERT_EQ(Object_encode_integer(10), 0x28);
1047 PASS();
1048}
1049
1050TEST encode_negative_integer(void) {
1051 ASSERT_EQ(Object_encode_integer(0), 0x0);
1052 ASSERT_EQ(Object_encode_integer(-1), 0xfffffffffffffffc);
1053 ASSERT_EQ(Object_encode_integer(-10), 0xffffffffffffffd8);
1054 PASS();
1055}
1056
1057TEST encode_char(void) {
1058 ASSERT_EQ(Object_encode_char('\0'), 0xf);
1059 ASSERT_EQ(Object_encode_char('a'), 0x610f);
1060 PASS();
1061}
1062
1063TEST decode_char(void) {
1064 ASSERT_EQ(Object_decode_char(0xf), '\0');
1065 ASSERT_EQ(Object_decode_char(0x610f), 'a');
1066 PASS();
1067}
1068
1069TEST encode_bool(void) {
1070 ASSERT_EQ(Object_encode_bool(true), 0x9f);
1071 ASSERT_EQ(Object_encode_bool(false), 0x1f);
1072 ASSERT_EQ(Object_true(), 0x9f);
1073 ASSERT_EQ(Object_false(), 0x1f);
1074 PASS();
1075}
1076
1077TEST decode_bool(void) {
1078 ASSERT_EQ(Object_decode_bool(0x9f), true);
1079 ASSERT_EQ(Object_decode_bool(0x1f), false);
1080 PASS();
1081}
1082
1083TEST address(void) {
1084 ASSERT_EQ(Object_address((void *)0xFF01), 0xFF00);
1085 PASS();
1086}
1087
1088TEST ast_new_pair(void) {
1089 ASTNode *node = AST_new_pair(NULL, NULL);
1090 ASSERT(AST_is_pair(node));
1091 AST_heap_free(node);
1092 PASS();
1093}
1094
1095TEST ast_pair_car_returns_car(void) {
1096 ASTNode *node = AST_new_pair(AST_new_integer(123), NULL);
1097 ASTNode *car = AST_pair_car(node);
1098 ASSERT(AST_is_integer(car));
1099 ASSERT_EQ(Object_decode_integer((uword)car), 123);
1100 AST_heap_free(node);
1101 PASS();
1102}
1103
1104TEST ast_pair_cdr_returns_cdr(void) {
1105 ASTNode *node = AST_new_pair(NULL, AST_new_integer(123));
1106 ASTNode *cdr = AST_pair_cdr(node);
1107 ASSERT(AST_is_integer(cdr));
1108 ASSERT_EQ(Object_decode_integer((uword)cdr), 123);
1109 AST_heap_free(node);
1110 PASS();
1111}
1112
1113TEST ast_new_symbol(void) {
1114 const char *value = "my symbol";
1115 ASTNode *node = AST_new_symbol(value);
1116 ASSERT(AST_is_symbol(node));
1117 ASSERT_STR_EQ(AST_symbol_cstr(node), value);
1118 AST_heap_free(node);
1119 PASS();
1120}
1121
1122#define ASSERT_IS_CHAR_EQ(node, c) \
1123 do { \
1124 ASTNode *__tmp = node; \
1125 if (AST_is_error(__tmp)) { \
1126 fprintf(stderr, "Expected a char but got an error.\n"); \
1127 } \
1128 ASSERT(AST_is_char(__tmp)); \
1129 ASSERT_EQ(AST_get_char(__tmp), c); \
1130 } while (0);
1131
1132#define ASSERT_IS_INT_EQ(node, val) \
1133 do { \
1134 ASTNode *__tmp = node; \
1135 if (AST_is_error(__tmp)) { \
1136 fprintf(stderr, "Expected an int but got an error.\n"); \
1137 } \
1138 ASSERT(AST_is_integer(__tmp)); \
1139 ASSERT_EQ(AST_get_integer(__tmp), val); \
1140 } while (0);
1141
1142#define ASSERT_IS_SYM_EQ(node, cstr) \
1143 do { \
1144 ASTNode *__tmp = node; \
1145 if (AST_is_error(__tmp)) { \
1146 fprintf(stderr, "Expected a symbol but got an error.\n"); \
1147 } \
1148 ASSERT(AST_is_symbol(__tmp)); \
1149 ASSERT_STR_EQ(AST_symbol_cstr(__tmp), cstr); \
1150 } while (0);
1151
1152TEST read_with_integer_returns_integer(void) {
1153 char *input = "1234";
1154 ASTNode *node = Reader_read(input);
1155 ASSERT_IS_INT_EQ(node, 1234);
1156 AST_heap_free(node);
1157 PASS();
1158}
1159
1160TEST read_with_negative_integer_returns_integer(void) {
1161 char *input = "-1234";
1162 ASTNode *node = Reader_read(input);
1163 ASSERT_IS_INT_EQ(node, -1234);
1164 AST_heap_free(node);
1165 PASS();
1166}
1167
1168TEST read_with_positive_integer_returns_integer(void) {
1169 char *input = "+1234";
1170 ASTNode *node = Reader_read(input);
1171 ASSERT_IS_INT_EQ(node, 1234);
1172 AST_heap_free(node);
1173 PASS();
1174}
1175
1176TEST read_with_leading_whitespace_ignores_whitespace(void) {
1177 char *input = " \t \n 1234";
1178 ASTNode *node = Reader_read(input);
1179 ASSERT_IS_INT_EQ(node, 1234);
1180 AST_heap_free(node);
1181 PASS();
1182}
1183
1184TEST read_with_symbol_returns_symbol(void) {
1185 char *input = "hello?+-*=>";
1186 ASTNode *node = Reader_read(input);
1187 ASSERT_IS_SYM_EQ(node, "hello?+-*=>");
1188 AST_heap_free(node);
1189 PASS();
1190}
1191
1192TEST read_with_symbol_with_trailing_digits(void) {
1193 char *input = "add1 1";
1194 ASTNode *node = Reader_read(input);
1195 ASSERT_IS_SYM_EQ(node, "add1");
1196 AST_heap_free(node);
1197 PASS();
1198}
1199
1200TEST read_with_char_returns_char(void) {
1201 char *input = "'a'";
1202 ASTNode *node = Reader_read(input);
1203 ASSERT_IS_CHAR_EQ(node, 'a');
1204 ASSERT(AST_is_error(Reader_read("''")));
1205 ASSERT(AST_is_error(Reader_read("'aa'")));
1206 ASSERT(AST_is_error(Reader_read("'aa")));
1207 AST_heap_free(node);
1208 PASS();
1209}
1210
1211TEST read_with_bool_returns_bool(void) {
1212 ASSERT_EQ(Reader_read("#t"), AST_new_bool(true));
1213 ASSERT_EQ(Reader_read("#f"), AST_new_bool(false));
1214 ASSERT(AST_is_error(Reader_read("#")));
1215 ASSERT(AST_is_error(Reader_read("#x")));
1216 ASSERT(AST_is_error(Reader_read("##")));
1217 PASS();
1218}
1219
1220TEST read_with_nil_returns_nil(void) {
1221 char *input = "()";
1222 ASTNode *node = Reader_read(input);
1223 ASSERT(AST_is_nil(node));
1224 AST_heap_free(node);
1225 PASS();
1226}
1227
1228TEST read_with_list_returns_list(void) {
1229 char *input = "( 1 2 0 )";
1230 ASTNode *node = Reader_read(input);
1231 ASSERT(AST_is_pair(node));
1232 ASSERT_IS_INT_EQ(AST_pair_car(node), 1);
1233 ASSERT_IS_INT_EQ(AST_pair_car(AST_pair_cdr(node)), 2);
1234 ASSERT_IS_INT_EQ(AST_pair_car(AST_pair_cdr(AST_pair_cdr(node))), 0);
1235 ASSERT(AST_is_nil(AST_pair_cdr(AST_pair_cdr(AST_pair_cdr(node)))));
1236 AST_heap_free(node);
1237 PASS();
1238}
1239
1240TEST read_with_nested_list_returns_list(void) {
1241 char *input = "((hello world) (foo bar))";
1242 ASTNode *node = Reader_read(input);
1243 ASSERT(AST_is_pair(node));
1244 ASTNode *first = AST_pair_car(node);
1245 ASSERT(AST_is_pair(first));
1246 ASSERT_IS_SYM_EQ(AST_pair_car(first), "hello");
1247 ASSERT_IS_SYM_EQ(AST_pair_car(AST_pair_cdr(first)), "world");
1248 ASSERT(AST_is_nil(AST_pair_cdr(AST_pair_cdr(first))));
1249 ASTNode *second = AST_pair_car(AST_pair_cdr(node));
1250 ASSERT(AST_is_pair(second));
1251 ASSERT_IS_SYM_EQ(AST_pair_car(second), "foo");
1252 ASSERT_IS_SYM_EQ(AST_pair_car(AST_pair_cdr(second)), "bar");
1253 ASSERT(AST_is_nil(AST_pair_cdr(AST_pair_cdr(second))));
1254 AST_heap_free(node);
1255 PASS();
1256}
1257
1258TEST buffer_write8_increases_length(Buffer *buf) {
1259 ASSERT_EQ(buf->len, 0);
1260 Buffer_write8(buf, 0xdb);
1261 ASSERT_EQ(Buffer_at8(buf, 0), 0xdb);
1262 ASSERT_EQ(buf->len, 1);
1263 PASS();
1264}
1265
1266TEST buffer_write8_expands_buffer(void) {
1267 Buffer buf;
1268 Buffer_init(&buf, 1);
1269 ASSERT_EQ(buf.capacity, 1);
1270 ASSERT_EQ(buf.len, 0);
1271 Buffer_write8(&buf, 0xdb);
1272 Buffer_write8(&buf, 0xef);
1273 ASSERT(buf.capacity > 1);
1274 ASSERT_EQ(buf.len, 2);
1275 Buffer_deinit(&buf);
1276 PASS();
1277}
1278
1279TEST buffer_write32_expands_buffer(void) {
1280 Buffer buf;
1281 Buffer_init(&buf, 1);
1282 ASSERT_EQ(buf.capacity, 1);
1283 ASSERT_EQ(buf.len, 0);
1284 Buffer_write32(&buf, 0xdeadbeef);
1285 ASSERT(buf.capacity > 1);
1286 ASSERT_EQ(buf.len, 4);
1287 Buffer_deinit(&buf);
1288 PASS();
1289}
1290
1291TEST buffer_write32_writes_little_endian(Buffer *buf) {
1292 Buffer_write32(buf, 0xdeadbeef);
1293 ASSERT_EQ(Buffer_at8(buf, 0), 0xef);
1294 ASSERT_EQ(Buffer_at8(buf, 1), 0xbe);
1295 ASSERT_EQ(Buffer_at8(buf, 2), 0xad);
1296 ASSERT_EQ(Buffer_at8(buf, 3), 0xde);
1297 PASS();
1298}
1299
1300TEST compile_positive_integer(Buffer *buf) {
1301 word value = 123;
1302 ASTNode *node = AST_new_integer(value);
1303 int compile_result = Compile_function(buf, node);
1304 ASSERT_EQ(compile_result, 0);
1305 // mov eax, imm(123)
1306 byte expected[] = {0x48, 0xc7, 0xc0, 0xec, 0x01, 0x00, 0x00};
1307 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1308 Buffer_make_executable(buf);
1309 uword result = Testing_execute_expr(buf);
1310 ASSERT_EQ(result, Object_encode_integer(value));
1311 PASS();
1312}
1313
1314TEST compile_negative_integer(Buffer *buf) {
1315 word value = -123;
1316 ASTNode *node = AST_new_integer(value);
1317 int compile_result = Compile_function(buf, node);
1318 ASSERT_EQ(compile_result, 0);
1319 // mov eax, imm(-123)
1320 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0xfe, 0xff, 0xff};
1321 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1322 Buffer_make_executable(buf);
1323 uword result = Testing_execute_expr(buf);
1324 ASSERT_EQ(result, Object_encode_integer(value));
1325 PASS();
1326}
1327
1328TEST compile_char(Buffer *buf) {
1329 char value = 'a';
1330 ASTNode *node = AST_new_char(value);
1331 int compile_result = Compile_function(buf, node);
1332 ASSERT_EQ(compile_result, 0);
1333 // mov eax, imm('a')
1334 byte expected[] = {0x48, 0xc7, 0xc0, 0x0f, 0x61, 0x00, 0x00};
1335 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1336 Buffer_make_executable(buf);
1337 uword result = Testing_execute_expr(buf);
1338 ASSERT_EQ(result, Object_encode_char(value));
1339 PASS();
1340}
1341
1342TEST compile_true(Buffer *buf) {
1343 ASTNode *node = AST_new_bool(true);
1344 int compile_result = Compile_function(buf, node);
1345 ASSERT_EQ(compile_result, 0);
1346 // mov eax, imm(true)
1347 byte expected[] = {0x48, 0xc7, 0xc0, 0x9f, 0x0, 0x0, 0x0};
1348 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1349 Buffer_make_executable(buf);
1350 uword result = Testing_execute_expr(buf);
1351 ASSERT_EQ(result, Object_true());
1352 PASS();
1353}
1354
1355TEST compile_false(Buffer *buf) {
1356 ASTNode *node = AST_new_bool(false);
1357 int compile_result = Compile_function(buf, node);
1358 ASSERT_EQ(compile_result, 0);
1359 // mov eax, imm(false)
1360 byte expected[] = {0x48, 0xc7, 0xc0, 0x1f, 0x00, 0x00, 0x00};
1361 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1362 Buffer_make_executable(buf);
1363 uword result = Testing_execute_expr(buf);
1364 ASSERT_EQ(result, Object_false());
1365 PASS();
1366}
1367
1368TEST compile_nil(Buffer *buf) {
1369 ASTNode *node = AST_nil();
1370 int compile_result = Compile_function(buf, node);
1371 ASSERT_EQ(compile_result, 0);
1372 // mov eax, imm(nil)
1373 byte expected[] = {0x48, 0xc7, 0xc0, 0x2f, 0x00, 0x00, 0x00};
1374 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1375 Buffer_make_executable(buf);
1376 uword result = Testing_execute_expr(buf);
1377 ASSERT_EQ(result, Object_nil());
1378 PASS();
1379}
1380
1381TEST compile_unary_add1(Buffer *buf) {
1382 ASTNode *node = new_unary_call("add1", AST_new_integer(123));
1383 int compile_result = Compile_function(buf, node);
1384 ASSERT_EQ(compile_result, 0);
1385 // mov rax, imm(123); add rax, imm(1)
1386 byte expected[] = {0x48, 0xc7, 0xc0, 0xec, 0x01, 0x00, 0x00,
1387 0x48, 0x05, 0x04, 0x00, 0x00, 0x00};
1388 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1389 Buffer_make_executable(buf);
1390 uword result = Testing_execute_expr(buf);
1391 ASSERT_EQ(result, Object_encode_integer(124));
1392 AST_heap_free(node);
1393 PASS();
1394}
1395
1396TEST compile_unary_add1_nested(Buffer *buf) {
1397 ASTNode *node =
1398 new_unary_call("add1", new_unary_call("add1", AST_new_integer(123)));
1399 int compile_result = Compile_function(buf, node);
1400 ASSERT_EQ(compile_result, 0);
1401 // mov rax, imm(123); add rax, imm(1); add rax, imm(1)
1402 byte expected[] = {0x48, 0xc7, 0xc0, 0xec, 0x01, 0x00, 0x00, 0x48, 0x05, 0x04,
1403 0x00, 0x00, 0x00, 0x48, 0x05, 0x04, 0x00, 0x00, 0x00};
1404 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1405 Buffer_make_executable(buf);
1406 uword result = Testing_execute_expr(buf);
1407 ASSERT_EQ(result, Object_encode_integer(125));
1408 AST_heap_free(node);
1409 PASS();
1410}
1411
1412TEST compile_unary_sub1(Buffer *buf) {
1413 ASTNode *node = new_unary_call("sub1", AST_new_integer(123));
1414 int compile_result = Compile_function(buf, node);
1415 ASSERT_EQ(compile_result, 0);
1416 // mov rax, imm(123); sub rax, imm(1)
1417 byte expected[] = {0x48, 0xc7, 0xc0, 0xec, 0x01, 0x00, 0x00,
1418 0x48, 0x2d, 0x04, 0x00, 0x00, 0x00};
1419 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1420 Buffer_make_executable(buf);
1421 uword result = Testing_execute_expr(buf);
1422 ASSERT_EQ(result, Object_encode_integer(122));
1423 AST_heap_free(node);
1424 PASS();
1425}
1426
1427TEST compile_unary_integer_to_char(Buffer *buf) {
1428 ASTNode *node = new_unary_call("integer->char", AST_new_integer(97));
1429 int compile_result = Compile_function(buf, node);
1430 ASSERT_EQ(compile_result, 0);
1431 // mov rax, imm(97); shl rax, 6; or rax, 0xf
1432 byte expected[] = {0x48, 0xc7, 0xc0, 0x84, 0x01, 0x00, 0x00, 0x48,
1433 0xc1, 0xe0, 0x06, 0x48, 0x83, 0xc8, 0x0f};
1434 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1435 Buffer_make_executable(buf);
1436 uword result = Testing_execute_expr(buf);
1437 ASSERT_EQ(result, Object_encode_char('a'));
1438 AST_heap_free(node);
1439 PASS();
1440}
1441
1442TEST compile_unary_char_to_integer(Buffer *buf) {
1443 ASTNode *node = new_unary_call("char->integer", AST_new_char('a'));
1444 int compile_result = Compile_function(buf, node);
1445 ASSERT_EQ(compile_result, 0);
1446 // mov rax, imm('a'); shr rax, 6
1447 byte expected[] = {0x48, 0xc7, 0xc0, 0x0f, 0x61, 0x00,
1448 0x00, 0x48, 0xc1, 0xe8, 0x06};
1449 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1450 Buffer_make_executable(buf);
1451 uword result = Testing_execute_expr(buf);
1452 ASSERT_EQ(result, Object_encode_integer(97));
1453 AST_heap_free(node);
1454 PASS();
1455}
1456
1457TEST compile_unary_nilp_with_nil_returns_true(Buffer *buf) {
1458 ASTNode *node = new_unary_call("nil?", AST_nil());
1459 int compile_result = Compile_function(buf, node);
1460 ASSERT_EQ(compile_result, 0);
1461 // 0: 48 c7 c0 2f 00 00 00 mov rax,0x2f
1462 // 7: 48 3d 2f 00 00 00 cmp rax,0x0000002f
1463 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1464 // 14: 0f 94 c0 sete al
1465 // 17: 48 c1 e0 07 shl rax,0x7
1466 // 1b: 48 83 c8 1f or rax,0x1f
1467 byte expected[] = {0x48, 0xc7, 0xc0, 0x2f, 0x00, 0x00, 0x00, 0x48,
1468 0x3d, 0x2f, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1469 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1470 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1471 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1472 Buffer_make_executable(buf);
1473 uword result = Testing_execute_expr(buf);
1474 ASSERT_EQ(result, Object_true());
1475 AST_heap_free(node);
1476 PASS();
1477}
1478
1479TEST compile_unary_nilp_with_non_nil_returns_false(Buffer *buf) {
1480 ASTNode *node = new_unary_call("nil?", AST_new_integer(5));
1481 int compile_result = Compile_function(buf, node);
1482 ASSERT_EQ(compile_result, 0);
1483 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
1484 // 7: 48 3d 2f 00 00 00 cmp rax,0x0000002f
1485 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1486 // 14: 0f 94 c0 sete al
1487 // 17: 48 c1 e0 07 shl rax,0x7
1488 // 1b: 48 83 c8 1f or rax,0x1f
1489 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48,
1490 0x3d, 0x2f, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1491 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1492 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1493 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1494 Buffer_make_executable(buf);
1495 uword result = Testing_execute_expr(buf);
1496 ASSERT_EQ(result, Object_false());
1497 AST_heap_free(node);
1498 PASS();
1499}
1500
1501TEST compile_unary_zerop_with_zero_returns_true(Buffer *buf) {
1502 ASTNode *node = new_unary_call("zero?", AST_new_integer(0));
1503 int compile_result = Compile_function(buf, node);
1504 ASSERT_EQ(compile_result, 0);
1505 // 0: 48 c7 c0 00 00 00 00 mov rax,0x0
1506 // 7: 48 3d 00 00 00 00 cmp rax,0x00000000
1507 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1508 // 14: 0f 94 c0 sete al
1509 // 17: 48 c1 e0 07 shl rax,0x7
1510 // 1b: 48 83 c8 1f or rax,0x1f
1511 byte expected[] = {0x48, 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x48,
1512 0x3d, 0x00, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1513 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1514 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1515 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1516 Buffer_make_executable(buf);
1517 uword result = Testing_execute_expr(buf);
1518 ASSERT_EQ(result, Object_true());
1519 AST_heap_free(node);
1520 PASS();
1521}
1522
1523TEST compile_unary_zerop_with_non_zero_returns_false(Buffer *buf) {
1524 ASTNode *node = new_unary_call("zero?", AST_new_integer(5));
1525 int compile_result = Compile_function(buf, node);
1526 ASSERT_EQ(compile_result, 0);
1527 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
1528 // 7: 48 3d 00 00 00 00 cmp rax,0x00000000
1529 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1530 // 14: 0f 94 c0 sete al
1531 // 17: 48 c1 e0 07 shl rax,0x7
1532 // 1b: 48 83 c8 1f or rax,0x1f
1533 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48,
1534 0x3d, 0x00, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1535 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1536 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1537 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1538 Buffer_make_executable(buf);
1539 uword result = Testing_execute_expr(buf);
1540 ASSERT_EQ(result, Object_false());
1541 AST_heap_free(node);
1542 PASS();
1543}
1544
1545TEST compile_unary_not_with_false_returns_true(Buffer *buf) {
1546 ASTNode *node = new_unary_call("not", AST_new_bool(false));
1547 int compile_result = Compile_function(buf, node);
1548 ASSERT_EQ(compile_result, 0);
1549 // 0: 48 c7 c0 1f 00 00 00 mov rax,0x1f
1550 // 7: 48 3d 1f 00 00 00 cmp rax,0x0000001f
1551 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1552 // 14: 0f 94 c0 sete al
1553 // 17: 48 c1 e0 07 shl rax,0x7
1554 // 1b: 48 83 c8 1f or rax,0x1f
1555 byte expected[] = {0x48, 0xc7, 0xc0, 0x1f, 0x00, 0x00, 0x00, 0x48,
1556 0x3d, 0x1f, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1557 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1558 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1559 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1560 Buffer_make_executable(buf);
1561 uword result = Testing_execute_expr(buf);
1562 ASSERT_EQ(result, Object_true());
1563 AST_heap_free(node);
1564 PASS();
1565}
1566
1567TEST compile_unary_not_with_non_false_returns_false(Buffer *buf) {
1568 ASTNode *node = new_unary_call("not", AST_new_integer(5));
1569 int compile_result = Compile_function(buf, node);
1570 ASSERT_EQ(compile_result, 0);
1571 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
1572 // 7: 48 3d 1f 00 00 00 cmp rax,0x0000001f
1573 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1574 // 14: 0f 94 c0 sete al
1575 // 17: 48 c1 e0 07 shl rax,0x7
1576 // 1b: 48 83 c8 1f or rax,0x1f
1577 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48,
1578 0x3d, 0x1f, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1579 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1580 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1581 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1582 Buffer_make_executable(buf);
1583 uword result = Testing_execute_expr(buf);
1584 ASSERT_EQ(result, Object_false());
1585 AST_heap_free(node);
1586 PASS();
1587}
1588
1589TEST compile_unary_integerp_with_integer_returns_true(Buffer *buf) {
1590 ASTNode *node = new_unary_call("integer?", AST_new_integer(5));
1591 int compile_result = Compile_function(buf, node);
1592 ASSERT_EQ(compile_result, 0);
1593 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
1594 // 7: 48 83 e0 03 and rax,0x3
1595 // b: 48 3d 00 00 00 00 cmp rax,0x00000000
1596 // 11: 48 c7 c0 00 00 00 00 mov rax,0x0
1597 // 18: 0f 94 c0 sete al
1598 // 1b: 48 c1 e0 07 shl rax,0x7
1599 // 1f: 48 83 c8 1f or rax,0x1f
1600 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48, 0x83,
1601 0xe0, 0x03, 0x48, 0x3d, 0x00, 0x00, 0x00, 0x00, 0x48,
1602 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0,
1603 0x48, 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1604 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1605 Buffer_make_executable(buf);
1606 uword result = Testing_execute_expr(buf);
1607 ASSERT_EQ(result, Object_true());
1608 AST_heap_free(node);
1609 PASS();
1610}
1611
1612TEST compile_unary_integerp_with_non_integer_returns_false(Buffer *buf) {
1613 ASTNode *node = new_unary_call("integer?", AST_nil());
1614 int compile_result = Compile_function(buf, node);
1615 ASSERT_EQ(compile_result, 0);
1616 // 0: 48 c7 c0 2f 00 00 00 mov rax,0x2f
1617 // 7: 48 83 e0 03 and rax,0x3
1618 // b: 48 3d 00 00 00 00 cmp rax,0x00000000
1619 // 11: 48 c7 c0 00 00 00 00 mov rax,0x0
1620 // 18: 0f 94 c0 sete al
1621 // 1b: 48 c1 e0 07 shl rax,0x7
1622 // 1f: 48 83 c8 1f or rax,0x1f
1623 byte expected[] = {0x48, 0xc7, 0xc0, 0x2f, 0x00, 0x00, 0x00, 0x48, 0x83,
1624 0xe0, 0x03, 0x48, 0x3d, 0x00, 0x00, 0x00, 0x00, 0x48,
1625 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0,
1626 0x48, 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1627 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1628 Buffer_make_executable(buf);
1629 uword result = Testing_execute_expr(buf);
1630 ASSERT_EQ(result, Object_false());
1631 AST_heap_free(node);
1632 PASS();
1633}
1634
1635TEST compile_unary_booleanp_with_boolean_returns_true(Buffer *buf) {
1636 ASTNode *node = new_unary_call("boolean?", AST_new_bool(true));
1637 int compile_result = Compile_function(buf, node);
1638 ASSERT_EQ(compile_result, 0);
1639 // 0: 48 c7 c0 9f 00 00 00 mov rax,0x9f
1640 // 7: 48 83 e0 3f and rax,0x3f
1641 // b: 48 3d 1f 00 00 00 cmp rax,0x0000001f
1642 // 11: 48 c7 c0 00 00 00 00 mov rax,0x0
1643 // 18: 0f 94 c0 sete al
1644 // 1b: 48 c1 e0 07 shl rax,0x7
1645 // 1f: 48 83 c8 1f or rax,0x1f
1646 byte expected[] = {0x48, 0xc7, 0xc0, 0x9f, 0x00, 0x00, 0x00, 0x48, 0x83,
1647 0xe0, 0x3f, 0x48, 0x3d, 0x1f, 0x00, 0x00, 0x00, 0x48,
1648 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0,
1649 0x48, 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1650 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1651 Buffer_make_executable(buf);
1652 uword result = Testing_execute_expr(buf);
1653 ASSERT_EQ(result, Object_true());
1654 AST_heap_free(node);
1655 PASS();
1656}
1657
1658TEST compile_unary_booleanp_with_non_boolean_returns_false(Buffer *buf) {
1659 ASTNode *node = new_unary_call("boolean?", AST_new_integer(5));
1660 int compile_result = Compile_function(buf, node);
1661 ASSERT_EQ(compile_result, 0);
1662 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
1663 // 7: 48 83 e0 3f and rax,0x3f
1664 // b: 48 3d 1f 00 00 00 cmp rax,0x0000001f
1665 // 11: 48 c7 c0 00 00 00 00 mov rax,0x0
1666 // 18: 0f 94 c0 sete al
1667 // 1b: 48 c1 e0 07 shl rax,0x7
1668 // 1f: 48 83 c8 1f or rax,0x1f
1669 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48, 0x83,
1670 0xe0, 0x3f, 0x48, 0x3d, 0x1f, 0x00, 0x00, 0x00, 0x48,
1671 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0,
1672 0x48, 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1673 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1674 Buffer_make_executable(buf);
1675 uword result = Testing_execute_expr(buf);
1676 ASSERT_EQ(result, Object_false());
1677 AST_heap_free(node);
1678 PASS();
1679}
1680
1681TEST compile_binary_plus(Buffer *buf) {
1682 ASTNode *node = new_binary_call("+", AST_new_integer(5), AST_new_integer(8));
1683 int compile_result = Compile_function(buf, node);
1684 ASSERT_EQ(compile_result, 0);
1685 byte expected[] = {
1686 // 0: 48 c7 c0 20 00 00 00 mov rax,0x20
1687 0x48, 0xc7, 0xc0, 0x20, 0x00, 0x00, 0x00,
1688 // 7: 48 89 45 f8 mov QWORD PTR [rbp-0x8],rax
1689 0x48, 0x89, 0x45, 0xf8,
1690 // b: 48 c7 c0 14 00 00 00 mov rax,0x14
1691 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
1692 // 12: 48 03 45 f8 add rax,QWORD PTR [rbp-0x8]
1693 0x48, 0x03, 0x45, 0xf8};
1694 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1695 Buffer_make_executable(buf);
1696 uword result = Testing_execute_expr(buf);
1697 ASSERT_EQ(result, Object_encode_integer(13));
1698 AST_heap_free(node);
1699 PASS();
1700}
1701
1702TEST compile_binary_plus_nested(Buffer *buf) {
1703 ASTNode *node = new_binary_call(
1704 "+", new_binary_call("+", AST_new_integer(1), AST_new_integer(2)),
1705 new_binary_call("+", AST_new_integer(3), AST_new_integer(4)));
1706 int compile_result = Compile_function(buf, node);
1707 ASSERT_EQ(compile_result, 0);
1708 byte expected[] = {
1709 // 4: 48 c7 c0 10 00 00 00 mov rax,0x10
1710 0x48, 0xc7, 0xc0, 0x10, 0x00, 0x00, 0x00,
1711 // b: 48 89 45 f8 mov QWORD PTR [rbp-0x8],rax
1712 0x48, 0x89, 0x45, 0xf8,
1713 // f: 48 c7 c0 0c 00 00 00 mov rax,0xc
1714 0x48, 0xc7, 0xc0, 0x0c, 0x00, 0x00, 0x00,
1715 // 16: 48 03 45 f8 add rax,QWORD PTR [rbp-0x8]
1716 0x48, 0x03, 0x45, 0xf8,
1717 // 1a: 48 89 45 f8 mov QWORD PTR [rbp-0x8],rax
1718 0x48, 0x89, 0x45, 0xf8,
1719 // 1e: 48 c7 c0 08 00 00 00 mov rax,0x8
1720 0x48, 0xc7, 0xc0, 0x08, 0x00, 0x00, 0x00,
1721 // 25: 48 89 45 f0 mov QWORD PTR [rbp-0x10],rax
1722 0x48, 0x89, 0x45, 0xf0,
1723 // 29: 48 c7 c0 04 00 00 00 mov rax,0x4
1724 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
1725 // 30: 48 03 45 f0 add rax,QWORD PTR [rbp-0x10]
1726 0x48, 0x03, 0x45, 0xf0,
1727 // 34: 48 03 45 f8 add rax,QWORD PTR [rbp-0x8]
1728 0x48, 0x03, 0x45, 0xf8};
1729 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1730 Buffer_make_executable(buf);
1731 uword result = Testing_execute_expr(buf);
1732 ASSERT_EQ(result, Object_encode_integer(10));
1733 AST_heap_free(node);
1734 PASS();
1735}
1736
1737TEST compile_binary_minus(Buffer *buf) {
1738 ASTNode *node = new_binary_call("-", AST_new_integer(5), AST_new_integer(8));
1739 int compile_result = Compile_function(buf, node);
1740 ASSERT_EQ(compile_result, 0);
1741 byte expected[] = {
1742 // 0: 48 c7 c0 20 00 00 00 mov rax,0x20
1743 0x48, 0xc7, 0xc0, 0x20, 0x00, 0x00, 0x00,
1744 // 7: 48 89 45 f8 mov QWORD PTR [rbp-0x8],rax
1745 0x48, 0x89, 0x45, 0xf8,
1746 // b: 48 c7 c0 14 00 00 00 mov rax,0x14
1747 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
1748 // 12: 48 2b 45 f8 add rax,QWORD PTR [rbp-0x8]
1749 0x48, 0x2b, 0x45, 0xf8};
1750 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1751 Buffer_make_executable(buf);
1752 uword result = Testing_execute_expr(buf);
1753 ASSERT_EQ(result, Object_encode_integer(-3));
1754 AST_heap_free(node);
1755 PASS();
1756}
1757
1758TEST compile_binary_minus_nested(Buffer *buf) {
1759 ASTNode *node = new_binary_call(
1760 "-", new_binary_call("-", AST_new_integer(5), AST_new_integer(1)),
1761 new_binary_call("-", AST_new_integer(4), AST_new_integer(3)));
1762 int compile_result = Compile_function(buf, node);
1763 ASSERT_EQ(compile_result, 0);
1764 byte expected[] = {
1765 // 4: 48 c7 c0 0c 00 00 00 mov rax,0xc
1766 0x48, 0xc7, 0xc0, 0x0c, 0x00, 0x00, 0x00,
1767 // b: 48 89 45 f8 mov QWORD PTR [rbp-0x8],rax
1768 0x48, 0x89, 0x45, 0xf8,
1769 // f: 48 c7 c0 10 00 00 00 mov rax,0x10
1770 0x48, 0xc7, 0xc0, 0x10, 0x00, 0x00, 0x00,
1771 // 16: 48 2b 45 f8 add rax,QWORD PTR [rbp-0x8]
1772 0x48, 0x2b, 0x45, 0xf8,
1773 // 1a: 48 89 45 f8 mov QWORD PTR [rbp-0x8],rax
1774 0x48, 0x89, 0x45, 0xf8,
1775 // 1e: 48 c7 c0 04 00 00 00 mov rax,0x4
1776 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
1777 // 25: 48 89 45 f0 mov QWORD PTR [rbp-0x10],rax
1778 0x48, 0x89, 0x45, 0xf0,
1779 // 29: 48 c7 c0 14 00 00 00 mov rax,0x14
1780 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
1781 // 30: 48 2b 45 f0 add rax,QWORD PTR [rbp-0x10]
1782 0x48, 0x2b, 0x45, 0xf0,
1783 // 34: 48 2b 45 f8 add rax,QWORD PTR [rbp-0x8]
1784 0x48, 0x2b, 0x45, 0xf8};
1785 EXPECT_FUNCTION_CONTAINS_CODE(buf, expected);
1786 Buffer_make_executable(buf);
1787 uword result = Testing_execute_expr(buf);
1788 ASSERT_EQ(result, Object_encode_integer(3));
1789 AST_heap_free(node);
1790 PASS();
1791}
1792
1793TEST compile_binary_mul(Buffer *buf) {
1794 ASTNode *node = new_binary_call("*", AST_new_integer(5), AST_new_integer(8));
1795 int compile_result = Compile_function(buf, node);
1796 ASSERT_EQ(compile_result, 0);
1797 Buffer_make_executable(buf);
1798 uword result = Testing_execute_expr(buf);
1799 ASSERT_EQ_FMT(Object_encode_integer(40), result, "0x%lx");
1800 AST_heap_free(node);
1801 PASS();
1802}
1803
1804TEST compile_binary_mul_nested(Buffer *buf) {
1805 ASTNode *node = new_binary_call(
1806 "*", new_binary_call("*", AST_new_integer(1), AST_new_integer(2)),
1807 new_binary_call("*", AST_new_integer(3), AST_new_integer(4)));
1808 int compile_result = Compile_function(buf, node);
1809 ASSERT_EQ(compile_result, 0);
1810 Buffer_make_executable(buf);
1811 uword result = Testing_execute_expr(buf);
1812 ASSERT_EQ_FMT(Object_encode_integer(24), result, "0x%lx");
1813 AST_heap_free(node);
1814 PASS();
1815}
1816
1817TEST compile_binary_eq_with_same_address_returns_true(Buffer *buf) {
1818 ASTNode *node = new_binary_call("=", AST_new_integer(5), AST_new_integer(5));
1819 int compile_result = Compile_function(buf, node);
1820 ASSERT_EQ(compile_result, 0);
1821 Buffer_make_executable(buf);
1822 uword result = Testing_execute_expr(buf);
1823 ASSERT_EQ_FMT(Object_true(), result, "0x%lx");
1824 AST_heap_free(node);
1825 PASS();
1826}
1827
1828TEST compile_binary_eq_with_different_address_returns_false(Buffer *buf) {
1829 ASTNode *node = new_binary_call("=", AST_new_integer(5), AST_new_integer(4));
1830 int compile_result = Compile_function(buf, node);
1831 ASSERT_EQ(compile_result, 0);
1832 Buffer_make_executable(buf);
1833 uword result = Testing_execute_expr(buf);
1834 ASSERT_EQ_FMT(Object_false(), result, "0x%lx");
1835 AST_heap_free(node);
1836 PASS();
1837}
1838
1839TEST compile_binary_lt_with_left_less_than_right_returns_true(Buffer *buf) {
1840 ASTNode *node = new_binary_call("<", AST_new_integer(-5), AST_new_integer(5));
1841 int compile_result = Compile_function(buf, node);
1842 ASSERT_EQ(compile_result, 0);
1843 Buffer_make_executable(buf);
1844 uword result = Testing_execute_expr(buf);
1845 ASSERT_EQ_FMT(Object_true(), result, "0x%lx");
1846 AST_heap_free(node);
1847 PASS();
1848}
1849
1850TEST compile_binary_lt_with_left_equal_to_right_returns_false(Buffer *buf) {
1851 ASTNode *node = new_binary_call("<", AST_new_integer(5), AST_new_integer(5));
1852 int compile_result = Compile_function(buf, node);
1853 ASSERT_EQ(compile_result, 0);
1854 Buffer_make_executable(buf);
1855 uword result = Testing_execute_expr(buf);
1856 ASSERT_EQ_FMT(Object_false(), result, "0x%lx");
1857 AST_heap_free(node);
1858 PASS();
1859}
1860
1861TEST compile_binary_lt_with_left_greater_than_right_returns_false(Buffer *buf) {
1862 ASTNode *node = new_binary_call("<", AST_new_integer(6), AST_new_integer(5));
1863 int compile_result = Compile_function(buf, node);
1864 ASSERT_EQ(compile_result, 0);
1865 Buffer_make_executable(buf);
1866 uword result = Testing_execute_expr(buf);
1867 ASSERT_EQ_FMT(Object_false(), result, "0x%lx");
1868 AST_heap_free(node);
1869 PASS();
1870}
1871
1872TEST compile_symbol_in_env_returns_value(Buffer *buf) {
1873 ASTNode *node = AST_new_symbol("hello");
1874 Env env0 = Env_bind("hello", 33, /*prev=*/NULL);
1875 Env env1 = Env_bind("world", 66, &env0);
1876 int compile_result = Compile_expr(buf, node, -kWordSize, &env1);
1877 ASSERT_EQ(compile_result, 0);
1878 byte expected[] = {// mov rax, [rbp+33]
1879 0x48, 0x8b, 0x45, 33};
1880 EXPECT_EQUALS_BYTES(buf, expected);
1881 AST_heap_free(node);
1882 PASS();
1883}
1884
1885TEST compile_symbol_in_env_returns_first_value(Buffer *buf) {
1886 ASTNode *node = AST_new_symbol("hello");
1887 Env env0 = Env_bind("hello", 55, /*prev=*/NULL);
1888 Env env1 = Env_bind("hello", 66, &env0);
1889 int compile_result = Compile_expr(buf, node, -kWordSize, &env1);
1890 ASSERT_EQ(compile_result, 0);
1891 byte expected[] = {// mov rax, [rbp+66]
1892 0x48, 0x8b, 0x45, 66};
1893 EXPECT_EQUALS_BYTES(buf, expected);
1894 AST_heap_free(node);
1895 PASS();
1896}
1897
1898TEST compile_symbol_not_in_env_raises_compile_error(Buffer *buf) {
1899 ASTNode *node = AST_new_symbol("hello");
1900 int compile_result = Compile_expr(buf, node, -kWordSize, NULL);
1901 ASSERT_EQ(compile_result, -1);
1902 AST_heap_free(node);
1903 PASS();
1904}
1905
1906TEST compile_let_with_no_bindings(Buffer *buf) {
1907 ASTNode *node = Reader_read("(let () (+ 1 2))");
1908 int compile_result = Compile_function(buf, node);
1909 ASSERT_EQ(compile_result, 0);
1910 Buffer_make_executable(buf);
1911 uword result = Testing_execute_expr(buf);
1912 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
1913 AST_heap_free(node);
1914 PASS();
1915}
1916
1917TEST compile_let_with_one_binding(Buffer *buf) {
1918 ASTNode *node = Reader_read("(let ((a 1)) (+ a 2))");
1919 int compile_result = Compile_function(buf, node);
1920 ASSERT_EQ(compile_result, 0);
1921 Buffer_make_executable(buf);
1922 uword result = Testing_execute_expr(buf);
1923 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
1924 AST_heap_free(node);
1925 PASS();
1926}
1927
1928TEST compile_let_with_multiple_bindings(Buffer *buf) {
1929 ASTNode *node = Reader_read("(let ((a 1) (b 2)) (+ a b))");
1930 int compile_result = Compile_function(buf, node);
1931 ASSERT_EQ(compile_result, 0);
1932 Buffer_make_executable(buf);
1933 uword result = Testing_execute_expr(buf);
1934 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
1935 AST_heap_free(node);
1936 PASS();
1937}
1938
1939TEST compile_nested_let(Buffer *buf) {
1940 ASTNode *node = Reader_read("(let ((a 1)) (let ((b 2)) (+ a b)))");
1941 int compile_result = Compile_function(buf, node);
1942 ASSERT_EQ(compile_result, 0);
1943 Buffer_make_executable(buf);
1944 uword result = Testing_execute_expr(buf);
1945 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
1946 AST_heap_free(node);
1947 PASS();
1948}
1949
1950TEST compile_let_is_not_let_star(Buffer *buf) {
1951 ASTNode *node = Reader_read("(let ((a 1) (b a)) a)");
1952 int compile_result = Compile_function(buf, node);
1953 ASSERT_EQ(compile_result, -1);
1954 AST_heap_free(node);
1955 PASS();
1956}
1957
1958SUITE(object_tests) {
1959 RUN_TEST(encode_positive_integer);
1960 RUN_TEST(encode_negative_integer);
1961 RUN_TEST(encode_char);
1962 RUN_TEST(decode_char);
1963 RUN_TEST(encode_bool);
1964 RUN_TEST(decode_bool);
1965 RUN_TEST(address);
1966}
1967
1968SUITE(ast_tests) {
1969 RUN_TEST(ast_new_pair);
1970 RUN_TEST(ast_pair_car_returns_car);
1971 RUN_TEST(ast_pair_cdr_returns_cdr);
1972 RUN_TEST(ast_new_symbol);
1973}
1974
1975SUITE(reader_tests) {
1976 RUN_TEST(read_with_integer_returns_integer);
1977 RUN_TEST(read_with_negative_integer_returns_integer);
1978 RUN_TEST(read_with_positive_integer_returns_integer);
1979 RUN_TEST(read_with_leading_whitespace_ignores_whitespace);
1980 RUN_TEST(read_with_symbol_returns_symbol);
1981 RUN_TEST(read_with_symbol_with_trailing_digits);
1982 RUN_TEST(read_with_nil_returns_nil);
1983 RUN_TEST(read_with_list_returns_list);
1984 RUN_TEST(read_with_nested_list_returns_list);
1985 RUN_TEST(read_with_char_returns_char);
1986 RUN_TEST(read_with_bool_returns_bool);
1987}
1988
1989SUITE(buffer_tests) {
1990 RUN_BUFFER_TEST(buffer_write8_increases_length);
1991 RUN_TEST(buffer_write8_expands_buffer);
1992 RUN_TEST(buffer_write32_expands_buffer);
1993 RUN_BUFFER_TEST(buffer_write32_writes_little_endian);
1994}
1995
1996SUITE(compiler_tests) {
1997 RUN_BUFFER_TEST(compile_positive_integer);
1998 RUN_BUFFER_TEST(compile_negative_integer);
1999 RUN_BUFFER_TEST(compile_char);
2000 RUN_BUFFER_TEST(compile_true);
2001 RUN_BUFFER_TEST(compile_false);
2002 RUN_BUFFER_TEST(compile_nil);
2003 RUN_BUFFER_TEST(compile_unary_add1);
2004 RUN_BUFFER_TEST(compile_unary_add1_nested);
2005 RUN_BUFFER_TEST(compile_unary_sub1);
2006 RUN_BUFFER_TEST(compile_unary_integer_to_char);
2007 RUN_BUFFER_TEST(compile_unary_char_to_integer);
2008 RUN_BUFFER_TEST(compile_unary_nilp_with_nil_returns_true);
2009 RUN_BUFFER_TEST(compile_unary_nilp_with_non_nil_returns_false);
2010 RUN_BUFFER_TEST(compile_unary_zerop_with_zero_returns_true);
2011 RUN_BUFFER_TEST(compile_unary_zerop_with_non_zero_returns_false);
2012 RUN_BUFFER_TEST(compile_unary_not_with_false_returns_true);
2013 RUN_BUFFER_TEST(compile_unary_not_with_non_false_returns_false);
2014 RUN_BUFFER_TEST(compile_unary_integerp_with_integer_returns_true);
2015 RUN_BUFFER_TEST(compile_unary_integerp_with_non_integer_returns_false);
2016 RUN_BUFFER_TEST(compile_unary_booleanp_with_boolean_returns_true);
2017 RUN_BUFFER_TEST(compile_unary_booleanp_with_non_boolean_returns_false);
2018 RUN_BUFFER_TEST(compile_binary_plus);
2019 RUN_BUFFER_TEST(compile_binary_plus_nested);
2020 RUN_BUFFER_TEST(compile_binary_minus);
2021 RUN_BUFFER_TEST(compile_binary_minus_nested);
2022 RUN_BUFFER_TEST(compile_binary_mul);
2023 RUN_BUFFER_TEST(compile_binary_mul_nested);
2024 RUN_BUFFER_TEST(compile_binary_eq_with_same_address_returns_true);
2025 RUN_BUFFER_TEST(compile_binary_eq_with_different_address_returns_false);
2026 RUN_BUFFER_TEST(compile_binary_lt_with_left_less_than_right_returns_true);
2027 RUN_BUFFER_TEST(compile_binary_lt_with_left_equal_to_right_returns_false);
2028 RUN_BUFFER_TEST(compile_binary_lt_with_left_greater_than_right_returns_false);
2029 RUN_BUFFER_TEST(compile_symbol_in_env_returns_value);
2030 RUN_BUFFER_TEST(compile_symbol_in_env_returns_first_value);
2031 RUN_BUFFER_TEST(compile_symbol_not_in_env_raises_compile_error);
2032 RUN_BUFFER_TEST(compile_let_with_no_bindings);
2033 RUN_BUFFER_TEST(compile_let_with_one_binding);
2034 RUN_BUFFER_TEST(compile_let_with_multiple_bindings);
2035 RUN_BUFFER_TEST(compile_nested_let);
2036 RUN_BUFFER_TEST(compile_let_is_not_let_star);
2037}
2038
2039// End Tests
2040
2041typedef void (*REPL_Callback)(char *);
2042
2043void print_value(uword object) {
2044 if (Object_is_integer(object)) {
2045 fprintf(stderr, "%ld", Object_decode_integer(object));
2046 return;
2047 }
2048 fprintf(stderr, "Unexpected value.");
2049}
2050
2051void print_assembly(char *line) {
2052 // Parse the line
2053 ASTNode *node = Reader_read(line);
2054 if (AST_is_error(node)) {
2055 fprintf(stderr, "Parse error.\n");
2056 return;
2057 }
2058
2059 // Compile the line
2060 Buffer buf;
2061 Buffer_init(&buf, 1);
2062 int result =
2063 Compile_expr(&buf, node, /*stack_index=*/-kWordSize, /*varenv=*/NULL);
2064 AST_heap_free(node);
2065 if (result < 0) {
2066 fprintf(stderr, "Compile error.\n");
2067 Buffer_deinit(&buf);
2068 return;
2069 }
2070
2071 // Print the assembled code
2072 for (size_t i = 0; i < buf.len; i++) {
2073 fprintf(stderr, "%.02x ", buf.address[i]);
2074 }
2075 fprintf(stderr, "\n");
2076
2077 // Clean up
2078 Buffer_deinit(&buf);
2079}
2080
2081void evaluate_expr(char *line) {
2082 // Parse the line
2083 ASTNode *node = Reader_read(line);
2084 if (AST_is_error(node)) {
2085 fprintf(stderr, "Parse error.\n");
2086 return;
2087 }
2088
2089 // Compile the line
2090 Buffer buf;
2091 Buffer_init(&buf, 1);
2092 int compile_result = Compile_function(&buf, node);
2093 AST_heap_free(node);
2094 if (compile_result < 0) {
2095 fprintf(stderr, "Compile error.\n");
2096 Buffer_deinit(&buf);
2097 return;
2098 }
2099
2100 // Execute the code
2101 Buffer_make_executable(&buf);
2102 uword result = Testing_execute_expr(&buf);
2103
2104 // Print the result
2105 print_value(result);
2106 fprintf(stderr, "\n");
2107
2108 // Clean up
2109 Buffer_deinit(&buf);
2110}
2111
2112int repl(REPL_Callback callback) {
2113 do {
2114 // Read a line
2115 fprintf(stdout, "lisp> ");
2116 char *line = NULL;
2117 size_t size = 0;
2118 ssize_t nchars = getline(&line, &size, stdin);
2119 if (nchars < 0) {
2120 fprintf(stderr, "Goodbye.\n");
2121 free(line);
2122 break;
2123 }
2124
2125 callback(line);
2126 free(line);
2127 } while (true);
2128 return 0;
2129}
2130
2131GREATEST_MAIN_DEFS();
2132
2133int run_tests(int argc, char **argv) {
2134 GREATEST_MAIN_BEGIN();
2135 RUN_SUITE(object_tests);
2136 RUN_SUITE(ast_tests);
2137 RUN_SUITE(reader_tests);
2138 RUN_SUITE(buffer_tests);
2139 RUN_SUITE(compiler_tests);
2140 GREATEST_MAIN_END();
2141}
2142
2143int main(int argc, char **argv) {
2144 if (argc == 2) {
2145 if (strcmp(argv[1], "--repl-assembly") == 0) {
2146 return repl(print_assembly);
2147 }
2148 if (strcmp(argv[1], "--repl-eval") == 0) {
2149 return repl(evaluate_expr);
2150 }
2151 }
2152 return run_tests(argc, argv);
2153}