1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
#include <lcq/pit/utils.h>
#include <lcq/pit/lexer.h>
#include <lcq/pit/parser.h>
#include <lcq/pit/runtime.h>
#include <lcq/pit/library.h>
enum pit_value_sort pit_value_sort(pit_value v) {
/* if this isn't a NaN, or it's a quiet NaN, this is a real double */
/* if (((v >> 52) & 0b011111111111) != 0b011111111111 || ((v >> 51) & 0b1) == 1) return PIT_VALUE_SORT_DOUBLE; */
if (((v >> 52) & 0x7ff) != 0x7ff || ((v >> 51) & 1) == 1) return PIT_VALUE_SORT_DOUBLE;
/* otherwise, we've packed something else in the significand
0 for signaling NaN -+
sign --+ +- 1 (NaN)| +- our sort tag + our data
| | | | |
s111111111110ttddddddddddddddddddddddddddddddddddddddddddddddddd */
/* return (v & 0b0000000000000110000000000000000000000000000000000000000000000000) >> 49; */
return (v & 0x6000000000000) >> 49; /* equivalent hex literal */
}
u64 pit_value_data(pit_value v) {
/* return v & 0b0000000000000001111111111111111111111111111111111111111111111111; */
return v & 0x1ffffffffffff;
}
static u64 ref_hash(pit_ref x) { return (u64) x; }
static bool ref_equal(pit_ref x, pit_ref y) { return x == y; }
pit_runtime *pit_runtime_new(u8 *buf, i64 len) {
pit_arena *a = pit_arena_new(buf, len, sizeof(u8));
pit_runtime *ret = pit_arena_alloc_back(a, sizeof(*ret));
i64 heap_size = len / 4;
i64 annotations_size = len / 32;
i64 symtab_size = len / 16;
i64 stack_size = len / 32;
pit_hashtable_key_vtable(pit_ref) vt;
vt.hash = ref_hash;
vt.equal = ref_equal;
ret->heap = pit_arena_new(pit_arena_alloc_back(a, heap_size), heap_size, sizeof(pit_value_heavy));
ret->backbuffer = pit_arena_new(pit_arena_alloc_back(a, heap_size), heap_size, sizeof(pit_value_heavy));
ret->annotations = pit_hashtable_new(pit_ref, pit_annotation)(pit_arena_alloc_back(a, annotations_size), annotations_size, vt);
ret->annotations_backbuffer = pit_hashtable_new(pit_ref, pit_annotation)(pit_arena_alloc_back(a, annotations_size), annotations_size, vt);
ret->symtab = pit_vec_new(pit_symtab_entry)(pit_arena_alloc_back(a, symtab_size), symtab_size);
ret->expr_stack = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size);
ret->result_stack = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size);
ret->compilation_stack = pit_vec_new(pit_compilation_entry)(pit_arena_alloc_back(a, stack_size), stack_size);
ret->traversal = pit_vec_new(pit_traversal_entry)(pit_arena_alloc_back(a, stack_size), stack_size);
ret->callstack = pit_vec_new(pit_callstack_entry)(pit_arena_alloc_back(a, stack_size), stack_size);
ret->saved_bindings = pit_vec_new(pit_value)(pit_arena_alloc_back(a, stack_size), stack_size);
ret->frozen_values = 0;
ret->frozen_symtab = 0;
ret->error = PIT_NIL;
ret->source_line = ret->source_column = -1;
ret->error_line = ret->error_column = -1;
pit_value nil = pit_symtab_intern_cstr(ret, "nil"); /* nil must be the 0th symbol for PIT_NIL to work */
pit_symtab_set(ret, nil, PIT_NIL);
pit_value truth = pit_symtab_intern_cstr(ret, "t");
pit_symtab_set(ret, truth, truth);
pit_compile_install_special_forms(ret);
ret->msg_out_of_memory = pit_value_bytes_new_cstr(ret, "out of memory!");
pit_runtime_freeze(ret);
return ret;
}
void pit_runtime_freeze(pit_runtime *rt) {
rt->frozen_values = rt->heap->next;
rt->frozen_symtab = rt->symtab->next;
}
void pit_runtime_reset(pit_runtime *rt) {
rt->heap->next = rt->frozen_values;
rt->symtab->next = rt->frozen_symtab;
}
pit_value pit_error_get(pit_runtime *rt) {
pit_value ret = rt->error;
rt->error = PIT_NIL;
return ret;
}
void pit_error(pit_runtime *rt, char *format, ...) {
if (rt->error == PIT_NIL) { /* only record the first error encountered */
char buf[1024] = {0};
va_list vargs;
va_start(vargs, format);
pit_libc_string_vsnprintf(buf, sizeof(buf), format, vargs);
va_end(vargs);
rt->error = rt->msg_out_of_memory; /* we set the error now to prevent infinite recursion */
rt->error = pit_value_bytes_new_cstr(rt, buf); /* in case this errs also */
if (rt->error == PIT_NIL) rt->error = rt->msg_out_of_memory;
rt->error_line = rt->source_line;
rt->error_column = rt->source_column;
}
}
void pit_annotation_set(struct pit_runtime *rt, pit_ref ref, pit_annotation annotation) {
if (pit_hashtable_insert(pit_ref, pit_annotation)(rt->annotations, ref, annotation) < 0)
pit_error(rt, "annotation overflow");
}
pit_annotation *pit_annotation_get(struct pit_runtime *rt, pit_ref ref) {
return pit_hashtable_lookup(pit_ref, pit_annotation)(rt->annotations, ref);
}
void pit_compilation_push_value(struct pit_runtime *rt, pit_vec(pit_compilation_entry) *s, pit_value x) {
pit_compilation_entry ent;
ent.sort = PIT_COMPILATION_ENTRY_VALUE;
ent.in.value = x;
if (pit_vec_push(pit_compilation_entry)(s, ent) < 0)
pit_error(rt, "compilation stack overflow");
}
void pit_compilation_push_drop(struct pit_runtime *rt, pit_vec(pit_compilation_entry) *s) {
pit_compilation_entry ent;
ent.sort = PIT_COMPILATION_ENTRY_DROP;
if (pit_vec_push(pit_compilation_entry)(s, ent) < 0)
pit_error(rt, "compilation stack overflow");
}
void pit_compilation_push_begin_code(struct pit_runtime *rt, pit_vec(pit_compilation_entry) *s) {
pit_compilation_entry ent;
ent.sort = PIT_COMPILATION_ENTRY_BEGIN_CODE;
if (pit_vec_push(pit_compilation_entry)(s, ent) < 0)
pit_error(rt, "compilation stack overflow");
}
void pit_compilation_push_end_code(struct pit_runtime *rt, pit_vec(pit_compilation_entry) *s) {
pit_compilation_entry ent;
ent.sort = PIT_COMPILATION_ENTRY_END_CODE;
if (pit_vec_push(pit_compilation_entry)(s, ent) < 0)
pit_error(rt, "compilation stack overflow");
}
void pit_traversal_push_value(struct pit_runtime *rt, pit_vec(pit_traversal_entry) *s, pit_value x) {
pit_traversal_entry ent;
ent.sort = PIT_TRAVERSAL_ENTRY_VALUE;
ent.in.value = x;
if (pit_vec_push(pit_traversal_entry)(s, ent) < 0)
pit_error(rt, "traversal overflow");
}
void pit_traversal_push_dump_string(struct pit_runtime *rt, pit_vec(pit_traversal_entry) *s, char *m) {
pit_traversal_entry ent;
ent.sort = PIT_TRAVERSAL_ENTRY_DUMP_STRING;
ent.in.dump_string = m;
if (pit_vec_push(pit_traversal_entry)(s, ent) < 0)
pit_error(rt, "traversal overflow");
}
void pit_traversal_push_application(struct pit_runtime *rt, pit_vec(pit_traversal_entry) *s, i64 arity, pit_annotation *annotation) {
pit_traversal_entry ent;
ent.sort = PIT_TRAVERSAL_ENTRY_APPLICATION;
ent.in.application.arity = arity;
ent.in.application.annotation = annotation;
if (pit_vec_push(pit_traversal_entry)(s, ent) < 0)
pit_error(rt, "traversal overflow");
}
void pit_traversal_push_begin_code(struct pit_runtime *rt, pit_vec(pit_traversal_entry) *s) {
pit_traversal_entry ent;
ent.sort = PIT_TRAVERSAL_ENTRY_BEGIN_CODE;
if (pit_vec_push(pit_traversal_entry)(s, ent) < 0)
pit_error(rt, "traversal overflow");
}
void pit_traversal_push_end_code(struct pit_runtime *rt, pit_vec(pit_traversal_entry) *s) {
pit_traversal_entry ent;
ent.sort = PIT_TRAVERSAL_ENTRY_END_CODE;
if (pit_vec_push(pit_traversal_entry)(s, ent) < 0)
pit_error(rt, "traversal overflow");
}
|
