bernsteinbear.com
this repo has no description
1#include <assert.h>
2#include <stdbool.h>
3#include <stdint.h>
4#include <stdio.h>
5
6typedef uint64_t Object;
7
8extern Object scheme_entry(Object *closure, Object *heap);
9
10#define fixnum_mask 3
11#define fixnum_tag 0
12#define fixnum_shift 2
13#define char_tag 0xf
14#define char_shift 8
15#define obj_false 0x1f
16#define obj_true 0x9f
17#define empty_list 0x2f
18#define heap_mask 7
19#define cons_tag 0x1
20#define vector_tag 0x2
21#define string_tag 0x3
22#define symbol_tag 0x5
23#define closure_tag 0x6
24
25bool is_fixnum(Object obj) {
26 return (obj & fixnum_mask) == fixnum_tag;
27}
28
29int64_t unbox_fixnum(Object obj) {
30 assert(is_fixnum(obj));
31 return ((int64_t)obj) >> fixnum_shift;
32}
33
34bool is_char(Object obj) {
35 return (obj & 0xff) == char_tag;
36}
37
38char unbox_char(Object obj) {
39 assert(is_char(obj));
40 return obj >> char_shift;
41}
42
43bool is_cons(Object obj) {
44 return (obj & heap_mask) == cons_tag;
45}
46
47Object* unbox_heap(Object obj) {
48 return (Object*)(obj & ~heap_mask);
49}
50
51Object car(Object obj) {
52 assert(is_cons(obj));
53 return unbox_heap(obj)[0];
54}
55
56Object cdr(Object obj) {
57 assert(is_cons(obj));
58 return unbox_heap(obj)[1];
59}
60
61bool is_closure(Object obj) {
62 return (obj & heap_mask) == closure_tag;
63}
64
65bool is_empty_list(Object obj) {
66 return obj == empty_list;
67}
68
69void print_obj(Object obj) {
70 FILE *fp = stdout;
71 if (is_fixnum(obj)) {
72 fprintf(fp, "%ld", unbox_fixnum(obj));
73 } else if (is_char(obj)) {
74 fprintf(fp, "'%c'", unbox_char(obj));
75 } else if (obj == obj_true) {
76 fprintf(fp, "#t");
77 } else if (obj == obj_false) {
78 fprintf(fp, "#f");
79 } else if (is_empty_list(obj)) {
80 fprintf(fp, "()");
81 } else if (is_cons(obj)) {
82 fprintf(fp, "(");
83 print_obj(car(obj));
84 fprintf(fp, " . ");
85 print_obj(cdr(obj));
86 fprintf(fp, ")");
87 } else if (is_closure(obj)) {
88 fprintf(fp, "<closure>");
89 } else {
90 fprintf(fp, "<unknown %p>", (void*)obj);
91 }
92}
93
94void println_obj(Object obj) {
95 FILE *fp = stdout;
96 print_obj(obj);
97 fprintf(fp, "\n");
98}
99
100int main() {
101 Object heap[100];
102 Object obj = scheme_entry(NULL, heap);
103 println_obj(obj);
104}