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