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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
#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->fuel = -1;
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_set_fuel(pit_runtime *rt, i64 fuel) {
rt->fuel = fuel;
}
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_vsnprintf(rt, 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");
}
/* check invariants - these should always hold between top-level evaluations! */
void pit_check_invariants(pit_runtime *rt) {
if (rt->saved_bindings->next != 0) {
pit_error(rt, "leaked saved_bindings memory! %ld", rt->saved_bindings->next);
}
if (rt->expr_stack->next != 0) {
pit_error(rt, "leaked expr_stack memory! %ld", rt->expr_stack->next);
}
if (rt->result_stack->next != 0) {
pit_error(rt, "leaked result_stack memory! %ld", rt->result_stack->next);
}
if (rt->compilation_stack->next != 0) {
pit_error(rt, "leaked compilation_stack memory! %ld", rt->compilation_stack->next);
}
if (rt->traversal->next != 0) {
pit_error(rt, "leaked traversal memory! %ld", rt->traversal->next);
}
if (rt->callstack->next != 0) {
pit_error(rt, "leaked callstack memory! %ld", rt->callstack->next);
}
}
pit_value pit_load_bytes(pit_runtime *rt, u8 *data, i64 len) {
pit_lexer lex;
pit_parser parse;
bool eof = false;
pit_value p = PIT_NIL;
pit_value compiled = PIT_NIL;
pit_value ret = PIT_NIL;
pit_lex_bytes(&lex, (char *) data, len);
pit_parser_from_lexer(&parse, &lex);
while (p = pit_parse(rt, &parse, &eof), !eof) {
pit_check_invariants(rt); if (!pit_value_eq(rt->error, PIT_NIL)) return PIT_NIL;
compiled = pit_compile(rt, p);
pit_check_invariants(rt); if (!pit_value_eq(rt->error, PIT_NIL)) return PIT_NIL;
ret = pit_vm_eval(rt, compiled);
pit_check_invariants(rt); if (!pit_value_eq(rt->error, PIT_NIL)) return PIT_NIL;
}
pit_check_invariants(rt); if (!pit_value_eq(rt->error, PIT_NIL)) return PIT_NIL;
return ret;
}
pit_value pit_load_cstr(pit_runtime *rt, char *data) {
i64 len = (i64) pit_libc_string_strlen(data);
return pit_load_bytes(rt, (u8 *) data, len);
}
|
