tons more renaming to ubik
Haldean Brown
6 years ago
0 | expelc/expelc | |
1 | expelc/expeli | |
2 | runexpel/runexpel | |
0 | ub/ubic | |
1 | ub/ubi | |
2 | ubik/ubik | |
3 | 3 | |
4 | 4 | dist |
5 | 5 | build |
0 | SUBDIRS = include libexpel expelc runexpel test/unit test/pyasm test/prog | |
0 | SUBDIRS = include libubik ub ubik test/unit test/pyasm test/prog |
0 | Architecture of the Expel Runtime ====================================== | |
0 | Architecture of the Ubik Runtime ======================================= | |
1 | 1 | Haldean Brown First draft: Nov 2015 |
2 | 2 | Last updated: Mar 2016 |
3 | 3 | |
4 | 4 | |
5 | 5 | This document attempts to fully explain the implementation and behavior |
6 | of the Expel runtime. When the code and this document disagree, the code | |
6 | of the Ubik runtime. When the code and this document disagree, the code | |
7 | 7 | is incorrect; on the other hand, don't trust anything in this document. |
8 | 8 | |
9 | 9 | |
10 | 10 | Structure of the project ----------------------------------------------- |
11 | 11 | |
12 | 12 | The project itself is divided into a few software components. By far the |
13 | most interesting is libexpel, which is the shared library that contains | |
14 | the entirety of the Expel runtime. There's runexpel, which is a simple | |
15 | thing that uses libexpel to load and run Expel bytecode. There's expelc | |
16 | and expeli, which are a compiler and interpreter, respectively; both are | |
17 | thin wrappers around libexpel, which contains the actual compiler | |
13 | most interesting is libubik, which is the shared library that contains | |
14 | the entirety of the Ubik runtime. There's runubik, which is a simple | |
15 | thing that uses libubik to load and run Ubik bytecode. There's ubikc | |
16 | and ubiki, which are a compiler and interpreter, respectively; both are | |
17 | thin wrappers around libubik, which contains the actual compiler | |
18 | 18 | implementation. And then there's pyasm, which is a hilarious "assembler" |
19 | 19 | written as a Python DSL; pyasm will be gone the moment there's a working |
20 | Expel compiler, but for now, with my focus on the runtime, pyasm is here | |
20 | Ubik compiler, but for now, with my focus on the runtime, pyasm is here | |
21 | 21 | to stay. |
22 | 22 | |
23 | 23 | There are unit tests and "integration tests"; unit tests are haphazard |
25 | 25 | test/pyasm/*.xlpy) are pretty comprehensive. You can run all of the |
26 | 26 | tests by running `make check`. |
27 | 27 | |
28 | To build and test expel, run the following commands: | |
28 | To build and test ubik, run the following commands: | |
29 | 29 | |
30 | 30 | ./configure |
31 | 31 | make check |
32 | 32 | |
33 | If the configure script is not present (i.e., you got Expel from git | |
33 | If the configure script is not present (i.e., you got Ubik from git | |
34 | 34 | instead of from a tarball), you will need to run: |
35 | 35 | |
36 | 36 | autoreconf --install |
37 | 37 | |
38 | 38 | Before you run anything else. When you're done with all that, the |
39 | compiler will be present at expelc/expelc, the interpreter will be at | |
40 | expelc/expeli and the runtime will be at runexpel/runexpel. To install | |
39 | compiler will be present at ubikc/ubikc, the interpreter will be at | |
40 | ubikc/ubiki and the runtime will be at runubik/runubik. To install | |
41 | 41 | these to your system path (along with the headers and static library), |
42 | 42 | use: |
43 | 43 | |
48 | 48 | It does some simple checks to make sure that you're not doing anything |
49 | 49 | dumb. |
50 | 50 | |
51 | For completeness, building Expel requires: | |
51 | For completeness, building Ubik requires: | |
52 | 52 | |
53 | 53 | - GCC 4.9 or later (it's possible that the build works with other |
54 | 54 | versions of GCC and with clang, but they're untested) |
56 | 56 | - Flex 2.6 or later |
57 | 57 | - GNU autoconf 2.69 or later |
58 | 58 | |
59 | Expel has no runtime dependencies outside of libc. The rest of this | |
59 | Ubik has no runtime dependencies outside of libc. The rest of this | |
60 | 60 | document is more interesting, I promise. |
61 | 61 | |
62 | 62 | |
63 | 63 | Runtime representations ------------------------------------------------ |
64 | 64 | |
65 | Expel is based on a simple primitive: unbalanced binary trees of 64-bit | |
65 | Ubik is based on a simple primitive: unbalanced binary trees of 64-bit | |
66 | 66 | values (called "words"). Everything is expressed in this way, from |
67 | 67 | integers to types to functions; this homogeneity of data representation |
68 | 68 | allows us to simplify otherwise-complicated tasks and has a satisfying |
69 | 69 | purity. Note that the in-memory representation is extremely close to the |
70 | on-disk representation of compiled Expel programs. | |
70 | on-disk representation of compiled Ubik programs. | |
71 | 71 | |
72 | 72 | Each node in the tree has a left value, a right value, and a tag. Each |
73 | 73 | value can be one of two things: a pointer to another node or a word; the |
109 | 109 | they are identified only by an integer constant; derived types (quite |
110 | 110 | predictably) require quite a bit more information about the type itself. |
111 | 111 | |
112 | The base types of Expel are a few flavors of integer, lists and tuples. | |
112 | The base types of Ubik are a few flavors of integer, lists and tuples. | |
113 | 113 | Each of these has a base type code and comes with a tree encoding. The |
114 | 114 | full list of base type codes is: |
115 | 115 | |
170 | 170 | appear on the left of a typed value is a type descriptor value, and |
171 | 171 | could appear on the right of a type node. |
172 | 172 | |
173 | A resource identifier is how all entities within the expel runtime are | |
173 | A resource identifier is how all entities within the ubik runtime are | |
174 | 174 | identified. Resources all have a name, author, version and scope; all of |
175 | 175 | these are encoded in the URI tree. The left of a URI tree is the |
176 | 176 | constant word `uri`, and the right is a cons-cell list, where the first |
184 | 184 | |
185 | 185 | Building logic --------------------------------------------------------- |
186 | 186 | |
187 | Logic in Expel is encoded in a directed acyclic graph of computations | |
187 | Logic in Ubik is encoded in a directed acyclic graph of computations | |
188 | 188 | (DAGC); nodes in this graph then reference values stored as trees. There |
189 | 189 | are four kinds of nodes in a DAGC: |
190 | 190 | |
213 | 213 | evaluating them just calls the associated native |
214 | 214 | code block. That code block then fills in the result |
215 | 215 | of the compuation over the graph on the native node. |
216 | Reading native nodes in from expel bytecode is not | |
216 | Reading native nodes in from ubik bytecode is not | |
217 | 217 | supported; this is only a construct used internally |
218 | 218 | in the runtime. |
219 | 219 | `ref` This node has the value of another node in the |
230 | 230 | terminal nodes is found, and all nodes in that set are evaluated in |
231 | 231 | turn. This gives the result for the DAGC. Once evaluated, the DAGC is |
232 | 232 | semantically and computationally equivalent to a single value; this is |
233 | possible because all functions in Expel are idempotent, and thus a | |
233 | possible because all functions in Ubik are idempotent, and thus a | |
234 | 234 | zero-arity function is equivalent to a value. |
235 | 235 | |
236 | 236 | Logic is then built up by creating a number of graphs and referencing |
239 | 239 | completed. Once all required input nodes have been completed, the DAGC |
240 | 240 | can be evaluated. |
241 | 241 | |
242 | An expel bytecode blob contains some number of graphs; the various | |
242 | An ubik bytecode blob contains some number of graphs; the various | |
243 | 243 | graphs can reference each other, and in general their ordering in the |
244 | 244 | bytecode does not matter. There is only one exception: when evaluating a |
245 | 245 | bytecode blob, the first graph is considered to represent the desired |
249 | 249 | |
250 | 250 | Encoding in-flight and at-rest ----------------------------------------- |
251 | 251 | |
252 | Expel bytecode has a single binary storage format that is used for | |
252 | Ubik bytecode has a single binary storage format that is used for | |
253 | 253 | network operations and for on-disk storage. The format begins with a |
254 | 254 | header, and then contains a number of encoded graphs. |
255 | 255 | |
368 | 368 | Byte index Field |
369 | 369 | 0-7 Node index of referrent node |
370 | 370 | |
371 | Expel bytecode blobs may have arbitrary data following the data encoded | |
371 | Ubik bytecode blobs may have arbitrary data following the data encoded | |
372 | 372 | by the standard; conforming parsers will ignore the data that follows |
373 | 373 | the encoded graphs. This is provided as a means for tools to attach |
374 | 374 | metadata onto the end of the bytecode if so desired. |
375 | 375 | |
376 | 376 | Compilation ------------------------------------------------------------ |
377 | 377 | |
378 | The compiler for Expel is distributed as part of the Expel library; a | |
378 | The compiler for Ubik is distributed as part of the Ubik library; a | |
379 | 379 | compiler executable can be built using: |
380 | 380 | |
381 | $ make dist/expelc | |
382 | $ dist/expelc path/to/file.xl out.xlb | |
381 | $ make dist/ubic | |
382 | $ dist/ubic path/to/file.xl out.xlb | |
383 | 383 | |
384 | 384 | The process of creating an executable is divided into two phases, not |
385 | 385 | unlike compilation for C and other native languages: compilation and |
390 | 390 | the details away from the user, but they still get the advantage of |
391 | 391 | fast, incremental builds. |
392 | 392 | |
393 | Compilation begins by loading the given Expel file and generating code | |
393 | Compilation begins by loading the given Ubik file and generating code | |
394 | 394 | for the module (see below). In general, at the end of this process there |
395 | 395 | are still unresolved references; we collect all of the imports that |
396 | 396 | provide those references, and find the files that provide the requisite |
1 | 1 | # Process this file with autoconf to produce a configure script. |
2 | 2 | |
3 | 3 | AC_PREREQ([2.69]) |
4 | AC_INIT([expel], [0.1], [expel@haldean.org]) | |
4 | AC_INIT([ubik], [0.1], [ubik@haldean.org]) | |
5 | 5 | |
6 | 6 | # Use automake to compile Makefile.ac to Makefile.in |
7 | 7 | AM_INIT_AUTOMAKE([foreign -Wall -Werror]) |
8 | 8 | |
9 | 9 | # Make sure we're running in the right directory |
10 | AC_CONFIG_SRCDIR([libexpel/rt.c]) | |
10 | AC_CONFIG_SRCDIR([libubik/rt.c]) | |
11 | 11 | |
12 | 12 | AC_CONFIG_HEADERS([config.h]) |
13 | 13 | |
44 | 44 | AC_FUNC_REALLOC |
45 | 45 | AC_CHECK_FUNCS([backtrace backtrace_symbols_fd bzero clock_gettime fmemopen getcwd memmove memset strdup]) |
46 | 46 | |
47 | AC_CONFIG_FILES([Makefile include/Makefile expelc/Makefile libexpel/Makefile | |
48 | runexpel/Makefile test/prog/Makefile test/unit/Makefile | |
47 | AC_CONFIG_FILES([Makefile include/Makefile ub/Makefile libubik/Makefile | |
48 | ubik/Makefile test/prog/Makefile test/unit/Makefile | |
49 | 49 | test/pyasm/Makefile]) |
50 | 50 | AC_OUTPUT |
0 | include ../res/build-config.am | |
1 | ||
2 | bin_PROGRAMS = expelc expeli | |
3 | ||
4 | expelc_LDADD = ../libexpel/libexpel.a | |
5 | expeli_LDADD = ../libexpel/libexpel.a |
0 | /* | |
1 | * expelc.c: expel compiler | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | ||
20 | #include <stdio.h> | |
21 | #include <stdlib.h> | |
22 | #include <string.h> | |
23 | ||
24 | #include "ubik/compile.h" | |
25 | #include "ubik/env.h" | |
26 | #include "ubik/ubik.h" | |
27 | #include "ubik/parse.h" | |
28 | #include "ubik/schedule.h" | |
29 | #include "ubik/value.h" | |
30 | ||
31 | #define c(x) \ | |
32 | do { \ | |
33 | err = x; \ | |
34 | if (err != OK) \ | |
35 | { \ | |
36 | char *expl = xl_error_explain(err); \ | |
37 | printf("%s\n", expl); \ | |
38 | free(err); free(expl); \ | |
39 | goto teardown; \ | |
40 | } } while(0) | |
41 | ||
42 | void | |
43 | usage() | |
44 | { | |
45 | printf("expelc compiles expel source code to bytecode\n"); | |
46 | printf("usage: expelc SOURCE OUT\n"); | |
47 | } | |
48 | ||
49 | int | |
50 | main(int argc, char *argv[]) | |
51 | { | |
52 | struct xl_dagc **graphs = NULL; | |
53 | struct xl_stream in, out; | |
54 | size_t i; | |
55 | size_t n_graphs = 0; | |
56 | xl_error err; | |
57 | struct xl_compilation_env env; | |
58 | char *source_name; | |
59 | ||
60 | if (argc != 3) | |
61 | { | |
62 | usage(); | |
63 | return EXIT_FAILURE; | |
64 | } | |
65 | ||
66 | c(xl_start()); | |
67 | ||
68 | source_name = argv[1]; | |
69 | if (xl_stream_rfile(&in, source_name) != OK) | |
70 | { | |
71 | printf("could not open %s for reading\n", argv[1]); | |
72 | return EXIT_FAILURE; | |
73 | } | |
74 | if (xl_stream_wfile(&out, argv[2]) != OK) | |
75 | { | |
76 | printf("could not open %s for writing\n", argv[2]); | |
77 | return EXIT_FAILURE; | |
78 | } | |
79 | ||
80 | c(xl_compile_env_default(&env)); | |
81 | c(xl_compile(&graphs, &n_graphs, source_name, &in, &env)); | |
82 | c(xl_compile_env_free(&env)); | |
83 | c(xl_save(&out, graphs, n_graphs)); | |
84 | ||
85 | teardown: | |
86 | xl_stream_close(&in); | |
87 | xl_stream_close(&out); | |
88 | ||
89 | for (i = 0; i < n_graphs; i++) | |
90 | { | |
91 | if (xl_release(graphs[i]) != OK) | |
92 | printf("error when releasing graph\n"); | |
93 | } | |
94 | ||
95 | free(graphs); | |
96 | ||
97 | if (xl_teardown() != OK) | |
98 | printf("error when tearing down runtime\n"); | |
99 | ||
100 | return err == OK ? EXIT_SUCCESS : EXIT_FAILURE; | |
101 | } | |
102 |
0 | /* | |
1 | * expeli.c: expel interpreter | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | ||
20 | #include <stdio.h> | |
21 | #include <stdlib.h> | |
22 | #include <string.h> | |
23 | ||
24 | #include "ubik/ast.h" | |
25 | #include "ubik/compile.h" | |
26 | #include "ubik/env.h" | |
27 | #include "ubik/ubik.h" | |
28 | #include "ubik/parse.h" | |
29 | #include "ubik/resolve.h" | |
30 | #include "ubik/schedule.h" | |
31 | #include "ubik/value.h" | |
32 | ||
33 | #define c(x) \ | |
34 | do { \ | |
35 | err = x; \ | |
36 | if (err != OK) \ | |
37 | { \ | |
38 | char *expl = xl_error_explain(err); \ | |
39 | printf("%s\n", expl); \ | |
40 | free(err); free(expl); \ | |
41 | goto teardown; \ | |
42 | } } while(0) | |
43 | ||
44 | int | |
45 | main(int argc, char *argv[]) | |
46 | { | |
47 | struct xl_ast *ast; | |
48 | struct xl_dagc **graphs; | |
49 | struct xl_stream sstdin; | |
50 | struct xl_env env = {0}; | |
51 | struct xl_scheduler *s; | |
52 | local(resolve_context) struct xl_resolve_context rctx = {0}; | |
53 | size_t n_graphs; | |
54 | size_t i; | |
55 | xl_error err; | |
56 | xl_error teardown_err; | |
57 | xl_error parse_err; | |
58 | char *buf; | |
59 | ||
60 | ast = NULL; | |
61 | graphs = NULL; | |
62 | s = NULL; | |
63 | ||
64 | c(xl_start()); | |
65 | ||
66 | c(xl_stream_rfilep(&sstdin, stdin)); | |
67 | ||
68 | parse_err = xl_parse(&ast, "(stdin)", &sstdin); | |
69 | if (parse_err == OK) | |
70 | parse_err = xl_resolve(ast, "(stdin)", &sstdin, &rctx); | |
71 | if (argc > 1 && strcmp(argv[1], "emit-ast") == 0) | |
72 | err = xl_ast_print(ast); | |
73 | c(parse_err); | |
74 | c(err); | |
75 | ||
76 | c(xl_compile_ast(&graphs, &n_graphs, ast, NULL)); | |
77 | ||
78 | c(xl_env_init(&env)); | |
79 | ||
80 | c(xl_schedule_new(&s)); | |
81 | c(xl_schedule_push(s, graphs[0], &env, NULL)); | |
82 | c(xl_schedule_run(s)); | |
83 | ||
84 | teardown: | |
85 | if (ast != NULL) | |
86 | { | |
87 | teardown_err = xl_ast_free(ast); | |
88 | if (teardown_err != OK) | |
89 | { | |
90 | buf = xl_error_explain(teardown_err); | |
91 | printf("error when freeing ast: %s\n", buf); | |
92 | free(buf); | |
93 | free(teardown_err); | |
94 | } | |
95 | } | |
96 | ||
97 | if (s != NULL) | |
98 | { | |
99 | teardown_err = xl_schedule_free(s); | |
100 | if (teardown_err != OK) | |
101 | { | |
102 | buf = xl_error_explain(teardown_err); | |
103 | printf("error when freeing scheduler: %s\n", buf); | |
104 | free(buf); | |
105 | free(teardown_err); | |
106 | } | |
107 | free(s); | |
108 | } | |
109 | ||
110 | if (graphs != NULL) | |
111 | { | |
112 | for (i = 0; i < n_graphs; i++) | |
113 | { | |
114 | if (graphs[i] == NULL) | |
115 | continue; | |
116 | teardown_err = xl_release(graphs[i]); | |
117 | if (teardown_err != OK) | |
118 | { | |
119 | buf = xl_error_explain(teardown_err); | |
120 | printf("graph release failed: %s\n", buf); | |
121 | free(buf); | |
122 | free(teardown_err); | |
123 | } | |
124 | } | |
125 | free(graphs); | |
126 | } | |
127 | ||
128 | teardown_err = xl_env_free(&env); | |
129 | if (teardown_err != OK) | |
130 | { | |
131 | buf = xl_error_explain(teardown_err); | |
132 | printf("error when freeing environment: %s\n", buf); | |
133 | free(buf); | |
134 | free(teardown_err); | |
135 | } | |
136 | ||
137 | teardown_err = xl_teardown(); | |
138 | if (teardown_err != OK) | |
139 | { | |
140 | buf = xl_error_explain(teardown_err); | |
141 | printf("error when tearing down runtime: %s\n", buf); | |
142 | free(buf); | |
143 | free(teardown_err); | |
144 | } | |
145 | ||
146 | return err == OK ? EXIT_SUCCESS : EXIT_FAILURE; | |
147 | } | |
148 |
0 | lib_LIBRARIES = libexpel.a | |
1 | libexpel_a_SOURCES = store.c error.c uri.c gen.c timer.c eval.c load.c gc.c pointerset.c compile.c string.c schedule.c natives.c types.c print-ast.c value.c bdagc.c assert.c explain.c ast.c dagc.c parse.c util.c rt.c stream.c env.c token.l grammar.y uri-value.tree humanize-poly.tree vector.c resolve.c closure.c streamutil.c | |
2 | BUILT_SOURCES = grammar.h uri-value.h humanize-poly.h | |
3 | ||
4 | libexpel_a_CFLAGS = -std=c11 -Werror -Wall -Wextra -fno-strict-aliasing -rdynamic -Wswitch-enum -fPIC | |
5 | libexpel_a_CPPFLAGS = -I$(top_srcdir)/include/ -D_GNU_SOURCE #-D_FORTIFY_SOURCE=2 | |
6 | AM_YFLAGS = -d --report=state -Wall -Werror | |
7 | ||
8 | .tree.h: | |
9 | $(PYTHON) ../res/buildtree/buildtree.py $< $@ |
0 | /* | |
1 | * assert.h: compile-conditional assertions | |
2 | * Copyright (C) 2015, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include "ubik/assert.h" | |
20 | ||
21 | int | |
22 | break_on_assert() | |
23 | { | |
24 | return 0; | |
25 | } |
0 | /* | |
1 | * ast.c: in-memory ast representation | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include "ubik/assert.h" | |
20 | #include "ubik/ast.h" | |
21 | ||
22 | #include <stdlib.h> | |
23 | #include <string.h> | |
24 | ||
25 | #define check_alloc(x, nelem, contents) { \ | |
26 | (x) = calloc(nelem, sizeof(contents)); \ | |
27 | if ((x) == NULL) return xl_raise(ERR_NO_MEMORY, ""); } | |
28 | ||
29 | /* Allocates a new AST. */ | |
30 | no_ignore xl_error | |
31 | xl_ast_new(struct xl_ast **ast) | |
32 | { | |
33 | check_alloc(*ast, 1, struct xl_ast); | |
34 | return OK; | |
35 | } | |
36 | ||
37 | no_ignore static xl_error | |
38 | _free_atom(struct xl_ast_atom *atom) | |
39 | { | |
40 | switch (atom->atom_type) | |
41 | { | |
42 | case ATOM_NAME: | |
43 | case ATOM_TYPE_NAME: | |
44 | case ATOM_STRING: | |
45 | free(atom->str); | |
46 | break; | |
47 | ||
48 | case ATOM_QUALIFIED: | |
49 | free(atom->qualified.head); | |
50 | free(atom->qualified.tail); | |
51 | ||
52 | case ATOM_NUM: | |
53 | case ATOM_INT: | |
54 | break; | |
55 | ||
56 | default: | |
57 | return xl_raise(ERR_BAD_TYPE, "unknown atom type in free"); | |
58 | } | |
59 | ||
60 | free(atom); | |
61 | return OK; | |
62 | } | |
63 | ||
64 | no_ignore static xl_error | |
65 | _free_arg_list(struct xl_ast_arg_list *arg_list) | |
66 | { | |
67 | struct xl_ast_arg_list *next; | |
68 | ||
69 | while (arg_list != NULL) | |
70 | { | |
71 | next = arg_list->next; | |
72 | if (arg_list->name != NULL) | |
73 | free(arg_list->name); | |
74 | if (arg_list->gen != NULL) | |
75 | free(arg_list->gen); | |
76 | free(arg_list); | |
77 | arg_list = next; | |
78 | } | |
79 | return OK; | |
80 | } | |
81 | ||
82 | no_ignore static xl_error | |
83 | _free_expr(struct xl_ast_expr *expr) | |
84 | { | |
85 | xl_error err; | |
86 | ||
87 | switch (expr->expr_type) | |
88 | { | |
89 | case EXPR_ATOM: | |
90 | err = _free_atom(expr->atom); | |
91 | break; | |
92 | case EXPR_APPLY: | |
93 | err = _free_expr(expr->apply.head); | |
94 | if (err != OK) | |
95 | return err; | |
96 | err = _free_expr(expr->apply.tail); | |
97 | break; | |
98 | case EXPR_LAMBDA: | |
99 | err = _free_expr(expr->lambda.body); | |
100 | if (err != OK) | |
101 | return err; | |
102 | err = _free_arg_list(expr->lambda.args); | |
103 | break; | |
104 | case EXPR_CONSTRUCTOR: | |
105 | free(expr->constructor.type_name); | |
106 | err = xl_ast_free(expr->constructor.scope); | |
107 | break; | |
108 | case EXPR_CONDITIONAL: | |
109 | err = _free_expr(expr->condition.cond); | |
110 | if (err != OK) | |
111 | return err; | |
112 | err = _free_expr(expr->condition.implied); | |
113 | if (err != OK) | |
114 | return err; | |
115 | err = _free_expr(expr->condition.opposed); | |
116 | break; | |
117 | case EXPR_BLOCK: | |
118 | err = xl_ast_free(expr->block); | |
119 | break; | |
120 | default: | |
121 | return xl_raise(ERR_BAD_TYPE, "unknown expr type in free"); | |
122 | } | |
123 | ||
124 | if (err != OK) | |
125 | return err; | |
126 | ||
127 | if (expr->gen != NULL) | |
128 | free(expr->gen); | |
129 | free(expr); | |
130 | return OK; | |
131 | } | |
132 | ||
133 | no_ignore static xl_error | |
134 | _free_type_expr(struct xl_ast_type_expr *type_expr) | |
135 | { | |
136 | xl_error err; | |
137 | ||
138 | switch (type_expr->type_expr_type) | |
139 | { | |
140 | case TYPE_EXPR_ATOM: | |
141 | free(type_expr->name); | |
142 | break; | |
143 | ||
144 | case TYPE_EXPR_APPLY: | |
145 | err = _free_type_expr(type_expr->apply.head); | |
146 | if (err != OK) | |
147 | return err; | |
148 | err = _free_type_expr(type_expr->apply.tail); | |
149 | if (err != OK) | |
150 | return err; | |
151 | break; | |
152 | } | |
153 | ||
154 | free(type_expr); | |
155 | return OK; | |
156 | } | |
157 | ||
158 | no_ignore static xl_error | |
159 | _free_binding(struct xl_ast_binding *binding) | |
160 | { | |
161 | xl_error err; | |
162 | ||
163 | free(binding->name); | |
164 | ||
165 | err = _free_expr(binding->expr); | |
166 | if (err != OK) | |
167 | return err; | |
168 | ||
169 | if (binding->type_expr != NULL) | |
170 | { | |
171 | err = _free_type_expr(binding->type_expr); | |
172 | if (err != OK) | |
173 | return err; | |
174 | } | |
175 | ||
176 | free(binding); | |
177 | return OK; | |
178 | } | |
179 | ||
180 | no_ignore static xl_error | |
181 | _free_member_list(struct xl_ast_member_list *member_list) | |
182 | { | |
183 | xl_error err; | |
184 | ||
185 | if (member_list->next) | |
186 | { | |
187 | err = _free_member_list(member_list->next); | |
188 | if (err != OK) | |
189 | return err; | |
190 | } | |
191 | ||
192 | free(member_list->name); | |
193 | ||
194 | err = _free_type_expr(member_list->type); | |
195 | if (err != OK) | |
196 | return err; | |
197 | ||
198 | free(member_list); | |
199 | return OK; | |
200 | } | |
201 | ||
202 | no_ignore static xl_error | |
203 | _free_type(struct xl_ast_type *type) | |
204 | { | |
205 | xl_error err; | |
206 | ||
207 | free(type->name); | |
208 | ||
209 | switch (type->type) | |
210 | { | |
211 | case TYPE_RECORD: | |
212 | err = _free_member_list(type->members); | |
213 | if (err != OK) | |
214 | return err; | |
215 | break; | |
216 | ||
217 | default: | |
218 | return xl_raise(ERR_BAD_TYPE, "unknown type type in free"); | |
219 | } | |
220 | ||
221 | free(type); | |
222 | return OK; | |
223 | } | |
224 | ||
225 | no_ignore static xl_error | |
226 | _free_import_list(struct xl_ast_import_list *import_list) | |
227 | { | |
228 | struct xl_ast_import_list *to_free; | |
229 | ||
230 | while (import_list != NULL) | |
231 | { | |
232 | to_free = import_list; | |
233 | import_list = to_free->next; | |
234 | ||
235 | free(to_free->name); | |
236 | free(to_free); | |
237 | } | |
238 | ||
239 | return OK; | |
240 | } | |
241 | ||
242 | no_ignore xl_error | |
243 | xl_ast_free(struct xl_ast *ast) | |
244 | { | |
245 | size_t i; | |
246 | xl_error err; | |
247 | ||
248 | for (i = 0; i < ast->bindings.n; i++) | |
249 | { | |
250 | err = _free_binding(ast->bindings.elems[i]); | |
251 | if (err != OK) | |
252 | return err; | |
253 | } | |
254 | xl_vector_free(&ast->bindings); | |
255 | ||
256 | for (i = 0; i < ast->types.n; i++) | |
257 | { | |
258 | err = _free_type(ast->types.elems[i]); | |
259 | if (err != OK) | |
260 | return err; | |
261 | } | |
262 | xl_vector_free(&ast->types); | |
263 | ||
264 | if (ast->immediate != NULL) | |
265 | { | |
266 | err = _free_expr(ast->immediate); | |
267 | if (err != OK) | |
268 | return err; | |
269 | } | |
270 | ||
271 | if (ast->imports != NULL) | |
272 | { | |
273 | err = _free_import_list(ast->imports); | |
274 | if (err != OK) | |
275 | return err; | |
276 | } | |
277 | ||
278 | free(ast); | |
279 | return OK; | |
280 | } | |
281 | ||
282 | no_ignore xl_error | |
283 | xl_ast_bind(struct xl_ast *ast, struct xl_ast_binding *bind) | |
284 | { | |
285 | return xl_vector_append(&ast->bindings, bind); | |
286 | } | |
287 | ||
288 | no_ignore xl_error | |
289 | xl_ast_add_type(struct xl_ast *ast, struct xl_ast_type *type) | |
290 | { | |
291 | return xl_vector_append(&ast->types, type); | |
292 | } | |
293 | ||
294 | no_ignore xl_error | |
295 | xl_ast_atom_new_qualified( | |
296 | struct xl_ast_atom **atom, | |
297 | char *name) | |
298 | { | |
299 | size_t head_len; | |
300 | size_t tail_len; | |
301 | size_t name_len; | |
302 | size_t i; | |
303 | ||
304 | head_len = 0; | |
305 | tail_len = 0; | |
306 | name_len = strlen(name); | |
307 | for (i = 0; i < name_len; i++) | |
308 | { | |
309 | if (name[i] == ':') | |
310 | { | |
311 | head_len = i; | |
312 | tail_len = name_len - i - 1; | |
313 | break; | |
314 | } | |
315 | } | |
316 | ||
317 | xl_assert(head_len > 0); | |
318 | xl_assert(tail_len > 0); | |
319 | ||
320 | check_alloc(*atom, 1, struct xl_ast_atom); | |
321 | (*atom)->atom_type = ATOM_QUALIFIED; | |
322 | ||
323 | (*atom)->qualified.head = calloc(head_len + 1, sizeof(char)); | |
324 | if ((*atom)->qualified.head == NULL) | |
325 | return xl_raise(ERR_NO_MEMORY, "qualified alloc"); | |
326 | memcpy((*atom)->qualified.head, name, head_len); | |
327 | ||
328 | (*atom)->qualified.tail = calloc(tail_len + 1, sizeof(char)); | |
329 | if ((*atom)->qualified.tail == NULL) | |
330 | return xl_raise(ERR_NO_MEMORY, "qualified alloc"); | |
331 | memcpy((*atom)->qualified.tail, &name[head_len + 1], tail_len); | |
332 | ||
333 | free(name); | |
334 | ||
335 | return OK; | |
336 | } | |
337 | ||
338 | no_ignore xl_error | |
339 | xl_ast_import( | |
340 | struct xl_ast *ast, | |
341 | struct xl_ast_import_list *import_list) | |
342 | { | |
343 | import_list->next = ast->imports; | |
344 | ast->imports = import_list; | |
345 | return OK; | |
346 | } | |
347 | ||
348 | no_ignore xl_error | |
349 | xl_ast_subexprs( | |
350 | struct xl_ast **subast, | |
351 | struct xl_ast_expr **subexprs, | |
352 | size_t *n_subexprs, | |
353 | struct xl_ast_expr *expr) | |
354 | { | |
355 | *subast = NULL; | |
356 | *n_subexprs = 0; | |
357 | ||
358 | switch (expr->expr_type) | |
359 | { | |
360 | case EXPR_ATOM: | |
361 | return OK; | |
362 | ||
363 | case EXPR_APPLY: | |
364 | subexprs[0] = expr->apply.head; | |
365 | subexprs[1] = expr->apply.tail; | |
366 | *n_subexprs = 2; | |
367 | return OK; | |
368 | ||
369 | case EXPR_LAMBDA: | |
370 | subexprs[0] = expr->lambda.body; | |
371 | *n_subexprs = 1; | |
372 | return OK; | |
373 | ||
374 | case EXPR_CONSTRUCTOR: | |
375 | *subast = expr->constructor.scope; | |
376 | return OK; | |
377 | ||
378 | case EXPR_CONDITIONAL: | |
379 | subexprs[0] = expr->condition.cond; | |
380 | subexprs[1] = expr->condition.implied; | |
381 | subexprs[2] = expr->condition.opposed; | |
382 | *n_subexprs = 3; | |
383 | return OK; | |
384 | ||
385 | case EXPR_BLOCK: | |
386 | *subast = expr->block; | |
387 | return OK; | |
388 | } | |
389 | ||
390 | return xl_raise(ERR_BAD_TYPE, "bad type in expr subexpressions"); | |
391 | } | |
392 | ||
393 | void | |
394 | xl_ast_merge_loc( | |
395 | struct xl_ast_loc *res, | |
396 | struct xl_ast_loc *l1, | |
397 | struct xl_ast_loc *l2) | |
398 | { | |
399 | res->line_start = size_min(l1->line_start, l2->line_start); | |
400 | res->line_end = size_max(l1->line_end, l2->line_end); | |
401 | res->col_start = size_min(l1->col_start, l2->col_start); | |
402 | res->col_end = size_max(l1->col_end, l2->col_end); | |
403 | } |
0 | /* | |
1 | * bdagc.c: graph builder | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include "ubik/assert.h" | |
20 | #include "ubik/bdagc.h" | |
21 | ||
22 | #include <stdlib.h> | |
23 | #include <string.h> | |
24 | ||
25 | no_ignore xl_error | |
26 | xl_bdagc_init(struct xl_graph_builder *b) | |
27 | { | |
28 | b->nodes = NULL; | |
29 | b->n_nodes = 0; | |
30 | b->cap_nodes = 0; | |
31 | b->result = NULL; | |
32 | return OK; | |
33 | } | |
34 | ||
35 | /* Adds a node to the graph. */ | |
36 | no_ignore xl_error | |
37 | xl_bdagc_push_node( | |
38 | struct xl_graph_builder *b, | |
39 | struct xl_dagc_node *node) | |
40 | { | |
41 | size_t new_cap; | |
42 | struct xl_dagc_node **temp; | |
43 | ||
44 | if (b->n_nodes == b->cap_nodes) | |
45 | { | |
46 | new_cap = b->cap_nodes == 0 ? 8 : b->cap_nodes * 2; | |
47 | temp = realloc( | |
48 | b->nodes, new_cap * sizeof(struct xl_dagc_node *)); | |
49 | if (temp == NULL) | |
50 | return xl_raise(ERR_NO_MEMORY, "bdagc push node"); | |
51 | b->nodes = temp; | |
52 | b->cap_nodes = new_cap; | |
53 | } | |
54 | ||
55 | b->nodes[b->n_nodes++] = node; | |
56 | return OK; | |
57 | } | |
58 | ||
59 | /* Builds the graph. */ | |
60 | no_ignore xl_error | |
61 | xl_bdagc_build( | |
62 | struct xl_dagc **outgraph, | |
63 | struct xl_graph_builder *b) | |
64 | { | |
65 | xl_error err; | |
66 | size_t i; | |
67 | size_t node_size; | |
68 | struct xl_dagc *graph; | |
69 | ||
70 | err = xl_dagc_alloc(&graph, b->n_nodes, sizeof(struct xl_dagc), NULL); | |
71 | if (err != OK) | |
72 | return err; | |
73 | ||
74 | xl_assert(b->result != NULL); | |
75 | ||
76 | for (i = 0; i < b->n_nodes; i++) | |
77 | { | |
78 | err = xl_dagc_node_sizeof(&node_size, b->nodes[i]); | |
79 | if (err != OK) | |
80 | return err; | |
81 | memcpy(graph->nodes[i], b->nodes[i], node_size); | |
82 | ||
83 | err = xl_dagc_replace_node_refs( | |
84 | graph->nodes[i], b->nodes, graph->nodes, b->n_nodes); | |
85 | if (err != OK) | |
86 | return err; | |
87 | ||
88 | if (b->nodes[i] == b->result) | |
89 | graph->result = graph->nodes[i]; | |
90 | } | |
91 | ||
92 | err = xl_dagc_init(graph); | |
93 | if (err != OK) | |
94 | return err; | |
95 | ||
96 | free(b->nodes); | |
97 | ||
98 | *outgraph = graph; | |
99 | return OK; | |
100 | } |
0 | /* | |
1 | * closure.c: closure transformation on ASTs | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include <string.h> | |
20 | ||
21 | #include "ubik/assert.h" | |
22 | #include "ubik/ast.h" | |
23 | #include "ubik/closure.h" | |
24 | #include "ubik/resolve.h" | |
25 | ||
26 | /* A brief digression into the algorithm at play here. | |
27 | * | |
28 | * The goal of the closure transformation is to turn closures into | |
29 | * partially-applied functions to capture the closed-over data. This | |
30 | * allows us to maintain simplicity at the VM layer, and doing it as a | |
31 | * source transformation seems the easiest, so that's what we're doing | |
32 | * here. | |
33 | * | |
34 | * By the time we get here, every name has been resolved in one way or | |
35 | * another. The different resolution types are all listed out in | |
36 | * resolve.h, but the one we're interested in here is RESOLVE_CLOSURE. | |
37 | * The goal is, by the time we're done with it, the AST will have no | |
38 | * names that are resolved to a closure. | |
39 | * | |
40 | * Here's the algorithm: | |
41 | * 1. Find a "bottom" expression: this is an expression that is a | |
42 | * name A that resolved to a closure. Let B be the bottom | |
43 | * expression. (this happens in traverse_expr) | |
44 | * 2. For every expression above the bottom expression, apply the | |
45 | * first of the following applicable rules (this happens in | |
46 | * apply_upward_transform): | |
47 | * a. If the expression is a lambda expression, prepend A to | |
48 | * its list of arguments and mark it as needing application | |
49 | * (this state is stored in expr->scope->needs_closure_appl). | |
50 | * If the binding for A is reachable from this expression's scope | |
51 | * without crossing a function boundary, this expression is | |
52 | * the "top" expression; goto 3. Else continue recursing | |
53 | * upwards. | |
54 | * b. For all other expressions, do nothing and recurse to its | |
55 | * parent. | |
56 | * 3. Let X by the top expression (this, as well as steps 4 and 5, | |
57 | * happen in apply_downwards_transform). | |
58 | * 4. Examine each subexpression of X. If a subexpression Y is | |
59 | * marked as needing application, replace Y in X with an apply | |
60 | * expression whose function is Y and whose argument is an | |
61 | * atomic expression with name A and local resolution (this | |
62 | * specific transformation happens in apply_closure). | |
63 | * 5. For each subexpression Y of X, let X = Y and goto 3. | |
64 | * 6. Change the resolution of B to local. | |
65 | * 7. Repeat until there are no more names resolved to a closure. | |
66 | */ | |
67 | ||
68 | no_ignore static xl_error | |
69 | apply_closure(struct xl_ast_expr **lambda, char *resolving_name) | |
70 | { | |
71 | struct xl_ast_expr *apply; | |
72 | struct xl_ast_expr *name; | |
73 | ||
74 | (*lambda)->scope->needs_closure_appl = false; | |
75 | ||
76 | /* damn this is a lot of work. */ | |
77 | name = calloc(1, sizeof(struct xl_ast_expr)); | |
78 | if (name == NULL) | |
79 | return xl_raise(ERR_NO_MEMORY, "closure name alloc"); | |
80 | name->expr_type = EXPR_ATOM; | |
81 | ||
82 | name->atom = calloc(1, sizeof(struct xl_ast_atom)); | |
83 | if (name->atom == NULL) | |
84 | return xl_raise(ERR_NO_MEMORY, "closure name alloc"); | |
85 | name->atom->atom_type = ATOM_NAME; | |
86 | name->atom->name_loc = calloc(1, sizeof(struct xl_resolve_name_loc)); | |
87 | if (name->atom->name_loc == NULL) | |
88 | return xl_raise(ERR_NO_MEMORY, "closure name alloc"); | |
89 | name->atom->name_loc->type = RESOLVE_LOCAL; | |
90 | ||
91 | name->atom->str = strdup(resolving_name); | |
92 | if (name->atom->str == NULL) | |
93 | return xl_raise(ERR_NO_MEMORY, "closure name alloc"); | |
94 | ||
95 | name->scope = (*lambda)->scope->parent; | |
96 | ||
97 | apply = calloc(1, sizeof(struct xl_ast_expr)); | |
98 | if (apply == NULL) | |
99 | return xl_raise(ERR_NO_MEMORY, "closure apply alloc"); | |
100 | apply->expr_type = EXPR_APPLY; | |
101 | ||
102 | apply->scope = (*lambda)->scope->parent; | |
103 | ||
104 | apply->apply.head = *lambda; | |
105 | apply->apply.tail = name; | |
106 | ||
107 | *lambda = apply; | |
108 | return OK; | |
109 | } | |
110 | ||
111 | no_ignore static xl_error | |
112 | apply_downwards_transform( | |
113 | char *resolving_name, | |
114 | struct xl_resolve_context *ctx, | |
115 | struct xl_ast_expr **expr_ref) | |
116 | { | |
117 | struct xl_ast *subast; | |
118 | xl_error err; | |
119 | size_t i; | |
120 | struct xl_ast_expr *expr; | |
121 | ||
122 | expr = *expr_ref; | |
123 | subast = NULL; | |
124 | ||
125 | if (expr->scope->needs_closure_appl) | |
126 | { | |
127 | err = apply_closure(expr_ref, resolving_name); | |
128 | if (err != OK) | |
129 | return err; | |
130 | expr = *expr_ref; | |
131 | } | |
132 | ||
133 | #define check_closure_appl(subexpr) do { \ | |
134 | err = apply_downwards_transform(resolving_name, ctx, &subexpr); \ | |
135 | if (err != OK) return err; \ | |
136 | } while (0) | |
137 | ||
138 | switch (expr->expr_type) | |
139 | { | |
140 | case EXPR_ATOM: | |
141 | return OK; | |
142 | ||
143 | case EXPR_APPLY: | |
144 | check_closure_appl(expr->apply.head); | |
145 | check_closure_appl(expr->apply.tail); | |
146 | return OK; | |
147 | ||
148 | case EXPR_LAMBDA: | |
149 | check_closure_appl(expr->lambda.body); | |
150 | return OK; | |
151 | ||
152 | case EXPR_CONDITIONAL: | |
153 | check_closure_appl(expr->condition.cond); | |
154 | check_closure_appl(expr->condition.implied); | |
155 | check_closure_appl(expr->condition.opposed); | |
156 | return OK; | |
157 | ||
158 | case EXPR_CONSTRUCTOR: | |
159 | subast = expr->constructor.scope; | |
160 | break; | |
161 | case EXPR_BLOCK: | |
162 | subast = expr->block; | |
163 | break; | |
164 | } | |
165 | ||
166 | for (i = 0; i < subast->bindings.n; i++) | |
167 | { | |
168 | struct xl_ast_binding *bind; | |
169 | bind = subast->bindings.elems[i]; | |
170 | check_closure_appl(bind->expr); | |
171 | } | |
172 | ||
173 | if (subast->immediate != NULL) | |
174 | { | |
175 | check_closure_appl(subast->immediate); | |
176 | } | |
177 | return OK; | |
178 | } | |
179 | ||
180 | no_ignore static xl_error | |
181 | apply_upwards_transform( | |
182 | char **resolving_name_ref, | |
183 | struct xl_resolve_context *ctx, | |
184 | struct xl_ast_expr **expr_ref) | |
185 | { | |
186 | char *resolving_name; | |
187 | bool is_top; | |
188 | size_t i; | |
189 | struct xl_ast_expr *expr; | |
190 | struct xl_ast_arg_list *args; | |
191 | struct xl_resolve_scope *scope; | |
192 | ||
193 | resolving_name = *resolving_name_ref; | |
194 | expr = *expr_ref; | |
195 | ||
196 | /* check to see if we can reach the definition of this name from where | |
197 | * we are, without crossing a boundary. */ | |
198 | is_top = false; | |
199 | scope = expr->scope; | |
200 | do | |
201 | { | |
202 | for (i = 0; i < scope->names.n; i++) | |
203 | { | |
204 | struct xl_resolve_name *name; | |
205 | name = scope->names.elems[i]; | |
206 | if (strcmp(name->name, resolving_name) == 0) | |
207 | { | |
208 | is_top = true; | |
209 | goto break_all; | |
210 | } | |
211 | } | |
212 | if (scope->boundary == BOUNDARY_FUNCTION) | |
213 | goto break_all; | |
214 | scope = scope->parent; | |
215 | } while (scope != NULL); | |
216 | ||
217 | break_all: | |
218 | ||
219 | if (expr->expr_type == EXPR_LAMBDA) | |
220 | { | |
221 | args = calloc(1, sizeof(struct xl_ast_arg_list)); | |
222 | args->name = strdup(resolving_name); | |
223 | args->next = expr->lambda.args; | |
224 | ||
225 | expr->lambda.args = args; | |
226 | expr->scope->needs_closure_appl = true; | |
227 | } | |
228 | ||
229 | if (is_top) | |
230 | { | |
231 | *resolving_name_ref = NULL; | |
232 | return apply_downwards_transform(resolving_name, ctx, expr_ref); | |
233 | } | |
234 | return OK; | |
235 | } | |
236 | ||
237 | static inline bool | |
238 | is_closure_ref(struct xl_ast_expr *expr) | |
239 | { | |
240 | if (expr->expr_type != EXPR_ATOM) | |
241 | return false; | |
242 | if (expr->atom->atom_type != ATOM_NAME) | |
243 | return false; | |
244 | return expr->atom->name_loc->type == RESOLVE_CLOSURE; | |
245 | } | |
246 | ||
247 | no_ignore static xl_error | |
248 | traverse_ast( | |
249 | char **resolving_name, | |
250 | bool *changed, | |
251 | struct xl_resolve_context *ctx, | |
252 | struct xl_ast *ast); | |
253 | ||
254 | no_ignore static xl_error | |
255 | traverse_expr( | |
256 | char **resolving_name, | |
257 | bool *changed, | |
258 | struct xl_resolve_context *ctx, | |
259 | struct xl_ast_expr **expr_ref) | |
260 | { | |
261 | struct xl_ast *subast; | |
262 | struct xl_ast_expr *expr; | |
263 | xl_error err; | |
264 | ||
265 | expr = *expr_ref; | |
266 | subast = NULL; | |
267 | ||
268 | if (is_closure_ref(expr)) | |
269 | { | |
270 | *resolving_name = expr->atom->str; | |
271 | expr->atom->name_loc->type = RESOLVE_LOCAL; | |
272 | *changed = true; | |
273 | return OK; | |
274 | } | |
275 | ||
276 | #define traverse_child(subexpr) do { \ | |
277 | err = traverse_expr(resolving_name, changed, ctx, &subexpr); \ | |
278 | if (err != OK) \ | |
279 | return err; \ | |
280 | if (*resolving_name != NULL) \ | |
281 | { \ | |
282 | err = apply_upwards_transform( \ | |
283 | resolving_name, ctx, expr_ref); \ | |
284 | return err; \ | |
285 | } \ | |
286 | } while (0) | |
287 | ||
288 | switch (expr->expr_type) | |
289 | { | |
290 | case EXPR_ATOM: | |
291 | return OK; | |
292 | ||
293 | case EXPR_APPLY: | |
294 | traverse_child(expr->apply.head); | |
295 | traverse_child(expr->apply.tail); | |
296 | return OK; | |
297 | ||
298 | case EXPR_LAMBDA: | |
299 | traverse_child(expr->lambda.body); | |
300 | return OK; | |
301 | ||
302 | case EXPR_CONDITIONAL: | |
303 | traverse_child(expr->condition.cond); | |
304 | traverse_child(expr->condition.implied); | |
305 | traverse_child(expr->condition.opposed); | |
306 | return OK; | |
307 | ||
308 | case EXPR_CONSTRUCTOR: | |
309 | subast = expr->constructor.scope; | |
310 | break; | |
311 | case EXPR_BLOCK: | |
312 | subast = expr->block; | |
313 | break; | |
314 | } | |
315 | ||
316 | if (subast != NULL) | |
317 | { | |
318 | err = traverse_ast(resolving_name, changed, ctx, subast); | |
319 | if (err != OK) | |
320 | return err; | |
321 | ||
322 | if (*resolving_name != NULL) | |
323 | { | |
324 | err = apply_upwards_transform( | |
325 | resolving_name, ctx, expr_ref); | |
326 | return err; | |
327 | } | |
328 | } | |
329 | return OK; | |
330 | } | |
331 | ||
332 | no_ignore xl_error | |
333 | traverse_ast( | |
334 | char **resolving_name, | |
335 | bool *changed, | |
336 | struct xl_resolve_context *ctx, | |
337 | struct xl_ast *ast) | |
338 | { | |
339 | size_t i; | |
340 | xl_error err; | |
341 | ||
342 | for (i = 0; i < ast->bindings.n; i++) | |
343 | { | |
344 | struct xl_ast_binding *bind; | |
345 | ||
346 | bind = ast->bindings.elems[i]; | |
347 | err = traverse_expr( | |
348 | resolving_name, changed, ctx, &bind->expr); | |
349 | if (err != OK) | |
350 | return err; | |
351 | } | |
352 | ||
353 | if (ast->immediate != NULL) | |
354 | { | |
355 | err = traverse_expr( | |
356 | resolving_name, changed, ctx, &ast->immediate); | |
357 | if (err != OK) | |
358 | return err; | |
359 | } | |
360 | ||
361 | return OK; | |
362 | } | |
363 | ||
364 | no_ignore xl_error | |
365 | xl_reduce_closures( | |
366 | struct xl_resolve_context *ctx, | |
367 | struct xl_ast *ast) | |
368 | { | |
369 | char *resolving_name; | |
370 | bool changed; | |
371 | xl_error err; | |
372 | ||
373 | do | |
374 | { | |
375 | changed = false; | |
376 | resolving_name = NULL; | |
377 | ||
378 | err = traverse_ast(&resolving_name, &changed, ctx, ast); | |
379 | if (err != OK) | |
380 | return err; | |
381 | xl_assert(resolving_name == NULL); | |
382 | } while (changed); | |
383 | ||
384 | return OK; | |
385 | } |
0 | /* | |
1 | * compile.c: expel compilation | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include <stdio.h> | |
20 | #include <stdlib.h> | |
21 | #include <string.h> | |
22 | #include <unistd.h> | |
23 | ||
24 | #include "ubik/compile.h" | |
25 | #include "ubik/gen.h" | |
26 | #include "ubik/parse.h" | |
27 | #include "ubik/resolve.h" | |
28 | #include "ubik/string.h" | |
29 | #include "ubik/util.h" | |
30 | ||
31 | ||
32 | no_ignore xl_error | |
33 | xl_compile_env_default(struct xl_compilation_env *cenv) | |
34 | { | |
35 | char *scratch_dir; | |
36 | char *include_dirs; | |
37 | xl_error err; | |
38 | ||
39 | scratch_dir = calloc(512, sizeof(char)); | |
40 | if (getcwd(scratch_dir, 500) == NULL) | |
41 | { | |
42 | perror("could not open current directory"); | |
43 | return xl_raise(ERR_UNEXPECTED_FAILURE, "getcwd"); | |
44 | } | |
45 | strcat(scratch_dir, "/expel-build"); | |
46 | cenv->scratch_dir = scratch_dir; | |
47 | ||
48 | include_dirs = getenv("EXPEL_INCLUDE"); | |
49 | if (include_dirs == NULL) | |
50 | { | |
51 | cenv->include_dirs = NULL; | |
52 | cenv->n_include_dirs = 0; | |
53 | } | |
54 | else | |
55 | { | |
56 | err = xl_string_split( | |
57 | &cenv->include_dirs, | |
58 | &cenv->n_include_dirs, | |
59 | include_dirs, | |
60 | strlen(include_dirs), | |
61 | ':'); | |
62 | if (err != OK) | |
63 | return err; | |
64 | } | |
65 | ||
66 | return OK; | |
67 | } | |
68 | ||
69 | no_ignore xl_error | |
70 | xl_compile_env_free(struct xl_compilation_env *cenv) | |
71 | { | |
72 | size_t i; | |
73 | ||
74 | free(cenv->scratch_dir); | |
75 | ||
76 | for (i = 0; i < cenv->n_include_dirs; i++) | |
77 | free(cenv->include_dirs[i]); | |
78 | free(cenv->include_dirs); | |
79 | ||
80 | return OK; | |
81 | } | |
82 | ||
83 | no_ignore xl_error | |
84 | xl_compile( | |
85 | struct xl_dagc ***graphs, | |
86 | size_t *n_graphs, | |
87 | char *source_name, | |
88 | struct xl_stream *in_stream, | |
89 | struct xl_compilation_env *cenv) | |
90 | { | |
91 | struct xl_ast *ast; | |
92 | local(resolve_context) struct xl_resolve_context ctx = {0}; | |
93 | xl_error err; | |
94 | xl_error free_err; | |
95 | ||
96 | err = xl_parse(&ast, source_name, in_stream); | |
97 | if (err != OK) | |
98 | return err; | |
99 | ||
100 | err = xl_resolve(ast, source_name, in_stream, &ctx); | |
101 | if (err != OK) | |
102 | goto free_ast; | |
103 | ||
104 | err = xl_compile_ast(graphs, n_graphs, ast, cenv); | |
105 | if (err != OK) | |
106 | goto free_ast; | |
107 | ||
108 | free_ast: | |
109 | free_err = xl_ast_free(ast); | |
110 | if (err != OK) | |
111 | return err; | |
112 | if (free_err != OK) | |
113 | return free_err; | |
114 | return OK; | |
115 | } | |
116 | ||
117 | no_ignore static xl_error | |
118 | _open_stream_for_requirement( | |
119 | struct xl_stream *out, | |
120 | char **source_name, | |
121 | char *package_name, | |
122 | struct xl_compilation_env *cenv) | |
123 | { | |
124 | size_t i; | |
125 | char *test_file; | |
126 | char *test_basename; | |
127 | xl_error err; | |
128 | ||
129 | test_basename = calloc(strlen(package_name) + 4, sizeof(char)); | |
130 | strcpy(test_basename, package_name); | |
131 | strcat(test_basename, ".xl"); | |
132 | ||
133 | for (i = 0; i < cenv->n_include_dirs; i++) | |
134 | { | |
135 | err = xl_string_path_concat( | |
136 | &test_file, cenv->include_dirs[i], test_basename); | |
137 | if (err != OK) | |
138 | return err; | |
139 | if (access(test_file, R_OK) == 0) | |
140 | { | |
141 | err = xl_stream_rfile(out, test_file); | |
142 | if (err != OK) | |
143 | return err; | |
144 | #ifdef XL_COMPILE_DEBUG | |
145 | printf("found %s for %s\n", test_file, package_name); | |
146 | #endif | |
147 | free(test_file); | |
148 | *source_name = test_basename; | |
149 | return OK; | |
150 | } | |
151 | free(test_file); | |
152 | } | |
153 | ||
154 | free(test_basename); | |
155 | return xl_raise(ERR_ABSENT, package_name); | |
156 | } | |
157 | ||
158 | no_ignore static xl_error | |
159 | _add_requirement( | |
160 | struct xl_dagc ***graphs, | |
161 | size_t *n_graphs, | |
162 | struct xl_gen_requires *requires, | |
163 | struct xl_uri *dependency, | |
164 | struct xl_compilation_env *cenv) | |
165 | { | |
166 | struct xl_dagc **req_graphs; | |
167 | size_t n_req_graphs; | |
168 | struct xl_gen_requires *req_requires; | |
169 | struct xl_stream package_stream; | |
170 | struct xl_ast *ast; | |
171 | struct xl_dagc **buf; | |
172 | char *source_name; | |
173 | xl_error err; | |
174 | ||
175 | unused(requires); | |
176 | ||
177 | source_name = NULL; | |
178 | err = _open_stream_for_requirement( | |
179 | &package_stream, &source_name, dependency->source, cenv); | |
180 | if (err != OK) | |
181 | return err; | |
182 | ||
183 | err = xl_parse(&ast, source_name, &package_stream); | |
184 | free(source_name); | |
185 | if (err != OK) | |
186 | return err; | |
187 | ||
188 | req_requires = NULL; | |
189 | err = xl_compile_unit( | |
190 | &req_graphs, &n_req_graphs, &req_requires, ast, LOAD_IMPORTED, | |
191 | dependency->source); | |
192 | if (err != OK) | |
193 | return err; | |
194 | if (req_requires != NULL) | |
195 | return xl_raise( | |
196 | ERR_NOT_IMPLEMENTED, | |
197 | "only one level of imports allowed"); | |
198 | ||
199 | buf = realloc( | |
200 | *graphs, | |
201 | (*n_graphs + n_req_graphs) * sizeof(struct xl_dagc **)); | |
202 | if (buf == NULL) | |
203 | return xl_raise(ERR_NO_MEMORY, "graph list realloc"); | |
204 | memcpy( | |
205 | &buf[*n_graphs], | |
206 | req_graphs, | |
207 | n_req_graphs * sizeof(struct xl_dagc **)); | |
208 | *graphs = buf; | |
209 | *n_graphs += n_req_graphs; | |
210 | ||
211 | err = xl_ast_free(ast); | |
212 | if (err != OK) | |
213 | return err; | |
214 | ||
215 | xl_stream_close(&package_stream); | |
216 | free(req_graphs); | |
217 | ||
218 | return OK; | |
219 | } | |
220 | ||
221 | no_ignore xl_error | |
222 | xl_compile_ast( | |
223 | struct xl_dagc ***graphs, | |
224 | size_t *n_graphs, | |
225 | struct xl_ast *ast, | |
226 | struct xl_compilation_env *cenv) | |
227 | { | |
228 | struct xl_gen_requires *requires; | |
229 | struct xl_gen_requires *head; | |
230 | xl_error err; | |
231 | ||
232 | requires = NULL; | |
233 | err = xl_compile_unit( | |
234 | graphs, n_graphs, &requires, ast, LOAD_MAIN, NULL); | |
235 | if (err != OK) | |
236 | return err; | |
237 | ||
238 | head = requires; | |
239 | while (requires != NULL) | |
240 | { | |
241 | err = _add_requirement( | |
242 | graphs, n_graphs, requires, | |
243 | requires->dependency, cenv); | |
244 | if (err != OK) | |
245 | return err; | |
246 | requires = requires->next; | |
247 | } | |
248 | ||
249 | err = xl_gen_requires_free(head); | |
250 | if (err != OK) | |
251 | return err; | |
252 | ||
253 | return OK; | |
254 | } |
0 | /* | |
1 | * dagc.c: common tasks for directed acyclic graphs of computation | |
2 | * Copyright (C) 2015, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include <stdbool.h> | |
20 | #include <stdlib.h> | |
21 | #include <string.h> | |
22 | ||
23 | #include "ubik/assert.h" | |
24 | #include "ubik/dagc.h" | |
25 | #include "ubik/ubik.h" | |
26 | #include "ubik/util.h" | |
27 | ||
28 | no_ignore xl_error | |
29 | xl_dagc_new(struct xl_dagc **graph, size_t n_nodes) | |
30 | { | |
31 | return xl_dagc_alloc( | |
32 | graph, n_nodes, sizeof(struct xl_dagc), NULL); | |
33 | } | |
34 | ||
35 | /* Gets the dependencies of a node. | |
36 | * | |
37 | * For nodes with two dependencies, d1 and d2 will be filled in | |
38 | * with valid pointers. For nodes with one dependency, d1 will be | |
39 | * filled in with a pointer and d2 will be set to NULL. For nodes | |
40 | * with no dependencies, both will be NULL. */ | |
41 | no_ignore xl_error | |
42 | xl_dagc_get_deps( | |
43 | struct xl_dagc_node **d1, | |
44 | struct xl_dagc_node **d2, | |
45 | struct xl_dagc_node **d3, | |
46 | struct xl_dagc_node *n) | |
47 | { | |
48 | switch (n->node_type) | |
49 | { | |
50 | case DAGC_NODE_APPLY: | |
51 | *d1 = ((struct xl_dagc_apply *) n)->func; | |
52 | *d2 = ((struct xl_dagc_apply *) n)->arg; | |
53 | *d3 = NULL; | |
54 | return OK; | |
55 | ||
56 | case DAGC_NODE_COND: | |
57 | *d1 = ((struct xl_dagc_cond *) n)->condition; | |
58 | *d2 = ((struct xl_dagc_cond *) n)->if_true; | |
59 | *d3 = ((struct xl_dagc_cond *) n)->if_false; | |
60 | return OK; | |
61 | ||
62 | case DAGC_NODE_LOAD: | |
63 | *d1 = NULL; | |
64 | *d2 = NULL; | |
65 | *d3 = NULL; | |
66 | return OK; | |
67 | ||
68 | case DAGC_NODE_REF: | |
69 | *d1 = ((struct xl_dagc_ref *) n)->referrent; | |
70 | *d2 = NULL; | |
71 | *d3 = NULL; | |
72 | return OK; | |
73 | ||
74 | case DAGC_NODE_STORE: | |
75 | *d1 = ((struct xl_dagc_store *) n)->value; | |
76 | *d2 = NULL; | |
77 | *d3 = NULL; | |
78 | return OK; | |
79 | ||
80 | case DAGC_NODE_CONST: | |
81 | case DAGC_NODE_INPUT: | |
82 | case DAGC_NODE_NATIVE: | |
83 | *d1 = NULL; | |
84 | *d2 = NULL; | |
85 | *d3 = NULL; | |
86 | return OK; | |
87 | } | |
88 | return xl_raise(ERR_UNKNOWN_TYPE, "get deps"); | |
89 | } | |
90 | ||
91 | static int | |
92 | _cmp_adjacency(const void *v1, const void *v2) | |
93 | { | |
94 | uintptr_t p1, p2; | |
95 | p1 = *((uintptr_t *) v1); | |
96 | p2 = *((uintptr_t *) v2); | |
97 | if (p1 < p2) | |
98 | return -1; | |
99 | if (p1 > p2) | |
100 | return 1; | |
101 | return 0; | |
102 | } | |
103 | ||
104 | no_ignore static xl_error | |
105 | _find_adjacency( | |
106 | size_t *i, | |
107 | struct xl_dagc_adjacency *adjacencies, | |
108 | size_t n, | |
109 | struct xl_dagc_node *child) | |
110 | { | |
111 | uintptr_t cptr, aptr; | |
112 | size_t min, max; | |
113 | ||
114 | min = 0; | |
115 | max = n; | |
116 | cptr = (uintptr_t) child; | |
117 | ||
118 | while (min < max) | |
119 | { | |
120 | *i = (min + max - 1) / 2; | |
121 | aptr = (uintptr_t) adjacencies[*i].child; | |
122 | if (aptr == cptr) | |
123 | return OK; | |
124 | if (aptr > cptr) | |
125 | max = *i; | |
126 | if (aptr < cptr) | |
127 | min = *i + 1; | |
128 | } | |
129 | return xl_raise(ERR_ABSENT, "find adjacency"); | |
130 | } | |
131 | ||
132 | no_ignore static xl_error | |
133 | _increment_n_parents( | |
134 | struct xl_dagc *graph, | |
135 | struct xl_dagc_node *child) | |
136 | { | |
137 | xl_error err; | |
138 | size_t i; | |
139 | ||
140 | i = graph->n; | |
141 | err = _find_adjacency(&i, graph->adjacency, graph->n, child); | |
142 | if (err != OK) | |
143 | return err; | |
144 | if (unlikely(i >= graph->n)) | |
145 | return xl_raise(ERR_UNEXPECTED_FAILURE, | |
146 | "find adjacent result bogus"); | |
147 | graph->adjacency[i].n_parents++; | |
148 | return OK; | |
149 | } | |
150 | ||
151 | no_ignore static xl_error | |
152 | _add_parent( | |
153 | struct xl_dagc *graph, | |
154 | struct xl_dagc_node *parent, | |
155 | struct xl_dagc_node *child) | |
156 | { | |
157 | struct xl_dagc_adjacency *adj; | |
158 | size_t adj_i, parent_i; | |
159 | xl_error err; | |
160 | ||
161 | adj_i = graph->n; | |
162 | err = _find_adjacency( | |
163 | &adj_i, graph->adjacency, graph->n, child); | |
164 | if (err != OK) | |
165 | return err; | |
166 | if (unlikely(adj_i >= graph->n)) | |
167 | return xl_raise(ERR_UNEXPECTED_FAILURE, | |
168 | "find adjacent result bogus"); | |
169 | adj = &graph->adjacency[adj_i]; | |
170 | /* Find the first NULL parent entry. */ | |
171 | for (parent_i = 0; | |
172 | adj->parents[parent_i] && parent_i < adj->n_parents; | |
173 | parent_i++); | |
174 | if (adj->parents[parent_i] != NULL) | |
175 | return xl_raise(ERR_UNEXPECTED_FAILURE, | |
176 | "all parents full already"); | |
177 | adj->parents[parent_i] = parent; | |
178 | return OK; | |
179 | } | |
180 | ||
181 | no_ignore xl_error | |
182 | xl_dagc_init(struct xl_dagc *graph) | |
183 | { | |
184 | struct xl_dagc_node *p, *d1, *d2, *d3; | |
185 | struct xl_dagc_adjacency *adj; | |
186 | size_t i, next_in, next_out; | |
187 | xl_error err; | |
188 | ||
189 | graph->tag = TAG_GRAPH; | |
190 | graph->refcount = 1; | |
191 | ||
192 | /* Adjacency is stored as a sorted list of adjacency | |
193 | * lists; the first element in each list is the child and | |
194 | * the remaining elements are parents. */ | |
195 | graph->adjacency = calloc(graph->n, sizeof(struct xl_dagc_adjacency)); | |
196 | ||
197 | for (i = 0; i < graph->n; i++) | |
198 | { | |
199 | graph->adjacency[i].child = graph->nodes[i]; | |
200 | graph->adjacency[i].parents = NULL; | |
201 | graph->adjacency[i].n_parents = 0; | |
202 | } | |
203 | ||
204 | qsort(graph->adjacency, graph->n, | |
205 | sizeof(struct xl_dagc_adjacency), _cmp_adjacency); | |
206 | ||
207 | /* First go through and count how many parents each one has. */ | |
208 | for (i = 0; i < graph->n; i++) | |
209 | { | |
210 | p = graph->nodes[i]; | |
211 | err = xl_dagc_get_deps(&d1, &d2, &d3, p); | |
212 | if (err != OK) | |
213 | return err; | |
214 | ||
215 | if (d1 != NULL) | |
216 | { | |
217 | err = _increment_n_parents(graph, d1); | |
218 | if (err != OK) | |
219 | return err; | |
220 | } | |
221 | if (d2 != NULL) | |
222 | { | |
223 | err = _increment_n_parents(graph, d2); | |
224 | if (err != OK) | |
225 | return err; | |
226 | } | |
227 | if (d3 != NULL) | |
228 | { | |
229 | err = _increment_n_parents(graph, d3); | |
230 | if (err != OK) | |
231 | return err; | |
232 | } | |
233 | } | |
234 | ||
235 | /* Now allocate the parent arrays. */ | |
236 | for (i = 0; i < graph->n; i++) | |
237 | { | |
238 | adj = &graph->adjacency[i]; | |
239 | adj->parents = calloc( | |
240 | adj->n_parents, sizeof(struct xl_dagc_node *)); | |
241 | } | |
242 | ||
243 | /* Finally fill in the actual parent arrays. */ | |
244 | for (i = 0; i < graph->n; i++) | |
245 | { | |
246 | p = graph->nodes[i]; | |
247 | err = xl_dagc_get_deps(&d1, &d2, &d3, p); | |
248 | if (err != OK) | |
249 | return err; | |
250 | ||
251 | if (d1 != NULL) | |
252 | { | |
253 | err = _add_parent(graph, p, d1); | |
254 | if (err != OK) | |
255 | return err; | |
256 | } | |
257 | if (d2 != NULL) | |
258 | { | |
259 | err = _add_parent(graph, p, d2); | |
260 | if (err != OK) | |
261 | return err; | |
262 | } | |
263 | if (d3 != NULL) | |
264 | { | |
265 | err = _add_parent(graph, p, d3); | |
266 | if (err != OK) | |
267 | return err; | |
268 | } | |
269 | } | |
270 | ||
271 | /* Go through and find how many nodes are inputs or terminals */ | |
272 | graph->in_arity = 0; | |
273 | graph->out_arity = 0; | |
274 | for (i = 0; i < graph->n; i++) | |
275 | { | |
276 | p = graph->nodes[i]; | |
277 | if (p->node_type == DAGC_NODE_INPUT) | |
278 | graph->in_arity++; | |
279 | if (p->is_terminal) | |
280 | graph->out_arity++; | |
281 | } | |
282 | ||
283 | /* Then populate the input and terminal lists. */ | |
284 | graph->inputs = calloc(graph->in_arity, sizeof(struct xl_dagc_node *)); | |
285 | graph->terminals = | |
286 | calloc(graph->out_arity, sizeof(struct xl_dagc_node *)); | |
287 | for (i = 0, next_out = 0; i < graph->n; i++) | |
288 | { | |
289 | p = graph->nodes[i]; | |
290 | if (p->node_type == DAGC_NODE_INPUT) | |
291 | { | |
292 | next_in = ((struct xl_dagc_input *) p)->arg_num; | |
293 | xl_assert(next_in < graph->in_arity); | |
294 | if (graph->inputs[next_in] != NULL) | |
295 | return xl_raise( | |
296 | ERR_BAD_GRAPH, | |
297 | "multiple inputs with same arg num"); | |
298 | graph->inputs[next_in] = p; | |
299 | } | |
300 | if (p->is_terminal) | |
301 | graph->terminals[next_out++] = p; | |
302 | } | |
303 | ||
304 | return OK; | |
305 | } | |
306 | ||
307 | no_ignore xl_error | |
308 | xl_dagc_get_parents( | |
309 | struct xl_dagc_node ***parents, | |
310 | size_t *n_parents, | |
311 | struct xl_dagc *graph, | |
312 | struct xl_dagc_node *child) | |
313 | { | |
314 | size_t i; | |
315 | xl_error err; | |
316 | ||
317 | i = graph->n; | |
318 | err = _find_adjacency(&i, graph->adjacency, graph->n, child); | |
319 | if (err != OK) | |
320 | return err; | |
321 | if (unlikely(i >= graph->n)) | |
322 | return xl_raise(ERR_UNEXPECTED_FAILURE, NULL); | |
323 | ||
324 | *parents = graph->adjacency[i].parents; | |
325 | *n_parents = graph->adjacency[i].n_parents; | |
326 | return OK; | |
327 | } | |
328 | ||
329 | no_ignore xl_error | |
330 | xl_dagc_node_sizeof( | |
331 | size_t *size, | |
332 | struct xl_dagc_node *node) | |
333 | { | |
334 | switch (node->node_type) | |
335 | { | |
336 | case DAGC_NODE_APPLY: | |
337 | *size = sizeof(struct xl_dagc_apply); | |
338 | return OK; | |
339 | case DAGC_NODE_COND: | |
340 | *size = sizeof(struct xl_dagc_cond); | |
341 | return OK; | |
342 | case DAGC_NODE_CONST: | |
343 | *size = sizeof(struct xl_dagc_const); | |
344 | return OK; | |
345 | case DAGC_NODE_INPUT: | |
346 | *size = sizeof(struct xl_dagc_input); | |
347 | return OK; | |
348 | case DAGC_NODE_LOAD: | |
349 | *size = sizeof(struct xl_dagc_load); | |
350 | return OK; | |
351 | case DAGC_NODE_NATIVE: | |
352 | *size = sizeof(struct xl_dagc_native); | |
353 | return OK; | |
354 | case DAGC_NODE_REF: | |
355 | *size = sizeof(struct xl_dagc_ref); | |
356 | return OK; | |
357 | case DAGC_NODE_STORE: | |
358 | *size = sizeof(struct xl_dagc_store); | |
359 | return OK; | |
360 | } | |
361 | return xl_raise(ERR_UNKNOWN_TYPE, "unknown node type in size"); | |
362 | } | |
363 | ||
364 | no_ignore static xl_error | |
365 | _replace_ref( | |
366 | struct xl_dagc_node **ref, | |
367 | struct xl_dagc_node **proto, | |
368 | struct xl_dagc_node **copied, | |
369 | size_t n) | |
370 | { | |
371 | size_t i; | |
372 | ||
373 | if (*ref == NULL) | |
374 | return OK; | |
375 | for (i = 0; i < n; i++) | |
376 | { | |
377 | if (proto[i] == *ref) | |
378 | { | |
379 | *ref = copied[i]; | |
380 | return OK; | |
381 | } | |
382 | } | |
383 | return xl_raise(ERR_ABSENT, "replace ref"); | |
384 | } | |
385 | ||
386 | no_ignore xl_error | |
387 | xl_dagc_replace_node_refs( | |
388 | struct xl_dagc_node *node, | |
389 | struct xl_dagc_node **proto, | |
390 | struct xl_dagc_node **copied, | |
391 | size_t n_nodes) | |
392 | { | |
393 | union xl_dagc_any_node *n; | |
394 | xl_error err; | |
395 | ||
396 | n = (union xl_dagc_any_node *) node; | |
397 | ||
398 | switch (node->node_type) | |
399 | { | |
400 | case DAGC_NODE_APPLY: | |
401 | err = _replace_ref(&n->as_apply.func, proto, copied, n_nodes); | |
402 | if (err != OK) | |
403 | return err; | |
404 | err = _replace_ref(&n->as_apply.arg, proto, copied, n_nodes); | |
405 | return err; | |
406 | ||
407 | case DAGC_NODE_REF: | |
408 | err = _replace_ref(&n->as_ref.referrent, proto, copied, n_nodes); | |
409 | return err; | |
410 | ||
411 | case DAGC_NODE_STORE: | |
412 | err = _replace_ref(&n->as_store.value, proto, copied, n_nodes); | |
413 | return err; | |
414 | ||
415 | case DAGC_NODE_COND: | |
416 | err = _replace_ref(&n->as_cond.condition, proto, copied, n_nodes); | |
417 | if (err != OK) | |
418 | return err; | |
419 | err = _replace_ref(&n->as_cond.if_true, proto, copied, n_nodes); | |
420 | if (err != OK) | |
421 | return err; | |
422 | err = _replace_ref(&n->as_cond.if_false, proto, copied, n_nodes); | |
423 | return err; | |
424 | ||
425 | case DAGC_NODE_LOAD: | |
426 | case DAGC_NODE_CONST: | |
427 | case DAGC_NODE_INPUT: | |
428 | case DAGC_NODE_NATIVE: | |
429 | return OK; | |
430 | } | |
431 | return xl_raise(ERR_UNKNOWN_TYPE, "replace node refs"); | |
432 | } | |
433 | ||
434 | no_ignore static xl_error | |
435 | _increment_value_refs(struct xl_dagc_node *node) | |
436 | { | |
437 | struct xl_dagc_load *l; | |
438 | struct xl_dagc_store *s; | |
439 | struct xl_dagc_const *c; | |
440 | xl_error err; | |
441 | ||
442 | if (node->known.any != NULL) | |
443 | { | |
444 | err = xl_take(node->known.any); | |
445 | if (err != OK) | |
446 | return err; | |
447 | } | |
448 | if (node->known_type != NULL) | |
449 | { | |
450 | err = xl_take(node->known_type); | |
451 | if (err != OK) | |
452 | return err; | |
453 | } | |
454 | ||
455 | switch (node->node_type) | |
456 | { | |
457 | case DAGC_NODE_APPLY: | |
458 | case DAGC_NODE_NATIVE: | |
459 | case DAGC_NODE_COND: | |
460 | case DAGC_NODE_REF: | |
461 | case DAGC_NODE_INPUT: | |
462 | return OK; | |
463 | ||
464 | case DAGC_NODE_LOAD: | |
465 | l = (struct xl_dagc_load *) node; | |
466 | return xl_take(l->loc); | |
467 | ||
468 | case DAGC_NODE_STORE: | |
469 | s = (struct xl_dagc_store *) node; | |
470 | return xl_take(s->loc); | |
471 | ||
472 | case DAGC_NODE_CONST: | |
473 | c = (struct xl_dagc_const *) node; | |
474 | err = xl_take(c->type); | |
475 | if (err != OK) | |
476 | return err; | |
477 | return xl_take(c->value.any); | |
478 | } | |
479 | return xl_raise(ERR_UNKNOWN_TYPE, "inc value refs"); | |
480 | } | |
481 | ||
482 | no_ignore xl_error | |
483 | xl_dagc_copy( | |
484 | struct xl_dagc **res_ptr, | |
485 | struct xl_dagc *proto) | |
486 | { | |
487 | struct xl_dagc_adjacency *adj; | |
488 | struct xl_dagc *result; | |
489 | size_t i, j, size; | |
490 | xl_error err; | |
491 | ||
492 | /* Start by making a direct copy, then replace all of the references. */ | |
493 | size = sizeof(struct xl_dagc); | |
494 | if (proto->tag & TAG_GRAPH_NATIVE) | |
495 | size = sizeof(struct xl_dagc_native); | |
496 | ||
497 | err = xl_dagc_alloc(&result, proto->n, size, proto); | |
498 | if (err != OK) | |
499 | return err; | |
500 | *res_ptr = result; | |
501 | ||
502 | result->refcount = 0; | |
503 | ||
504 | memcpy(result->nodes[0], proto->nodes[0], | |
505 | proto->n * sizeof(union xl_dagc_any_node)); | |
506 | ||
507 | for (i = 0; i < result->n; i++) | |
508 | { | |
509 | err = xl_dagc_replace_node_refs( | |
510 | result->nodes[i], proto->nodes, result->nodes, | |
511 | result->n); | |
512 | if (err != OK) | |
513 | return err; | |
514 | err = _increment_value_refs(result->nodes[i]); | |
515 | if (err != OK) | |
516 | return err; | |
517 | } | |
518 | ||
519 | result->inputs = | |
520 | calloc(result->in_arity, sizeof(struct xl_dagc_node *)); | |
521 | result->terminals = | |
522 | calloc(result->out_arity, sizeof(struct xl_dagc_node *)); | |
523 | for (i = 0; i < result->in_arity; i++) | |
524 | { | |
525 | result->inputs[i] = proto->inputs[i]; | |
526 | err = _replace_ref( | |
527 | &result->inputs[i], proto->nodes, result->nodes, | |
528 | result->n); | |
529 | if (err != OK) | |
530 | return err; | |
531 | } | |
532 | for (i = 0; i < result->out_arity; i++) | |
533 | { | |
534 | result->terminals[i] = proto->terminals[i]; | |
535 | err = _replace_ref( | |
536 | &result->terminals[i], proto->nodes, result->nodes, | |
537 | result->n); | |
538 | if (err != OK) | |
539 | return err; | |
540 | } | |
541 | ||
542 | if (proto->result != NULL) | |
543 | { | |
544 | err = _replace_ref( | |
545 | &result->result, proto->nodes, result->nodes, | |
546 | result->n); | |
547 | if (err != OK) | |
548 | return err; | |
549 | } | |
550 | ||
551 | result->adjacency = | |
552 | calloc(result->n, sizeof(struct xl_dagc_adjacency)); | |
553 | memcpy(result->adjacency, proto->adjacency, | |
554 | result->n * sizeof(struct xl_dagc_adjacency)); | |
555 | ||
556 | for (i = 0; i < result->n; i++) | |
557 | { | |
558 | adj = &result->adjacency[i]; | |
559 | err = _replace_ref( | |
560 | &adj->child, proto->nodes, result->nodes, result->n); | |
561 | if (err != OK) | |
562 | return err; | |
563 | ||
564 | adj->parents = | |
565 | calloc(adj->n_parents, sizeof(struct xl_dagc_node *)); | |
566 | memcpy(adj->parents, proto->adjacency[i].parents, | |
567 | adj->n_parents * sizeof(struct xl_dagc_node *)); | |
568 | for (j = 0; j < adj->n_parents; j++) | |
569 | { | |
570 | err = _replace_ref( | |
571 | &adj->parents[j], proto->nodes, | |
572 | result->nodes, result->n); | |
573 | if (err != OK) | |
574 | return err; | |
575 | } | |
576 | } | |
577 | ||
578 | qsort(result->adjacency, result->n, | |
579 | sizeof(struct xl_dagc_adjacency), _cmp_adjacency); | |
580 | ||
581 | if (result->identity != NULL) | |
582 | { | |
583 | err = xl_take(result->identity); | |
584 | if (err != OK) | |
585 | return err; | |
586 | } | |
587 | ||
588 | return OK; | |
589 | } |
0 | /* | |
1 | * env.c: expel environment definitions | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include <math.h> | |
20 | #include <string.h> | |
21 | ||
22 | #include "ubik/assert.h" | |
23 | #include "ubik/ubik.h" | |
24 | #include "ubik/env.h" | |
25 | #include "ubik/util.h" | |
26 | ||
27 | #define ENV_MAX_LOAD 0.5 | |
28 | #define ENV_INIT_CAP 8 | |
29 | #define ENV_CAP_SCALE 2 | |
30 | ||
31 | static struct xl_env root; | |
32 | ||
33 | struct xl_env * | |
34 | xl_env_get_root() | |
35 | { | |
36 | return &root; | |
37 | } | |
38 | ||
39 | no_ignore xl_error | |
40 | xl_env_init(struct xl_env *env) | |
41 | { | |
42 | env->bindings = NULL; | |
43 | env->n = 0; | |
44 | env->cap = 0; | |
45 | env->parent = xl_env_get_root(); | |
46 | env->watches = NULL; | |
47 | return OK; | |
48 | } | |
49 | ||
50 | no_ignore xl_error | |
51 | xl_env_make_child(struct xl_env *child, struct xl_env *parent) | |
52 | { | |
53 | xl_error err; | |
54 | err = xl_env_init(child); | |
55 | if (err != OK) | |
56 | return err; | |
57 | child->parent = parent; | |
58 | return OK; | |
59 | } | |
60 | ||
61 | no_ignore xl_error | |
62 | xl_env_free(struct xl_env *env) | |
63 | { | |
64 | xl_error err; | |
65 | size_t i; | |
66 | struct xl_env_watch_list *to_free; | |
67 | ||
68 | if (likely(env->bindings != NULL)) | |
69 | { | |
70 | for (i = 0; i < env->cap; i++) | |
71 | { | |
72 | if (env->bindings[i].value.any == NULL) | |
73 | continue; | |
74 | err = xl_release(env->bindings[i].uri); | |
75 | if (err != OK) | |
76 | return err; | |
77 | err = xl_release(env->bindings[i].type); | |
78 | if (err != OK) | |
79 | return err; | |
80 | err = xl_release(env->bindings[i].value.any); | |
81 | if (err != OK) | |
82 | return err; | |
83 | } | |
84 | free(env->bindings); | |
85 | } | |
86 | while (env->watches != NULL) | |
87 | { | |
88 | to_free = env->watches; | |
89 | env->watches = to_free->prev; | |
90 | ||
91 | if (to_free->watch->refcount > 1) | |
92 | to_free->watch->refcount--; | |
93 | else | |
94 | free(to_free->watch); | |
95 | free(to_free); | |
96 | } | |
97 | ||
98 | env->n = 0; | |
99 | env->cap = 0; | |
100 | env->bindings = NULL; | |
101 | ||
102 | env->watches = NULL; | |
103 | if (env != xl_env_get_root()) | |
104 | env->parent = xl_env_get_root(); | |
105 | return OK; | |
106 | } | |
107 | ||
108 | no_ignore xl_error | |
109 | xl_env_iterate( | |
110 | xl_env_cb callback, | |
111 | struct xl_env *env, | |
112 | void *callback_arg) | |
113 | { | |
114 | xl_error err; | |
115 | size_t i; | |
116 | ||
117 | for (i = 0; i < env->cap; i++) | |
118 | { | |
119 | if (env->bindings[i].uri == NULL) | |
120 | continue; | |
121 | err = callback(callback_arg, env, env->bindings[i].uri); | |
122 | if (err != OK) | |
123 | return err; | |
124 | } | |
125 | ||
126 | return OK; | |
127 | } | |
128 | ||
129 | no_ignore xl_error | |
130 | xl_env_get( | |
131 | union xl_value_or_graph *value, | |
132 | struct xl_value **type, | |
133 | struct xl_env *env, | |
134 | struct xl_uri *uri) | |
135 | { | |
136 | size_t i; | |
137 | size_t probed; | |
138 | size_t h; | |
139 | bool found; | |
140 | ||
141 | found = false; | |
142 | ||
143 | if (env->cap != 0) | |
144 | { | |
145 | h = uri->hash % env->cap; | |
146 | for (probed = 0; probed < env->cap; probed++) | |
147 | { | |
148 | i = (h + probed) % env->cap; | |
149 | if (env->bindings[i].uri == NULL) | |
150 | break; | |
151 | if (env->bindings[i].uri->hash != uri->hash) | |
152 | continue; | |
153 | if (xl_uri_eq(uri, env->bindings[i].uri)) | |
154 | { | |
155 | if (value != NULL) | |
156 | { | |
157 | value->any = env->bindings[i].value.any; | |
158 | *type = env->bindings[i].type; | |
159 | } | |
160 | found = true; | |
161 | break; | |
162 | } | |
163 | } | |
164 | } | |
165 | ||
166 | if (found) | |
167 | return OK; | |
168 | ||
169 | xl_assert(env->parent != env); | |
170 | if (env->parent == NULL) | |
171 | return xl_raise(ERR_ABSENT, "xl_get"); | |
172 | return xl_env_get(value, type, env->parent, uri); | |
173 | } | |
174 | ||
175 | no_ignore xl_error | |
176 | xl_env_present( | |
177 | bool *is_present, | |
178 | struct xl_env *env, | |
179 | struct xl_uri *uri) | |
180 | { | |
181 | xl_error err; | |
182 | ||
183 | err = xl_env_get(NULL, NULL, env, uri); | |
184 | if (err == OK) | |
185 | *is_present = true; | |
186 | else if (err->error_code == ERR_ABSENT) | |
187 | { | |
188 | free(err); | |
189 | *is_present = false; | |
190 | } | |
191 | else | |
192 | return err; | |
193 | return OK; | |
194 | } | |
195 | ||
196 | /* Inserts the given URI-value pair into the given binding array. | |
197 | * | |
198 | * This assumes that the table has space for another entry, and | |
199 | * will return ERR_FULL if the table has no spaces remaining. | |
200 | * | |
201 | * The overwrite parameter controls whether existing data will be | |
202 | * overwritten. True means that it will be, false means that it | |
203 | * will not. */ | |
204 | no_ignore static xl_error | |
205 | _insert( | |
206 | struct xl_binding *binds, | |
207 | size_t cap, | |
208 | struct xl_binding *insert, | |
209 | bool overwrite) | |
210 | { | |
211 | size_t i; | |
212 | size_t probed; | |
213 | xl_error err; | |
214 | ||
215 | i = insert->uri->hash % cap; | |
216 | for (probed = 0; probed < cap; probed++) | |
217 | { | |
218 | if (binds[i].uri == NULL) | |
219 | break; | |
220 | if (xl_uri_eq(binds[i].uri, insert->uri)) | |
221 | break; | |
222 | i = (i + 1) % cap; | |
223 | } | |
224 | if (unlikely(probed == cap)) | |
225 | return xl_raise(ERR_FULL, "env insert"); | |
226 | ||
227 | /* There was already a value at this key, we need to release our | |
228 | * reference on it. */ | |
229 | if (unlikely(binds[i].value.any != NULL)) | |
230 | { | |
231 | if (!overwrite) | |
232 | return xl_raise(ERR_PRESENT, "env overwrite"); | |
233 | err = xl_release(binds[i].value.any); | |
234 | if (err != OK) | |
235 | return err; | |
236 | err = xl_release(binds[i].uri); | |
237 | if (err != OK) | |
238 | return err; | |
239 | err = xl_release(binds[i].type); | |
240 | if (err != OK) | |
241 | return err; | |
242 | } | |
243 | ||
244 | binds[i] = *insert; | |
245 | return OK; | |
246 | } | |
247 | ||
248 | /* Resizes and rebalances an environment, scaling the capacity by | |
249 | * ENV_CAP_SCALE as defined above. | |
250 | * | |
251 | * This first allocates a new bindings array, and then reinserts the | |
252 | * bindings from the old bindings array into the new one. Finally, it | |
253 | * frees the old array and updates the env struct to reference the new | |
254 | * array. If an error occurs during rebalancing, the environment remains | |
255 | * unmodified and a nonzero error code is returned. */ | |
256 | static xl_error | |
257 | _resize_rebalance(struct xl_env *env) | |
258 | { | |
259 | struct xl_binding *new_binds; | |
260 | size_t new_cap; | |
261 | size_t i; | |
262 | size_t reinserted; | |
263 | xl_error err; | |
264 | ||
265 | if (env->cap == 0) | |
266 | new_cap = ENV_INIT_CAP; | |
267 | else | |
268 | new_cap = ENV_CAP_SCALE * env->cap; | |
269 | ||
270 | new_binds = calloc(new_cap, sizeof(struct xl_binding)); | |
271 | if (new_binds == NULL) | |
272 | return xl_raise(ERR_NO_MEMORY, "env resize"); | |
273 | ||
274 | err = OK; | |
275 | for (i = 0, reinserted = 0; i < env->cap && reinserted < env->n; i++) | |
276 | { | |
277 | if (env->bindings[i].uri == NULL) | |
278 | continue; | |
279 | ||
280 | err = _insert(new_binds, new_cap, &env->bindings[i], false); | |
281 | if (err != OK) | |
282 | break; | |
283 | } | |
284 | ||
285 | /* if an error occurs, the environment remains unchanged. */ | |
286 | if (err != OK) | |
287 | { | |
288 | free(new_binds); | |
289 | return err; | |
290 | } | |
291 | ||
292 | free(env->bindings); | |
293 | env->bindings = new_binds; | |
294 | env->cap = new_cap; | |
295 | return OK; | |
296 | } | |
297 | ||
298 | no_ignore static xl_error | |
299 | _set( | |
300 | struct xl_env *env, | |
301 | struct xl_uri *uri, | |
302 | union xl_value_or_graph value, | |
303 | struct xl_value *type, | |
304 | bool overwrite) | |
305 | { | |
306 | struct xl_binding new_binding; | |
307 | struct xl_env_watch_list *watch, *to_free; | |
308 | xl_error err, ignore; | |
309 | ||
310 | err = OK; | |
311 | if (unlikely(env->cap == 0)) | |
312 | err = _resize_rebalance(env); | |
313 | else if (unlikely((float) env->n / (float) env->cap > ENV_MAX_LOAD)) | |
314 | err = _resize_rebalance(env); | |
315 | if (err != OK) | |
316 | return err; | |
317 | ||
318 | new_binding.uri = uri; | |
319 | new_binding.value = value; | |
320 | new_binding.type = type; | |
321 | ||
322 | /* Take a reference to the value. We do this before we know whether the | |
323 | * insert succeeded, because the insert can result in a release, which | |
324 | * itself can result in a GC. We want to make sure that this doesn't get | |
325 | * GCed if we are going to keep this thing, so we take a reference now | |
326 | * and release it if the insert fails later. */ | |
327 | err = xl_take(value.any); | |
328 | if (err != OK) | |
329 | return err; | |
330 | err = xl_take(type); | |
331 | if (err != OK) | |
332 | return err; | |
333 | err = xl_take(uri); | |
334 | if (err != OK) | |
335 | return err; | |
336 | ||
337 | err = _insert(env->bindings, env->cap, &new_binding, overwrite); | |
338 | if (err != OK) | |
339 | { | |
340 | /* We're on the clean-up codepath, and we want the returned | |
341 | * error to be the actual error, not whatever went wrong during | |
342 | * the release, so we drop this error on the ground. | |
343 | * | |
344 | * (I like that it takes this much effort to ignore an | |
345 | * unignorable parameter) */ | |
346 | ignore = xl_release(value.any); | |
347 | unused(ignore); | |
348 | ignore = xl_release(type); | |
349 | unused(ignore); | |
350 | ignore = xl_release(uri); | |
351 | unused(ignore); | |
352 | ||
353 | return err; | |
354 | } | |
355 | env->n++; | |
356 | ||
357 | watch = env->watches; | |
358 | while (watch != NULL) | |
359 | { | |
360 | if (xl_uri_eq(watch->watch->uri, uri)) | |
361 | { | |
362 | err = watch->watch->cb( | |
363 | watch->watch->arg, | |
364 | watch->watch->target_env, | |
365 | watch->watch->uri); | |
366 | if (err != OK) | |
367 | return err; | |
368 | ||
369 | watch->watch->fired = true; | |
370 | } | |
371 | ||
372 | to_free = NULL; | |
373 | if (watch->watch->fired) | |
374 | { | |
375 | watch->watch->refcount--; | |
376 | ||
377 | to_free = watch; | |
378 | if (watch->prev != NULL) | |
379 | watch->prev->next = watch->next; | |
380 | if (watch->next != NULL) | |
381 | watch->next->prev = watch->prev; | |
382 | if (env->watches == watch) | |
383 | env->watches = watch->prev; | |
384 | } | |
385 | ||
386 | watch = watch->prev; | |
387 | ||
388 | if (to_free != NULL && to_free->watch->refcount == 0) | |
389 | free(to_free->watch); | |
390 | if (to_free != NULL) | |
391 | free(to_free); | |
392 | } | |
393 | ||
394 | return OK; | |
395 | } | |
396 | ||
397 | no_ignore xl_error | |
398 | xl_env_set( | |
399 | struct xl_env *env, | |
400 | struct xl_uri *uri, | |
401 | union xl_value_or_graph value, | |
402 | struct xl_value *type) | |
403 | { | |
404 | return _set(env, uri, value, type, false); | |
405 | } | |
406 | ||
407 | no_ignore xl_error | |
408 | xl_env_overwrite( | |
409 | struct xl_env *env, | |
410 | struct xl_uri *uri, | |
411 | union xl_value_or_graph value, | |
412 | struct xl_value *type) | |
413 | { | |
414 | return _set(env, uri, value, type, true); | |
415 | } | |
416 | ||
417 | no_ignore xl_error | |
418 | xl_env_watch( | |
419 | xl_env_cb callback, | |
420 | struct xl_env *env, | |
421 | struct xl_uri *uri, | |
422 | void *callback_arg) | |
423 | { | |
424 | struct xl_env_watch *watcher; | |
425 | struct xl_env_watch_list *watchlist; | |
426 | ||
427 | watcher = calloc(1, sizeof(struct xl_env_watch)); | |
428 | if (watcher == NULL) | |
429 | return xl_raise(ERR_NO_MEMORY, "env watch alloc"); | |
430 | ||
431 | watcher->uri = uri; | |
432 | watcher->cb = callback; | |
433 | watcher->arg = callback_arg; | |
434 | watcher->target_env = env; | |
435 | watcher->fired = false; | |
436 | ||
437 | while (env != NULL) | |
438 | { | |
439 | watchlist = calloc(1, sizeof(struct xl_env_watch_list)); | |
440 | if (watchlist == NULL) | |
441 | return xl_raise(ERR_NO_MEMORY, "env watchlist alloc"); | |
442 | ||
443 | watchlist->watch = watcher; | |
444 | watchlist->prev = env->watches; | |
445 | watchlist->next = NULL; | |
446 | if (env->watches != NULL) | |
447 | env->watches->next = watchlist; | |
448 | env->watches = watchlist; | |
449 | ||
450 | watcher->refcount++; | |
451 | env = env->parent; | |
452 | } | |
453 | ||
454 | return OK; | |
455 | } |
0 | /* | |
1 | * error.c: error tracking for expel runtime | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include <stdio.h> | |
20 | #include <stdlib.h> | |
21 | ||
22 | #include "ubik/ubik.h" | |
23 | #include "ubik/util.h" | |
24 | ||
25 | xl_error | |
26 | xl_error_new( | |
27 | const xl_word code, | |
28 | const char *tag, | |
29 | const char *file, | |
30 | const uint32_t lineno, | |
31 | const char *function) | |
32 | { | |
33 | struct xl_error *res; | |
34 | ||
35 | res = calloc(1, sizeof(struct xl_error)); | |
36 | res->error_code = code; | |
37 | res->tag = tag; | |
38 | res->file = file; | |
39 | res->lineno = lineno; | |
40 | res->function = function; | |
41 | return res; | |
42 | } | |
43 | ||
44 | char * | |
45 | xl_error_explain(xl_error err) | |
46 | { | |
47 | char *res; | |
48 | char *err_word_expl; | |
49 | int aspr_res; | |
50 | ||
51 | err_word_expl = xl_word_explain(err->error_code); | |
52 | aspr_res = asprintf(&res, "error %s at %s:%u: %s", | |
53 | err_word_expl, err->file, err->lineno, err->tag); | |
54 | ||
55 | if (aspr_res < 0) | |
56 | res = NULL; | |
57 | free(err_word_expl); | |
58 | return res; | |
59 | } |
0 | /* | |
1 | * eval.c: evaluate nodes in directed acyclic graphs of computation | |
2 | * Copyright (C) 2015, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include "ubik/assert.h" | |
20 | #include "ubik/dagc.h" | |
21 | #include "ubik/env.h" | |
22 | #include "ubik/ubik.h" | |
23 | #include "ubik/types.h" | |
24 | #include "ubik/util.h" | |
25 | #include "ubik/value.h" | |
26 | ||
27 | no_ignore static xl_error | |
28 | _eval_apply(struct xl_env *env, struct xl_dagc_apply *node) | |
29 | { | |
30 | xl_error err; | |
31 | struct xl_dagc_input *input; | |
32 | struct xl_dagc *result; | |
33 | struct xl_dagc *proto; | |
34 | size_t i; | |
35 | ||
36 | unused(env); | |
37 | ||
38 | if ((*node->func->known.tag & TAG_TYPE_MASK) != TAG_GRAPH) | |
39 | { | |
40 | err = xl_type_match_polyfunc( | |
41 | &proto, node->func->known.tree, node->arg->known_type); | |
42 | if (err != OK) | |
43 | return err; | |
44 | } | |
45 | else | |
46 | { | |
47 | proto = node->func->known.graph; | |
48 | } | |
49 | ||
50 | if (proto->in_arity == 0) | |
51 | return xl_raise(ERR_BAD_TYPE, "apply: graph has no inputs"); | |
52 | ||
53 | err = xl_dagc_copy(&result, proto); | |
54 | if (err != OK) | |
55 | return err; | |
56 | node->head.known.graph = result; | |
57 | ||
58 | err = xl_take(result); | |
59 | if (err != OK) | |
60 | return err; | |
61 | ||
62 | /* Take an input node off the front, shift the remaining ones left. */ | |
63 | input = (struct xl_dagc_input *) result->inputs[0]; | |
64 | result->in_arity--; | |
65 | for (i = 0; i < result->in_arity; i++) | |
66 | result->inputs[i] = result->inputs[i + 1]; | |
67 | ||
68 | input->head.flags = XL_DAGC_FLAG_COMPLETE; | |
69 | ||
70 | input->head.known_type = node->arg->known_type; | |
71 | err = xl_take(input->head.known_type); | |
72 | if (err != OK) | |
73 | return err; | |
74 | ||
75 | input->head.known = node->arg->known; | |
76 | err = xl_take(input->head.known.any); | |
77 | if (err != OK) | |
78 | return err; | |
79 | ||
80 | err = xl_value_new(&node->head.known_type); | |
81 | if (err != OK) | |
82 | return err; | |
83 | err = xl_type_func_apply(node->head.known_type, node->func->known_type); | |
84 | if (err != OK) | |
85 | return err; | |
86 | ||
87 | node->head.flags |= XL_DAGC_FLAG_COMPLETE; | |
88 | return OK; | |
89 | } | |
90 | ||
91 | no_ignore static xl_error | |
92 | _eval_const(struct xl_env *env, struct xl_dagc_const *node) | |
93 | { | |
94 | xl_error err; | |
95 | unused(env); | |
96 | ||
97 | /* We end up having two references for a single value from a single | |
98 | * node; this is so we don't have to worry about whether things are | |
99 | * populated when we eventually free the graph. */ | |
100 | node->head.known_type = node->type; | |
101 | err = xl_take(node->type); | |
102 | if (err != OK) | |
103 | return err; | |
104 | ||
105 | node->head.known = node->value; | |
106 | err = xl_take(node->head.known.any); | |
107 | if (err != OK) | |
108 | return err; | |
109 | ||
110 | node->head.flags |= XL_DAGC_FLAG_COMPLETE; | |
111 | return OK; | |
112 | } | |
113 | ||
114 | no_ignore static xl_error | |
115 | _eval_ref(struct xl_env *env, struct xl_dagc_ref *node) | |
116 | { | |
117 | xl_error err; | |
118 | unused(env); | |
119 | ||
120 | node->head.known_type = node->referrent->known_type; | |
121 | err = xl_take(node->head.known_type); | |
122 | if (err != OK) | |
123 | return err; | |
124 | ||
125 | node->head.known.any = node->referrent->known.any; | |
126 | err = xl_take(node->head.known.any); | |
127 | if (err != OK) | |
128 | return err; | |
129 | ||
130 | node->head.flags |= XL_DAGC_FLAG_COMPLETE; | |
131 | return OK; | |
132 | } | |
133 | ||
134 | no_ignore static xl_error | |
135 | _mark_load_complete( | |
136 | void *node_void, | |
137 | struct xl_env *env, | |
138 | struct xl_uri *uri) | |
139 | { | |
140 | struct xl_dagc_node *node; | |
141 | unused(env); | |
142 | unused(uri); | |
143 | ||
144 | node = (struct xl_dagc_node *) node_void; | |
145 | node->flags &= ~XL_DAGC_FLAG_WAIT_DATA; | |
146 | return OK; | |
147 | } | |
148 | ||
149 | no_ignore static xl_error | |
150 | _eval_load(struct xl_env *env, struct xl_dagc_load *node) | |
151 | { | |
152 | union xl_value_or_graph value; | |
153 | struct xl_value *type; | |
154 | xl_error err; | |
155 | ||
156 | err = xl_env_get(&value, &type, env, node->loc); | |
157 | if (err != OK) | |
158 | { | |
159 | /* native funcs never reappear; they're gone forever. */ | |
160 | if (node->loc->scope == SCOPE_NATIVE) | |
161 | return err; | |
162 | ||
163 | if (err->error_code == ERR_ABSENT) | |
164 | { | |
165 | free(err); | |
166 | node->head.flags |= XL_DAGC_FLAG_WAIT_DATA; | |
167 | err = xl_env_watch( | |
168 | _mark_load_complete, env, node->loc, node); | |
169 | if (err != OK) | |
170 | return err; | |
171 | return OK; | |
172 | } | |
173 | return err; | |
174 | } | |
175 | ||
176 | err = xl_take(value.any); | |
177 | if (err != OK) | |
178 | return err; | |
179 | ||
180 | err = xl_take(type); | |
181 | if (err != OK) | |
182 | return err; | |
183 | ||
184 | node->head.known_type = type; | |
185 | node->head.known = value; | |
186 | ||
187 | node->head.flags |= XL_DAGC_FLAG_COMPLETE; | |
188 | return OK; | |
189 | } | |
190 | ||
191 | no_ignore static xl_error | |
192 | _eval_cond(struct xl_env *env, struct xl_dagc_cond *cond) | |
193 | { | |
194 | struct xl_dagc_node *res; | |
195 | xl_error err; | |
196 | bool condition; | |
197 | ||
198 | unused(env); | |
199 | ||
200 | err = xl_value_as_bool(&condition, cond->condition->known.tree); | |
201 | if (err != OK) | |
202 | return err; | |
203 | ||
204 | res = condition ? cond->if_true : cond->if_false; | |
205 | ||
206 | if (res->known.any == NULL) | |
207 | { | |
208 | /* If this is true, we just got done evaluating the condition | |
209 | * but we haven't scheduled the if_true/if_false nodes. We set | |
210 | * our wait flag on the appropriate node and let the scheduler | |
211 | * pick it up and reevaluate us later. */ | |
212 | cond->head.flags |= condition | |
213 | ? XL_DAGC_FLAG_WAIT_D2 | |
214 | : XL_DAGC_FLAG_WAIT_D3; | |
215 | return OK; | |
216 | } | |
217 | ||
218 | cond->head.known_type = res->known_type; | |
219 | cond->head.known = res->known; | |
220 | ||
221 | err = xl_take(cond->head.known_type); | |
222 | if (err != OK) | |
223 | return err; | |
224 | err = xl_take(cond->head.known.any); | |
225 | if (err != OK) | |
226 | return err; | |
227 | ||
228 | cond->head.flags |= XL_DAGC_FLAG_COMPLETE; | |
229 | return OK; | |
230 | } | |
231 | ||
232 | no_ignore static xl_error | |
233 | _eval_store(struct xl_env *env, struct xl_dagc_store *node) | |
234 | { | |
235 | xl_error err; | |
236 | ||
237 | node->head.known_type = node->value->known_type; | |
238 | node->head.known = node->value->known; | |
239 | ||
240 | err = xl_take(node->head.known.any); | |
241 | if (err != OK) | |
242 | return err; | |
243 | ||
244 | err = xl_take(node->head.known_type); | |
245 | if (err != OK) | |
246 | return err; | |
247 | ||
248 | node->head.flags |= XL_DAGC_FLAG_COMPLETE; | |
249 | return xl_env_set( | |
250 | env, node->loc, node->value->known, node->value->known_type); | |
251 | } | |
252 | ||
253 | no_ignore static xl_error | |
254 | _eval_input(struct xl_env *env, struct xl_dagc_input *node) | |
255 | { | |
256 | unused(env); | |
257 | unused(node); | |
258 | ||
259 | node->head.flags |= XL_DAGC_FLAG_COMPLETE; | |
260 | return OK; | |
261 | } | |
262 | ||
263 | no_ignore xl_error | |
264 | xl_dagc_node_eval( | |
265 | struct xl_env *env, | |
266 | struct xl_dagc_node *node) | |
267 | { | |
268 | xl_error err; | |
269 | ||
270 | xl_assert(!(node->flags & XL_DAGC_WAIT_MASK)); | |
271 | ||
272 | switch (node->node_type) | |
273 | { | |
274 | case DAGC_NODE_APPLY: | |
275 | err = _eval_apply(env, (struct xl_dagc_apply *) node); | |
276 | break; | |
277 | case DAGC_NODE_CONST: | |
278 | err = _eval_const(env, (struct xl_dagc_const *) node); | |
279 | break; | |
280 | case DAGC_NODE_LOAD: | |
281 | err = _eval_load(env, (struct xl_dagc_load *) node); | |
282 | break; | |
283 | case DAGC_NODE_STORE: | |
284 | err = _eval_store(env, (struct xl_dagc_store *) node); | |
285 | break; | |
286 | case DAGC_NODE_INPUT: | |
287 | err = _eval_input(env, (struct xl_dagc_input *) node); | |
288 | break; | |
289 | case DAGC_NODE_COND: | |
290 | err = _eval_cond(env, (struct xl_dagc_cond *) node); | |
291 | break; | |
292 | case DAGC_NODE_REF: | |
293 | err = _eval_ref(env, (struct xl_dagc_ref *) node); | |
294 | break; | |
295 | case DAGC_NODE_NATIVE: | |
296 | return xl_raise(ERR_BAD_TYPE, "node_eval: can't eval native"); | |
297 | default: | |
298 | return xl_raise(ERR_UNKNOWN_TYPE, "node_eval"); | |
299 | } | |
300 | ||
301 | if (err != OK) | |
302 | return err; | |
303 | ||
304 | return OK; | |
305 | } |
0 | /* | |
1 | * explain.c: human descriptions of runtime objects | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | #include <inttypes.h> | |
20 | #include <stdio.h> | |
21 | #include <stdlib.h> | |
22 | ||
23 | #include "ubik/dagc.h" | |
24 | #include "ubik/ubik.h" | |
25 | #include "ubik/uri.h" | |
26 | #include "ubik/util.h" | |
27 | ||
28 | char * | |
29 | xl_node_explain(struct xl_dagc_node *node) | |
30 | { | |
31 | union xl_dagc_any_node *n; | |
32 | char *res; | |
33 | char *node_type; | |
34 | char *id; | |
35 | char *uri; | |
36 | int aspr_res; | |
37 | ||
38 | node_type = xl_word_explain(node->node_type); | |
39 | id = xl_word_explain(node->id); | |
40 | ||
41 | n = (union xl_dagc_any_node *) node; | |
42 | ||
43 | if (node->node_type == DAGC_NODE_CONST) | |
44 | { | |
45 | if (*n->as_const.value.tag == | |
46 | (TAG_VALUE | TAG_LEFT_WORD | TAG_RIGHT_WORD)) | |
47 | { | |
48 | aspr_res = asprintf( | |
49 | &res, | |
50 | "%s %s @%hx = (0x%02" PRIX64 ", 0x%02" PRIX64 ")", | |
51 | node_type, id, (short)((uintptr_t) n), | |
52 | n->as_const.value.tree->left.w, | |
53 | n->as_const.value.tree->right.w); | |
54 | } | |
55 | else | |
56 | { | |
57 | aspr_res = asprintf( | |
58 | &res, "%s %s @%hx tag = 0x%hx", | |
59 | node_type, id, (short)((uintptr_t) n), | |
60 | *n->as_const.value.tag); | |
61 | } | |
62 | } | |
63 | else if (node->node_type == DAGC_NODE_LOAD) | |
64 | { | |
65 | uri = xl_uri_explain(n->as_load.loc); | |
66 | aspr_res = asprintf( | |
67 | &res, "%s %s @%hx uri %s", | |
68 | node_type, id, (short)((uintptr_t) n), uri); | |
69 | free(uri); | |
70 | } | |
71 | else if (node->node_type == DAGC_NODE_STORE) | |
72 | { | |
73 | uri = xl_uri_explain(n->as_store.loc); | |
74 | aspr_res = asprintf( | |
75 | &res, "%s %s @%hx uri %s", | |
76 | node_type, id, (short)((uintptr_t) n), uri); | |
77 | free(uri); | |
78 | } | |
79 | else | |
80 | { | |
81 | aspr_res = asprintf( | |
82 | &res, "%s %s @%hx", | |
83 | node_type, id, (short)((uintptr_t) n)); | |
84 | } | |
85 | ||
86 | if (aspr_res < 0) | |
87 | res = NULL; | |
88 | free(node_type); | |
89 | free(id); | |
90 | return res; | |
91 | } |
0 | /* | |
1 | * refcount.c: reference counting implementation | |
2 | * Copyright (C) 2016, Haldean Brown | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * GNU General Public License for more details. | |
13 | * | |
14 | * You should have received a copy of the GNU General Public License along | |
15 | * with this program; if not, write to the Free Software Foundation, Inc., | |
16 | * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
17 | */ | |
18 | ||
19 | /* Define XL_GC_DEBUG to have garbage collection information | |
20 | * printed to stderr. */ | |
21 | ||
22 | #include <stdio.h> | |
23 | #define gc_out stderr | |
24 | ||
25 | #include <inttypes.h> | |
26 | #include <stdbool.h> | |
27 | #include <stdlib.h> | |
28 | #include <string.h> | |
29 | ||
30 | #include "ubik/assert.h" | |
31 | #include "ubik/dagc.h" | |
32 | #include "ubik/ubik.h" | |
33 | #include "ubik/gc.h" | |
34 | #include "ubik/pointerset.h" | |
35 | #include "ubik/stream.h" | |
36 | #include "ubik/uri.h" | |
37 | #include "ubik/util.h" | |
38 | #include "ubik/vector.h" | |
39 | #include "ubik/value.h" | |
40 | ||
41 | static struct xl_gc_info *gc_stats; | |
42 | ||
43 | static struct xl_vector graph_alloc = {0}; | |
44 | static struct xl_vector graph_freed = {0}; | |
45 | ||
46 | static struct xl_vector value_alloc = {0}; | |
47 | static struct xl_vector value_freed = {0}; | |
48 | ||
49 | static struct xl_uri *graph_trace = NULL; | |
50 | static char *graph_trace_str = NULL; | |
51 | ||
52 | void | |
53 | xl_gc_start() | |
54 | { | |
55 | char *trace_uri_str; | |
56 | char *buf; | |
57 | xl_error err; | |
58 | ||
59 | if (unlikely(gc_stats != NULL)) | |
60 | free(gc_stats); | |
61 | gc_stats = calloc(1, sizeof(struct xl_gc_info)); | |
62 | xl_assert(gc_stats != NULL); | |
63 | ||
64 | trace_uri_str = getenv("EXPEL_TRACE_GRAPH"); | |
65 | if (trace_uri_str != NULL) | |
66 | { | |
67 | graph_trace = calloc(1, sizeof(struct xl_uri)); | |
68 | if (graph_trace == NULL) | |
69 | { | |
70 | fprintf(gc_out, "couldn't trace: alloc uri failed\n"); | |
71 | return; | |
72 | } | |
73 | ||
74 | err = xl_uri_parse(graph_trace, trace_uri_str); | |
75 | if (err != OK) | |
76 | { | |
77 | buf = xl_error_explain(err); | |
78 | fprintf(gc_out, "couldn't trace: parse uri failed: %s\n", buf); | |
79 | free(buf); | |
80 | free(graph_trace); | |
81 | graph_trace = NULL; | |
82 | return; | |
83 | } | |
84 | ||
85 | err = xl_take(graph_trace); | |
86 | if (err != OK) | |
87 | { | |
88 | buf = xl_error_explain(err); | |
89 | fprintf(gc_out, "couldn't trace: take uri failed: %s\n", buf); | |
90 | free(buf); | |
91 | free(graph_trace); | |
92 | free(graph_trace->name); | |
93 | if (graph_trace->source != NULL) | |
94 | free(graph_trace->source); | |
95 | graph_trace = NULL; | |
96 | return; | |
97 | } | |
98 | ||
99 | graph_trace_str = trace_uri_str; | |
100 | fprintf(gc_out, "tracing %s\n", graph_trace_str); | |
101 | } | |
102 | } | |
103 | ||
104 | void | |
105 | xl_gc_teardown() | |
106 | { | |
107 | xl_error err; | |
108 | ||
109 | #if XL_GC_DEBUG && XL_GC_DEBUG_V | |
110 | size_t i; | |
111 | bool present; | |
112 | bool any_leaked; | |
113 | struct xl_dagc *graph; | |
114 | struct xl_value *value; | |
115 | char *buf; | |
116 | struct xl_stream s; | |
117 | ||
118 | err = xl_stream_wfilep(&s, gc_out); | |
119 | if (err != OK) | |
120 | { | |
121 | fprintf(gc_out, "couldn't open stream to gc output\n"); | |
122 | return; | |
123 | } | |
124 | ||
125 | fprintf(gc_out, "========================================\ngc stats:\n"); | |
126 | fprintf(gc_out, "alloc %lu vals, %lu freed, %ld remaining\n", | |
127 | gc_stats->n_val_allocs, | |
128 | gc_stats->n_val_frees, | |
129 | (int64_t) gc_stats->n_val_allocs - gc_stats->n_val_frees); | |
130 | fprintf(gc_out, "alloc %lu graphs, %lu freed, %ld remaining\n", | |
131 | gc_stats->n_graph_allocs, | |
132 | gc_stats->n_graph_frees, | |
133 | (int64_t) gc_stats->n_graph_allocs - gc_stats->n_graph_frees); | |
134 | ||
135 | fprintf(gc_out, "========================================\nleaked graphs:\n"); | |
136 | any_leaked = false; | |
137 | for (i = 0; i < graph_alloc.n; i++) | |
138 | { | |
139 | graph = (struct xl_dagc *) graph_alloc.elems[i]; | |
140 | err = xl_pointer_set_present(&present, &graph_freed, graph); | |
141 | if (err != OK || present) | |
142 | continue; | |
143 | any_leaked = true; | |
144 | ||
145 | fprintf(gc_out, "%016" PRIxPTR ":\n", (uintptr_t) graph); | |
146 | fprintf(gc_out, "\t%lu leaked refs\n", graph->refcount); | |
147 | ||
148 | if (graph->identity == NULL) | |
149 | buf = NULL; | |
150 | else | |
151 | buf = xl_uri_explain(graph->identity); | |
152 | fprintf(gc_out, "\tidentity %s\n", buf); | |
153 | if (buf != NULL) | |
154 | free(buf); | |
155 | ||
156 | fprintf(gc_out, "\tin arity %lu\n", graph->in_arity); | |
157 | } | |
158 | if (!any_leaked) | |
159 | fprintf(gc_out, "none!\n"); | |
160 | ||
161 | fprintf(gc_out, "========================================\nleaked values:\n"); | |
162 | any_leaked = false; | |
163 | for (i = 0; i < value_alloc.n; i++) | |
164 | { | |
165 | ||
166 | value = (struct xl_value *) value_alloc.elems[i]; | |
167 | err = xl_pointer_set_present(&present, &value_freed, value); | |
168 | if (err != OK || present) | |
169 | continue; | |
170 | any_leaked = true; | |
171 | ||
172 | fprintf(gc_out, "%016" PRIxPTR ":\n", (uintptr_t) value); | |
173 | fprintf(gc_out, "\t%lu leaked refs\n", value->refcount); | |
174 | fprintf(gc_out, "\t"); | |
175 | err = xl_value_print(&s, value); | |
176 | if (err != OK) | |
177 | fprintf(gc_out, "...couldn't print value"); | |
178 | fprintf(gc_out, "\n"); | |
179 | } | |
180 | if (!any_leaked) | |
181 | fprintf(gc_out, "none!\n"); | |
182 | fprintf(gc_out, "========================================\n"); | |
183 | #endif | |
184 | ||
185 | xl_vector_free(&graph_alloc); | |
186 | xl_vector_free(&graph_freed); | |
187 | xl_vector_free(&value_alloc); | |
188 | xl_vector_free(&value_freed); | |
189 | ||
190 | xl_gc_free_all(); | |
191 | free(gc_stats); | |
192 | gc_stats = NULL; | |
193 | ||
194 | if (graph_trace != NULL) | |
195 | { | |
196 | err = xl_release(graph_trace); | |
197 | if (err != OK) | |
198 | fprintf(gc_out, "couldn't free graph trace\n"); | |
199 | graph_trace = NULL; | |
200 | } | |
201 | } | |
202 | ||
203 | void | |
204 | xl_gc_get_stats(struct xl_gc_info *stats) | |
205 | { | |
206 | memcpy(stats, gc_stats, sizeof(struct xl_gc_info)); | |
207 | } | |
208 | ||
209 | void | |
210 | xl_gc_free_all() | |
211 | { | |
212 | } | |
213 | ||
214 | no_ignore xl_error | |
215 | xl_dagc_alloc( | |
216 | struct xl_dagc **graph, | |
217 | size_t n_nodes, | |
218 | size_t size, | |
219 | void *copy_from) | |
220 | { | |
221 | size_t i; | |
222 | union xl_dagc_any_node *node_memory; | |
223 | ||
224 | #if XL_GC_DEBUG && XL_GC_DEBUG_V | |
225 | xl_error err; | |
226 | #endif | |
227 | ||
228 | *graph = calloc(1, size); | |
229 | if (*graph == NULL) | |
230 | return xl_raise(ERR_NO_MEMORY, "graph allocation"); | |
231 | ||
232 | #if XL_GC_DEBUG | |
233 | #if XL_GC_DEBUG_V | |
234 | fprintf(gc_out, "alloc graph %hx\n", | |
235 | (uint16_t) ((uintptr_t) *graph)); | |
236 | err = xl_pointer_set_add(NULL, &graph_alloc, *graph); | |
237 | if (err != OK) | |
238 | return err; | |
239 | #endif | |
240 | gc_stats->n_graph_allocs++; | |
241 | #endif | |
242 | ||
243 | if (copy_from != NULL) | |
244 | memcpy(*graph, copy_from, size); | |
245 | ||
246 | /* Every node is a different size in this regime of ours, which means we | |
247 | * can't just allocate a list of xl_dagc_nodes and call it a day; they | |
248 | * would all be too small. But we want the API of the graph to make it | |
249 | * look like everything is a node, so here's what we do; we allocate a | |
250 | * big memory region that we're going to use for all of our nodes, and | |
251 | * then we make references into that region that are all spaced | |
252 | * max-node-sized apart. While this means there's an extra indirection | |
253 | * for each access to a node, sequential node access is rare and the API | |
254 | * niceness is worth it. */ | |
255 | node_memory = calloc(n_nodes, sizeof(union xl_dagc_any_node)); | |
256 | if (node_memory == NULL) | |
257 | return xl_raise(ERR_NO_MEMORY, "graph allocation"); | |
258 | ||
259 | (*graph)->nodes = calloc(n_nodes, sizeof(struct xl_dagc_node *)); | |
260 | if ((*graph)->nodes == NULL) | |
261 | return xl_raise(ERR_NO_MEMORY, "graph allocation"); | |
262 | ||
263 | for (i = 0; i < n_nodes; i++) | |
264 | { | |
265 | (*graph)->nodes[i] = (struct xl_dagc_node *) &node_memory[i]; | |
266 | } | |
267 | (*graph)->n = n_nodes; | |
268 | return OK; | |
269 | } | |
270 | ||
271 | /* Creates a new value. */ | |
272 | no_ignore xl_error | |
273 | xl_value_new(struct xl_value **v) | |
274 | { | |
275 | #if XL_GC_DEBUG && XL_GC_DEBUG_V | |
276 | xl_error err; | |
277 | #endif | |
278 | ||
279 | xl_assert(gc_stats != NULL); | |
280 | ||
281 | *v = calloc(1, sizeof(struct xl_value)); | |
282 | if (*v == NULL) | |
283 | return xl_raise(ERR_NO_MEMORY, "new value"); | |
284 | (*v)->tag = TAG_VALUE; | |
285 | (*v)->refcount = 1; | |
286 | ||
287 | #if XL_GC_DEBUG | |
288 | gc_stats->n_val_allocs++; | |
289 | ||
290 | #if XL_GC_DEBUG_V | |
291 | err = xl_pointer_set_add(NULL, &value_alloc, *v); | |
292 | if (err != OK) | |
293 | return err; | |
294 | #endif | |
295 | #endif | |
296 | ||
297 | return OK; | |
298 | } | |
299 | ||
300 | /* Takes a reference to the given tree. */ | |
301 | no_ignore xl_error | |
302 | xl_take(void *p) | |
303 | { | |
304 | struct xl_value *v; | |
305 | struct xl_dagc *g; | |
306 | struct xl_uri *u; | |
307 | xl_tag tag; | |
308 | ||
309 | tag = *((xl_tag *) p); | |
310 | ||
311 | if ((tag & TAG_TYPE_MASK) == TAG_VALUE) | |
312 | { | |
313 | v = (struct xl_value *) p; | |
314 | if (unlikely(v->refcount == UINT64_MAX)) | |
315 | return xl_raise(ERR_REFCOUNT_OVERFLOW, "take"); | |
316 | v->refcount++; | |
317 | return OK; | |
318 | } | |
319 | if ((tag & TAG_TYPE_MASK) == TAG_GRAPH) | |
320 | { | |
321 | g = (struct xl_dagc *) p; | |
322 | if (unlikely(g->refcount == UINT64_MAX)) | |
323 | return xl_raise(ERR_REFCOUNT_OVERFLOW, "take"); | |
324 | g->refcount++; | |
325 | ||
326 | if (g->identity != NULL && graph_trace != NULL | |
327 | && unlikely(xl_uri_eq(g->identity, graph_trace))) | |
328 | { | |
329 | fprintf(gc_out, "\ntaking ref to traced %s\n", graph_trace_str); | |
330 | fprintf(gc_out, "addr 0x%" PRIxPTR " arity %lu new ref %lu\n", | |
331 | (uintptr_t) g, g->in_arity, g->refcount); | |
332 | xl_trace_print(); | |
333 | } | |
334 | return OK; | |
335 | } | |
336 | if ((tag & TAG_TYPE_MASK) == TAG_URI) | |
337 | { | |
338 | u = (struct xl_uri *) p; | |
339 | if (unlikely(u->refcount == UINT64_MAX)) | |
340 | return xl_raise(ERR_REFCOUNT_OVERFLOW, "take"); | |
341 | u->refcount++; | |
342 | return OK; | |
343 | } | |
344 | return xl_raise(ERR_BAD_TAG, "take"); | |
345 | } | |
346 | ||
347 | /* Releases a reference to the given tree. */ | |
348 | no_ignore static xl_error | |
349 | _release_value(struct xl_value *v) | |
350 | { | |
351 | xl_error err; | |
352 | ||
353 | if (unlikely(v->refcount == 0)) | |
354 | return xl_raise(ERR_REFCOUNT_UNDERFLOW, "release"); | |
355 | v->refcount--; | |
356 | ||
357 | err = OK; | |
358 | ||
359 | if (v->refcount == 0) | |
360 | { | |
361 | if (v->tag & (TAG_LEFT_NODE | TAG_LEFT_GRAPH)) | |
362 | err = xl_release(v->left.any); | |
363 | if (err == OK && (v->tag & (TAG_RIGHT_NODE | TAG_RIGHT_GRAPH))) | |
364 | err = xl_release(v->right.any); | |
365 | ||
366 | #if XL_GC_DEBUG | |
367 | gc_stats->n_val_frees++; | |
368 | #if XL_GC_DEBUG_V | |
369 | err = xl_pointer_set_add(NULL, &value_freed, v); | |
370 | if (err != OK) | |
371 | return err; | |
372 | #endif | |
373 | #endif | |
374 | ||
375 | free(v); | |
376 | } | |
377 | ||
378 | return err; | |
379 | } | |
380 | ||
381 | no_ignore static xl_error | |
382 | _release_node(struct xl_dagc_node *node) | |
383 | { | |
384 | union xl_dagc_any_node *n; | |
385 | xl_error err; | |
386 | ||
387 | n = (union xl_dagc_any_node *) node; | |
388 | ||
389 | switch (node->node_type) | |
390 | { | |
391 | case DAGC_NODE_APPLY: | |
392 | case DAGC_NODE_COND: | |
393 | case DAGC_NODE_INPUT: | |
394 | case DAGC_NODE_NATIVE: | |
395 | case DAGC_NODE_REF: | |
396 | break; | |
397 | ||
398 | case DAGC_NODE_CONST: | |
399 | err = xl_release(n->as_const.type); | |
400 | if (err != OK) | |
401 | return err; | |
402 | err = xl_release(n->as_const.value.any); | |
403 | if (err != OK) | |
404 | return err; | |
405 | break; | |
406 | ||
407 | case DAGC_NODE_LOAD: | |
408 | err = xl_release(n->as_load.loc); | |
409 | if (err != OK) | |
410 | return err; | |
411 | break; | |
412 | ||
413 | case DAGC_NODE_STORE: | |
414 | err = xl_release(n->as_store.loc); | |
415 | if (err != OK) | |
416 | return err; | |
417 | break; | |
418 | ||
419 | default: | |
420 | return xl_raise(ERR_UNKNOWN_TYPE, "release node: node type"); | |
421 | } | |
422 | ||
423 | if (node->known_type != NULL) | |
424 | { | |
425 | err = xl_release(node->known_type); | |
426 | if (err != OK) | |
427 | return err; | |
428 | } | |
429 | if (node->known.any != NULL) | |
430 | { | |
431 | err = xl_release(node->known.any); | |
432 | if (err != OK) | |
433 | return err; | |
434 | } | |
435 | return OK; | |
436 | } | |
437 | ||
438 | no_ignore static xl_error | |
439 | _release_graph(struct xl_dagc *g) | |
440 | { | |
441 | size_t i; | |
442 | xl_error err; | |
443 | uint64_t self_refs; | |
444 | struct xl_dagc_const *n; | |
445 | ||
446 | #if XL_GC_DEBUG && XL_GC_DEBUG_V | |
447 | char *buf; | |
448 | #endif | |
449 | ||
450 | if (unlikely(g->refcount == 0)) | |
451 | return xl_raise(ERR_REFCOUNT_UNDERFLOW, "release"); | |
452 | g->refcount--; | |
453 | ||
454 | if (g->identity != NULL && graph_trace != NULL | |
455 | && unlikely(xl_uri_eq(g->identity, graph_trace))) | |
456 | { | |
457 | fprintf(gc_out, "\nreleasing ref to traced %s\n", | |
458 | graph_trace_str); | |
459 | fprintf(gc_out, "addr 0x%" PRIxPTR " arity %lu new ref %lu\n", | |
460 | (uintptr_t) g, g->in_arity, g->refcount); | |
461 | xl_trace_print(); | |
462 | } | |
463 | ||
464 | self_refs = 0; | |
465 | for (i = 0; i < g->n; i++) | |
466 | { | |
467 | if (g->nodes[i]->known.graph == g) | |
468 | self_refs++; | |
469 | ||
470 | n = (struct xl_dagc_const *) g->nodes[i]; | |
471 | if (n->head.node_type != DAGC_NODE_CONST) | |
472 | continue; | |
473 | if (n->value.graph == g) | |
474 | self_refs++; | |
475 | } | |
476 | ||
477 | if (g->refcount > self_refs) | |
478 | return OK; | |
479 | ||
480 | for (i = 0; i < g->n; i++) | |
481 | { | |
482 | err = _release_node(g->nodes[i]); | |
483 | if (err != OK) | |
484 | return err; | |
485 | } | |
486 | /* This is tricky; the nodes are allocated all at once, even though it | |
487 | * looks like they're all allocated on their own. Check out | |
488 | * xl_dagc_graph_alloc for more deets. */ | |
489 | free(g->nodes[0]); | |
490 | free(g->nodes); | |
491 | ||
492 | for (i = 0; i < g->n; i++) | |
493 | free(g->adjacency[i].parents); | |
494 | free(g->adjacency); | |
495 | ||
496 | free(g->inputs); | |
497 | free(g->terminals); | |
498 | ||
499 | #if XL_GC_DEBUG | |
500 | #if XL_GC_DEBUG_V | |
501 | fprintf(gc_out, "free graph %hx\n", | |
502 | (uint16_t) ((uintptr_t) g)); | |
503 | fprintf(gc_out, "\tarity %lu\n", g->in_arity); | |
504 | if (g->identity != NULL) | |
505 | { | |
506 | buf = xl_uri_explain(g->identity); | |
507 | fprintf(gc_out, "\tidentity %s (%lu)\n", | |
508 | buf, g->identity->refcount); | |
509 | free(buf); | |
510 | } | |
511 | else | |
512 | fprintf(gc_out, "\tidentity null\n"); | |
513 | err = xl_pointer_set_add(NULL, &graph_freed, g); | |
514 | if (err != OK) | |
515 | return err; | |
516 | #endif | |
517 | gc_stats->n_graph_frees++; | |
518 | #endif | |
519 | ||
520 | if (g->identity != NULL) | |
521 | { | |
522 | err = xl_release(g->identity); | |
523 | if (err != OK) | |
524 | return err; | |
525 | } | |
526 | ||
527 |