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