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 kCarIndex = 0,
69 kCarOffset = kCarIndex * kWordSize,
70 kCdrIndex = kCarIndex + 1,
71 kCdrOffset = kCdrIndex * kWordSize,
72 kPairSize = kCdrOffset + kWordSize,
73};
74
75// These are defined as macros because they will not work as static const int
76// constants (per above explanation), and enum constants are only required to
77// be an int wide (per ISO C).
78#define INTEGER_MAX ((1LL << (kIntegerBits - 1)) - 1)
79#define INTEGER_MIN (-(1LL << (kIntegerBits - 1)))
80
81uword Object_encode_integer(word value) {
82 assert(value < INTEGER_MAX && "too big");
83 assert(value > INTEGER_MIN && "too small");
84 return value << kIntegerShift;
85}
86
87word Object_decode_integer(uword value) { return (word)value >> kIntegerShift; }
88
89bool Object_is_integer(uword value) {
90 return (value & kIntegerTagMask) == kIntegerTag;
91}
92
93uword Object_encode_char(char value) {
94 return ((uword)value << kCharShift) | kCharTag;
95}
96
97char Object_decode_char(uword value) {
98 return (value >> kCharShift) & kCharMask;
99}
100
101bool Object_is_char(uword value) {
102 return (value & kImmediateTagMask) == kCharTag;
103}
104
105uword Object_encode_bool(bool value) {
106 return ((uword)value << kBoolShift) | kBoolTag;
107}
108
109bool Object_decode_bool(uword value) { return value & kBoolMask; }
110
111uword Object_true() { return Object_encode_bool(true); }
112
113uword Object_false() { return Object_encode_bool(false); }
114
115uword Object_nil() { return kNilTag; }
116
117uword Object_error() { return kErrorTag; }
118
119uword Object_address(void *obj) { return (uword)obj & kHeapPtrMask; }
120
121bool Object_is_pair(uword value) { return (value & kHeapTagMask) == kPairTag; }
122
123uword Object_pair_car(uword value) {
124 assert(Object_is_pair(value));
125 return ((uword *)Object_address((void *)value))[kCarIndex];
126}
127
128uword Object_pair_cdr(uword value) {
129 assert(Object_is_pair(value));
130 return ((uword *)Object_address((void *)value))[kCdrIndex];
131}
132
133// End Objects
134
135// Buffer
136
137typedef unsigned char byte;
138
139typedef enum {
140 kWritable,
141 kExecutable,
142} BufferState;
143
144typedef struct {
145 byte *address;
146 BufferState state;
147 word len;
148 word capacity;
149 uword entrypoint;
150} Buffer;
151
152byte *Buffer_alloc_writable(word capacity) {
153 byte *result = mmap(/*addr=*/NULL, capacity, PROT_READ | PROT_WRITE,
154 MAP_ANONYMOUS | MAP_PRIVATE,
155 /*filedes=*/-1, /*off=*/0);
156 assert(result != MAP_FAILED);
157 return result;
158}
159
160void Buffer_init(Buffer *result, word capacity) {
161 result->address = Buffer_alloc_writable(capacity);
162 assert(result->address != MAP_FAILED);
163 result->state = kWritable;
164 result->len = 0;
165 result->capacity = capacity;
166 result->entrypoint = 0;
167}
168
169word Buffer_len(Buffer *buf) { return buf->len; }
170
171uword Buffer_entrypoint(Buffer *buf) { return buf->entrypoint; }
172void Buffer_set_entrypoint(Buffer *buf, uword entrypoint) {
173 buf->entrypoint = entrypoint;
174}
175
176void Buffer_deinit(Buffer *buf) {
177 munmap(buf->address, buf->capacity);
178 buf->address = NULL;
179 buf->len = 0;
180 buf->capacity = 0;
181}
182
183int Buffer_make_executable(Buffer *buf) {
184 int result = mprotect(buf->address, buf->len, PROT_EXEC);
185 buf->state = kExecutable;
186 return result;
187}
188
189byte Buffer_at8(Buffer *buf, word pos) { return buf->address[pos]; }
190
191void Buffer_at_put8(Buffer *buf, word pos, byte b) { buf->address[pos] = b; }
192
193word max(word left, word right) { return left > right ? left : right; }
194
195void Buffer_ensure_capacity(Buffer *buf, word additional_capacity) {
196 if (buf->len + additional_capacity <= buf->capacity) {
197 return;
198 }
199 word new_capacity =
200 max(buf->capacity * 2, buf->capacity + additional_capacity);
201 byte *address = Buffer_alloc_writable(new_capacity);
202 memcpy(address, buf->address, buf->len);
203 int result = munmap(buf->address, buf->capacity);
204 assert(result == 0 && "munmap failed");
205 buf->address = address;
206 buf->capacity = new_capacity;
207}
208
209void Buffer_write8(Buffer *buf, byte b) {
210 Buffer_ensure_capacity(buf, sizeof b);
211 Buffer_at_put8(buf, buf->len++, b);
212}
213
214void Buffer_write16(Buffer *buf, uint16_t value) {
215 for (uword i = 0; i < sizeof(value); i++) {
216 Buffer_write8(buf, (value >> (i * kBitsPerByte)) & 0xff);
217 }
218}
219
220void Buffer_write32(Buffer *buf, uint32_t value) {
221 for (uword i = 0; i < sizeof(value); i++) {
222 Buffer_write8(buf, (value >> (i * kBitsPerByte)) & 0xff);
223 }
224}
225
226void Buffer_write64(Buffer *buf, uint64_t value) {
227 for (uword i = 0; i < sizeof(value); i++) {
228 Buffer_write8(buf, (value >> (i * kBitsPerByte)) & 0xff);
229 }
230}
231
232void Buffer_at_put16(Buffer *buf, word offset, uint16_t value) {
233 for (uword i = 0; i < sizeof(value); i++) {
234 Buffer_at_put8(buf, offset + i, (value >> (i * kBitsPerByte)) & 0xff);
235 }
236}
237
238void Buffer_at_put32(Buffer *buf, word offset, uint32_t value) {
239 for (uword i = 0; i < sizeof(value); i++) {
240 Buffer_at_put8(buf, offset + i, (value >> (i * kBitsPerByte)) & 0xff);
241 }
242}
243
244void Buffer_at_put64(Buffer *buf, word offset, uint64_t value) {
245 for (uword i = 0; i < sizeof(value); i++) {
246 Buffer_at_put8(buf, offset + i, (value >> (i * kBitsPerByte)) & 0xff);
247 }
248}
249
250void Buffer_write_arr(Buffer *buf, const byte *arr, word arr_size) {
251 Buffer_ensure_capacity(buf, arr_size);
252 for (word i = 0; i < arr_size; i++) {
253 Buffer_write8(buf, arr[i]);
254 }
255}
256
257void Buffer_dump(Buffer *buf, FILE *fp) {
258 for (word i = 0; i < Buffer_len(buf); i++) {
259 fprintf(fp, "%.2x ", buf->address[i]);
260 }
261 fprintf(fp, "\n");
262}
263
264// End Buffer
265
266// Emit
267
268typedef enum {
269 kRax = 0,
270 kRcx,
271 kRdx,
272 kRbx,
273 kRsp,
274 kRbp,
275 kRsi,
276 kRdi,
277} Register;
278
279typedef enum {
280 kAl = 0,
281 kCl,
282 kDl,
283 kBl,
284 kAh,
285 kCh,
286 kDh,
287 kBh,
288} PartialRegister;
289
290typedef enum {
291 kOverflow = 0,
292 kNotOverflow,
293 kBelow,
294 kCarry = kBelow,
295 kNotAboveOrEqual = kBelow,
296 kAboveOrEqual,
297 kNotBelow = kAboveOrEqual,
298 kNotCarry = kAboveOrEqual,
299 kEqual,
300 kZero = kEqual,
301 kLess = 0xc,
302 kNotGreaterOrEqual = kLess,
303 // TODO(max): Add more
304} Condition;
305
306typedef struct Indirect {
307 Register reg;
308 word disp;
309} Indirect;
310
311Indirect Ind(Register reg, word disp) {
312 return (Indirect){.reg = reg, .disp = disp};
313}
314
315// [ Instruction Prefixes (1 byte, optional) ]
316// [ Opcode (1, 2, or 3 bytes) ]
317// [ ModR/M (1 byte, if required) ]
318// [ Scale-Index-Base (1 byte, if required) ]
319// [ Displacement (1, 2, or 4 bytes, if required) ]
320// [ Immediate data (1, 2, or 4 bytes, if required) ]
321
322// http://www.c-jump.com/CIS77/CPU/x86/lecture.html
323// https://wiki.osdev.org/X86-64_Instruction_Encoding
324
325enum {
326 kRexPrefix = 0x48,
327};
328
329typedef enum {
330 Scale1 = 0,
331 Scale2,
332 Scale4,
333 Scale8,
334} Scale;
335
336typedef enum {
337 kIndexRax = 0,
338 kIndexRcx,
339 kIndexRdx,
340 kIndexRbx,
341 kIndexNone,
342 kIndexRbp,
343 kIndexRsi,
344 kIndexRdi
345} Index;
346
347byte modrm(byte mod, byte rm, byte reg) {
348 return ((mod & 0x3) << 6) | ((reg & 0x7) << 3) | (rm & 0x7);
349}
350
351byte sib(Register base, Index index, Scale scale) {
352 return ((scale & 0x3) << 6) | ((index & 0x7) << 3) | (base & 0x7);
353}
354
355void Emit_mov_reg_imm32(Buffer *buf, Register dst, int32_t src) {
356 Buffer_write8(buf, kRexPrefix);
357 Buffer_write8(buf, 0xc7);
358 Buffer_write8(buf, modrm(/*direct*/ 3, dst, 0));
359 Buffer_write32(buf, src);
360}
361
362void Emit_ret(Buffer *buf) { Buffer_write8(buf, 0xc3); }
363
364void Emit_add_reg_imm32(Buffer *buf, Register dst, int32_t src) {
365 Buffer_write8(buf, kRexPrefix);
366 if (dst == kRax) {
367 // Optimization: add eax, {imm32} can either be encoded as 05 {imm32} or 81
368 // c0 {imm32}.
369 Buffer_write8(buf, 0x05);
370 } else {
371 Buffer_write8(buf, 0x81);
372 Buffer_write8(buf, modrm(/*direct*/ 3, dst, 0));
373 }
374 Buffer_write32(buf, src);
375}
376
377void Emit_sub_reg_imm32(Buffer *buf, Register dst, int32_t src) {
378 Buffer_write8(buf, kRexPrefix);
379 if (dst == kRax) {
380 // Optimization: sub eax, {imm32} can either be encoded as 2d {imm32} or 81
381 // e8 {imm32}.
382 Buffer_write8(buf, 0x2d);
383 } else {
384 Buffer_write8(buf, 0x81);
385 Buffer_write8(buf, modrm(/*direct*/ 3, dst, 5));
386 }
387 Buffer_write32(buf, src);
388}
389
390void Emit_shl_reg_imm8(Buffer *buf, Register dst, int8_t bits) {
391 Buffer_write8(buf, kRexPrefix);
392 Buffer_write8(buf, 0xc1);
393 Buffer_write8(buf, modrm(/*direct*/ 3, dst, 4));
394 Buffer_write8(buf, bits);
395}
396
397void Emit_shr_reg_imm8(Buffer *buf, Register dst, int8_t bits) {
398 Buffer_write8(buf, kRexPrefix);
399 Buffer_write8(buf, 0xc1);
400 Buffer_write8(buf, modrm(/*direct*/ 3, dst, 5));
401 Buffer_write8(buf, bits);
402}
403
404void Emit_or_reg_imm8(Buffer *buf, Register dst, uint8_t tag) {
405 Buffer_write8(buf, kRexPrefix);
406 Buffer_write8(buf, 0x83);
407 Buffer_write8(buf, modrm(/*direct*/ 3, dst, 1));
408 Buffer_write8(buf, tag);
409}
410
411void Emit_and_reg_imm8(Buffer *buf, Register dst, uint8_t tag) {
412 Buffer_write8(buf, kRexPrefix);
413 Buffer_write8(buf, 0x83);
414 Buffer_write8(buf, modrm(/*direct*/ 3, dst, 4));
415 Buffer_write8(buf, tag);
416}
417
418void Emit_cmp_reg_imm32(Buffer *buf, Register left, int32_t right) {
419 Buffer_write8(buf, kRexPrefix);
420 if (left == kRax) {
421 // Optimization: cmp rax, {imm32} can either be encoded as 3d {imm32} or 81
422 // f8 {imm32}.
423 Buffer_write8(buf, 0x3d);
424 } else {
425 Buffer_write8(buf, 0x81);
426 Buffer_write8(buf, modrm(/*direct*/ 3, left, 7));
427 }
428 Buffer_write32(buf, right);
429}
430
431void Emit_setcc_imm8(Buffer *buf, Condition cond, PartialRegister dst) {
432 // TODO(max): Emit a REX prefix if we need anything above RDI.
433 Buffer_write8(buf, 0x0f);
434 Buffer_write8(buf, 0x90 + cond);
435 Buffer_write8(buf, 0xc0 + (dst & 0x7));
436}
437
438uint8_t disp8(int8_t disp) { return disp >= 0 ? disp : 0x100 + disp; }
439
440void Emit_address_disp8(Buffer *buf, Register direct, Indirect indirect) {
441 if (indirect.reg == kRsp) {
442 Buffer_write8(buf, modrm(/*disp8*/ 1, kIndexNone, direct));
443 Buffer_write8(buf, sib(kRsp, kIndexNone, Scale1));
444 } else {
445 Buffer_write8(buf, modrm(/*disp8*/ 1, indirect.reg, direct));
446 }
447 Buffer_write8(buf, disp8(indirect.disp));
448}
449
450// mov [dst+disp], src
451// or
452// mov %src, disp(%dst)
453void Emit_store_reg_indirect(Buffer *buf, Indirect dst, Register src) {
454 Buffer_write8(buf, kRexPrefix);
455 Buffer_write8(buf, 0x89);
456 Emit_address_disp8(buf, src, dst);
457}
458
459// add dst, [src+disp]
460// or
461// add disp(%src), %dst
462void Emit_add_reg_indirect(Buffer *buf, Register dst, Indirect src) {
463 Buffer_write8(buf, kRexPrefix);
464 Buffer_write8(buf, 0x03);
465 Emit_address_disp8(buf, dst, src);
466}
467
468// sub dst, [src+disp]
469// or
470// sub disp(%src), %dst
471void Emit_sub_reg_indirect(Buffer *buf, Register dst, Indirect src) {
472 Buffer_write8(buf, kRexPrefix);
473 Buffer_write8(buf, 0x2b);
474 Emit_address_disp8(buf, dst, src);
475}
476
477// mul rax, [src+disp]
478// or
479// mul disp(%src), %rax
480void Emit_mul_reg_indirect(Buffer *buf, Indirect src) {
481 Buffer_write8(buf, kRexPrefix);
482 Buffer_write8(buf, 0xf7);
483 Emit_address_disp8(buf, /*subop*/ 4, src);
484}
485
486// cmp left, [right+disp]
487// or
488// cmp disp(%right), %left
489void Emit_cmp_reg_indirect(Buffer *buf, Register left, Indirect right) {
490 Buffer_write8(buf, kRexPrefix);
491 Buffer_write8(buf, 0x3b);
492 Emit_address_disp8(buf, left, right);
493}
494
495// mov dst, [src+disp]
496// or
497// mov disp(%src), %dst
498void Emit_load_reg_indirect(Buffer *buf, Register dst, Indirect src) {
499 Buffer_write8(buf, kRexPrefix);
500 Buffer_write8(buf, 0x8b);
501 Emit_address_disp8(buf, dst, src);
502}
503
504uint32_t disp32(int32_t disp) { return disp >= 0 ? disp : 0x100000000 + disp; }
505
506word Emit_jcc(Buffer *buf, Condition cond, int32_t offset) {
507 Buffer_write8(buf, 0x0f);
508 Buffer_write8(buf, 0x80 + cond);
509 word pos = Buffer_len(buf);
510 Buffer_write32(buf, disp32(offset));
511 return pos;
512}
513
514word Emit_jmp(Buffer *buf, int32_t offset) {
515 Buffer_write8(buf, 0xe9);
516 word pos = Buffer_len(buf);
517 Buffer_write32(buf, disp32(offset));
518 return pos;
519}
520
521void Emit_backpatch_imm32(Buffer *buf, int32_t target_pos) {
522 word current_pos = Buffer_len(buf);
523 word relative_pos = current_pos - target_pos - sizeof(int32_t);
524 Buffer_at_put32(buf, target_pos, disp32(relative_pos));
525}
526
527void Emit_mov_reg_reg(Buffer *buf, Register dst, Register src) {
528 Buffer_write8(buf, kRexPrefix);
529 Buffer_write8(buf, 0x89);
530 Buffer_write8(buf, modrm(/*direct*/ 3, dst, src));
531}
532
533void Emit_syscall(Buffer *buf) {
534 Buffer_write8(buf, 0x0f);
535 Buffer_write8(buf, 0x05);
536}
537
538// End Emit
539
540// AST
541
542typedef struct ASTNode ASTNode;
543
544typedef struct Pair {
545 ASTNode *car;
546 ASTNode *cdr;
547} Pair;
548
549typedef struct Symbol {
550 word length;
551 char cstr[];
552} Symbol;
553
554bool AST_is_integer(ASTNode *node) {
555 return ((uword)node & kIntegerTagMask) == kIntegerTag;
556}
557
558word AST_get_integer(ASTNode *node) {
559 return Object_decode_integer((uword)node);
560}
561
562ASTNode *AST_new_integer(word value) {
563 return (ASTNode *)Object_encode_integer(value);
564}
565
566bool AST_is_char(ASTNode *node) {
567 return ((uword)node & kImmediateTagMask) == kCharTag;
568}
569
570char AST_get_char(ASTNode *node) { return Object_decode_char((uword)node); }
571
572ASTNode *AST_new_char(char value) {
573 return (ASTNode *)Object_encode_char(value);
574}
575
576bool AST_is_bool(ASTNode *node) {
577 return ((uword)node & kImmediateTagMask) == kBoolTag;
578}
579
580bool AST_get_bool(ASTNode *node) { return Object_decode_bool((uword)node); }
581
582ASTNode *AST_new_bool(bool value) {
583 return (ASTNode *)Object_encode_bool(value);
584}
585
586bool AST_is_nil(ASTNode *node) { return (uword)node == Object_nil(); }
587
588ASTNode *AST_nil() { return (ASTNode *)Object_nil(); }
589
590bool AST_is_error(ASTNode *node) { return (uword)node == Object_error(); }
591
592ASTNode *AST_error() { return (ASTNode *)Object_error(); }
593
594ASTNode *AST_heap_alloc(unsigned char tag, uword size) {
595 // Initialize to 0
596 uword address = (uword)calloc(size, 1);
597 return (ASTNode *)(address | tag);
598}
599
600bool AST_is_heap_object(ASTNode *node) {
601 // For some reason masking out the tag first and then doing the comparison
602 // makes this branchless
603 unsigned char tag = (uword)node & kHeapTagMask;
604 // Heap object tags are between 0b001 and 0b110 except for 0b100 (which is an
605 // integer)
606 return (tag & kIntegerTagMask) > 0 && (tag & kImmediateTagMask) != 0x7;
607}
608
609void AST_pair_set_car(ASTNode *node, ASTNode *car);
610void AST_pair_set_cdr(ASTNode *node, ASTNode *cdr);
611
612ASTNode *AST_new_pair(ASTNode *car, ASTNode *cdr) {
613 ASTNode *node = AST_heap_alloc(kPairTag, sizeof(Pair));
614 AST_pair_set_car(node, car);
615 AST_pair_set_cdr(node, cdr);
616 return node;
617}
618
619bool AST_is_pair(ASTNode *node) {
620 return ((uword)node & kHeapTagMask) == kPairTag;
621}
622
623Pair *AST_as_pair(ASTNode *node) {
624 assert(AST_is_pair(node));
625 return (Pair *)Object_address(node);
626}
627
628ASTNode *AST_pair_car(ASTNode *node) { return AST_as_pair(node)->car; }
629
630void AST_pair_set_car(ASTNode *node, ASTNode *car) {
631 AST_as_pair(node)->car = car;
632}
633
634ASTNode *AST_pair_cdr(ASTNode *node) { return AST_as_pair(node)->cdr; }
635
636void AST_pair_set_cdr(ASTNode *node, ASTNode *cdr) {
637 AST_as_pair(node)->cdr = cdr;
638}
639
640void AST_heap_free(ASTNode *node) {
641 if (!AST_is_heap_object(node)) {
642 return;
643 }
644 if (AST_is_pair(node)) {
645 AST_heap_free(AST_pair_car(node));
646 AST_heap_free(AST_pair_cdr(node));
647 }
648 free((void *)Object_address(node));
649}
650
651Symbol *AST_as_symbol(ASTNode *node);
652
653ASTNode *AST_new_symbol(const char *str) {
654 word data_length = strlen(str) + 1; // for NUL
655 ASTNode *node = AST_heap_alloc(kSymbolTag, sizeof(Symbol) + data_length);
656 Symbol *s = AST_as_symbol(node);
657 s->length = data_length;
658 memcpy(s->cstr, str, data_length);
659 return node;
660}
661
662bool AST_is_symbol(ASTNode *node) {
663 return ((uword)node & kHeapTagMask) == kSymbolTag;
664}
665
666Symbol *AST_as_symbol(ASTNode *node) {
667 assert(AST_is_symbol(node));
668 return (Symbol *)Object_address(node);
669}
670
671const char *AST_symbol_cstr(ASTNode *node) {
672 return (const char *)AST_as_symbol(node)->cstr;
673}
674
675bool AST_symbol_matches(ASTNode *node, const char *cstr) {
676 return strcmp(AST_symbol_cstr(node), cstr) == 0;
677}
678
679int node_to_str(ASTNode *node, char *buf, word size);
680
681int list_to_str(ASTNode *node, char *buf, word size) {
682 if (AST_is_pair(node)) {
683 word result = 0;
684 result += snprintf(buf + result, size, " ");
685 result += node_to_str(AST_pair_car(node), buf + result, size);
686 result += list_to_str(AST_pair_cdr(node), buf + result, size);
687 return result;
688 }
689 if (AST_is_nil(node)) {
690 return snprintf(buf, size, ")");
691 }
692 word result = 0;
693 result += snprintf(buf + result, size, " . ");
694 result += node_to_str(node, buf + result, size);
695 result += snprintf(buf + result, size, ")");
696 return result;
697}
698
699int node_to_str(ASTNode *node, char *buf, word size) {
700 if (AST_is_integer(node)) {
701 return snprintf(buf, size, "%ld", AST_get_integer(node));
702 }
703 if (AST_is_char(node)) {
704 return snprintf(buf, size, "'%c'", AST_get_char(node));
705 }
706 if (AST_is_bool(node)) {
707 return snprintf(buf, size, "%s", AST_get_bool(node) ? "true" : "false");
708 }
709 if (AST_is_nil(node)) {
710 return snprintf(buf, size, "nil");
711 }
712 if (AST_is_pair(node)) {
713 word result = 0;
714 result += snprintf(buf + result, size, "(");
715 result += node_to_str(AST_pair_car(node), buf + result, size);
716 result += list_to_str(AST_pair_cdr(node), buf + result, size);
717 return result;
718 }
719 if (AST_is_symbol(node)) {
720 return snprintf(buf, size, "%s", AST_symbol_cstr(node));
721 }
722 assert(0 && "unknown ast");
723}
724
725char *AST_to_cstr(ASTNode *node) {
726 int size = node_to_str(node, NULL, 0);
727 char *buf = malloc(size + 1);
728 assert(buf != NULL);
729 node_to_str(node, buf, size + 1);
730 buf[size] = '\0';
731 return buf;
732}
733
734// End AST
735
736// Reader
737
738void advance(word *pos) { ++*pos; }
739
740char next(char *input, word *pos) {
741 advance(pos);
742 return input[*pos];
743}
744
745ASTNode *read_integer(char *input, word *pos, int sign) {
746 word result = 0;
747 for (char c = input[*pos]; isdigit(c); c = next(input, pos)) {
748 result *= 10;
749 result += c - '0';
750 }
751 return AST_new_integer(sign * result);
752}
753
754bool starts_symbol(char c) {
755 switch (c) {
756 case '+':
757 case '-':
758 case '*':
759 case '<':
760 case '>':
761 case '=':
762 case '?':
763 return true;
764 default:
765 return isalpha(c);
766 }
767}
768
769bool is_symbol_char(char c) { return starts_symbol(c) || isdigit(c); }
770
771const word ATOM_MAX = 32;
772
773ASTNode *read_symbol(char *input, word *pos) {
774 char buf[ATOM_MAX + 1]; // +1 for NUL
775 word length = 0;
776 for (length = 0; length < ATOM_MAX && is_symbol_char(input[*pos]); length++) {
777 buf[length] = input[*pos];
778 advance(pos);
779 }
780 buf[length] = '\0';
781 return AST_new_symbol(buf);
782}
783
784ASTNode *read_char(char *input, word *pos) {
785 char c = input[*pos];
786 if (c == '\'') {
787 return AST_error();
788 }
789 advance(pos);
790 if (input[*pos] != '\'') {
791 return AST_error();
792 }
793 advance(pos);
794 return AST_new_char(c);
795}
796
797char skip_whitespace(char *input, word *pos) {
798 char c = '\0';
799 for (c = input[*pos]; isspace(c); c = next(input, pos)) {
800 ;
801 }
802 return c;
803}
804
805ASTNode *read_rec(char *input, word *pos);
806
807ASTNode *read_list(char *input, word *pos) {
808 char c = skip_whitespace(input, pos);
809 if (c == ')') {
810 advance(pos);
811 return AST_nil();
812 }
813 ASTNode *car = read_rec(input, pos);
814 assert(car != AST_error());
815 ASTNode *cdr = read_list(input, pos);
816 assert(cdr != AST_error());
817 return AST_new_pair(car, cdr);
818}
819
820ASTNode *read_rec(char *input, word *pos) {
821 char c = skip_whitespace(input, pos);
822 if (isdigit(c)) {
823 return read_integer(input, pos, /*sign=*/1);
824 }
825 if (c == '-' && isdigit(input[*pos + 1])) {
826 advance(pos);
827 return read_integer(input, pos, /*sign=*/-1);
828 }
829 if (c == '+' && isdigit(input[*pos + 1])) {
830 advance(pos);
831 return read_integer(input, pos, /*sign=*/1);
832 }
833 if (starts_symbol(c)) {
834 return read_symbol(input, pos);
835 }
836 if (c == '\'') {
837 advance(pos); // skip '\''
838 return read_char(input, pos);
839 }
840 if (c == '#' && input[*pos + 1] == 't') {
841 advance(pos); // skip '#'
842 advance(pos); // skip 't'
843 return AST_new_bool(true);
844 }
845 if (c == '#' && input[*pos + 1] == 'f') {
846 advance(pos); // skip '#'
847 advance(pos); // skip 'f'
848 return AST_new_bool(false);
849 }
850 if (c == '(') {
851 advance(pos); // skip '('
852 return read_list(input, pos);
853 }
854 return AST_error();
855}
856
857ASTNode *Reader_read(char *input) {
858 word pos = 0;
859 return read_rec(input, &pos);
860}
861
862// End Reader
863
864// Env
865
866typedef struct Env {
867 const char *name;
868 word value;
869 struct Env *prev;
870} Env;
871
872Env Env_bind(const char *name, word value, Env *prev) {
873 return (Env){.name = name, .value = value, .prev = prev};
874}
875
876bool Env_find(Env *env, const char *key, word *result) {
877 if (env == NULL)
878 return false;
879 if (strcmp(env->name, key) == 0) {
880 *result = env->value;
881 return true;
882 }
883 return Env_find(env->prev, key, result);
884}
885
886// End Env
887
888// Compile
889
890WARN_UNUSED int Compile_expr(Buffer *buf, ASTNode *node, word stack_index,
891 Env *varenv, Env *labels);
892
893ASTNode *operand1(ASTNode *args) { return AST_pair_car(args); }
894
895ASTNode *operand2(ASTNode *args) { return AST_pair_car(AST_pair_cdr(args)); }
896
897ASTNode *operand3(ASTNode *args) {
898 return AST_pair_car(AST_pair_cdr(AST_pair_cdr(args)));
899}
900
901#define _(exp) \
902 do { \
903 int result = exp; \
904 if (result != 0) \
905 return result; \
906 } while (0)
907
908void Compile_compare_imm32(Buffer *buf, int32_t value) {
909 Emit_cmp_reg_imm32(buf, kRax, value);
910 Emit_mov_reg_imm32(buf, kRax, 0);
911 Emit_setcc_imm8(buf, kEqual, kAl);
912 Emit_shl_reg_imm8(buf, kRax, kBoolShift);
913 Emit_or_reg_imm8(buf, kRax, kBoolTag);
914}
915
916// This is let, not let*. Therefore we keep track of two environments -- the
917// parent environment, for evaluating the bindings, and the body environment,
918// which will have all of the bindings in addition to the parent. This makes
919// programs like (let ((a 1) (b a)) b) fail.
920WARN_UNUSED int Compile_let(Buffer *buf, ASTNode *bindings, ASTNode *body,
921 word stack_index, Env *binding_env, Env *body_env,
922 Env *labels) {
923 if (AST_is_nil(bindings)) {
924 // Base case: no bindings. Compile the body
925 _(Compile_expr(buf, body, stack_index, body_env, labels));
926 return 0;
927 }
928 assert(AST_is_pair(bindings));
929 // Get the next binding
930 ASTNode *binding = AST_pair_car(bindings);
931 ASTNode *name = AST_pair_car(binding);
932 assert(AST_is_symbol(name));
933 ASTNode *binding_expr = AST_pair_car(AST_pair_cdr(binding));
934 // Compile the binding expression
935 _(Compile_expr(buf, binding_expr, stack_index, binding_env, labels));
936 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRsp, stack_index),
937 /*src=*/kRax);
938 // Bind the name
939 Env entry = Env_bind(AST_symbol_cstr(name), stack_index, body_env);
940 _(Compile_let(buf, AST_pair_cdr(bindings), body, stack_index - kWordSize,
941 /*binding_env=*/binding_env, /*body_env=*/&entry, labels));
942 return 0;
943}
944
945const int32_t kLabelPlaceholder = 0xdeadbeef;
946
947WARN_UNUSED int Compile_if(Buffer *buf, ASTNode *cond, ASTNode *consequent,
948 ASTNode *alternate, word stack_index, Env *varenv,
949 Env *labels) {
950 _(Compile_expr(buf, cond, stack_index, varenv, labels));
951 Emit_cmp_reg_imm32(buf, kRax, Object_false());
952 word alternate_pos = Emit_jcc(buf, kEqual, kLabelPlaceholder); // je alternate
953 _(Compile_expr(buf, consequent, stack_index, varenv, labels));
954 word end_pos = Emit_jmp(buf, kLabelPlaceholder); // jmp end
955 Emit_backpatch_imm32(buf, alternate_pos); // alternate:
956 _(Compile_expr(buf, alternate, stack_index, varenv, labels));
957 Emit_backpatch_imm32(buf, end_pos); // end:
958 return 0;
959}
960
961const Register kHeapPointer = kRsi;
962
963WARN_UNUSED int Compile_cons(Buffer *buf, ASTNode *car, ASTNode *cdr,
964 word stack_index, Env *varenv, Env *labels) {
965 // Compile and store car on the stack
966 _(Compile_expr(buf, car, stack_index, varenv, labels));
967 Emit_store_reg_indirect(buf,
968 /*dst=*/Ind(kRsp, stack_index),
969 /*src=*/kRax);
970 // Compile and store cdr
971 _(Compile_expr(buf, cdr, stack_index - kWordSize, varenv, labels));
972 Emit_store_reg_indirect(buf, /*dst=*/Ind(kHeapPointer, kCdrOffset),
973 /*src=*/kRax);
974 // Fetch car and store in the heap
975 Emit_load_reg_indirect(buf, /*dst=*/kRax, /*src=*/Ind(kRsp, stack_index));
976 Emit_store_reg_indirect(buf, /*dst=*/Ind(kHeapPointer, kCarOffset),
977 /*src=*/kRax);
978 // Store tagged pointer in rax
979 // TODO(max): Rewrite as lea rax, [rsi+kPairTag]
980 Emit_mov_reg_reg(buf, /*dst=*/kRax, /*src=*/kHeapPointer);
981 Emit_or_reg_imm8(buf, /*dst=*/kRax, kPairTag);
982 // Bump the heap pointer
983 Emit_add_reg_imm32(buf, /*dst=*/kHeapPointer, kPairSize);
984 return 0;
985}
986
987word list_length(ASTNode *node) {
988 if (AST_is_nil(node)) {
989 return 0;
990 }
991 assert(AST_is_pair(node));
992 return 1 + list_length(AST_pair_cdr(node));
993}
994
995void Emit_rsp_adjust(Buffer *buf, word adjust) {
996 if (adjust < 0) {
997 Emit_sub_reg_imm32(buf, kRsp, -adjust);
998 } else if (adjust > 0) {
999 Emit_add_reg_imm32(buf, kRsp, adjust);
1000 }
1001}
1002
1003void Emit_call_imm32(Buffer *buf, word absolute_address) {
1004 // 5 is length of call instruction
1005 word relative_address = absolute_address - (Buffer_len(buf) + 5);
1006 Buffer_write8(buf, 0xe8);
1007 Buffer_write32(buf, relative_address);
1008}
1009
1010WARN_UNUSED int Compile_labelcall(Buffer *buf, ASTNode *callable, ASTNode *args,
1011 word stack_index, Env *varenv, Env *labels,
1012 word nargs, word rsp_adjust) {
1013 if (AST_is_nil(args)) {
1014 const char *symbol = AST_symbol_cstr(callable);
1015 word code_address;
1016 if (!Env_find(labels, symbol, &code_address)) {
1017 return -1;
1018 }
1019 // TODO(max): Determine if we need to align the stack to 16 bytes
1020 // Save the locals
1021 Emit_rsp_adjust(buf, rsp_adjust);
1022 Emit_call_imm32(buf, code_address);
1023 // Unsave the locals
1024 Emit_rsp_adjust(buf, -rsp_adjust);
1025 return 0;
1026 }
1027 assert(AST_is_pair(args));
1028 ASTNode *arg = AST_pair_car(args);
1029 _(Compile_expr(buf, arg, stack_index, varenv, labels));
1030 Emit_store_reg_indirect(buf, Ind(kRsp, stack_index), kRax);
1031 return Compile_labelcall(buf, callable, AST_pair_cdr(args),
1032 stack_index - kWordSize, varenv, labels, nargs,
1033 rsp_adjust);
1034}
1035
1036WARN_UNUSED int Compile_call(Buffer *buf, ASTNode *callable, ASTNode *args,
1037 word stack_index, Env *varenv, Env *labels) {
1038 if (AST_is_symbol(callable)) {
1039 if (AST_symbol_matches(callable, "add1")) {
1040 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1041 Emit_add_reg_imm32(buf, kRax, Object_encode_integer(1));
1042 return 0;
1043 }
1044 if (AST_symbol_matches(callable, "sub1")) {
1045 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1046 Emit_sub_reg_imm32(buf, kRax, Object_encode_integer(1));
1047 return 0;
1048 }
1049 if (AST_symbol_matches(callable, "integer->char")) {
1050 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1051 Emit_shl_reg_imm8(buf, kRax, kCharShift - kIntegerShift);
1052 Emit_or_reg_imm8(buf, kRax, kCharTag);
1053 return 0;
1054 }
1055 if (AST_symbol_matches(callable, "char->integer")) {
1056 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1057 Emit_shr_reg_imm8(buf, kRax, kCharShift - kIntegerShift);
1058 return 0;
1059 }
1060 if (AST_symbol_matches(callable, "nil?")) {
1061 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1062 Compile_compare_imm32(buf, Object_nil());
1063 return 0;
1064 }
1065 if (AST_symbol_matches(callable, "zero?")) {
1066 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1067 Compile_compare_imm32(buf, Object_encode_integer(0));
1068 return 0;
1069 }
1070 if (AST_symbol_matches(callable, "not")) {
1071 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1072 // All non #f values are truthy
1073 // ...this might be a problem if we want to make nil falsey
1074 Compile_compare_imm32(buf, Object_false());
1075 return 0;
1076 }
1077 if (AST_symbol_matches(callable, "integer?")) {
1078 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1079 Emit_and_reg_imm8(buf, kRax, kIntegerTagMask);
1080 Compile_compare_imm32(buf, kIntegerTag);
1081 return 0;
1082 }
1083 if (AST_symbol_matches(callable, "boolean?")) {
1084 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1085 Emit_and_reg_imm8(buf, kRax, kImmediateTagMask);
1086 Compile_compare_imm32(buf, kBoolTag);
1087 return 0;
1088 }
1089 if (AST_symbol_matches(callable, "+")) {
1090 _(Compile_expr(buf, operand2(args), stack_index, varenv, labels));
1091 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRsp, stack_index),
1092 /*src=*/kRax);
1093 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv,
1094 labels));
1095 Emit_add_reg_indirect(buf, /*dst=*/kRax, /*src=*/Ind(kRsp, stack_index));
1096 return 0;
1097 }
1098 if (AST_symbol_matches(callable, "-")) {
1099 _(Compile_expr(buf, operand2(args), stack_index, varenv, labels));
1100 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRsp, stack_index),
1101 /*src=*/kRax);
1102 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv,
1103 labels));
1104 Emit_sub_reg_indirect(buf, /*dst=*/kRax, /*src=*/Ind(kRsp, stack_index));
1105 return 0;
1106 }
1107 if (AST_symbol_matches(callable, "*")) {
1108 _(Compile_expr(buf, operand2(args), stack_index, varenv, labels));
1109 // Remove the tag so that the result is still only tagged with 0b00
1110 // instead of 0b0000
1111 Emit_shr_reg_imm8(buf, kRax, kIntegerShift);
1112 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRsp, stack_index),
1113 /*src=*/kRax);
1114 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv,
1115 labels));
1116 Emit_mul_reg_indirect(buf, /*src=*/Ind(kRsp, stack_index));
1117 return 0;
1118 }
1119 if (AST_symbol_matches(callable, "=")) {
1120 _(Compile_expr(buf, operand2(args), stack_index, varenv, labels));
1121 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRsp, stack_index),
1122 /*src=*/kRax);
1123 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv,
1124 labels));
1125 Emit_cmp_reg_indirect(buf, kRax, Ind(kRsp, stack_index));
1126 Emit_mov_reg_imm32(buf, kRax, 0);
1127 Emit_setcc_imm8(buf, kEqual, kAl);
1128 Emit_shl_reg_imm8(buf, kRax, kBoolShift);
1129 Emit_or_reg_imm8(buf, kRax, kBoolTag);
1130 return 0;
1131 }
1132 if (AST_symbol_matches(callable, "<")) {
1133 _(Compile_expr(buf, operand2(args), stack_index, varenv, labels));
1134 Emit_store_reg_indirect(buf, /*dst=*/Ind(kRsp, stack_index),
1135 /*src=*/kRax);
1136 _(Compile_expr(buf, operand1(args), stack_index - kWordSize, varenv,
1137 labels));
1138 Emit_cmp_reg_indirect(buf, kRax, Ind(kRsp, stack_index));
1139 Emit_mov_reg_imm32(buf, kRax, 0);
1140 Emit_setcc_imm8(buf, kLess, kAl);
1141 Emit_shl_reg_imm8(buf, kRax, kBoolShift);
1142 Emit_or_reg_imm8(buf, kRax, kBoolTag);
1143 return 0;
1144 }
1145 if (AST_symbol_matches(callable, "let")) {
1146 return Compile_let(buf, /*bindings=*/operand1(args),
1147 /*body=*/operand2(args), stack_index,
1148 /*binding_env=*/varenv,
1149 /*body_env=*/varenv, labels);
1150 }
1151 if (AST_symbol_matches(callable, "if")) {
1152 return Compile_if(buf, /*condition=*/operand1(args),
1153 /*consequent=*/operand2(args),
1154 /*alternate=*/operand3(args), stack_index, varenv,
1155 labels);
1156 }
1157 if (AST_symbol_matches(callable, "cons")) {
1158 return Compile_cons(buf, /*car=*/operand1(args), /*cdr=*/operand2(args),
1159 stack_index, varenv, labels);
1160 }
1161 if (AST_symbol_matches(callable, "car")) {
1162 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1163 Emit_load_reg_indirect(buf, /*dst=*/kRax,
1164 /*src=*/Ind(kRax, kCarOffset - kPairTag));
1165 return 0;
1166 }
1167 if (AST_symbol_matches(callable, "cdr")) {
1168 _(Compile_expr(buf, operand1(args), stack_index, varenv, labels));
1169 Emit_load_reg_indirect(buf, /*dst=*/kRax,
1170 /*src=*/Ind(kRax, kCdrOffset - kPairTag));
1171 return 0;
1172 }
1173 if (AST_symbol_matches(callable, "labelcall")) {
1174 ASTNode *label = operand1(args);
1175 assert(AST_is_symbol(label));
1176 ASTNode *call_args = AST_pair_cdr(args);
1177 word nargs = list_length(call_args);
1178 // Skip a space on the stack to put the return address
1179 return Compile_labelcall(buf, label, call_args, stack_index - kWordSize,
1180 // TODO(max): Figure out the +kWordSize
1181 varenv, labels, nargs, stack_index + kWordSize);
1182 }
1183 }
1184 assert(0 && "unexpected call type");
1185}
1186
1187WARN_UNUSED int Compile_expr(Buffer *buf, ASTNode *node, word stack_index,
1188 Env *varenv, Env *labels) {
1189 if (AST_is_integer(node)) {
1190 word value = AST_get_integer(node);
1191 Emit_mov_reg_imm32(buf, kRax, Object_encode_integer(value));
1192 return 0;
1193 }
1194 if (AST_is_char(node)) {
1195 char value = AST_get_char(node);
1196 Emit_mov_reg_imm32(buf, kRax, Object_encode_char(value));
1197 return 0;
1198 }
1199 if (AST_is_bool(node)) {
1200 bool value = AST_get_bool(node);
1201 Emit_mov_reg_imm32(buf, kRax, Object_encode_bool(value));
1202 return 0;
1203 }
1204 if (AST_is_nil(node)) {
1205 Emit_mov_reg_imm32(buf, kRax, Object_nil());
1206 return 0;
1207 }
1208 if (AST_is_pair(node)) {
1209 return Compile_call(buf, AST_pair_car(node), AST_pair_cdr(node),
1210 stack_index, varenv, labels);
1211 }
1212 if (AST_is_symbol(node)) {
1213 const char *symbol = AST_symbol_cstr(node);
1214 word value;
1215 if (Env_find(varenv, symbol, &value)) {
1216 Emit_load_reg_indirect(buf, /*dst=*/kRax, /*src=*/Ind(kRsp, value));
1217 return 0;
1218 }
1219 return -1;
1220 }
1221 assert(0 && "unexpected node type");
1222}
1223
1224const byte kEntryPrologue[] = {
1225 // Save the heap in rsi, our global heap pointer
1226 // mov rsi, rdi
1227 kRexPrefix,
1228 0x89,
1229 0xfe,
1230};
1231
1232const byte kFunctionEpilogue[] = {
1233 // ret
1234 0xc3,
1235};
1236
1237WARN_UNUSED int Compile_code_impl(Buffer *buf, ASTNode *formals, ASTNode *body,
1238 word stack_index, Env *varenv, Env *labels) {
1239 if (AST_is_nil(formals)) {
1240 _(Compile_expr(buf, body, stack_index, varenv, labels));
1241 Buffer_write_arr(buf, kFunctionEpilogue, sizeof kFunctionEpilogue);
1242 return 0;
1243 }
1244 assert(AST_is_pair(formals));
1245 ASTNode *name = AST_pair_car(formals);
1246 assert(AST_is_symbol(name));
1247 Env entry = Env_bind(AST_symbol_cstr(name), stack_index, varenv);
1248 return Compile_code_impl(buf, AST_pair_cdr(formals), body,
1249 stack_index - kWordSize, &entry, labels);
1250}
1251
1252WARN_UNUSED int Compile_code(Buffer *buf, ASTNode *code, Env *labels) {
1253 assert(AST_is_pair(code));
1254 ASTNode *code_sym = AST_pair_car(code);
1255 assert(AST_is_symbol(code_sym));
1256 assert(AST_symbol_matches(code_sym, "code"));
1257 ASTNode *args = AST_pair_cdr(code);
1258 ASTNode *formals = operand1(args);
1259 ASTNode *code_body = operand2(args);
1260 return Compile_code_impl(buf, formals, code_body, /*stack_index=*/-kWordSize,
1261 /*varenv=*/NULL, labels);
1262}
1263
1264WARN_UNUSED int Compile_labels(Buffer *buf, ASTNode *bindings, ASTNode *body,
1265 Env *labels, word body_pos) {
1266 if (AST_is_nil(bindings)) {
1267 Buffer_set_entrypoint(buf, Buffer_len(buf));
1268 Emit_backpatch_imm32(buf, body_pos);
1269 // Base case: no bindings. Compile the body
1270 _(Compile_expr(buf, body, /*stack_index=*/-kWordSize, /*varenv=*/NULL,
1271 labels));
1272 return 0;
1273 }
1274 assert(AST_is_pair(bindings));
1275 // Get the next binding
1276 ASTNode *binding = AST_pair_car(bindings);
1277 ASTNode *name = AST_pair_car(binding);
1278 assert(AST_is_symbol(name));
1279 ASTNode *binding_code = AST_pair_car(AST_pair_cdr(binding));
1280 word function_location = Buffer_len(buf);
1281 // Bind the name to the location in the instruction stream
1282 Env entry = Env_bind(AST_symbol_cstr(name), function_location, labels);
1283 // Compile the binding function
1284 _(Compile_code(buf, binding_code, &entry));
1285 _(Compile_labels(buf, AST_pair_cdr(bindings), body, &entry, body_pos));
1286 return 0;
1287}
1288
1289WARN_UNUSED int Compile_entry(Buffer *buf, ASTNode *node) {
1290 Buffer_write_arr(buf, kEntryPrologue, sizeof kEntryPrologue);
1291 assert(AST_is_pair(node) && "program must have labels");
1292 // Assume it's (labels ...)
1293 ASTNode *labels_sym = AST_pair_car(node);
1294 assert(AST_is_symbol(labels_sym) && "program must have labels");
1295 assert(AST_symbol_matches(labels_sym, "labels") &&
1296 "program must have labels");
1297 // Jump to body
1298 word body_pos = Emit_jmp(buf, kLabelPlaceholder);
1299 ASTNode *args = AST_pair_cdr(node);
1300 ASTNode *bindings = operand1(args);
1301 assert(AST_is_pair(bindings) || AST_is_nil(bindings));
1302 ASTNode *body = operand2(args);
1303 _(Compile_labels(buf, bindings, body, /*labels=*/NULL, body_pos));
1304 Emit_shr_reg_imm8(buf, kRax, kIntegerShift);
1305 Emit_mov_reg_reg(buf, kRdi, kRax); // return code from result of body
1306 Emit_mov_reg_imm32(buf, kRax, 60); // exit
1307 Emit_syscall(buf);
1308 // Buffer_write_arr(buf, kFunctionEpilogue, sizeof kFunctionEpilogue);
1309 return 0;
1310}
1311
1312WARN_UNUSED int Compile_to_file(ASTNode *node, const char *filename) {
1313 (void)node;
1314 Buffer buf;
1315 Buffer_init(&buf, 1);
1316
1317 word org = 0x08048000;
1318
1319 // BEGIN e_ident
1320 Buffer_write8(&buf, 0x7F);
1321 Buffer_write8(&buf, 'E');
1322 Buffer_write8(&buf, 'L');
1323 Buffer_write8(&buf, 'F');
1324 Buffer_write8(&buf, 2); // 64-bit
1325 Buffer_write8(&buf, 1); // little-endian
1326 Buffer_write8(&buf, 1); // ???
1327 Buffer_write8(&buf, 0); // ???
1328 for (word i = 0; i < 8; i++) {
1329 Buffer_write8(&buf, 0); // unused e_ident
1330 }
1331 // END e_ident
1332 Buffer_write32(&buf, 0x003e0002); // e_machine_type
1333 Buffer_write32(&buf, 1); // e_version
1334 word e_entry_pos = Buffer_len(&buf);
1335 Buffer_write64(&buf, 0); // e_entry
1336 word e_phoff_pos = Buffer_len(&buf);
1337 Buffer_write64(&buf, 0); // e_phoff
1338 Buffer_write64(&buf, 0); // e_shoff
1339 Buffer_write32(&buf, 0); // e_flags
1340 word e_ehsize_pos = Buffer_len(&buf);
1341 Buffer_write16(&buf, 0); // e_ehsize
1342 word e_phentsize_pos = Buffer_len(&buf);
1343 Buffer_write16(&buf, 0); // e_phentsize
1344 Buffer_write16(&buf, 1); // e_phnum
1345 Buffer_write16(&buf, 0); // e_shentsize
1346 Buffer_write16(&buf, 0); // e_shnum
1347 Buffer_write16(&buf, 0); // e_shstrndx
1348
1349 // Backpatch e_ehsize
1350 Buffer_at_put32(&buf, e_ehsize_pos, Buffer_len(&buf));
1351
1352 word phdr_start_pos = Buffer_len(&buf);
1353 // Backpatch e_phoff
1354 Buffer_at_put64(&buf, e_phoff_pos, phdr_start_pos);
1355
1356 Buffer_write32(&buf, 1); // p_type
1357 Buffer_write32(&buf, 5); // p_flags
1358 Buffer_write64(&buf, 0); // p_offset
1359 Buffer_write64(&buf, org); // p_vaddr
1360 Buffer_write64(&buf, org); // p_paddr
1361 word filesz_pos = Buffer_len(&buf);
1362 Buffer_write64(&buf, 0); // p_filesz
1363 word memsz_pos = Buffer_len(&buf);
1364 Buffer_write64(&buf, 0); // p_memsz
1365 Buffer_write64(&buf, 0x1000); // p_align
1366
1367 word phdrsize = Buffer_len(&buf) - phdr_start_pos;
1368 // Backpatch e_phentsize
1369 Buffer_at_put16(&buf, e_phentsize_pos, phdrsize);
1370
1371 _(Compile_entry(&buf, node));
1372
1373 // Backpatch e_entry
1374 Buffer_at_put64(&buf, e_entry_pos, org + buf.entrypoint);
1375
1376 word filesize = Buffer_len(&buf);
1377 // Backpatch p_filesz
1378 Buffer_at_put64(&buf, filesz_pos, filesize);
1379 // Backpatch p_memsz
1380 Buffer_at_put64(&buf, memsz_pos, filesize);
1381
1382 FILE *fp = fopen(filename, "w+b");
1383 assert(fp != NULL);
1384 size_t written =
1385 fwrite(buf.address, /*size=*/1, /*nmemb=*/Buffer_len(&buf), fp);
1386 assert(written == (size_t)Buffer_len(&buf));
1387 fclose(fp);
1388 return 0;
1389}
1390
1391// End Compile
1392
1393typedef uword (*JitFunction)(uword *heap);
1394
1395// Testing
1396
1397uword Testing_execute_entry(Buffer *buf, uword *heap) {
1398 assert(buf != NULL);
1399 assert(buf->address != NULL);
1400 assert(buf->state == kExecutable);
1401 // The pointer-pointer cast is allowed but the underlying
1402 // data-to-function-pointer back-and-forth is only guaranteed to work on
1403 // POSIX systems (because of eg dlsym).
1404 JitFunction function = *(JitFunction *)(&buf->address);
1405 return function(heap);
1406}
1407
1408uword Testing_execute_expr(Buffer *buf) {
1409 return Testing_execute_entry(buf, /*heap=*/NULL);
1410}
1411
1412TEST Testing_expect_entry_has_contents(Buffer *buf, byte *arr,
1413 size_t arr_size) {
1414 word total_size = sizeof kEntryPrologue + arr_size + sizeof kFunctionEpilogue;
1415 ASSERT_EQ_FMT(total_size, Buffer_len(buf), "%ld");
1416
1417 byte *ptr = buf->address;
1418 ASSERT_MEM_EQ(kEntryPrologue, ptr, sizeof kEntryPrologue);
1419 ptr += sizeof kEntryPrologue;
1420 ASSERT_MEM_EQ(arr, ptr, arr_size);
1421 ptr += arr_size;
1422 ASSERT_MEM_EQ(kFunctionEpilogue, ptr, sizeof kFunctionEpilogue);
1423 ptr += sizeof kFunctionEpilogue;
1424 PASS();
1425}
1426
1427WARN_UNUSED int Testing_compile_expr_entry(Buffer *buf, ASTNode *node) {
1428 Buffer_write_arr(buf, kEntryPrologue, sizeof kEntryPrologue);
1429 _(Compile_expr(buf, node, /*stack_index=*/-kWordSize, /*varenv=*/NULL,
1430 /*labels=*/NULL));
1431 Buffer_write_arr(buf, kFunctionEpilogue, sizeof kFunctionEpilogue);
1432 return 0;
1433}
1434
1435#define EXPECT_EQUALS_BYTES(buf, arr) \
1436 ASSERT_EQ_FMT(sizeof arr, Buffer_len(buf), "%ld"); \
1437 ASSERT_MEM_EQ(arr, (buf)->address, sizeof arr)
1438
1439#define EXPECT_ENTRY_CONTAINS_CODE(buf, arr) \
1440 CHECK_CALL(Testing_expect_entry_has_contents(buf, arr, sizeof arr))
1441
1442#define RUN_BUFFER_TEST(test_name) \
1443 do { \
1444 Buffer buf; \
1445 Buffer_init(&buf, 1); \
1446 GREATEST_RUN_TEST1(test_name, &buf); \
1447 Buffer_deinit(&buf); \
1448 } while (0)
1449
1450#define RUN_HEAP_TEST(test_name) \
1451 do { \
1452 Buffer buf; \
1453 Buffer_init(&buf, 1); \
1454 uword *heap = malloc(1000 * kWordSize); \
1455 GREATEST_RUN_TESTp(test_name, &buf, heap); \
1456 free(heap); \
1457 Buffer_deinit(&buf); \
1458 } while (0)
1459
1460ASTNode *list1(ASTNode *item0) { return AST_new_pair(item0, AST_nil()); }
1461
1462ASTNode *list2(ASTNode *item0, ASTNode *item1) {
1463 return AST_new_pair(item0, list1(item1));
1464}
1465
1466ASTNode *list3(ASTNode *item0, ASTNode *item1, ASTNode *item2) {
1467 return AST_new_pair(item0, list2(item1, item2));
1468}
1469
1470ASTNode *new_unary_call(const char *name, ASTNode *arg) {
1471 return list2(AST_new_symbol(name), arg);
1472}
1473
1474ASTNode *new_binary_call(const char *name, ASTNode *arg0, ASTNode *arg1) {
1475 return list3(AST_new_symbol(name), arg0, arg1);
1476}
1477
1478// End Testing
1479
1480// Tests
1481
1482TEST encode_positive_integer(void) {
1483 ASSERT_EQ(Object_encode_integer(0), 0x0);
1484 ASSERT_EQ(Object_encode_integer(1), 0x4);
1485 ASSERT_EQ(Object_encode_integer(10), 0x28);
1486 PASS();
1487}
1488
1489TEST encode_negative_integer(void) {
1490 ASSERT_EQ(Object_encode_integer(0), 0x0);
1491 ASSERT_EQ(Object_encode_integer(-1), 0xfffffffffffffffc);
1492 ASSERT_EQ(Object_encode_integer(-10), 0xffffffffffffffd8);
1493 PASS();
1494}
1495
1496TEST encode_char(void) {
1497 ASSERT_EQ(Object_encode_char('\0'), 0xf);
1498 ASSERT_EQ(Object_encode_char('a'), 0x610f);
1499 PASS();
1500}
1501
1502TEST decode_char(void) {
1503 ASSERT_EQ(Object_decode_char(0xf), '\0');
1504 ASSERT_EQ(Object_decode_char(0x610f), 'a');
1505 PASS();
1506}
1507
1508TEST encode_bool(void) {
1509 ASSERT_EQ(Object_encode_bool(true), 0x9f);
1510 ASSERT_EQ(Object_encode_bool(false), 0x1f);
1511 ASSERT_EQ(Object_true(), 0x9f);
1512 ASSERT_EQ(Object_false(), 0x1f);
1513 PASS();
1514}
1515
1516TEST decode_bool(void) {
1517 ASSERT_EQ(Object_decode_bool(0x9f), true);
1518 ASSERT_EQ(Object_decode_bool(0x1f), false);
1519 PASS();
1520}
1521
1522TEST address(void) {
1523 ASSERT_EQ(Object_address((void *)0xFF01), 0xFF00);
1524 PASS();
1525}
1526
1527TEST emit_mov_reg_imm32_emits_modrm(Buffer *buf) {
1528 Emit_mov_reg_imm32(buf, kRax, 100);
1529 byte expected[] = {0x48, 0xc7, 0xc0, 0x64, 0x00, 0x00, 0x00};
1530 EXPECT_EQUALS_BYTES(buf, expected);
1531 ASSERT_EQ_FMT(modrm(/*direct*/ 3, kRax, 0), 0xc0, "0x%.2x");
1532 PASS();
1533}
1534
1535TEST emit_store_reg_indirect_emits_modrm_sib(Buffer *buf) {
1536 Emit_store_reg_indirect(buf, Ind(kRsp, -8), kRax);
1537 byte expected[] = {0x48, 0x89, 0x44, 0x24, 0xf8};
1538 EXPECT_EQUALS_BYTES(buf, expected);
1539 ASSERT_EQ_FMT(modrm(/*disp8*/ 1, kIndexNone, kRax), 0x44, "0x%.2x");
1540 ASSERT_EQ_FMT(sib(kRsp, kIndexNone, Scale1), 0x24, "0x%.2x");
1541 PASS();
1542}
1543
1544TEST ast_new_pair(void) {
1545 ASTNode *node = AST_new_pair(NULL, NULL);
1546 ASSERT(AST_is_pair(node));
1547 AST_heap_free(node);
1548 PASS();
1549}
1550
1551TEST ast_pair_car_returns_car(void) {
1552 ASTNode *node = AST_new_pair(AST_new_integer(123), NULL);
1553 ASTNode *car = AST_pair_car(node);
1554 ASSERT(AST_is_integer(car));
1555 ASSERT_EQ(Object_decode_integer((uword)car), 123);
1556 AST_heap_free(node);
1557 PASS();
1558}
1559
1560TEST ast_pair_cdr_returns_cdr(void) {
1561 ASTNode *node = AST_new_pair(NULL, AST_new_integer(123));
1562 ASTNode *cdr = AST_pair_cdr(node);
1563 ASSERT(AST_is_integer(cdr));
1564 ASSERT_EQ(Object_decode_integer((uword)cdr), 123);
1565 AST_heap_free(node);
1566 PASS();
1567}
1568
1569TEST ast_new_symbol(void) {
1570 const char *value = "my symbol";
1571 ASTNode *node = AST_new_symbol(value);
1572 ASSERT(AST_is_symbol(node));
1573 ASSERT_STR_EQ(AST_symbol_cstr(node), value);
1574 AST_heap_free(node);
1575 PASS();
1576}
1577
1578#define ASSERT_IS_CHAR_EQ(node, c) \
1579 do { \
1580 ASTNode *__tmp = node; \
1581 if (AST_is_error(__tmp)) { \
1582 fprintf(stderr, "Expected a char but got an error.\n"); \
1583 } \
1584 ASSERT(AST_is_char(__tmp)); \
1585 ASSERT_EQ(AST_get_char(__tmp), c); \
1586 } while (0);
1587
1588#define ASSERT_IS_INT_EQ(node, val) \
1589 do { \
1590 ASTNode *__tmp = node; \
1591 if (AST_is_error(__tmp)) { \
1592 fprintf(stderr, "Expected an int but got an error.\n"); \
1593 } \
1594 ASSERT(AST_is_integer(__tmp)); \
1595 ASSERT_EQ(AST_get_integer(__tmp), val); \
1596 } while (0);
1597
1598#define ASSERT_IS_SYM_EQ(node, cstr) \
1599 do { \
1600 ASTNode *__tmp = node; \
1601 if (AST_is_error(__tmp)) { \
1602 fprintf(stderr, "Expected a symbol but got an error.\n"); \
1603 } \
1604 ASSERT(AST_is_symbol(__tmp)); \
1605 ASSERT_STR_EQ(AST_symbol_cstr(__tmp), cstr); \
1606 } while (0);
1607
1608TEST read_with_integer_returns_integer(void) {
1609 char *input = "1234";
1610 ASTNode *node = Reader_read(input);
1611 ASSERT_IS_INT_EQ(node, 1234);
1612 AST_heap_free(node);
1613 PASS();
1614}
1615
1616TEST read_with_negative_integer_returns_integer(void) {
1617 char *input = "-1234";
1618 ASTNode *node = Reader_read(input);
1619 ASSERT_IS_INT_EQ(node, -1234);
1620 AST_heap_free(node);
1621 PASS();
1622}
1623
1624TEST read_with_positive_integer_returns_integer(void) {
1625 char *input = "+1234";
1626 ASTNode *node = Reader_read(input);
1627 ASSERT_IS_INT_EQ(node, 1234);
1628 AST_heap_free(node);
1629 PASS();
1630}
1631
1632TEST read_with_leading_whitespace_ignores_whitespace(void) {
1633 char *input = " \t \n 1234";
1634 ASTNode *node = Reader_read(input);
1635 ASSERT_IS_INT_EQ(node, 1234);
1636 AST_heap_free(node);
1637 PASS();
1638}
1639
1640TEST read_with_symbol_returns_symbol(void) {
1641 char *input = "hello?+-*=>";
1642 ASTNode *node = Reader_read(input);
1643 ASSERT_IS_SYM_EQ(node, "hello?+-*=>");
1644 AST_heap_free(node);
1645 PASS();
1646}
1647
1648TEST read_with_symbol_with_trailing_digits(void) {
1649 char *input = "add1 1";
1650 ASTNode *node = Reader_read(input);
1651 ASSERT_IS_SYM_EQ(node, "add1");
1652 AST_heap_free(node);
1653 PASS();
1654}
1655
1656TEST read_with_char_returns_char(void) {
1657 char *input = "'a'";
1658 ASTNode *node = Reader_read(input);
1659 ASSERT_IS_CHAR_EQ(node, 'a');
1660 ASSERT(AST_is_error(Reader_read("''")));
1661 ASSERT(AST_is_error(Reader_read("'aa'")));
1662 ASSERT(AST_is_error(Reader_read("'aa")));
1663 AST_heap_free(node);
1664 PASS();
1665}
1666
1667TEST read_with_bool_returns_bool(void) {
1668 ASSERT_EQ(Reader_read("#t"), AST_new_bool(true));
1669 ASSERT_EQ(Reader_read("#f"), AST_new_bool(false));
1670 ASSERT(AST_is_error(Reader_read("#")));
1671 ASSERT(AST_is_error(Reader_read("#x")));
1672 ASSERT(AST_is_error(Reader_read("##")));
1673 PASS();
1674}
1675
1676TEST read_with_nil_returns_nil(void) {
1677 char *input = "()";
1678 ASTNode *node = Reader_read(input);
1679 ASSERT(AST_is_nil(node));
1680 AST_heap_free(node);
1681 PASS();
1682}
1683
1684TEST read_with_list_returns_list(void) {
1685 char *input = "( 1 2 0 )";
1686 ASTNode *node = Reader_read(input);
1687 ASSERT(AST_is_pair(node));
1688 ASSERT_IS_INT_EQ(AST_pair_car(node), 1);
1689 ASSERT_IS_INT_EQ(AST_pair_car(AST_pair_cdr(node)), 2);
1690 ASSERT_IS_INT_EQ(AST_pair_car(AST_pair_cdr(AST_pair_cdr(node))), 0);
1691 ASSERT(AST_is_nil(AST_pair_cdr(AST_pair_cdr(AST_pair_cdr(node)))));
1692 AST_heap_free(node);
1693 PASS();
1694}
1695
1696TEST read_with_nested_list_returns_list(void) {
1697 char *input = "((hello world) (foo bar))";
1698 ASTNode *node = Reader_read(input);
1699 ASSERT(AST_is_pair(node));
1700 ASTNode *first = AST_pair_car(node);
1701 ASSERT(AST_is_pair(first));
1702 ASSERT_IS_SYM_EQ(AST_pair_car(first), "hello");
1703 ASSERT_IS_SYM_EQ(AST_pair_car(AST_pair_cdr(first)), "world");
1704 ASSERT(AST_is_nil(AST_pair_cdr(AST_pair_cdr(first))));
1705 ASTNode *second = AST_pair_car(AST_pair_cdr(node));
1706 ASSERT(AST_is_pair(second));
1707 ASSERT_IS_SYM_EQ(AST_pair_car(second), "foo");
1708 ASSERT_IS_SYM_EQ(AST_pair_car(AST_pair_cdr(second)), "bar");
1709 ASSERT(AST_is_nil(AST_pair_cdr(AST_pair_cdr(second))));
1710 AST_heap_free(node);
1711 PASS();
1712}
1713
1714TEST buffer_write8_increases_length(Buffer *buf) {
1715 ASSERT_EQ(Buffer_len(buf), 0);
1716 Buffer_write8(buf, 0xdb);
1717 ASSERT_EQ(Buffer_at8(buf, 0), 0xdb);
1718 ASSERT_EQ(Buffer_len(buf), 1);
1719 PASS();
1720}
1721
1722TEST buffer_write8_expands_buffer(void) {
1723 Buffer buf;
1724 Buffer_init(&buf, 1);
1725 ASSERT_EQ(buf.capacity, 1);
1726 ASSERT_EQ(buf.len, 0);
1727 Buffer_write8(&buf, 0xdb);
1728 Buffer_write8(&buf, 0xef);
1729 ASSERT(buf.capacity > 1);
1730 ASSERT_EQ(buf.len, 2);
1731 Buffer_deinit(&buf);
1732 PASS();
1733}
1734
1735TEST buffer_write32_expands_buffer(void) {
1736 Buffer buf;
1737 Buffer_init(&buf, 1);
1738 ASSERT_EQ(buf.capacity, 1);
1739 ASSERT_EQ(buf.len, 0);
1740 Buffer_write32(&buf, 0xdeadbeef);
1741 ASSERT(buf.capacity > 1);
1742 ASSERT_EQ(buf.len, 4);
1743 Buffer_deinit(&buf);
1744 PASS();
1745}
1746
1747TEST buffer_write32_writes_little_endian(Buffer *buf) {
1748 Buffer_write32(buf, 0xdeadbeef);
1749 ASSERT_EQ(Buffer_at8(buf, 0), 0xef);
1750 ASSERT_EQ(Buffer_at8(buf, 1), 0xbe);
1751 ASSERT_EQ(Buffer_at8(buf, 2), 0xad);
1752 ASSERT_EQ(Buffer_at8(buf, 3), 0xde);
1753 PASS();
1754}
1755
1756TEST compile_positive_integer(Buffer *buf) {
1757 word value = 123;
1758 ASTNode *node = AST_new_integer(value);
1759 int compile_result = Testing_compile_expr_entry(buf, node);
1760 ASSERT_EQ(compile_result, 0);
1761 // mov eax, imm(123)
1762 byte expected[] = {0x48, 0xc7, 0xc0, 0xec, 0x01, 0x00, 0x00};
1763 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1764 Buffer_make_executable(buf);
1765 uword result = Testing_execute_expr(buf);
1766 ASSERT_EQ(result, Object_encode_integer(value));
1767 PASS();
1768}
1769
1770TEST compile_negative_integer(Buffer *buf) {
1771 word value = -123;
1772 ASTNode *node = AST_new_integer(value);
1773 int compile_result = Testing_compile_expr_entry(buf, node);
1774 ASSERT_EQ(compile_result, 0);
1775 // mov eax, imm(-123)
1776 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0xfe, 0xff, 0xff};
1777 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1778 Buffer_make_executable(buf);
1779 uword result = Testing_execute_expr(buf);
1780 ASSERT_EQ(result, Object_encode_integer(value));
1781 PASS();
1782}
1783
1784TEST compile_char(Buffer *buf) {
1785 char value = 'a';
1786 ASTNode *node = AST_new_char(value);
1787 int compile_result = Testing_compile_expr_entry(buf, node);
1788 ASSERT_EQ(compile_result, 0);
1789 // mov eax, imm('a')
1790 byte expected[] = {0x48, 0xc7, 0xc0, 0x0f, 0x61, 0x00, 0x00};
1791 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1792 Buffer_make_executable(buf);
1793 uword result = Testing_execute_expr(buf);
1794 ASSERT_EQ(result, Object_encode_char(value));
1795 PASS();
1796}
1797
1798TEST compile_true(Buffer *buf) {
1799 ASTNode *node = AST_new_bool(true);
1800 int compile_result = Testing_compile_expr_entry(buf, node);
1801 ASSERT_EQ(compile_result, 0);
1802 // mov eax, imm(true)
1803 byte expected[] = {0x48, 0xc7, 0xc0, 0x9f, 0x0, 0x0, 0x0};
1804 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1805 Buffer_make_executable(buf);
1806 uword result = Testing_execute_expr(buf);
1807 ASSERT_EQ(result, Object_true());
1808 PASS();
1809}
1810
1811TEST compile_false(Buffer *buf) {
1812 ASTNode *node = AST_new_bool(false);
1813 int compile_result = Testing_compile_expr_entry(buf, node);
1814 ASSERT_EQ(compile_result, 0);
1815 // mov eax, imm(false)
1816 byte expected[] = {0x48, 0xc7, 0xc0, 0x1f, 0x00, 0x00, 0x00};
1817 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1818 Buffer_make_executable(buf);
1819 uword result = Testing_execute_expr(buf);
1820 ASSERT_EQ(result, Object_false());
1821 PASS();
1822}
1823
1824TEST compile_nil(Buffer *buf) {
1825 ASTNode *node = AST_nil();
1826 int compile_result = Testing_compile_expr_entry(buf, node);
1827 ASSERT_EQ(compile_result, 0);
1828 // mov eax, imm(nil)
1829 byte expected[] = {0x48, 0xc7, 0xc0, 0x2f, 0x00, 0x00, 0x00};
1830 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1831 Buffer_make_executable(buf);
1832 uword result = Testing_execute_expr(buf);
1833 ASSERT_EQ(result, Object_nil());
1834 PASS();
1835}
1836
1837TEST compile_unary_add1(Buffer *buf) {
1838 ASTNode *node = new_unary_call("add1", AST_new_integer(123));
1839 int compile_result = Testing_compile_expr_entry(buf, node);
1840 ASSERT_EQ(compile_result, 0);
1841 // mov rax, imm(123); add rax, imm(1)
1842 byte expected[] = {0x48, 0xc7, 0xc0, 0xec, 0x01, 0x00, 0x00,
1843 0x48, 0x05, 0x04, 0x00, 0x00, 0x00};
1844 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1845 Buffer_make_executable(buf);
1846 uword result = Testing_execute_expr(buf);
1847 ASSERT_EQ(result, Object_encode_integer(124));
1848 AST_heap_free(node);
1849 PASS();
1850}
1851
1852TEST compile_unary_add1_nested(Buffer *buf) {
1853 ASTNode *node =
1854 new_unary_call("add1", new_unary_call("add1", AST_new_integer(123)));
1855 int compile_result = Testing_compile_expr_entry(buf, node);
1856 ASSERT_EQ(compile_result, 0);
1857 // mov rax, imm(123); add rax, imm(1); add rax, imm(1)
1858 byte expected[] = {0x48, 0xc7, 0xc0, 0xec, 0x01, 0x00, 0x00, 0x48, 0x05, 0x04,
1859 0x00, 0x00, 0x00, 0x48, 0x05, 0x04, 0x00, 0x00, 0x00};
1860 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1861 Buffer_make_executable(buf);
1862 uword result = Testing_execute_expr(buf);
1863 ASSERT_EQ(result, Object_encode_integer(125));
1864 AST_heap_free(node);
1865 PASS();
1866}
1867
1868TEST compile_unary_sub1(Buffer *buf) {
1869 ASTNode *node = new_unary_call("sub1", AST_new_integer(123));
1870 int compile_result = Testing_compile_expr_entry(buf, node);
1871 ASSERT_EQ(compile_result, 0);
1872 // mov rax, imm(123); sub rax, imm(1)
1873 byte expected[] = {0x48, 0xc7, 0xc0, 0xec, 0x01, 0x00, 0x00,
1874 0x48, 0x2d, 0x04, 0x00, 0x00, 0x00};
1875 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1876 Buffer_make_executable(buf);
1877 uword result = Testing_execute_expr(buf);
1878 ASSERT_EQ(result, Object_encode_integer(122));
1879 AST_heap_free(node);
1880 PASS();
1881}
1882
1883TEST compile_unary_integer_to_char(Buffer *buf) {
1884 ASTNode *node = new_unary_call("integer->char", AST_new_integer(97));
1885 int compile_result = Testing_compile_expr_entry(buf, node);
1886 ASSERT_EQ(compile_result, 0);
1887 // mov rax, imm(97); shl rax, 6; or rax, 0xf
1888 byte expected[] = {0x48, 0xc7, 0xc0, 0x84, 0x01, 0x00, 0x00, 0x48,
1889 0xc1, 0xe0, 0x06, 0x48, 0x83, 0xc8, 0x0f};
1890 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1891 Buffer_make_executable(buf);
1892 uword result = Testing_execute_expr(buf);
1893 ASSERT_EQ(result, Object_encode_char('a'));
1894 AST_heap_free(node);
1895 PASS();
1896}
1897
1898TEST compile_unary_char_to_integer(Buffer *buf) {
1899 ASTNode *node = new_unary_call("char->integer", AST_new_char('a'));
1900 int compile_result = Testing_compile_expr_entry(buf, node);
1901 ASSERT_EQ(compile_result, 0);
1902 // mov rax, imm('a'); shr rax, 6
1903 byte expected[] = {0x48, 0xc7, 0xc0, 0x0f, 0x61, 0x00,
1904 0x00, 0x48, 0xc1, 0xe8, 0x06};
1905 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1906 Buffer_make_executable(buf);
1907 uword result = Testing_execute_expr(buf);
1908 ASSERT_EQ(result, Object_encode_integer(97));
1909 AST_heap_free(node);
1910 PASS();
1911}
1912
1913TEST compile_unary_nilp_with_nil_returns_true(Buffer *buf) {
1914 ASTNode *node = new_unary_call("nil?", AST_nil());
1915 int compile_result = Testing_compile_expr_entry(buf, node);
1916 ASSERT_EQ(compile_result, 0);
1917 // 0: 48 c7 c0 2f 00 00 00 mov rax,0x2f
1918 // 7: 48 3d 2f 00 00 00 cmp rax,0x0000002f
1919 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1920 // 14: 0f 94 c0 sete al
1921 // 17: 48 c1 e0 07 shl rax,0x7
1922 // 1b: 48 83 c8 1f or rax,0x1f
1923 byte expected[] = {0x48, 0xc7, 0xc0, 0x2f, 0x00, 0x00, 0x00, 0x48,
1924 0x3d, 0x2f, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1925 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1926 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1927 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1928 Buffer_make_executable(buf);
1929 uword result = Testing_execute_expr(buf);
1930 ASSERT_EQ(result, Object_true());
1931 AST_heap_free(node);
1932 PASS();
1933}
1934
1935TEST compile_unary_nilp_with_non_nil_returns_false(Buffer *buf) {
1936 ASTNode *node = new_unary_call("nil?", AST_new_integer(5));
1937 int compile_result = Testing_compile_expr_entry(buf, node);
1938 ASSERT_EQ(compile_result, 0);
1939 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
1940 // 7: 48 3d 2f 00 00 00 cmp rax,0x0000002f
1941 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1942 // 14: 0f 94 c0 sete al
1943 // 17: 48 c1 e0 07 shl rax,0x7
1944 // 1b: 48 83 c8 1f or rax,0x1f
1945 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48,
1946 0x3d, 0x2f, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1947 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1948 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1949 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1950 Buffer_make_executable(buf);
1951 uword result = Testing_execute_expr(buf);
1952 ASSERT_EQ(result, Object_false());
1953 AST_heap_free(node);
1954 PASS();
1955}
1956
1957TEST compile_unary_zerop_with_zero_returns_true(Buffer *buf) {
1958 ASTNode *node = new_unary_call("zero?", AST_new_integer(0));
1959 int compile_result = Testing_compile_expr_entry(buf, node);
1960 ASSERT_EQ(compile_result, 0);
1961 // 0: 48 c7 c0 00 00 00 00 mov rax,0x0
1962 // 7: 48 3d 00 00 00 00 cmp rax,0x00000000
1963 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1964 // 14: 0f 94 c0 sete al
1965 // 17: 48 c1 e0 07 shl rax,0x7
1966 // 1b: 48 83 c8 1f or rax,0x1f
1967 byte expected[] = {0x48, 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x48,
1968 0x3d, 0x00, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1969 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1970 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1971 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1972 Buffer_make_executable(buf);
1973 uword result = Testing_execute_expr(buf);
1974 ASSERT_EQ(result, Object_true());
1975 AST_heap_free(node);
1976 PASS();
1977}
1978
1979TEST compile_unary_zerop_with_non_zero_returns_false(Buffer *buf) {
1980 ASTNode *node = new_unary_call("zero?", AST_new_integer(5));
1981 int compile_result = Testing_compile_expr_entry(buf, node);
1982 ASSERT_EQ(compile_result, 0);
1983 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
1984 // 7: 48 3d 00 00 00 00 cmp rax,0x00000000
1985 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
1986 // 14: 0f 94 c0 sete al
1987 // 17: 48 c1 e0 07 shl rax,0x7
1988 // 1b: 48 83 c8 1f or rax,0x1f
1989 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48,
1990 0x3d, 0x00, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
1991 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
1992 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
1993 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
1994 Buffer_make_executable(buf);
1995 uword result = Testing_execute_expr(buf);
1996 ASSERT_EQ(result, Object_false());
1997 AST_heap_free(node);
1998 PASS();
1999}
2000
2001TEST compile_unary_not_with_false_returns_true(Buffer *buf) {
2002 ASTNode *node = new_unary_call("not", AST_new_bool(false));
2003 int compile_result = Testing_compile_expr_entry(buf, node);
2004 ASSERT_EQ(compile_result, 0);
2005 // 0: 48 c7 c0 1f 00 00 00 mov rax,0x1f
2006 // 7: 48 3d 1f 00 00 00 cmp rax,0x0000001f
2007 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
2008 // 14: 0f 94 c0 sete al
2009 // 17: 48 c1 e0 07 shl rax,0x7
2010 // 1b: 48 83 c8 1f or rax,0x1f
2011 byte expected[] = {0x48, 0xc7, 0xc0, 0x1f, 0x00, 0x00, 0x00, 0x48,
2012 0x3d, 0x1f, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
2013 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
2014 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
2015 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2016 Buffer_make_executable(buf);
2017 uword result = Testing_execute_expr(buf);
2018 ASSERT_EQ(result, Object_true());
2019 AST_heap_free(node);
2020 PASS();
2021}
2022
2023TEST compile_unary_not_with_non_false_returns_false(Buffer *buf) {
2024 ASTNode *node = new_unary_call("not", AST_new_integer(5));
2025 int compile_result = Testing_compile_expr_entry(buf, node);
2026 ASSERT_EQ(compile_result, 0);
2027 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
2028 // 7: 48 3d 1f 00 00 00 cmp rax,0x0000001f
2029 // d: 48 c7 c0 00 00 00 00 mov rax,0x0
2030 // 14: 0f 94 c0 sete al
2031 // 17: 48 c1 e0 07 shl rax,0x7
2032 // 1b: 48 83 c8 1f or rax,0x1f
2033 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48,
2034 0x3d, 0x1f, 0x00, 0x00, 0x00, 0x48, 0xc7, 0xc0,
2035 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0, 0x48,
2036 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
2037 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2038 Buffer_make_executable(buf);
2039 uword result = Testing_execute_expr(buf);
2040 ASSERT_EQ(result, Object_false());
2041 AST_heap_free(node);
2042 PASS();
2043}
2044
2045TEST compile_unary_integerp_with_integer_returns_true(Buffer *buf) {
2046 ASTNode *node = new_unary_call("integer?", AST_new_integer(5));
2047 int compile_result = Testing_compile_expr_entry(buf, node);
2048 ASSERT_EQ(compile_result, 0);
2049 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
2050 // 7: 48 83 e0 03 and rax,0x3
2051 // b: 48 3d 00 00 00 00 cmp rax,0x00000000
2052 // 11: 48 c7 c0 00 00 00 00 mov rax,0x0
2053 // 18: 0f 94 c0 sete al
2054 // 1b: 48 c1 e0 07 shl rax,0x7
2055 // 1f: 48 83 c8 1f or rax,0x1f
2056 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48, 0x83,
2057 0xe0, 0x03, 0x48, 0x3d, 0x00, 0x00, 0x00, 0x00, 0x48,
2058 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0,
2059 0x48, 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
2060 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2061 Buffer_make_executable(buf);
2062 uword result = Testing_execute_expr(buf);
2063 ASSERT_EQ(result, Object_true());
2064 AST_heap_free(node);
2065 PASS();
2066}
2067
2068TEST compile_unary_integerp_with_non_integer_returns_false(Buffer *buf) {
2069 ASTNode *node = new_unary_call("integer?", AST_nil());
2070 int compile_result = Testing_compile_expr_entry(buf, node);
2071 ASSERT_EQ(compile_result, 0);
2072 // 0: 48 c7 c0 2f 00 00 00 mov rax,0x2f
2073 // 7: 48 83 e0 03 and rax,0x3
2074 // b: 48 3d 00 00 00 00 cmp rax,0x00000000
2075 // 11: 48 c7 c0 00 00 00 00 mov rax,0x0
2076 // 18: 0f 94 c0 sete al
2077 // 1b: 48 c1 e0 07 shl rax,0x7
2078 // 1f: 48 83 c8 1f or rax,0x1f
2079 byte expected[] = {0x48, 0xc7, 0xc0, 0x2f, 0x00, 0x00, 0x00, 0x48, 0x83,
2080 0xe0, 0x03, 0x48, 0x3d, 0x00, 0x00, 0x00, 0x00, 0x48,
2081 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0,
2082 0x48, 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
2083 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2084 Buffer_make_executable(buf);
2085 uword result = Testing_execute_expr(buf);
2086 ASSERT_EQ(result, Object_false());
2087 AST_heap_free(node);
2088 PASS();
2089}
2090
2091TEST compile_unary_booleanp_with_boolean_returns_true(Buffer *buf) {
2092 ASTNode *node = new_unary_call("boolean?", AST_new_bool(true));
2093 int compile_result = Testing_compile_expr_entry(buf, node);
2094 ASSERT_EQ(compile_result, 0);
2095 // 0: 48 c7 c0 9f 00 00 00 mov rax,0x9f
2096 // 7: 48 83 e0 3f and rax,0x3f
2097 // b: 48 3d 1f 00 00 00 cmp rax,0x0000001f
2098 // 11: 48 c7 c0 00 00 00 00 mov rax,0x0
2099 // 18: 0f 94 c0 sete al
2100 // 1b: 48 c1 e0 07 shl rax,0x7
2101 // 1f: 48 83 c8 1f or rax,0x1f
2102 byte expected[] = {0x48, 0xc7, 0xc0, 0x9f, 0x00, 0x00, 0x00, 0x48, 0x83,
2103 0xe0, 0x3f, 0x48, 0x3d, 0x1f, 0x00, 0x00, 0x00, 0x48,
2104 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0,
2105 0x48, 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
2106 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2107 Buffer_make_executable(buf);
2108 uword result = Testing_execute_expr(buf);
2109 ASSERT_EQ(result, Object_true());
2110 AST_heap_free(node);
2111 PASS();
2112}
2113
2114TEST compile_unary_booleanp_with_non_boolean_returns_false(Buffer *buf) {
2115 ASTNode *node = new_unary_call("boolean?", AST_new_integer(5));
2116 int compile_result = Testing_compile_expr_entry(buf, node);
2117 ASSERT_EQ(compile_result, 0);
2118 // 0: 48 c7 c0 14 00 00 00 mov rax,0x14
2119 // 7: 48 83 e0 3f and rax,0x3f
2120 // b: 48 3d 1f 00 00 00 cmp rax,0x0000001f
2121 // 11: 48 c7 c0 00 00 00 00 mov rax,0x0
2122 // 18: 0f 94 c0 sete al
2123 // 1b: 48 c1 e0 07 shl rax,0x7
2124 // 1f: 48 83 c8 1f or rax,0x1f
2125 byte expected[] = {0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00, 0x48, 0x83,
2126 0xe0, 0x3f, 0x48, 0x3d, 0x1f, 0x00, 0x00, 0x00, 0x48,
2127 0xc7, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0f, 0x94, 0xc0,
2128 0x48, 0xc1, 0xe0, 0x07, 0x48, 0x83, 0xc8, 0x1f};
2129 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2130 Buffer_make_executable(buf);
2131 uword result = Testing_execute_expr(buf);
2132 ASSERT_EQ(result, Object_false());
2133 AST_heap_free(node);
2134 PASS();
2135}
2136
2137TEST compile_binary_plus(Buffer *buf) {
2138 ASTNode *node = new_binary_call("+", AST_new_integer(5), AST_new_integer(8));
2139 int compile_result = Testing_compile_expr_entry(buf, node);
2140 ASSERT_EQ(compile_result, 0);
2141 byte expected[] = {
2142 // 0: 48 c7 c0 20 00 00 00 mov rax,0x20
2143 0x48, 0xc7, 0xc0, 0x20, 0x00, 0x00, 0x00,
2144 // 7: 48 89 45 f8 mov QWORD PTR [rsp-0x8],rax
2145 0x48, 0x89, 0x44, 0x24, 0xf8,
2146 // b: 48 c7 c0 14 00 00 00 mov rax,0x14
2147 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2148 // 12: 48 03 45 f8 add rax,QWORD PTR [rsp-0x8]
2149 0x48, 0x03, 0x44, 0x24, 0xf8};
2150 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2151 Buffer_make_executable(buf);
2152 uword result = Testing_execute_expr(buf);
2153 ASSERT_EQ(result, Object_encode_integer(13));
2154 AST_heap_free(node);
2155 PASS();
2156}
2157
2158TEST compile_binary_plus_nested(Buffer *buf) {
2159 ASTNode *node = new_binary_call(
2160 "+", new_binary_call("+", AST_new_integer(1), AST_new_integer(2)),
2161 new_binary_call("+", AST_new_integer(3), AST_new_integer(4)));
2162 int compile_result = Testing_compile_expr_entry(buf, node);
2163 ASSERT_EQ(compile_result, 0);
2164 byte expected[] = {
2165 // 4: 48 c7 c0 10 00 00 00 mov rax,0x10
2166 0x48, 0xc7, 0xc0, 0x10, 0x00, 0x00, 0x00,
2167 // b: 48 89 45 f8 mov QWORD PTR [rsp-0x8],rax
2168 0x48, 0x89, 0x44, 0x24, 0xf8,
2169 // f: 48 c7 c0 0c 00 00 00 mov rax,0xc
2170 0x48, 0xc7, 0xc0, 0x0c, 0x00, 0x00, 0x00,
2171 // 16: 48 03 45 f8 add rax,QWORD PTR [rsp-0x8]
2172 0x48, 0x03, 0x44, 0x24, 0xf8,
2173 // 1a: 48 89 45 f8 mov QWORD PTR [rsp-0x8],rax
2174 0x48, 0x89, 0x44, 0x24, 0xf8,
2175 // 1e: 48 c7 c0 08 00 00 00 mov rax,0x8
2176 0x48, 0xc7, 0xc0, 0x08, 0x00, 0x00, 0x00,
2177 // 25: 48 89 45 f0 mov QWORD PTR [rsp-0x10],rax
2178 0x48, 0x89, 0x44, 0x24, 0xf0,
2179 // 29: 48 c7 c0 04 00 00 00 mov rax,0x4
2180 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2181 // 30: 48 03 45 f0 add rax,QWORD PTR [rsp-0x10]
2182 0x48, 0x03, 0x44, 0x24, 0xf0,
2183 // 34: 48 03 45 f8 add rax,QWORD PTR [rsp-0x8]
2184 0x48, 0x03, 0x44, 0x24, 0xf8};
2185 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2186 Buffer_make_executable(buf);
2187 uword result = Testing_execute_expr(buf);
2188 ASSERT_EQ(result, Object_encode_integer(10));
2189 AST_heap_free(node);
2190 PASS();
2191}
2192
2193TEST compile_binary_minus(Buffer *buf) {
2194 ASTNode *node = new_binary_call("-", AST_new_integer(5), AST_new_integer(8));
2195 int compile_result = Testing_compile_expr_entry(buf, node);
2196 ASSERT_EQ(compile_result, 0);
2197 byte expected[] = {
2198 // 0: 48 c7 c0 20 00 00 00 mov rax,0x20
2199 0x48, 0xc7, 0xc0, 0x20, 0x00, 0x00, 0x00,
2200 // 7: 48 89 45 f8 mov QWORD PTR [rsp-0x8],rax
2201 0x48, 0x89, 0x44, 0x24, 0xf8,
2202 // b: 48 c7 c0 14 00 00 00 mov rax,0x14
2203 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2204 // 12: 48 2b 45 f8 add rax,QWORD PTR [rsp-0x8]
2205 0x48, 0x2b, 0x44, 0x24, 0xf8};
2206 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2207 Buffer_make_executable(buf);
2208 uword result = Testing_execute_expr(buf);
2209 ASSERT_EQ(result, Object_encode_integer(-3));
2210 AST_heap_free(node);
2211 PASS();
2212}
2213
2214TEST compile_binary_minus_nested(Buffer *buf) {
2215 ASTNode *node = new_binary_call(
2216 "-", new_binary_call("-", AST_new_integer(5), AST_new_integer(1)),
2217 new_binary_call("-", AST_new_integer(4), AST_new_integer(3)));
2218 int compile_result = Testing_compile_expr_entry(buf, node);
2219 ASSERT_EQ(compile_result, 0);
2220 byte expected[] = {
2221 // 4: 48 c7 c0 0c 00 00 00 mov rax,0xc
2222 0x48, 0xc7, 0xc0, 0x0c, 0x00, 0x00, 0x00,
2223 // b: 48 89 45 f8 mov QWORD PTR [rsp-0x8],rax
2224 0x48, 0x89, 0x44, 0x24, 0xf8,
2225 // f: 48 c7 c0 10 00 00 00 mov rax,0x10
2226 0x48, 0xc7, 0xc0, 0x10, 0x00, 0x00, 0x00,
2227 // 16: 48 2b 45 f8 add rax,QWORD PTR [rsp-0x8]
2228 0x48, 0x2b, 0x44, 0x24, 0xf8,
2229 // 1a: 48 89 45 f8 mov QWORD PTR [rsp-0x8],rax
2230 0x48, 0x89, 0x44, 0x24, 0xf8,
2231 // 1e: 48 c7 c0 04 00 00 00 mov rax,0x4
2232 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2233 // 25: 48 89 45 f0 mov QWORD PTR [rsp-0x10],rax
2234 0x48, 0x89, 0x44, 0x24, 0xf0,
2235 // 29: 48 c7 c0 14 00 00 00 mov rax,0x14
2236 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2237 // 30: 48 2b 45 f0 add rax,QWORD PTR [rsp-0x10]
2238 0x48, 0x2b, 0x44, 0x24, 0xf0,
2239 // 34: 48 2b 45 f8 add rax,QWORD PTR [rsp-0x8]
2240 0x48, 0x2b, 0x44, 0x24, 0xf8};
2241 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2242 Buffer_make_executable(buf);
2243 uword result = Testing_execute_expr(buf);
2244 ASSERT_EQ(result, Object_encode_integer(3));
2245 AST_heap_free(node);
2246 PASS();
2247}
2248
2249TEST compile_binary_mul(Buffer *buf) {
2250 ASTNode *node = new_binary_call("*", AST_new_integer(5), AST_new_integer(8));
2251 int compile_result = Testing_compile_expr_entry(buf, node);
2252 ASSERT_EQ(compile_result, 0);
2253 Buffer_make_executable(buf);
2254 uword result = Testing_execute_expr(buf);
2255 ASSERT_EQ_FMT(Object_encode_integer(40), result, "0x%lx");
2256 AST_heap_free(node);
2257 PASS();
2258}
2259
2260TEST compile_binary_mul_nested(Buffer *buf) {
2261 ASTNode *node = new_binary_call(
2262 "*", new_binary_call("*", AST_new_integer(1), AST_new_integer(2)),
2263 new_binary_call("*", AST_new_integer(3), AST_new_integer(4)));
2264 int compile_result = Testing_compile_expr_entry(buf, node);
2265 ASSERT_EQ(compile_result, 0);
2266 Buffer_make_executable(buf);
2267 uword result = Testing_execute_expr(buf);
2268 ASSERT_EQ_FMT(Object_encode_integer(24), result, "0x%lx");
2269 AST_heap_free(node);
2270 PASS();
2271}
2272
2273TEST compile_binary_eq_with_same_address_returns_true(Buffer *buf) {
2274 ASTNode *node = new_binary_call("=", AST_new_integer(5), AST_new_integer(5));
2275 int compile_result = Testing_compile_expr_entry(buf, node);
2276 ASSERT_EQ(compile_result, 0);
2277 Buffer_make_executable(buf);
2278 uword result = Testing_execute_expr(buf);
2279 ASSERT_EQ_FMT(Object_true(), result, "0x%lx");
2280 AST_heap_free(node);
2281 PASS();
2282}
2283
2284TEST compile_binary_eq_with_different_address_returns_false(Buffer *buf) {
2285 ASTNode *node = new_binary_call("=", AST_new_integer(5), AST_new_integer(4));
2286 int compile_result = Testing_compile_expr_entry(buf, node);
2287 ASSERT_EQ(compile_result, 0);
2288 Buffer_make_executable(buf);
2289 uword result = Testing_execute_expr(buf);
2290 ASSERT_EQ_FMT(Object_false(), result, "0x%lx");
2291 AST_heap_free(node);
2292 PASS();
2293}
2294
2295TEST compile_binary_lt_with_left_less_than_right_returns_true(Buffer *buf) {
2296 ASTNode *node = new_binary_call("<", AST_new_integer(-5), AST_new_integer(5));
2297 int compile_result = Testing_compile_expr_entry(buf, node);
2298 ASSERT_EQ(compile_result, 0);
2299 Buffer_make_executable(buf);
2300 uword result = Testing_execute_expr(buf);
2301 ASSERT_EQ_FMT(Object_true(), result, "0x%lx");
2302 AST_heap_free(node);
2303 PASS();
2304}
2305
2306TEST compile_binary_lt_with_left_equal_to_right_returns_false(Buffer *buf) {
2307 ASTNode *node = new_binary_call("<", AST_new_integer(5), AST_new_integer(5));
2308 int compile_result = Testing_compile_expr_entry(buf, node);
2309 ASSERT_EQ(compile_result, 0);
2310 Buffer_make_executable(buf);
2311 uword result = Testing_execute_expr(buf);
2312 ASSERT_EQ_FMT(Object_false(), result, "0x%lx");
2313 AST_heap_free(node);
2314 PASS();
2315}
2316
2317TEST compile_binary_lt_with_left_greater_than_right_returns_false(Buffer *buf) {
2318 ASTNode *node = new_binary_call("<", AST_new_integer(6), AST_new_integer(5));
2319 int compile_result = Testing_compile_expr_entry(buf, node);
2320 ASSERT_EQ(compile_result, 0);
2321 Buffer_make_executable(buf);
2322 uword result = Testing_execute_expr(buf);
2323 ASSERT_EQ_FMT(Object_false(), result, "0x%lx");
2324 AST_heap_free(node);
2325 PASS();
2326}
2327
2328TEST compile_symbol_in_env_returns_value(Buffer *buf) {
2329 ASTNode *node = AST_new_symbol("hello");
2330 Env env0 = Env_bind("hello", 33, /*prev=*/NULL);
2331 Env env1 = Env_bind("world", 66, &env0);
2332 int compile_result =
2333 Compile_expr(buf, node, -kWordSize, &env1, /*labels=*/NULL);
2334 ASSERT_EQ(compile_result, 0);
2335 byte expected[] = {// mov rax, [rsp+33]
2336 0x48, 0x8b, 0x44, 0x24, 33};
2337 EXPECT_EQUALS_BYTES(buf, expected);
2338 AST_heap_free(node);
2339 PASS();
2340}
2341
2342TEST compile_symbol_in_env_returns_first_value(Buffer *buf) {
2343 ASTNode *node = AST_new_symbol("hello");
2344 Env env0 = Env_bind("hello", 55, /*prev=*/NULL);
2345 Env env1 = Env_bind("hello", 66, &env0);
2346 int compile_result =
2347 Compile_expr(buf, node, -kWordSize, &env1, /*labels=*/NULL);
2348 ASSERT_EQ(compile_result, 0);
2349 byte expected[] = {// mov rax, [rsp+66]
2350 0x48, 0x8b, 0x44, 0x24, 66};
2351 EXPECT_EQUALS_BYTES(buf, expected);
2352 AST_heap_free(node);
2353 PASS();
2354}
2355
2356TEST compile_symbol_not_in_env_raises_compile_error(Buffer *buf) {
2357 ASTNode *node = AST_new_symbol("hello");
2358 int compile_result =
2359 Compile_expr(buf, node, -kWordSize, /*varenv=*/NULL, /*labels=*/NULL);
2360 ASSERT_EQ(compile_result, -1);
2361 AST_heap_free(node);
2362 PASS();
2363}
2364
2365TEST compile_let_with_no_bindings(Buffer *buf) {
2366 ASTNode *node = Reader_read("(let () (+ 1 2))");
2367 int compile_result = Testing_compile_expr_entry(buf, node);
2368 ASSERT_EQ(compile_result, 0);
2369 Buffer_make_executable(buf);
2370 uword result = Testing_execute_expr(buf);
2371 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
2372 AST_heap_free(node);
2373 PASS();
2374}
2375
2376TEST compile_let_with_one_binding(Buffer *buf) {
2377 ASTNode *node = Reader_read("(let ((a 1)) (+ a 2))");
2378 int compile_result = Testing_compile_expr_entry(buf, node);
2379 ASSERT_EQ(compile_result, 0);
2380 Buffer_make_executable(buf);
2381 uword result = Testing_execute_expr(buf);
2382 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
2383 AST_heap_free(node);
2384 PASS();
2385}
2386
2387TEST compile_let_with_multiple_bindings(Buffer *buf) {
2388 ASTNode *node = Reader_read("(let ((a 1) (b 2)) (+ a b))");
2389 int compile_result = Testing_compile_expr_entry(buf, node);
2390 ASSERT_EQ(compile_result, 0);
2391 Buffer_make_executable(buf);
2392 uword result = Testing_execute_expr(buf);
2393 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
2394 AST_heap_free(node);
2395 PASS();
2396}
2397
2398TEST compile_nested_let(Buffer *buf) {
2399 ASTNode *node = Reader_read("(let ((a 1)) (let ((b 2)) (+ a b)))");
2400 int compile_result = Testing_compile_expr_entry(buf, node);
2401 ASSERT_EQ(compile_result, 0);
2402 Buffer_make_executable(buf);
2403 uword result = Testing_execute_expr(buf);
2404 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
2405 AST_heap_free(node);
2406 PASS();
2407}
2408
2409TEST compile_let_is_not_let_star(Buffer *buf) {
2410 ASTNode *node = Reader_read("(let ((a 1) (b a)) a)");
2411 int compile_result = Testing_compile_expr_entry(buf, node);
2412 ASSERT_EQ(compile_result, -1);
2413 AST_heap_free(node);
2414 PASS();
2415}
2416
2417TEST compile_if_with_true_cond(Buffer *buf) {
2418 ASTNode *node = Reader_read("(if #t 1 2)");
2419 int compile_result = Testing_compile_expr_entry(buf, node);
2420 ASSERT_EQ(compile_result, 0);
2421 byte expected[] = {
2422 // mov rax, 0x9f
2423 0x48, 0xc7, 0xc0, 0x9f, 0x00, 0x00, 0x00,
2424 // cmp rax, 0x1f
2425 0x48, 0x3d, 0x1f, 0x00, 0x00, 0x00,
2426 // je alternate
2427 0x0f, 0x84, 0x0c, 0x00, 0x00, 0x00,
2428 // mov rax, compile(1)
2429 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2430 // jmp end
2431 0xe9, 0x07, 0x00, 0x00, 0x00,
2432 // alternate:
2433 // mov rax, compile(2)
2434 0x48, 0xc7, 0xc0, 0x08, 0x00, 0x00, 0x00
2435 // end:
2436 };
2437 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2438 Buffer_make_executable(buf);
2439 uword result = Testing_execute_expr(buf);
2440 ASSERT_EQ_FMT(Object_encode_integer(1), result, "0x%lx");
2441 AST_heap_free(node);
2442 PASS();
2443}
2444
2445TEST compile_if_with_false_cond(Buffer *buf) {
2446 ASTNode *node = Reader_read("(if #f 1 2)");
2447 int compile_result = Testing_compile_expr_entry(buf, node);
2448 ASSERT_EQ(compile_result, 0);
2449 byte expected[] = {
2450 // mov rax, 0x1f
2451 0x48, 0xc7, 0xc0, 0x1f, 0x00, 0x00, 0x00,
2452 // cmp rax, 0x1f
2453 0x48, 0x3d, 0x1f, 0x00, 0x00, 0x00,
2454 // je alternate
2455 0x0f, 0x84, 0x0c, 0x00, 0x00, 0x00,
2456 // mov rax, compile(1)
2457 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2458 // jmp end
2459 0xe9, 0x07, 0x00, 0x00, 0x00,
2460 // alternate:
2461 // mov rax, compile(2)
2462 0x48, 0xc7, 0xc0, 0x08, 0x00, 0x00, 0x00
2463 // end:
2464 };
2465 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2466 Buffer_make_executable(buf);
2467 uword result = Testing_execute_expr(buf);
2468 ASSERT_EQ_FMT(Object_encode_integer(2), result, "0x%lx");
2469 AST_heap_free(node);
2470 PASS();
2471}
2472
2473TEST compile_nested_if(Buffer *buf) {
2474 ASTNode *node = Reader_read("(if (< 1 2) (if #f 3 4) 5)");
2475 int compile_result = Testing_compile_expr_entry(buf, node);
2476 ASSERT_EQ(compile_result, 0);
2477 Buffer_make_executable(buf);
2478 uword result = Testing_execute_expr(buf);
2479 ASSERT_EQ_FMT(Object_encode_integer(4), result, "0x%lx");
2480 AST_heap_free(node);
2481 PASS();
2482}
2483
2484TEST compile_cons(Buffer *buf, uword *heap) {
2485 ASTNode *node = Reader_read("(cons 1 2)");
2486 int compile_result = Testing_compile_expr_entry(buf, node);
2487 ASSERT_EQ(compile_result, 0);
2488 // clang-format off
2489 byte expected[] = {
2490 // mov rax, 0x2
2491 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2492 // mov [rsp-8], rax
2493 0x48, 0x89, 0x44, 0x24, 0xf8,
2494 // mov rax, 0x4
2495 0x48, 0xc7, 0xc0, 0x08, 0x00, 0x00, 0x00,
2496 // mov [rsi+Cdr], rax
2497 0x48, 0x89, 0x46, 0x08,
2498 // mov rax, [rsp-8]
2499 0x48, 0x8b, 0x44, 0x24, 0xf8,
2500 // mov [rsi+Car], rax
2501 0x48, 0x89, 0x46, 0x00,
2502 // mov rax, rsi
2503 0x48, 0x89, 0xf0,
2504 // or rax, kPairTag
2505 0x48, 0x83, 0xc8, 0x01,
2506 // add rsi, 2*kWordSize
2507 0x48, 0x81, 0xc6, 0x10, 0x00, 0x00, 0x00,
2508 };
2509 // clang-format on
2510 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2511 Buffer_make_executable(buf);
2512 uword result = Testing_execute_entry(buf, heap);
2513 ASSERT(Object_is_pair(result));
2514 ASSERT_EQ_FMT(Object_encode_integer(1), Object_pair_car(result), "0x%lx");
2515 ASSERT_EQ_FMT(Object_encode_integer(2), Object_pair_cdr(result), "0x%lx");
2516 AST_heap_free(node);
2517 PASS();
2518}
2519
2520TEST compile_two_cons(Buffer *buf, uword *heap) {
2521 ASTNode *node = Reader_read(
2522 "(let ((a (cons 1 2)) (b (cons 3 4))) (cons (cdr a) (cdr b)))");
2523 int compile_result = Testing_compile_expr_entry(buf, node);
2524 ASSERT_EQ(compile_result, 0);
2525 Buffer_make_executable(buf);
2526 uword result = Testing_execute_entry(buf, heap);
2527 ASSERT(Object_is_pair(result));
2528 ASSERT_EQ_FMT(Object_encode_integer(2), Object_pair_car(result), "0x%lx");
2529 ASSERT_EQ_FMT(Object_encode_integer(4), Object_pair_cdr(result), "0x%lx");
2530 AST_heap_free(node);
2531 PASS();
2532}
2533
2534TEST compile_nested_cons(Buffer *buf, uword *heap) {
2535 ASTNode *node = Reader_read("(cons (cons 1 2) (cons 3 4))");
2536 int compile_result = Testing_compile_expr_entry(buf, node);
2537 ASSERT_EQ(compile_result, 0);
2538 Buffer_make_executable(buf);
2539 uword result = Testing_execute_entry(buf, heap);
2540 ASSERT(Object_is_pair(result));
2541 ASSERT(Object_is_pair(Object_pair_car(result)));
2542 ASSERT_EQ_FMT(Object_encode_integer(1),
2543 Object_pair_car(Object_pair_car(result)), "0x%lx");
2544 ASSERT_EQ_FMT(Object_encode_integer(2),
2545 Object_pair_cdr(Object_pair_car(result)), "0x%lx");
2546 ASSERT(Object_is_pair(Object_pair_cdr(result)));
2547 ASSERT_EQ_FMT(Object_encode_integer(3),
2548 Object_pair_car(Object_pair_cdr(result)), "0x%lx");
2549 ASSERT_EQ_FMT(Object_encode_integer(4),
2550 Object_pair_cdr(Object_pair_cdr(result)), "0x%lx");
2551 AST_heap_free(node);
2552 PASS();
2553}
2554
2555TEST compile_car(Buffer *buf, uword *heap) {
2556 ASTNode *node = Reader_read("(car (cons 1 2))");
2557 int compile_result = Testing_compile_expr_entry(buf, node);
2558 ASSERT_EQ(compile_result, 0);
2559 // clang-format off
2560 byte expected[] = {
2561 // mov rax, 0x2
2562 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2563 // mov [rsp-8], rax
2564 0x48, 0x89, 0x44, 0x24, 0xf8,
2565 // mov rax, 0x4
2566 0x48, 0xc7, 0xc0, 0x08, 0x00, 0x00, 0x00,
2567 // mov [rsi+Cdr], rax
2568 0x48, 0x89, 0x46, 0x08,
2569 // mov rax, [rsp-8]
2570 0x48, 0x8b, 0x44, 0x24, 0xf8,
2571 // mov [rsi+Car], rax
2572 0x48, 0x89, 0x46, 0x00,
2573 // mov rax, rsi
2574 0x48, 0x89, 0xf0,
2575 // or rax, kPairTag
2576 0x48, 0x83, 0xc8, 0x01,
2577 // add rsi, 2*kWordSize
2578 0x48, 0x81, 0xc6, 0x10, 0x00, 0x00, 0x00,
2579 // mov rax, [rax-1]
2580 0x48, 0x8b, 0x40, 0xff,
2581 };
2582 // clang-format on
2583 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2584 Buffer_make_executable(buf);
2585 uword result = Testing_execute_entry(buf, heap);
2586 ASSERT_EQ_FMT(Object_encode_integer(1), result, "0x%lx");
2587 AST_heap_free(node);
2588 PASS();
2589}
2590
2591TEST compile_cdr(Buffer *buf, uword *heap) {
2592 ASTNode *node = Reader_read("(cdr (cons 1 2))");
2593 int compile_result = Testing_compile_expr_entry(buf, node);
2594 ASSERT_EQ(compile_result, 0);
2595 // clang-format off
2596 byte expected[] = {
2597 // mov rax, 0x2
2598 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2599 // mov [rsp-8], rax
2600 0x48, 0x89, 0x44, 0x24, 0xf8,
2601 // mov rax, 0x4
2602 0x48, 0xc7, 0xc0, 0x08, 0x00, 0x00, 0x00,
2603 // mov [rsi+Cdr], rax
2604 0x48, 0x89, 0x46, 0x08,
2605 // mov rax, [rsp-8]
2606 0x48, 0x8b, 0x44, 0x24, 0xf8,
2607 // mov [rsi+Car], rax
2608 0x48, 0x89, 0x46, 0x00,
2609 // mov rax, rsi
2610 0x48, 0x89, 0xf0,
2611 // or rax, kPairTag
2612 0x48, 0x83, 0xc8, 0x01,
2613 // add rsi, 2*kWordSize
2614 0x48, 0x81, 0xc6, 0x10, 0x00, 0x00, 0x00,
2615 // mov rax, [rax+7]
2616 0x48, 0x8b, 0x40, 0x07,
2617 };
2618 // clang-format on
2619 EXPECT_ENTRY_CONTAINS_CODE(buf, expected);
2620 Buffer_make_executable(buf);
2621 uword result = Testing_execute_entry(buf, heap);
2622 ASSERT_EQ_FMT(Object_encode_integer(2), result, "0x%lx");
2623 AST_heap_free(node);
2624 PASS();
2625}
2626
2627TEST compile_code_with_no_params(Buffer *buf) {
2628 ASTNode *node = Reader_read("(code () 1)");
2629 int compile_result = Compile_code(buf, node, /*labels=*/NULL);
2630 ASSERT_EQ(compile_result, 0);
2631 // clang-format off
2632 byte expected[] = {
2633 // mov rax, 0x2
2634 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2635 // ret
2636 0xc3,
2637 };
2638 // clang-format on
2639 EXPECT_EQUALS_BYTES(buf, expected);
2640 Buffer_make_executable(buf);
2641 uword result = Testing_execute_expr(buf);
2642 ASSERT_EQ_FMT(Object_encode_integer(1), result, "0x%lx");
2643 AST_heap_free(node);
2644 PASS();
2645}
2646
2647TEST compile_code_with_one_param(Buffer *buf) {
2648 ASTNode *node = Reader_read("(code (x) x)");
2649 int compile_result = Compile_code(buf, node, /*labels=*/NULL);
2650 ASSERT_EQ(compile_result, 0);
2651 // clang-format off
2652 byte expected[] = {
2653 // mov rax, [rsp-8]
2654 0x48, 0x8b, 0x44, 0x24, 0xf8,
2655 // ret
2656 0xc3,
2657 };
2658 // clang-format on
2659 EXPECT_EQUALS_BYTES(buf, expected);
2660 AST_heap_free(node);
2661 PASS();
2662}
2663
2664TEST compile_code_with_two_params(Buffer *buf) {
2665 ASTNode *node = Reader_read("(code (x y) (+ x y))");
2666 int compile_result = Compile_code(buf, node, /*labels=*/NULL);
2667 ASSERT_EQ(compile_result, 0);
2668 // clang-format off
2669 byte expected[] = {
2670 // mov rax, [rsp-16]
2671 0x48, 0x8b, 0x44, 0x24, 0xf0,
2672 // mov [rsp-24], rax
2673 0x48, 0x89, 0x44, 0x24, 0xe8,
2674 // mov rax, [rsp-8]
2675 0x48, 0x8b, 0x44, 0x24, 0xf8,
2676 // add rax, [rsp-24]
2677 0x48, 0x03, 0x44, 0x24, 0xe8,
2678 // ret
2679 0xc3,
2680 };
2681 // clang-format on
2682 EXPECT_EQUALS_BYTES(buf, expected);
2683 AST_heap_free(node);
2684 PASS();
2685}
2686
2687TEST compile_labels_with_no_labels(Buffer *buf) {
2688 ASTNode *node = Reader_read("(labels () 1)");
2689 int compile_result = Compile_entry(buf, node);
2690 ASSERT_EQ(compile_result, 0);
2691 // clang-format off
2692 byte expected[] = {
2693 // mov rsi, rdi
2694 0x48, 0x89, 0xfe,
2695 // jmp 0x00
2696 0xe9, 0x00, 0x00, 0x00, 0x00,
2697 // mov rax, 0x2
2698 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2699 // ret
2700 0xc3,
2701 };
2702 // clang-format on
2703 EXPECT_EQUALS_BYTES(buf, expected);
2704 Buffer_make_executable(buf);
2705 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2706 ASSERT_EQ_FMT(Object_encode_integer(1), result, "0x%lx");
2707 AST_heap_free(node);
2708 PASS();
2709}
2710
2711TEST compile_labels_with_one_label(Buffer *buf) {
2712 ASTNode *node = Reader_read("(labels ((const (code () 5))) 1)");
2713 int compile_result = Compile_entry(buf, node);
2714 ASSERT_EQ(compile_result, 0);
2715 // clang-format off
2716 byte expected[] = {
2717 // mov rsi, rdi
2718 0x48, 0x89, 0xfe,
2719 // jmp 0x08
2720 0xe9, 0x08, 0x00, 0x00, 0x00,
2721 // mov rax, compile(5)
2722 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2723 // ret
2724 0xc3,
2725 // mov rax, 0x2
2726 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2727 // ret
2728 0xc3,
2729 };
2730 // clang-format on
2731 EXPECT_EQUALS_BYTES(buf, expected);
2732 Buffer_make_executable(buf);
2733 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2734 ASSERT_EQ_FMT(Object_encode_integer(1), result, "0x%lx");
2735 AST_heap_free(node);
2736 PASS();
2737}
2738
2739TEST compile_labelcall_with_no_params(Buffer *buf) {
2740 ASTNode *node =
2741 Reader_read("(labels ((const (code () 5))) (labelcall const))");
2742 int compile_result = Compile_entry(buf, node);
2743 ASSERT_EQ(compile_result, 0);
2744 // clang-format off
2745 byte expected[] = {
2746 // mov rsi, rdi
2747 0x48, 0x89, 0xfe,
2748 // jmp 0x08
2749 0xe9, 0x08, 0x00, 0x00, 0x00,
2750 // mov rax, compile(5)
2751 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2752 // ret
2753 0xc3,
2754 // call `const`
2755 0xe8, 0xf3, 0xff, 0xff, 0xff,
2756 // ret
2757 0xc3,
2758 };
2759 // clang-format on
2760 EXPECT_EQUALS_BYTES(buf, expected);
2761 Buffer_make_executable(buf);
2762 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2763 ASSERT_EQ_FMT(Object_encode_integer(5), result, "0x%lx");
2764 AST_heap_free(node);
2765 PASS();
2766}
2767
2768TEST compile_labelcall_with_no_params_and_locals(Buffer *buf) {
2769 ASTNode *node = Reader_read(
2770 "(labels ((const (code () 5))) (let ((a 1)) (labelcall const)))");
2771 int compile_result = Compile_entry(buf, node);
2772 ASSERT_EQ(compile_result, 0);
2773 // clang-format off
2774 byte expected[] = {
2775 // mov rsi, rdi
2776 0x48, 0x89, 0xfe,
2777 // jmp 0x08
2778 0xe9, 0x08, 0x00, 0x00, 0x00,
2779 // mov rax, compile(5)
2780 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2781 // ret
2782 0xc3,
2783 // mov rax, compile(1)
2784 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2785 // mov [rsp-8], rax
2786 0x48, 0x89, 0x44, 0x24, 0xf8,
2787 // sub rsp, 8
2788 0x48, 0x81, 0xec, 0x08, 0x00, 0x00, 0x00,
2789 // call `const`
2790 0xe8, 0xe0, 0xff, 0xff, 0xff,
2791 // add rsp, 8
2792 0x48, 0x81, 0xc4, 0x08, 0x00, 0x00, 0x00,
2793 // ret
2794 0xc3,
2795 };
2796 // clang-format on
2797 EXPECT_EQUALS_BYTES(buf, expected);
2798 Buffer_make_executable(buf);
2799 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2800 ASSERT_EQ_FMT(Object_encode_integer(5), result, "0x%lx");
2801 AST_heap_free(node);
2802 PASS();
2803}
2804
2805TEST compile_labelcall_with_one_param(Buffer *buf) {
2806 ASTNode *node = Reader_read("(labels ((id (code (x) x))) (labelcall id 5))");
2807 int compile_result = Compile_entry(buf, node);
2808 ASSERT_EQ(compile_result, 0);
2809 // clang-format off
2810 byte expected[] = {
2811 // mov rsi, rdi
2812 0x48, 0x89, 0xfe,
2813 // jmp 0x06
2814 0xe9, 0x06, 0x00, 0x00, 0x00,
2815 // mov rax, [rsp-8]
2816 0x48, 0x8b, 0x44, 0x24, 0xf8,
2817 // ret
2818 0xc3,
2819 // mov rax, compile(5)
2820 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2821 // mov [rsp-16], rax
2822 0x48, 0x89, 0x44, 0x24, 0xf0,
2823 // call `id`
2824 0xe8, 0xe9, 0xff, 0xff, 0xff,
2825 // ret
2826 0xc3,
2827 };
2828 // clang-format on
2829 EXPECT_EQUALS_BYTES(buf, expected);
2830 Buffer_make_executable(buf);
2831 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2832 ASSERT_EQ_FMT(Object_encode_integer(5), result, "0x%lx");
2833 AST_heap_free(node);
2834 PASS();
2835}
2836
2837SUITE(object_tests) {
2838 RUN_TEST(encode_positive_integer);
2839 RUN_TEST(encode_negative_integer);
2840 RUN_TEST(encode_char);
2841 RUN_TEST(decode_char);
2842 RUN_TEST(encode_bool);
2843 RUN_TEST(decode_bool);
2844 RUN_TEST(address);
2845}
2846
2847TEST compile_labelcall_with_one_param_and_locals(Buffer *buf) {
2848 ASTNode *node = Reader_read(
2849 "(labels ((id (code (x) x))) (let ((a 1)) (labelcall id 5)))");
2850 int compile_result = Compile_entry(buf, node);
2851 ASSERT_EQ(compile_result, 0);
2852 // clang-format off
2853 byte expected[] = {
2854 // mov rsi, rdi
2855 0x48, 0x89, 0xfe,
2856 // jmp 0x06
2857 0xe9, 0x06, 0x00, 0x00, 0x00,
2858 // mov rax, [rsp-8]
2859 0x48, 0x8b, 0x44, 0x24, 0xf8,
2860 // ret
2861 0xc3,
2862 // mov rax, compile(1)
2863 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2864 // mov [rsp-8], rax
2865 0x48, 0x89, 0x44, 0x24, 0xf8,
2866 // mov rax, compile(5)
2867 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2868 // mov [rsp-24], rax
2869 0x48, 0x89, 0x44, 0x24, 0xe8,
2870 // sub rsp, 8
2871 0x48, 0x81, 0xec, 0x08, 0x00, 0x00, 0x00,
2872 // call `id`
2873 0xe8, 0xd6, 0xff, 0xff, 0xff,
2874 // add rsp, 8
2875 0x48, 0x81, 0xc4, 0x08, 0x00, 0x00, 0x00,
2876 // ret
2877 0xc3,
2878 };
2879 // clang-format on
2880 EXPECT_EQUALS_BYTES(buf, expected);
2881 Buffer_make_executable(buf);
2882 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2883 ASSERT_EQ_FMT(Object_encode_integer(5), result, "0x%lx");
2884 AST_heap_free(node);
2885 PASS();
2886}
2887
2888TEST compile_labelcall_with_two_params_and_locals(Buffer *buf) {
2889 ASTNode *node = Reader_read("(labels ((add (code (x y) (+ x y)))) (let ((a "
2890 "1)) (labelcall add 5 a)))");
2891 int compile_result = Compile_entry(buf, node);
2892 ASSERT_EQ(compile_result, 0);
2893 // clang-format off
2894 byte expected[] = {
2895 // mov rsi, rdi
2896 0x48, 0x89, 0xfe,
2897 // jmp 0x15
2898 0xe9, 0x15, 0x00, 0x00, 0x00,
2899 // mov rax, [rsp-16]
2900 0x48, 0x8b, 0x44, 0x24, 0xf0,
2901 // mov [rsp-24], rax
2902 0x48, 0x89, 0x44, 0x24, 0xe8,
2903 // mov rax, [rsp-8]
2904 0x48, 0x8b, 0x44, 0x24, 0xf8,
2905 // add rax, [rsp-24]
2906 0x48, 0x03, 0x44, 0x24, 0xe8,
2907 // ret
2908 0xc3,
2909 // mov rax, compile(1)
2910 0x48, 0xc7, 0xc0, 0x04, 0x00, 0x00, 0x00,
2911 // mov [rsp-8], rax
2912 0x48, 0x89, 0x44, 0x24, 0xf8,
2913 // mov rax, compile(5)
2914 0x48, 0xc7, 0xc0, 0x14, 0x00, 0x00, 0x00,
2915 // mov [rsp-24], rax
2916 0x48, 0x89, 0x44, 0x24, 0xe8,
2917 // mov rax, [rsp-8]
2918 0x48, 0x8b, 0x44, 0x24, 0xf8,
2919 // mov [rsp-32], rax
2920 0x48, 0x89, 0x44, 0x24, 0xe0,
2921 // sub rsp, 8
2922 0x48, 0x81, 0xec, 0x08, 0x00, 0x00, 0x00,
2923 // call `add`
2924 0xe8, 0xbd, 0xff, 0xff, 0xff,
2925 // add rsp, 8
2926 0x48, 0x81, 0xc4, 0x08, 0x00, 0x00, 0x00,
2927 // ret
2928 0xc3,
2929 };
2930 // clang-format on
2931 EXPECT_EQUALS_BYTES(buf, expected);
2932 Buffer_make_executable(buf);
2933 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2934 ASSERT_EQ_FMT(Object_encode_integer(6), result, "0x%lx");
2935 AST_heap_free(node);
2936 PASS();
2937}
2938
2939TEST compile_nested_labelcall(Buffer *buf) {
2940 ASTNode *node = Reader_read("(labels ((add (code (x y) (+ x y)))"
2941 " (sub (code (x y) (- x y))))"
2942 " (labelcall sub 4 (labelcall add 1 2)))");
2943 int compile_result = Compile_entry(buf, node);
2944 ASSERT_EQ(compile_result, 0);
2945 Buffer_make_executable(buf);
2946 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2947 ASSERT_EQ_FMT(Object_encode_integer(1), result, "0x%lx");
2948 AST_heap_free(node);
2949 PASS();
2950}
2951
2952TEST compile_multilevel_labelcall(Buffer *buf) {
2953 ASTNode *node =
2954 Reader_read("(labels ((add (code (x y) (+ x y)))"
2955 " (add2 (code (x y) (labelcall add x y))))"
2956 " (labelcall add2 1 2))");
2957 int compile_result = Compile_entry(buf, node);
2958 ASSERT_EQ(compile_result, 0);
2959 Buffer_make_executable(buf);
2960 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2961 ASSERT_EQ_FMT(Object_encode_integer(3), result, "0x%lx");
2962 AST_heap_free(node);
2963 PASS();
2964}
2965
2966TEST compile_factorial_labelcall(Buffer *buf) {
2967 ASTNode *node = Reader_read(
2968 "(labels ((factorial (code (x) "
2969 " (if (< x 2) 1 (* x (labelcall factorial (- x 1)))))))"
2970 " (labelcall factorial 5))");
2971 int compile_result = Compile_entry(buf, node);
2972 ASSERT_EQ(compile_result, 0);
2973 Buffer_make_executable(buf);
2974 uword result = Testing_execute_entry(buf, /*heap=*/NULL);
2975 ASSERT_EQ_FMT(Object_encode_integer(120), result, "0x%lx");
2976 AST_heap_free(node);
2977 PASS();
2978}
2979
2980SUITE(ast_tests) {
2981 RUN_TEST(ast_new_pair);
2982 RUN_TEST(ast_pair_car_returns_car);
2983 RUN_TEST(ast_pair_cdr_returns_cdr);
2984 RUN_TEST(ast_new_symbol);
2985}
2986
2987SUITE(reader_tests) {
2988 RUN_TEST(read_with_integer_returns_integer);
2989 RUN_TEST(read_with_negative_integer_returns_integer);
2990 RUN_TEST(read_with_positive_integer_returns_integer);
2991 RUN_TEST(read_with_leading_whitespace_ignores_whitespace);
2992 RUN_TEST(read_with_symbol_returns_symbol);
2993 RUN_TEST(read_with_symbol_with_trailing_digits);
2994 RUN_TEST(read_with_nil_returns_nil);
2995 RUN_TEST(read_with_list_returns_list);
2996 RUN_TEST(read_with_nested_list_returns_list);
2997 RUN_TEST(read_with_char_returns_char);
2998 RUN_TEST(read_with_bool_returns_bool);
2999}
3000
3001SUITE(buffer_tests) {
3002 RUN_BUFFER_TEST(buffer_write8_increases_length);
3003 RUN_TEST(buffer_write8_expands_buffer);
3004 RUN_TEST(buffer_write32_expands_buffer);
3005 RUN_BUFFER_TEST(buffer_write32_writes_little_endian);
3006 RUN_BUFFER_TEST(emit_mov_reg_imm32_emits_modrm);
3007 RUN_BUFFER_TEST(emit_store_reg_indirect_emits_modrm_sib);
3008}
3009
3010SUITE(compiler_tests) {
3011 RUN_BUFFER_TEST(compile_positive_integer);
3012 RUN_BUFFER_TEST(compile_negative_integer);
3013 RUN_BUFFER_TEST(compile_char);
3014 RUN_BUFFER_TEST(compile_true);
3015 RUN_BUFFER_TEST(compile_false);
3016 RUN_BUFFER_TEST(compile_nil);
3017 RUN_BUFFER_TEST(compile_unary_add1);
3018 RUN_BUFFER_TEST(compile_unary_add1_nested);
3019 RUN_BUFFER_TEST(compile_unary_sub1);
3020 RUN_BUFFER_TEST(compile_unary_integer_to_char);
3021 RUN_BUFFER_TEST(compile_unary_char_to_integer);
3022 RUN_BUFFER_TEST(compile_unary_nilp_with_nil_returns_true);
3023 RUN_BUFFER_TEST(compile_unary_nilp_with_non_nil_returns_false);
3024 RUN_BUFFER_TEST(compile_unary_zerop_with_zero_returns_true);
3025 RUN_BUFFER_TEST(compile_unary_zerop_with_non_zero_returns_false);
3026 RUN_BUFFER_TEST(compile_unary_not_with_false_returns_true);
3027 RUN_BUFFER_TEST(compile_unary_not_with_non_false_returns_false);
3028 RUN_BUFFER_TEST(compile_unary_integerp_with_integer_returns_true);
3029 RUN_BUFFER_TEST(compile_unary_integerp_with_non_integer_returns_false);
3030 RUN_BUFFER_TEST(compile_unary_booleanp_with_boolean_returns_true);
3031 RUN_BUFFER_TEST(compile_unary_booleanp_with_non_boolean_returns_false);
3032 RUN_BUFFER_TEST(compile_binary_plus);
3033 RUN_BUFFER_TEST(compile_binary_plus_nested);
3034 RUN_BUFFER_TEST(compile_binary_minus);
3035 RUN_BUFFER_TEST(compile_binary_minus_nested);
3036 RUN_BUFFER_TEST(compile_binary_mul);
3037 RUN_BUFFER_TEST(compile_binary_mul_nested);
3038 RUN_BUFFER_TEST(compile_binary_eq_with_same_address_returns_true);
3039 RUN_BUFFER_TEST(compile_binary_eq_with_different_address_returns_false);
3040 RUN_BUFFER_TEST(compile_binary_lt_with_left_less_than_right_returns_true);
3041 RUN_BUFFER_TEST(compile_binary_lt_with_left_equal_to_right_returns_false);
3042 RUN_BUFFER_TEST(compile_binary_lt_with_left_greater_than_right_returns_false);
3043 RUN_BUFFER_TEST(compile_symbol_in_env_returns_value);
3044 RUN_BUFFER_TEST(compile_symbol_in_env_returns_first_value);
3045 RUN_BUFFER_TEST(compile_symbol_not_in_env_raises_compile_error);
3046 RUN_BUFFER_TEST(compile_let_with_no_bindings);
3047 RUN_BUFFER_TEST(compile_let_with_one_binding);
3048 RUN_BUFFER_TEST(compile_let_with_multiple_bindings);
3049 RUN_BUFFER_TEST(compile_nested_let);
3050 RUN_BUFFER_TEST(compile_let_is_not_let_star);
3051 RUN_BUFFER_TEST(compile_if_with_true_cond);
3052 RUN_BUFFER_TEST(compile_if_with_false_cond);
3053 RUN_BUFFER_TEST(compile_nested_if);
3054 RUN_HEAP_TEST(compile_cons);
3055 RUN_HEAP_TEST(compile_two_cons);
3056 RUN_HEAP_TEST(compile_nested_cons);
3057 RUN_HEAP_TEST(compile_car);
3058 RUN_HEAP_TEST(compile_cdr);
3059 RUN_BUFFER_TEST(compile_code_with_no_params);
3060 RUN_BUFFER_TEST(compile_code_with_one_param);
3061 RUN_BUFFER_TEST(compile_code_with_two_params);
3062 RUN_BUFFER_TEST(compile_labels_with_no_labels);
3063 RUN_BUFFER_TEST(compile_labels_with_one_label);
3064 RUN_BUFFER_TEST(compile_labelcall_with_no_params);
3065 RUN_BUFFER_TEST(compile_labelcall_with_no_params_and_locals);
3066 RUN_BUFFER_TEST(compile_labelcall_with_one_param);
3067 RUN_BUFFER_TEST(compile_labelcall_with_one_param_and_locals);
3068 RUN_BUFFER_TEST(compile_labelcall_with_two_params_and_locals);
3069 RUN_BUFFER_TEST(compile_nested_labelcall);
3070 RUN_BUFFER_TEST(compile_multilevel_labelcall);
3071 RUN_BUFFER_TEST(compile_factorial_labelcall);
3072}
3073
3074// End Tests
3075
3076GREATEST_MAIN_DEFS();
3077
3078int run_tests(int argc, char **argv) {
3079 GREATEST_MAIN_BEGIN();
3080 RUN_SUITE(object_tests);
3081 RUN_SUITE(ast_tests);
3082 RUN_SUITE(reader_tests);
3083 RUN_SUITE(buffer_tests);
3084 RUN_SUITE(compiler_tests);
3085 GREATEST_MAIN_END();
3086}
3087
3088int main(int argc, char **argv) {
3089 assert(argc == 2 && "need filename and only filename");
3090 const char *filename = argv[1];
3091 ASTNode *program = Reader_read(
3092 "(labels ((factorial (code (x) "
3093 " (if (< x 2) 1 (* x (labelcall factorial (- x 1)))))))"
3094 " (labelcall factorial 5))");
3095 int code = Compile_to_file(program, filename);
3096 AST_heap_free(program);
3097 return code;
3098}