git @ Cat's Eye Technologies Kosheri / f3a6969
Initial import of Kosheri sources. Cat's Eye Technologies 10 years ago
52 changed file(s) with 6140 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
0 Kosheri
1 =======
2
3 Kosheri is a stack-based virtual machine. Here's what it offers:
4
5 * Garbage-collection, tagged tuples, dictionaries, function values,
6 coroutines, lightweight processes, textual and binary serialization,
7 and an assembler and disassembler. See "Features", below, for
8 more information.
9 * A really small code footprint. On Ubuntu 10.04 LTS, a minimal VM
10 executor compiles to an executable less than 16K in size.
11 * A clean, almost pedantic implementation. See "Implementation", below.
12 * Very few build dependencies. See "Build requirements", below.
13 * An extremely orthogonal architecture. See "Architecture", below.
14 * A reasonably efficient implementation. See "Performance", below.
15
16 Features
17 --------
18
19 * Ability to manipulate values of boolean, 32-bit integer,
20 process reference ("pid"), immutable string ("symbol"), and
21 tagged tuple type.
22 * Support for manipulating certain tagged tuple types:
23 dictionaries, function values, and activation records.
24 * Support for closures and coroutines via appropriate use of
25 activation records. (ARs retain some state after being
26 called; if this is not cleared, they can be continued.)
27 * A simple, mark-and-sweep garbage collector (for tuples and
28 symbols; everything else lives on the stack.)
29 * Concurrent operation. Each lightweight process can be a
30 VM process or a native process. Native processes are used to
31 implement interfaces to the rest of the world. Multitasking
32 is pre-emptive for VM processes, and co-operative for native
33 processes. Concurrency is implemented in the VM; system threads
34 and processes are not used. Interprocess communication is done
35 with Erlang-style messaging to processes' mailboxes.
36
37 Implementation
38 --------------
39
40 The code is generally written in BSD style(9). It compiles under
41 `-ansi -pedantic` with almost all `gcc` warnings enabled and treated as
42 errors. The core interfaces are `const`ified. `assert`s are
43 plentiful. I've tried to limit the amount of typecasting used in the
44 code, but of course there are some places where it is necessary.
45
46 Functions are often written in a straightforward, almost pedantic
47 fashion; there are of course some exceptions here too, like the
48 direct threading support.
49
50 Build requirements
51 ------------------
52
53 Only the following tools are required to build the VM and its tools:
54
55 * an ANSI C compiler (default is `gcc`) and linker (`ranlib`, `ar`)
56 * GNU Make
57
58 I have vague plans to remove even the dependency on GNU Make (the
59 code is so small that rebuilding the whole thing is not a huge burden,
60 so it could be done with a shell script or a custom build tool.)
61
62 Even `libc` is not a strict requirement for building the VM; a
63 few functions from `libc` that the code uses are implemented
64 independently in the code. The `standalone` target builds the
65 system with `-nostdlib`. However, while it builds it currently
66 does not link, as it requires some memory allocator to link to,
67 and it doesn't have one... yet.
68
69 Architecture
70 ------------
71
72 From inside the virtual machine, it's a truism that "everything's
73 a value, and every value that's not an atomic value is a tagged tuple."
74 The latter is true even for VM code and activation records and
75 dictionaries.
76
77 Moreover, this truism largely holds in the C code as well. In many
78 places in the assembler and elsewhere, we don't just use C structs
79 to hold our data, we use `struct value`s.
80
81 Every value has defined external representations, in human-readable and
82 compact binary forms, which can be generated and parsed.
83
84 The rest of this section is kind of scattered...
85
86 Some more notes on how the runtime is written in C...
87
88 Every C function in the Kosheri runtime is run in some environment.
89
90 We try to assume as little about the surrounding environment (e.g., OS)
91 as possible, and to present the world to these functions in as Kosheri-
92 like a way as possible.
93
94 Maybe not every function, but lots of functions. The ones that really
95 matter. Top-level functions especially -- (the ones that would be
96 command-line utilities in a Unix system.)
97
98 Every such function is passed a runtime environment. This runtime
99 environment consist of:
100
101 -- arguments that were passed to the function in the form of a Kosheri
102 dictionary (value_dict). The function may also have a data structure
103 associated with it (the "argdecl") that facilitates checking these
104 arguments for syntactic correctness and automatically returning an error
105 if they don't meet those checks. (this part's not done yet)
106
107 -- environment variables that were made available to the function.
108 (This is possibly not OK. Environment variables have a way of hanging
109 around that arguments don't. Some kind of adapter is called for that
110 translates (relevant) env vars to arguments first.)
111
112 -- streams available to the function, in the form of Kosheri processes.
113 The function should not assume the presence of a particular stream, or
114 at least, a function which does assume the presence of a particular
115 stream should not be assumed to always work. The function should also
116 not assume that the streams that are made available to it behave in a
117 particular way (for example, that a stream is directed to a vt100
118 terminal.) Instead it should look for a stream that abstractly presents
119 the behaviour that it wants.
120
121 Performance
122 -----------
123
124 Kosheri was designed to be reasonably efficient, for a virtual machine
125 without a JIT compiler.
126
127 The design decisions for performance are kind of all over the place,
128 sometimes being extremely optimized, sometimes sacrificing pure
129 performance for flexibility.
130
131 * "Direct threading" is possible with C compilers that support it,
132 such as `gcc`. This basically optimizes the main instruction-
133 selection `switch` into a computed `goto`.
134
135 * The compiled VM is small, really small. This means it can usually
136 fit entirely in the cache, and stay there. This can sometimes result
137 in a significant performance benefit.
138
139 On the other hand...
140
141 * The orthogonality of "everything is a tuple" extends far and wide.
142 All values are 8 bytes, including VM instructions. VM code size
143 could be reduced by packing 2 or 4 instructions into that 8 bytes,
144 but we don't do that yet.
145
146 * Input and output are modelled as processes, which means there is
147 some small overhead (to pack and unpack a message) added to I/O;
148 but I/O is I/O-bound anyway, so this is probably not something to
149 worry about.
150
151
152 Tour of the distribution
153 ------------------------
154
155 bin/
156
157 Where compiled binaries go.
158
159 eg/
160
161 Example assembly language files.
162
163 lib/
164
165 Where compiled libraries (static and dynamic) go.
166
167 src/
168
169 Source code for the virtual machine and tools.
170
171 src/build/
172
173 Source code for tools used during build-time, and not thereafter.
174
175 tests/
176
177 Tests.
178
179
180 Tour of the source
181 ------------------
182
183 assemble.c
184
185 Main program for the assembler.
186
187 chain.c
188 chain.h
189
190 Utilities to accumulate a linked list of values, then turn them
191 into a tuple when accumulation has finished.
192
193 cmdline.c
194 cmdline.h
195
196 Harness which translates command-line arguments to dictionaries,
197 and otherwise provides facilities so that programs can be written
198 in a "Kosheri view" of the outside world.
199
200 disasm.c
201
202 Main program for the disassembler.
203
204 discern.c
205 discern.h
206
207 Routines to parse human-readable representation of tuples into
208 the internal format.
209
210 file.c
211 file.h
212
213 Native implementation of processes supporting the stream-like interface
214 and which are backed with C's stdio.
215
216 freeze.c
217
218 Main program for the human-readable-value-to-compact-binary
219 serializer.
220
221 gen.c
222 gen.h
223
224 Routines for generating VM instructions (used by assembler, but
225 would also be useful for compilers targeting this VM.)
226
227 geninstr.c
228
229 A build tool which generates instrtab.c and instrenum.h from
230 vm.c.
231
232 instrtab.h
233
234 Header file for the generated instrtab.c.
235
236 lib.c
237 lib.h
238
239 Clean-room re-implementations of the few libc-supplied functions
240 which the VM uses.
241
242 load.c
243 load.h
244
245 Routines to parse (unserialize) the compact binary representation
246 of values.
247
248 portray.c
249 portray.h
250
251 Routines to format values into a human-readable representation.
252
253 process.c
254 process.h
255
256 Routines for communicating and switching between co-operative
257 lightweight concurrent processes.
258
259 render.c
260 render.h
261
262 Routines for rendering terms to file-like processes.
263
264 report.c
265 report.h
266
267 Routines for reporting errors, successes, etc. for the assembler,
268 disassembler, freezer and thawer.
269
270 run.c
271
272 Main program for the VM runner. Takes a VM program in the compact
273 binary representation and executes it.
274
275 save.c
276 save.h
277
278 Routines to generate (serialize) the compact binary representation
279 of values.
280
281 scan.c
282 scan.h
283
284 Lexical scanner, used by the assembler, and by the discern routines.
285 Fairly general, so could also be used to parse a language being
286 compiled to the VM.
287
288 stream.c
289 stream.h
290
291 Routines to communicate with processes which support the stream-like
292 interface; you can read from them, write to them, check for eof, and
293 close them.
294
295 thaw.c
296
297 Main program for the compact-binary-to-human-readable-value
298 unserializer.
299
300 value.c
301 value.h
302
303 Data structure (and associated functions) which internally
304 represents values, including atomic values (booleans, integers,
305 process id's, direct-threaded opcodes) and structured values
306 (tagged tuples and symbols.)
307
308 vm.c
309 vm.h
310
311 The virtual machine implementation itself.
312
313 vmproc.c
314 vmproc.h
315
316 The implementation of lightweight processes which uses the virtual machine
317 to execute the process.
0 TODO
1 ====
2
3 Correctness
4 -----------
5
6 * RECV instruction.
7
8 * Investigate why seemingly big-enough ARs are actually not big enough.
9
10 * Immutable values. This will help solve the problems of using
11 values as keys in a dictionary, and the problem of (not) sharing
12 data between processes.
13
14 * (BIG) Stack type checker in assembler.
15
16 * (BIG) Fix file processes to really be concurrent, esp. in read.
17 Use `select` (maybe export fd's to the scheduler.)
18
19 * (BIG) Error handling. Instead of just `assert()` (which isn't even there
20 when you define `NDEBUG`), throw an exception if the unexpected
21 happens. Or, send a message to the process which created this
22 process. (This will require `self` be accessible throughout the code
23 somehow.)
24
25 Testing
26 -------
27
28 * Falderal tests for all variants of conditionals.
29
30 * Falderal test for closures.
31
32 * Falderal test for sending and receiving messages.
33
34 * Falderal tests for dictionaries.
35
36 * Falderal test for portraying cyclic values.
37
38 * Falderal test for saving cycling values.
39
40 Accessibility
41 -------------
42
43 * Document C APIs (header files).
44
45 * enum success { SUCCESS = 1; FAILURE = 0; } and return this instead of int.
46
47 * Portray values from stream_render: %v or similar.
48
49 * Figure out way to debug messages received by file process
50 (can't write to file process, or you'll get an infinite loop.)
51
52 Portability
53 -----------
54
55 * Measure sizeof struct value et al in buildinfo. Spit out defines.
56 Think about how 64-bit systems will handle all this.
57
58 Footprint
59 ---------
60
61 * "small immediates" embedded in appropriate VM instructions.
62
63 * Go back to having "functional values", but basically say
64 that these are ARs with zero space allocated for arguments / locals.
65 Then have a VM instruction to create an AR from a functional value.
66 (Maybe also have a VM instruction to create a full AR instead of a
67 functional value, from a label, for when you want to call it one-off.)
68
69 Performance
70 -----------
71
72 * Allow symbols (/strings) to be interned. There is of course a
73 tradeoff here, so "allow" rather than "require".
74 Maybe have VALUE_TAG being "small strings" (fit in a struct value,
75 so, like, 7 characters). Then many problems go away...?
76
77 * Option to create a (non-interned) symbol from a const string in
78 a way that does not copy the const string.
79
80 * More efficient access of free variables. Split each AR into two sections: bound variables
81 and free variables. The bound variables are stored in the AR itself. Free variables are
82 stored in some other AR; pointers to them are stored in this AR. Then accessing a bound
83 variable is only a single indirection. Tradeoff is that more work needs to be done when
84 creating a functional value.
85
86 * In ARs, store top-of-stack pointer as a machine pointer,
87 not a tuple index.
0 #!/bin/sh
1
2 cd src
3 echo "Building 'debug' version..."
4 make clean debug >ERRORS 2>&1
5 if [ $? != 0 ]; then
6 cat ERRORS
7 rm -f ERRORS
8 exit 1
9 fi
10 rm -f ERRORS
11 ./assemble --asmfile ../$1 --vmfile out.kvm
12 gdb --args ./run --vmfile out.kvm
13 rm -f out.kvm
0 NEW_AR #10
1 GOTO :past_q
2 :q
3 ; no need to reserve space for parameters
4 GETI #0 ; local #0 = 1st parameter = a
5 STDOUT
6 PORTRAY
7
8 GETI #1 ; local #1 = 2nd parameter = b
9 STDOUT
10 PORTRAY
11
12 GETI #0
13 GETI #1
14 ADD_INT
15
16 YIELD #1 ; pass the result back to our caller
17 RET ; end of this function
18
19 :past_q
20
21 PUSH #1
22
23 PUSH #2
24 PUSH #3
25 PUSH #10 ; this function will need 4 slots: 2 args, 2 stack
26 FUN :q ; push a closure for q onto the stack
27 CALL #2 ; call it with two args
28
29 PUSH #10 ; this function will need 4 slots: 2 args, 2 stack
30 FUN :q ; push a closure for q onto the stack
31 CALL #2 ; call it with two args
32
33 STDOUT
34 PORTRAY
35
36 HALT
0 NEW_AR #3
1 PUSH #11 ; statically initialize our local
2 :label
3 GETI #0
4 STDOUT
5 PORTRAY
6 GETI #0
7 PUSH #1
8 SUB_INT
9 SETI #0
10 GETI #0
11 PUSH #0
12 JNE :label
13 HALT
0 NEW_AR #7
1 SPAWN :label
2 REST
3 PUSH #main
4 STDOUT
5 PORTRAY
6 HALT
7 :label
8 NEW_AR #7
9 PUSH #worker
10 STDOUT
11 PORTRAY
12 HALT
0 # Makefile for Kosheri.
1 # $Id: Makefile 146 2008-12-06 19:59:54Z catseye $
2
3 CC?=gcc
4 AR?=ar
5 RANLIB?=ranlib
6
7 O?=.o
8 EXE?=
9
10 OD?=./
11
12 DEBUG_PORTRAY_O?=
13
14 WARNS= -Werror -W -Wall -Wstrict-prototypes -Wmissing-prototypes \
15 -Wpointer-arith -Wno-uninitialized -Wreturn-type -Wcast-qual \
16 -Wwrite-strings -Wswitch -Wshadow -Wcast-align -Wchar-subscripts \
17 -Winline -Wnested-externs -Wredundant-decls
18 LIBS=-L. -lruntime
19 CFLAGS+=-ansi -pedantic ${WARNS} ${EXTRA_CFLAGS}
20
21 RUNTIME_OBJS= ${OD}lib${O} ${OD}value${O} \
22 ${OD}process${O} ${OD}file${O} ${OD}stream${O} \
23 ${DEBUG_PORTRAY_O} \
24 ${OD}render${O}
25 # ${OD}portray${O}
26
27 # portray and save are only needed for non-raw output
28 # instrtab is only needed for direct threading conversion
29 RUN_OBJS= ${OD}run${O} \
30 ${OD}load${O} \
31 ${OD}vm${O} ${OD}vmproc${O} \
32 ${OD}instrtab${O} \
33 ${OD}portray${O} \
34 ${OD}save${O} \
35 ${OD}cmdline${O}
36
37 ASSEMBLE_OBJS= ${OD}assemble${O} \
38 ${OD}instrtab${O} \
39 ${OD}report${O} ${OD}scan${O} ${OD}discern${O} ${OD}chain${O} \
40 ${OD}gen${O} ${OD}save${O} \
41 ${OD}portray${O} \
42 ${OD}cmdline${O}
43
44 DISASM_OBJS= ${OD}disasm${O} \
45 ${OD}instrtab${O} \
46 ${OD}report${O} \
47 ${OD}load${O} \
48 ${OD}portray${O} \
49 ${OD}chain${O} \
50 ${OD}cmdline${O}
51
52 FREEZE_OBJS= ${OD}freeze${O} \
53 ${OD}save${O} \
54 ${OD}report${O} ${OD}scan${O} \
55 ${OD}discern${O} ${OD}chain${O} \
56 ${OD}cmdline${O}
57
58 THAW_OBJS= ${OD}thaw${O} \
59 ${OD}load${O} \
60 ${OD}report${O} \
61 ${OD}portray${O} \
62 ${OD}cmdline${O}
63
64 BUILDINFO_OBJS= ${OD}buildinfo${O} \
65 ${OD}process${O} \
66 ${OD}cmdline${O}
67
68 PROGS=run${EXE} assemble${EXE} disasm${EXE} freeze${EXE} thaw${EXE} \
69 buildinfo${EXE}
70
71 all: ${PROGS}
72
73 geninstr${EXE}: geninstr.o
74 ${CC} geninstr.o -o geninstr${EXE}
75
76 instrtab.c instrenum.h instrlab.h localtypes.h: vm.c geninstr
77 ./geninstr vm.c
78
79 value.h: localtypes.h
80
81 value.c: value.h
82
83 vm.h: instrenum.h instrlab.h value.h
84
85 libruntime.a: ${RUNTIME_OBJS}
86 ${AR} rc libruntime.a ${RUNTIME_OBJS}
87 ${RANLIB} libruntime.a
88
89 run.c: vm.h
90
91 run${EXE}: ${RUN_OBJS} libruntime.a
92 ${CC} ${RUN_OBJS} ${LIBS} -o run${EXE}
93 assemble${EXE}: ${ASSEMBLE_OBJS} libruntime.a
94 ${CC} ${ASSEMBLE_OBJS} ${LIBS} -o assemble${EXE}
95 disasm${EXE}: ${DISASM_OBJS} libruntime.a
96 ${CC} ${DISASM_OBJS} ${LIBS} -o disasm${EXE}
97 freeze${EXE}: ${FREEZE_OBJS} libruntime.a
98 ${CC} ${FREEZE_OBJS} ${LIBS} -o freeze${EXE}
99 thaw${EXE}: ${THAW_OBJS} libruntime.a
100 ${CC} ${THAW_OBJS} ${LIBS} -o thaw${EXE}
101
102 buildinfo${EXE}: ${BUILDINFO_OBJS} libruntime.a
103 ${CC} ${BUILDINFO_OBJS} ${LIBS} -o buildinfo${EXE}
104
105
106 # when DEBUG is defined, save.o, load.o, and parse.o depend on portray.o
107 debug: clean
108 ${MAKE} DEBUG_PORTRAY_O="${OD}portray${O}" \
109 EXTRA_CFLAGS="-g -DDEBUG"
110
111 profiled: clean
112 ${MAKE} EXTRA_CFLAGS="-pg"
113
114 tool: clean
115 ${MAKE} EXTRA_CFLAGS="-DNDEBUG -Os" LIBS="-L. -lruntime -s"
116
117 # -finline-functions ?
118
119 static: clean
120 ${MAKE} EXTRA_CFLAGS="-DNDEBUG -Os" LIBS="-L. -lruntime -s -static"
121
122 standalone: clean
123 ${MAKE} EXTRA_CFLAGS="-DNDEBUG -DSTANDALONE -DCTYPE_IS_BUILTIN -Os -static -nostdlib" LIBS="-L. -lruntime -nostdlib -s"
124
125 win: clean
126 ${MAKE} EXE=.exe EXTRA_CFLAGS="-DNDEBUG -mno-cygwin" all
127
128 wintool: clean
129 ${MAKE} EXE=.exe EXTRA_CFLAGS="-DNDEBUG -Os -static -mno-cygwin" LIBS="-L. -lruntime -s"
130
131 clean:
132 rm -rf ${OD}*${O} *.so *.a *.core *.vm *.exe instrtab.c instrenum.h instrlab.h geninstr *.stackdump ${PROGS} foo.* LISTING OUTPUT
0 /*
1 * assemble.c
2 * Assembler for virtual machine.
3 * $Id: assemble.c 146 2008-12-06 19:59:54Z catseye $
4 */
5
6 #include "lib.h"
7 #include "cmdline.h"
8 #include "value.h"
9
10 #include "stream.h"
11 #include "file.h"
12
13 #include "scan.h"
14 #include "discern.h"
15
16 #include "report.h"
17
18 #include "gen.h"
19 #include "instrtab.h"
20 #include "save.h"
21
22 static struct value labels;
23
24 /* Routines */
25
26 static struct value *
27 fetch_label(const char *token, unsigned int length)
28 {
29 struct value lab_text;
30
31 value_symbol_new(&lab_text, token, length);
32 return value_dict_fetch(&labels, &lab_text);
33 }
34
35 static void
36 store_label(const char *token, unsigned int length, struct value *label)
37 {
38 struct value lab_text;
39
40 value_symbol_new(&lab_text, token, length);
41 value_dict_store(&labels, &lab_text, label);
42 }
43
44 static void
45 assemble(struct scanner *sc, struct value *gen)
46 {
47 struct opcode_entry *oe;
48 struct value label;
49 int count;
50
51 while (!scanner_eof(sc)) {
52 if (scanner_tokeq(sc, ";")) { /* A comment - ignore rest of line. */
53 scanner_scanline(sc);
54 continue;
55 }
56 if (scanner_tokeq(sc, ":")) { /* A label - associate string with addr. */
57 const char *str;
58 int len;
59
60 scanner_scan(sc);
61 str = scanner_token_string(sc);
62 len = scanner_token_length(sc);
63 value_copy(&label, fetch_label(str, len));
64 /* This may cause backpatching */
65 if (gen_define_label(gen, &label)) {
66 store_label(str, len, &label);
67 } else {
68 scanner_report(sc, REPORT_ERROR, "Label already defined");
69 }
70 scanner_scan(sc);
71 continue;
72 }
73
74 for (oe = opcode_table; oe->token != NULL; oe++) {
75 if (scanner_tokeq(sc, oe->token))
76 break;
77 }
78 if (oe->token == NULL) {
79 scanner_report(sc, REPORT_ERROR, "Unrecognized token");
80 scanner_scan(sc);
81 continue;
82 }
83
84 gen_integer(gen, oe->opcode);
85 scanner_scan(sc);
86
87 for (count = 0; count < oe->arity; count++) {
88 if (scanner_tokeq(sc, ":")) {
89 const char *str;
90 int len;
91
92 scanner_scan(sc);
93 str = scanner_token_string(sc);
94 len = scanner_token_length(sc);
95 value_copy(&label, fetch_label(str, len));
96 gen_gen_label_ref(gen, &label);
97 store_label(str, len, &label);
98 scanner_scan(sc);
99 continue;
100 } else if (scanner_tokeq(sc, "#")) {
101 struct value v;
102
103 scanner_scan(sc);
104 value_discern(&v, sc);
105 gen_value(gen, &v);
106 continue;
107 } else {
108 scanner_report(sc, REPORT_WARNING,
109 "Unrecognized argument");
110 scanner_scan(sc);
111 }
112 }
113 }
114 }
115
116 static void
117 assemble_main(struct value *args, struct value *result)
118 {
119 struct process *out;
120 struct scanner *sc;
121 struct reporter *r;
122 struct value gen, flat; /* the generator that we will use to build vm code */
123 struct value *asmfile, *vmfile;
124 struct value asmfile_sym, vmfile_sym;
125
126 r = reporter_new("Assembly", NULL, 1);
127
128 value_symbol_new(&asmfile_sym, "asmfile", 7);
129 value_symbol_new(&vmfile_sym, "vmfile", 6);
130
131 assert(value_is_tuple(args));
132 asmfile = value_dict_fetch(args, &asmfile_sym);
133 vmfile = value_dict_fetch(args, &vmfile_sym);
134
135 /*
136 * Generate.
137 */
138 sc = scanner_new(r);
139
140 if (!scanner_open(sc, value_symbol_get_token(asmfile))) {
141 value_integer_set(result, 1);
142 return;
143 }
144
145 gen_new_default(&gen);
146 value_dict_new(&labels, 8);
147 assemble(sc, &gen);
148 gen_integer(&gen, INSTR_EOF);
149 scanner_close(sc);
150 scanner_free(sc);
151
152 /*
153 * Write out.
154 */
155 out = file_open(value_symbol_get_token(vmfile), "w");
156 gen_flatten(&gen, &flat);
157 value_save(out, &flat);
158 stream_close(NULL, out);
159
160 value_integer_set(result, reporter_has_errors(r) ? 1 : 0);
161 reporter_free(r);
162 }
163
164 MAIN(assemble_main)
0 /*
1 * buildinfo.c
2 * Show some info about the built binary (also test for process-based I/O)
3 */
4
5 #include "lib.h"
6
7 #include "render.h"
8 #include "cmdline.h"
9
10 #include "process.h"
11 #include "file.h"
12
13 /* Main Program / Driver */
14
15 static void
16 buildinfo_main(struct value *args, struct value *result)
17 {
18 struct process *out;
19
20 out = file_open("*stdout", "w");
21 args = args;
22 process_render(out,
23 "sizeof(struct value) == %d\n", sizeof(struct value));
24 value_integer_set(result, 0);
25 }
26
27 MAIN(buildinfo_main)
0 /*
1 * chain.c
2 * Routines for collecting chains.
3 * $Id: chain.c 143 2008-07-18 06:42:22Z catseye $
4 */
5
6 #include "lib.h"
7 #include "chain.h"
8 #include "value.h"
9
10 struct chain {
11 struct chain *next;
12 struct value value;
13 };
14
15 struct chain *
16 add_to_chain(struct chain *c, struct value *v)
17 {
18 struct chain *n;
19
20 n = malloc(sizeof(struct chain));
21 n->next = NULL;
22 value_copy(&n->value, v);
23 if (c != NULL) {
24 c->next = n;
25 }
26 return n;
27 }
28
29 void
30 populate_tuple_from_chain(struct value *v, struct chain *c)
31 {
32 unsigned int i = 0;
33
34 while (c != NULL) {
35 value_tuple_store(v, i, &c->value);
36 i++;
37 c = c->next;
38 }
39 }
40
41 struct value *
42 search_chain(struct chain *c, struct value *f)
43 {
44 while (c != NULL) {
45 if (value_equal(f, &c->value))
46 return &c->value;
47 c = c->next;
48 }
49 return NULL;
50 }
51
52 void
53 free_chain(struct chain *c)
54 {
55 struct chain *next;
56
57 while (c != NULL) {
58 next = c->next;
59 free(c);
60 c = next;
61 }
62 }
0 /*
1 * chain.h
2 * Prototypes for chains.
3 */
4
5 #ifndef __CHAIN_H_
6 #define __CHAIN_H_
7
8 #include "value.h"
9
10 struct chain;
11
12 struct chain *add_to_chain(struct chain *, struct value *);
13 void populate_tuple_from_chain(struct value *, struct chain *);
14 struct value *search_chain(struct chain *, struct value *);
15 void free_chain(struct chain *);
16
17 #endif /* !__CHAIN_H_ */
0 /*
1 * cmdline.c
2 * Implementation of common command-line parsing functionality.
3 * $Id$
4 */
5
6 #include "lib.h"
7 #include "render.h"
8 #include "process.h"
9 #include "file.h"
10
11 #include "cmdline.h"
12
13 struct process *process_std = NULL;
14 struct process *process_err = NULL;
15
16 /*
17 static const char *progname = NULL;
18 static const struct argdecl *argdecl = NULL;
19 */
20
21 /* eventually this should parse an optional cmdline schema to validate the cmd line */
22 /* const struct argdecl *ad, */
23
24 int
25 cmdline_parse(struct value *dict, int argc, char **argv)
26 {
27 unsigned int arg_count, i;
28 struct value name, value;
29
30 assert(argc > 0);
31 arg_count = (unsigned int)argc;
32
33 value_dict_new(dict, 16); /* xxx */
34
35 for (i = 1; i < arg_count; i++) {
36 if (strlen(argv[i]) > 2 && argv[i][0] == '-' && argv[i][1] == '-') {
37 const char *arg_name = argv[i] + (2 * sizeof(char));
38 value_symbol_new(&name, arg_name, strlen(arg_name));
39 i++;
40 if (i < arg_count) {
41 value_symbol_new(&value, argv[i], strlen(argv[i]));
42 value_dict_store(dict, &name, &value);
43 } else {
44 /* complain */
45 }
46 } else {
47 /* complain */
48 }
49 }
50
51 return 1;
52 }
53
54 /* eventually this should parse an optional cmdline schema to validate the cmd line */
55
56 void
57 cmdline_usage(void)
58 {
59 exit(1);
60 }
61
62 int
63 cmdline_driver(void (*main)(struct value *, struct value *),
64 int argc, char **argv)
65 {
66 struct value cmdline, result;
67
68 cmdline_parse(&cmdline, argc, argv);
69 assert(value_is_tuple(&cmdline));
70
71 main(&cmdline, &result);
72
73 return value_get_integer(&result);
74 }
0 /*
1 * cmdline.h
2 * Prototypes for common command-line parsing functionality.
3 * $Id$
4 */
5
6 /*
7 * In the future, this should be progenv.h, which determines a
8 * program environment. This should include an "entry point"
9 * (not necessarily "main", since it should be able to operate
10 * in standalone and other contexts where a "command line" is
11 * not meaningful.)
12 */
13
14 #ifndef __CMDLINE_H_
15 #define __CMDLINE_H_
16
17 #include "value.h"
18
19 #include "file.h" /* ... because. */
20
21 struct process;
22
23 struct runenv {
24 struct handler *handler_std;
25 /*
26 struct stream *stream_std;
27 struct stream *stream_err;
28 */
29 const char *progname;
30 };
31
32 extern struct process *process_err;
33
34 int cmdline_driver(void (*)(struct value *, struct value *),
35 int, char **);
36 int cmdline_parse(struct value *, int, char **);
37 void cmdline_usage(void);
38
39 /*
40 * STANDALONE no longer supported / not yet re-supported
41 */
42 #ifdef STANDALONE
43 #define MAIN(function) \
44 int main(int argc, char **argv) \
45 { \
46 process_err = NULL; \
47 return cmdline_driver(function, argc, argv); \
48 }
49 #else
50 #define MAIN(function) \
51 int main(int argc, char **argv) \
52 { \
53 process_err = file_open("*stderr", "w"); \
54 return cmdline_driver(function, argc, argv); \
55 }
56 #endif /* STANDALONE */
57
58 #endif /* !__CMDLINE_H_ */
0 /*
1 * disasm.c
2 * Disassembler for virtual machine.
3 */
4
5 #include "lib.h"
6 #include "cmdline.h"
7
8 #include "value.h"
9 #include "chain.h"
10
11 #include "file.h"
12 #include "stream.h"
13 #include "render.h"
14
15 #include "report.h"
16 #include "instrtab.h"
17 #include "load.h"
18 #include "portray.h"
19
20 /* Routines */
21
22 static void
23 disassemble(struct reporter *r, struct process *p, struct value *code)
24 {
25 struct opcode_entry *oe;
26 int count, pc, opcode;
27 struct value *val;
28 struct value t;
29 struct chain *back, *front;
30
31 value_integer_set(&t, 0);
32
33 /* first pass: find label destination */
34
35 pc = 0;
36 back = front = add_to_chain(NULL, &t);
37 for (;;) {
38 val = value_tuple_fetch(code, pc);
39 if (value_is_integer(val)) {
40 opcode = value_get_integer(val);
41 if (opcode < 0 || opcode > INSTR_EOF) {
42 report(r, REPORT_ERROR, "Opcode not in range 0..%d", INSTR_EOF);
43 pc++;
44 } else if (opcode == INSTR_EOF) {
45 break;
46 } else {
47 oe = &opcode_table[opcode];
48 count = oe->arity;
49 pc++;
50 val = value_tuple_fetch(code, pc);
51 while (count > 0) {
52 if (oe->optype == OPTYPE_ADDR)
53 back = add_to_chain(back, val);
54 pc++;
55 val = value_tuple_fetch(code, pc);
56 count--;
57 }
58 }
59 } else {
60 report(r, REPORT_ERROR, "Opcode is not an integer");
61 pc++;
62 }
63 }
64
65 if (reporter_has_errors(r))
66 return;
67
68 /* second pass */
69 pc = 0;
70 for (;;) {
71 val = value_tuple_fetch(code, pc);
72 opcode = value_get_integer(val);
73 if (opcode == INSTR_EOF)
74 break;
75
76 value_integer_set(&t, pc);
77 if (search_chain(front, &t) != NULL) {
78 process_render(p, ":L%d\n", pc);
79 }
80
81 oe = &opcode_table[opcode];
82 process_render(p, "%s ", oe->token);
83 count = oe->arity;
84
85 pc++;
86 val = value_tuple_fetch(code, pc);
87
88 if (count == -1) {
89 report(r, REPORT_WARNING, "Unrecognized opcode");
90 process_render(p, "??? ");
91 } else {
92 while (count > 0) {
93 if (oe->optype == OPTYPE_ADDR) {
94 process_render(p, ":L%d ",
95 value_get_integer(val)
96 );
97 } else {
98 process_render(p, "#");
99 value_portray(p, val);
100 }
101 pc++;
102 val = value_tuple_fetch(code, pc);
103 count--;
104 }
105 }
106
107 process_render(p, "\n");
108 }
109
110 free_chain(front);
111 }
112
113 static void
114 disassemble_main(struct value *args, struct value *result)
115 {
116 struct reporter *r;
117 struct process *p;
118 struct value code; /* virtual machine code we will dump */
119 struct value *asmfile, *vmfile;
120 struct value asmfile_sym, vmfile_sym;
121
122 value_symbol_new(&asmfile_sym, "asmfile", 7);
123 value_symbol_new(&vmfile_sym, "vmfile", 6);
124
125 asmfile = value_dict_fetch(args, &asmfile_sym);
126 vmfile = value_dict_fetch(args, &vmfile_sym);
127
128 r = reporter_new("Disassembly", NULL, 1);
129
130 /*
131 * Load.
132 */
133 p = file_open(value_symbol_get_token(vmfile), "r");
134 value_load(&code, p);
135 stream_close(NULL, p);
136
137 p = file_open(value_symbol_get_token(asmfile), "w");
138 disassemble(r, p, &code);
139 stream_close(NULL, p);
140
141 value_integer_set(result, reporter_has_errors(r) ? 1 : 0);
142 reporter_free(r);
143 }
144
145 MAIN(disassemble_main)
0 /*
1 * discern.c
2 * Routines for parsing values (only; not program source) from a file-like process.
3 * $Id: discern.c 143 2008-07-18 06:42:22Z catseye $
4 */
5
6 #include "lib.h"
7
8 #include "scan.h"
9 #include "value.h"
10 #include "discern.h"
11 #include "chain.h"
12
13 /*
14 * A parser for values, inspired somewhat by Scheme/LISP S-expressions
15 * and Prolog/Erlang terms.
16 */
17 int
18 value_discern(struct value *top, struct scanner *sc)
19 {
20 if (scanner_tokeq(sc, "<")) {
21 struct chain *front, *back;
22 struct value tag, inner;
23 unsigned int size = 1;
24
25 /* Tuple. */
26 scanner_scan(sc);
27 value_discern(&tag, sc);
28 scanner_expect(sc, ":");
29 value_discern(&inner, sc);
30 back = front = add_to_chain(NULL, &inner);
31 while (scanner_tokeq(sc, ",")) {
32 scanner_scan(sc);
33 value_discern(&inner, sc);
34 back = add_to_chain(back, &inner);
35 size++;
36 }
37 scanner_expect(sc, ">");
38 value_tuple_new(top, &tag, size);
39 populate_tuple_from_chain(top, front);
40 free_chain(front);
41 return 1;
42 } else if (scanner_tokeq(sc, "[")) {
43 struct value inner, *left, right;
44
45 /* List: Sequence of tail-nested Pairs. */
46 scanner_scan(sc);
47 if (scanner_tokeq(sc, "]")) {
48 scanner_scan(sc);
49 value_copy(top, &VNULL);
50 return 1;
51 }
52 value_tuple_new(top, &tag_list, 2);
53 value_discern(&inner, sc);
54 value_tuple_store(top, 0, &inner);
55 /*value_tuple_store(top, 1, VNULL);*/
56 left = top;
57 while (scanner_tokeq(sc, ",")) {
58 scanner_scan(sc);
59 value_tuple_new(&right, &tag_list, 2);
60 value_discern(&inner, sc);
61 value_tuple_store(&right, 0, &inner);
62 /*value_set_index(right, 1, VNULL);*/
63 value_tuple_store(left, 1, &right);
64 left = value_tuple_fetch(left, 1);
65 }
66 if (scanner_tokeq(sc, "|")) {
67 scanner_scan(sc);
68 value_discern(&right, sc);
69 value_tuple_store(left, 1, &right);
70 }
71 scanner_expect(sc, "]");
72 return 1;
73 } else if (scanner_tokeq(sc, "{")) {
74 struct value left, right;
75
76 /* Dictionary: associations between keys and values. */
77 scanner_scan(sc);
78 value_dict_new(top, 31);
79
80 value_discern(&left, sc);
81 scanner_expect(sc, "=");
82 value_discern(&right, sc);
83 value_dict_store(top, &left, &right);
84 while (scanner_tokeq(sc, ",")) {
85 scanner_scan(sc);
86 value_discern(&left, sc);
87 scanner_expect(sc, "=");
88 value_discern(&right, sc);
89 value_dict_store(top, &left, &right);
90 }
91 scanner_expect(sc, "}");
92 return 1;
93 } else if (k_isdigit(scanner_token_string(sc)[0])) {
94 /* Integer. */
95 value_integer_set(top, k_atoi(scanner_token_string(sc),
96 scanner_token_length(sc)));
97 scanner_scan(sc);
98 return 1;
99 } else {
100 /* Symbol. */
101 value_symbol_new(top, scanner_token_string(sc),
102 scanner_token_length(sc));
103 scanner_scan(sc);
104 return 1;
105 }
106 }
0 /*
1 * discern.h
2 * Prototypes and structures for parsing values (only; not full
3 * program source code) from textual streams.
4 */
5
6 #ifndef __DISCERN_H_
7 #define __DISCERN_H_
8
9 struct value;
10 struct scanner;
11
12 int value_discern(struct value *, struct scanner *);
13
14 #endif /* !__DISCERN_H_ */
0 /*
1 * file.c
2 * Native processes for communicating with (reading, writing) files,
3 * exposing a stream-like interface.
4 */
5
6 #include <stdio.h>
7
8 #include "lib.h"
9 #include "process.h"
10 #include "file.h"
11
12 #ifdef DEBUG
13 #include "stream.h"
14 #include "portray.h"
15 #include "cmdline.h"
16 #endif
17
18 static void run(struct process *p)
19 {
20 struct value msg;
21 struct value response;
22 struct process *sender;
23 size_t result;
24 char *buffer;
25 size_t size;
26
27 assert(p != NULL);
28 assert(p->aux != NULL);
29
30 while (process_dequeue(p, &msg)) {
31 #ifdef DEBUG
32 /*
33 stream_write(NULL, process_err, "-->", 3);
34 value_portray(process_err, &msg);
35 stream_write(NULL, process_err, "<--", 3);
36 */
37 #endif
38 if (value_is_tuple(&msg)) {
39 const char *tag = value_symbol_get_token(value_tuple_get_tag(&msg));
40 if (strcmp(tag, "write") == 0) {
41 struct value *payload = value_tuple_fetch(&msg, 0);
42
43 result = fwrite(
44 value_symbol_get_token(payload),
45 value_symbol_get_length(payload),
46 1, (FILE *)p->aux
47 );
48 if (result) {
49 /* some kind of error occurred */
50 }
51 } else if (strcmp(tag, "read") == 0) {
52 sender = value_get_process(value_tuple_fetch(&msg, 0));
53 size = value_get_integer(value_tuple_fetch(&msg, 1));
54
55 buffer = value_symbol_new_buffer(&response, size);
56 result = fread(buffer, size, 1, (FILE *)p->aux);
57 if (result) {
58 /* some kind of error occurred, or we just need more */
59 }
60 process_enqueue(sender, &response);
61 } else if (strcmp(tag, "eof") == 0) {
62 sender = value_get_process(value_tuple_fetch(&msg, 0));
63
64 value_boolean_set(&response, feof((FILE *)p->aux));
65 process_enqueue(sender, &response);
66 } else if (strcmp(tag, "close") == 0) {
67 fclose((FILE *)p->aux);
68 p->aux = NULL;
69 }
70 }
71 }
72
73 p->waiting = 1;
74 }
75
76 static struct process *
77 file_fopen(FILE *file)
78 {
79 struct process *p;
80
81 p = process_new();
82 p->run = run;
83 p->aux = file;
84
85 return p;
86 }
87
88 struct process *
89 file_open(const char *locator, const char *mode)
90 {
91 FILE *f;
92
93 if (strcmp(locator, "*stdin") == 0) {
94 return file_fopen(stdin);
95 }
96 if (strcmp(locator, "*stdout") == 0) {
97 return file_fopen(stdout);
98 }
99 if (strcmp(locator, "*stderr") == 0) {
100 return file_fopen(stderr);
101 }
102
103 if ((f = fopen(locator, mode)) == NULL) {
104 /* XXX only if mode contains a 'strict' char flag... */
105 /* XXX this should use report.c somehow someday */
106 fprintf(stderr,
107 "Could not open '%s' in mode '%s'", locator, mode);
108 exit(1);
109 }
110
111 return file_fopen(f);
112 }
0 /*
1 * file.h
2 * Native processes for communicating with (reading, writing) files,
3 * exposing a stream-like interface.
4 */
5
6 #ifndef __FILE_H_
7 #define __FILE_H_
8
9 struct process;
10
11 struct process *file_open(const char *, const char *);
12
13 #endif /* !__FILE_H_ */
0 /*
1 * freeze.c
2 * Parse a constant term from a text file and
3 * write it out to a binary termfile.
4 * $Id: freeze.c 146 2008-12-06 19:59:54Z catseye $
5 */
6
7 #include "lib.h"
8 #include "cmdline.h"
9
10 #include "stream.h"
11 #include "file.h"
12
13 #include "report.h"
14 #include "value.h"
15
16 #include "discern.h"
17 #include "scan.h"
18 #include "save.h"
19
20 /* Main Program / Driver */
21
22 static void
23 freeze_main(struct value *args, struct value *result)
24 {
25 struct process *p;
26 struct scanner *sc;
27 struct reporter *r;
28 struct value term;
29
30 struct value *termfile, *binfile;
31 struct value termfile_sym, binfile_sym;
32
33 value_symbol_new(&termfile_sym, "termfile", 8);
34 value_symbol_new(&binfile_sym, "binfile", 7);
35 termfile = value_dict_fetch(args, &termfile_sym);
36 binfile = value_dict_fetch(args, &binfile_sym);
37
38 r = reporter_new("Freezing", NULL, 1);
39
40 /*
41 * Parse.
42 */
43 sc = scanner_new(r);
44 if (!scanner_open(sc, value_symbol_get_token(termfile))) {
45 value_integer_set(result, 1);
46 return;
47 }
48 if (!value_discern(&term, sc)) {
49 report(r, REPORT_ERROR, "Could not parse input term");
50 }
51
52 /*
53 * Write out.
54 */
55 p = file_open(value_symbol_get_token(binfile), "w");
56 if (!value_save(p, &term)) {
57 report(r, REPORT_ERROR,
58 "Could not write term to '%s'", binfile);
59 }
60 stream_close(NULL, p);
61
62 /*
63 * Finish up.
64 */
65 scanner_close(sc);
66 scanner_free(sc);
67
68 value_integer_set(result, reporter_has_errors(r) ? 1 : 0);
69 reporter_free(r);
70 }
71
72 MAIN(freeze_main)
0 /*
1 * gen.c
2 * Accumulate values in tuples with extents.
3 */
4
5 #include "lib.h"
6
7 #include "gen.h"
8
9 #ifdef DEBUG
10 #include "cmdline.h"
11 #include "portray.h"
12 #include "render.h"
13 #endif
14
15 /*
16 * This was originally intended to generate VM instructions, however
17 * it has more general applicability.
18 */
19
20 #define GEN_ROOT_TUPLE 0 /* The top tuple of the hierarchy */
21 #define GEN_CURRENT_TUPLE 1 /* The tuple currently being gen'ed into */
22 #define GEN_GLOBAL_POS 2 /* The global position to be gen'ed into */
23 #define GEN_LOCAL_POS 3 /* Gen offset into current tuple */
24
25 #define GEN_SIZE 4
26
27 int
28 gen_new(struct value *gen, struct value *tuple, unsigned int pos)
29 {
30 struct value gen_tag;
31
32 value_symbol_new(&gen_tag, "gen", 3);
33 if (!value_tuple_new(gen, &gen_tag, GEN_SIZE))
34 return 0;
35 value_tuple_store(gen, GEN_ROOT_TUPLE, tuple);
36 value_tuple_store(gen, GEN_CURRENT_TUPLE, tuple);
37 value_tuple_store_integer(gen, GEN_GLOBAL_POS, pos);
38 value_tuple_store_integer(gen, GEN_LOCAL_POS, pos);
39 return 1;
40 }
41
42 int
43 gen_new_default(struct value *gen)
44 {
45 struct value tuple, code_sym;
46
47 value_symbol_new(&code_sym, "code", 4);
48 value_tuple_new(&tuple, &code_sym, 8192);
49 return gen_new(gen, &tuple, 0);
50 }
51
52 /*
53 * Accumulate a value to a tuple.
54 */
55 void
56 gen_value(struct value *gen, struct value *value)
57 {
58 unsigned int pos = value_tuple_fetch_integer(gen, GEN_LOCAL_POS);
59 struct value *tuple = value_tuple_fetch(gen, GEN_CURRENT_TUPLE);
60 unsigned int size = value_tuple_get_size(tuple);
61 struct value new_tuple;
62
63 if (pos == (size - 1)) {
64 /* Last slot. Allocate a new tuple of twice the running size and plug it in. */
65 struct value *tag = value_tuple_get_tag(tuple);
66
67 value_tuple_new(&new_tuple, tag, size * 2);
68 value_tuple_store(tuple, pos, &new_tuple);
69 value_tuple_store(gen, GEN_CURRENT_TUPLE, &new_tuple);
70 pos = 0;
71 tuple = &new_tuple;
72 }
73 value_tuple_store(tuple, pos, value);
74 pos++;
75 value_tuple_store_integer(gen, GEN_LOCAL_POS, pos);
76
77 pos = value_tuple_fetch_integer(gen, GEN_GLOBAL_POS);
78 pos++;
79 value_tuple_store_integer(gen, GEN_GLOBAL_POS, pos);
80 }
81
82 /*
83 * Accumulate a value to a tuple.
84 */
85 void
86 gen_integer(struct value *gen, int i)
87 {
88 struct value val;
89
90 value_integer_set(&val, i);
91 gen_value(gen, &val);
92 }
93
94 /*
95 * Labels - forward reference and backpatching mechanism.
96 * This is designed to be used internally. External clients
97 * (that is, where labels must be human-readable, such as the
98 * assembler) should maintain a dictionary associating strings
99 * with labels.
100 *
101 * Use cases:
102 *
103 * 1) Backward reference (requires no backpatching):
104 *
105 * label = gen_define_label(gen, NULL);
106 * ...
107 * gen_integer(gen, INSTR_GOTO);
108 * gen_gen_label_ref(gen, label);
109 *
110 * 2) Forward reference (requires backpatching):
111 *
112 * gen_integer(gen, INSTR_GOTO);
113 * label = gen_gen_label_ref(gen, NULL);
114 * ...
115 * gen_define_label(gen, label);
116 *
117 */
118
119 #define GEN_LABEL_TUPLE 0 /* Tuple into which the label points */
120 #define GEN_LABEL_LOCAL_POS 1 /* local pos to which label refers */
121 #define GEN_LABEL_GLOBAL_POS 2 /* global pos to which label refers */
122 #define GEN_LABEL_NEXT 3 /* list of backpatches to apply */
123
124 #define GEN_LABEL_SIZE 4
125
126 static int
127 gen_label_new(struct value *gen_label)
128 {
129 struct value gen_label_tag;
130
131 value_symbol_new(&gen_label_tag, "genlab", 3);
132 if (!value_tuple_new(gen_label, &gen_label_tag, GEN_LABEL_SIZE))
133 return 0;
134 value_tuple_store(gen_label, GEN_LABEL_TUPLE, &VNULL);
135 value_tuple_store_integer(gen_label, GEN_LABEL_LOCAL_POS, 0);
136 value_tuple_store_integer(gen_label, GEN_LABEL_GLOBAL_POS, 0);
137 value_tuple_store(gen_label, GEN_LABEL_NEXT, &VNULL);
138
139 return 1;
140 }
141
142 /*
143 * Generate a reference to a label into the tuple, for instance as the
144 * immediate argument of a branch instruction. If the label parameter
145 * is NULL, this will generate and return a forward reference which
146 * should be resolved by subsequently passing it to gen_define_label().
147 */
148 void
149 gen_gen_label_ref(struct value *gen, struct value *gen_label)
150 {
151 struct value *bp;
152 struct value next;
153 int global_pos;
154
155 assert(gen_label != NULL);
156
157 if (value_is_null(gen_label)) {
158 /* Not yet allocated, so allocate a new undefined one. */
159 gen_label_new(gen_label);
160 }
161
162 global_pos = value_tuple_fetch_integer(gen_label, GEN_LABEL_GLOBAL_POS);
163 if (global_pos != 0) {
164 /* Already defined, so just use it. */
165 gen_integer(gen, global_pos);
166 return;
167 }
168
169 /*
170 * The label is newly allocated, or at least has not been defined
171 * yet. So, we remember that we will need to backpatch here in the
172 * future (by adding an entry to the label's backpatch list) and,
173 * for now, generate a NULL in its slot.
174 */
175
176 value_copy(&next, value_tuple_fetch(gen_label, GEN_LABEL_NEXT));
177 bp = value_tuple_fetch(gen_label, GEN_LABEL_NEXT);
178 gen_label_new(bp);
179 value_tuple_store(bp, GEN_LABEL_TUPLE, value_tuple_fetch(gen, GEN_CURRENT_TUPLE));
180 value_tuple_store(bp, GEN_LABEL_LOCAL_POS, value_tuple_fetch(gen, GEN_LOCAL_POS));
181 value_tuple_store(bp, GEN_LABEL_GLOBAL_POS, value_tuple_fetch(gen, GEN_GLOBAL_POS));
182 value_tuple_store(bp, GEN_LABEL_NEXT, &next);
183
184 gen_value(gen, &VNULL);
185 }
186
187 /*
188 * Define a label. If the label is already allocated, this will
189 * cause previously-generated forward references to this label to be
190 * backpatched with the now-known location.
191 */
192 int
193 gen_define_label(struct value *gen, struct value *gen_label)
194 {
195 struct value *tuple = value_tuple_fetch(gen, GEN_CURRENT_TUPLE);
196 unsigned int local_pos = value_tuple_fetch_integer(gen, GEN_LOCAL_POS);
197 unsigned int global_pos = value_tuple_fetch_integer(gen, GEN_GLOBAL_POS);
198
199 struct value *bp;
200
201 assert(gen_label != NULL);
202
203 if (value_is_null(gen_label)) {
204 /* Not yet allocated, so allocate a new undefined one. */
205 gen_label_new(gen_label);
206 } else {
207 /* Fail if we try to redefine a label. */
208 if (value_tuple_fetch_integer(gen_label, GEN_LABEL_GLOBAL_POS) != 0) {
209 return 0;
210 }
211 }
212
213 value_tuple_store(gen_label, GEN_LABEL_TUPLE, tuple);
214 value_tuple_store_integer(gen_label, GEN_LABEL_LOCAL_POS, local_pos);
215 value_tuple_store_integer(gen_label, GEN_LABEL_GLOBAL_POS, global_pos);
216
217 /*
218 * Resolve any previous forward references by backpatching.
219 */
220 bp = value_tuple_fetch(gen_label, GEN_LABEL_NEXT);
221 while (!value_is_null(bp)) {
222 /*
223 * Backpatch, by placing the current global position into
224 * the slot named by the bp entry, then remove entry from list.
225 */
226 value_tuple_store_integer(
227 value_tuple_fetch(bp, GEN_LABEL_TUPLE),
228 value_tuple_fetch_integer(bp, GEN_LABEL_LOCAL_POS),
229 global_pos
230 );
231 value_tuple_store(gen_label, GEN_LABEL_NEXT,
232 value_tuple_fetch(bp, GEN_LABEL_NEXT));
233 bp = value_tuple_fetch(gen_label, GEN_LABEL_NEXT);
234 }
235
236 return 1;
237 }
238
239 /*
240 * Return a single tuple containing the contents of the gen'ed tuple chain.
241 */
242 void
243 gen_flatten(struct value *gen, struct value *dest)
244 {
245 unsigned int dest_size = value_tuple_fetch_integer(gen, GEN_GLOBAL_POS);
246 struct value *current = value_tuple_fetch(gen, GEN_ROOT_TUPLE);
247 unsigned int j = 0;
248
249 value_tuple_new(dest, value_tuple_get_tag(current), dest_size);
250
251 while (!value_is_null(current)) {
252 unsigned int i = 0;
253 unsigned int current_size = value_tuple_get_size(current);
254 struct value *x;
255 for (i = 0; i < (current_size - 1) && i < dest_size; i++) {
256 x = value_tuple_fetch(current, i);
257
258 #ifdef DEBUG
259 process_render(process_err, "(flatten %d/%d -> %d/%d: ", i, current_size, j, dest_size);
260 value_portray(process_err, x);
261 process_render(process_err, ")\n");
262 #endif
263
264 value_tuple_store(dest, j, x);
265 j++;
266 }
267 current = value_tuple_fetch(current, (current_size - 1));
268 }
269 }
0 /*
1 * gen.h
2 * Accumulate values in tuples with extents.
3 * $Id: gen.h 144 2008-07-19 01:57:04Z catseye $
4 */
5
6 #ifndef __GEN_H_
7 #define __GEN_H_
8
9 #include "value.h"
10
11 int gen_new(struct value *, struct value *, unsigned int);
12 int gen_new_default(struct value *);
13 void gen_value(struct value *, struct value *);
14 void gen_integer(struct value *, int);
15 int gen_define_label(struct value *, struct value *);
16 void gen_gen_label_ref(struct value *, struct value *);
17 void gen_flatten(struct value *, struct value *);
18
19 #endif /* !__GEN_H_ */
0 /*
1 * geninstr.c
2 */
3
4 #include <ctype.h>
5 #include <stdio.h>
6 #include <stdlib.h>
7
8 static int
9 parse_descriptor_line(const char *line, char *name, char *mode)
10 {
11 while (isspace((int)*line) && (*line != '\0')) {
12 line++;
13 }
14 if (*line != '%')
15 return 0;
16 line++;
17 while (isspace((int)*line) && (*line != '\0')) {
18 line++;
19 }
20 while (!isspace((int)*line) && (*line != '\0')) {
21 *name = *line;
22 name++;
23 line++;
24 }
25 *name = '\0';
26 while (isspace((int)*line) && (*line != '\0')) {
27 line++;
28 }
29 while (!isspace((int)*line) && (*line != '\0')) {
30 *mode = *line;
31 mode++;
32 line++;
33 }
34 *mode = '\0';
35 return 1;
36 }
37
38 int
39 main(int argc, char **argv)
40 {
41 FILE *instrtab, *instrenum, *instrlab, *vm, *localtypes;
42 static char line[512], name[80], mode[80];
43
44 argc = argc;
45 argv = argv;
46
47 if ((instrtab = fopen("instrtab.c", "w")) == NULL) {
48 perror("Couldn't open instrtab.c for writing");
49 exit(1);
50 }
51 if ((instrenum = fopen("instrenum.h", "w")) == NULL) {
52 perror("Couldn't open instrenum.h for writing");
53 exit(1);
54 }
55 if ((instrlab = fopen("instrlab.h", "w")) == NULL) {
56 perror("Couldn't open instrlab.h for writing");
57 exit(1);
58 }
59 if ((vm = fopen("vm.c", "r")) == NULL) {
60 perror("Couldn't open vm.c for reading");
61 exit(1);
62 }
63 fputs(
64 "/*\n"
65 " * instrtab.c\n"
66 " * Table of VM instructions, mapping names to opcodes.\n"
67 " * NOTE: THIS FILE WAS AUTOMATICALLY GENERATED from vm.c by geninstr\n"
68 " */\n"
69 "\n"
70 "#include \"lib.h\"\n"
71 "\n"
72 "#include \"instrtab.h\"\n"
73 "\n"
74 "struct opcode_entry opcode_table[] = {\n", instrtab);
75 fputs(
76 "/*\n"
77 " * instrenum.h\n"
78 " * C 'enum' type for VM instructions.\n"
79 " * NOTE: THIS FILE WAS AUTOMATICALLY GENERATED from vm.c by geninstr\n"
80 " */\n"
81 "\n"
82 "#ifndef __INSTRENUM_H_\n"
83 "#define __INSTRENUM_H_\n"
84 "\n"
85 "enum opcode {\n", instrenum);
86 fputs(
87 "/*\n"
88 " * instrlab.h\n"
89 " * gcc labels for VM instructions, to support direct threading.\n"
90 " * NOTE: THIS FILE WAS AUTOMATICALLY GENERATED from vm.c by geninstr\n"
91 " */\n"
92 "\n"
93 "#ifndef __INSTRLAB_H_\n"
94 "#define __INSTRLAB_H_\n"
95 "\n"
96 "static clabel instr_label[] = {\n", instrlab);
97
98 while (fgets(line, 510, vm)) {
99 int arity = 1;
100 const char *optype = "NONE";
101
102 if (!parse_descriptor_line(line, name, mode))
103 continue;
104
105 switch (mode[0]) {
106 case 'i':
107 optype = "INT";
108 break;
109 case 'a':
110 optype = "ADDR";
111 break;
112 case 'v':
113 optype = "VALUE";
114 break;
115 default:
116 arity = 0;
117 break;
118 }
119
120 fprintf(instrtab, "\t{ \"%s\",\tINSTR_%s,\t%d,\tOPTYPE_%s\t},\n",
121 name, name, arity, optype);
122 fprintf(instrenum, "\tINSTR_%s,\n", name);
123 fprintf(instrlab, "\t&&LABEL_INSTR_%s,\n", name);
124 }
125 fclose(vm);
126 fputs("\t{ NULL,\t\tINSTR_NULL,\t0,\tOPTYPE_NONE }\n};\n", instrtab);
127 fclose(instrtab);
128 fputs("\tINSTR_NULL\n};\n\n#endif /* !__INSTRENUM_H_ */\n", instrenum);
129 fclose(instrenum);
130 fputs("\tNULL\n};\n\n#endif /* !__INSTRLAB_H_ */\n", instrlab);
131 fclose(instrlab);
132
133 if ((localtypes = fopen("localtypes.h", "w")) == NULL) {
134 perror("Couldn't open localtypes.h for writing");
135 exit(1);
136 }
137 fputs(
138 "/*\n"
139 " * localtypes.h\n"
140 " * Define some types for the local system.\n"
141 " * NOTE: THIS FILE WAS AUTOMATICALLY GENERATED by geninstr\n"
142 " */\n"
143 "\n"
144 "#ifndef __LOCALTYPES_H_\n"
145 "#define __LOCALTYPES_H_\n"
146 "\n", localtypes);
147 if (sizeof(void *) == sizeof(unsigned int)) {
148 fputs("#define PTR_INT unsigned int\n", localtypes);
149 } else if (sizeof(void *) == sizeof(unsigned long int)) {
150 fputs("#define PTR_INT unsigned long int\n", localtypes);
151 } else {
152 fputs("#define PTR_INT not_supported\n", localtypes);
153 }
154 fputs("\n#endif /* !__LOCALTYPES_H_ */\n", localtypes);
155 fclose(localtypes);
156
157 exit(0);
158 }
0 /*
1 * instrtab.h
2 * Table of VM instructions, mapping names to opcodes.
3 * $Id: instrtab.h 95 2006-02-14 01:33:18Z catseye $
4 */
5
6 #ifndef __INSTRTAB_H_
7 #define __INSTRTAB_H_
8
9 #include "instrenum.h"
10
11 enum optype {
12 OPTYPE_NONE,
13 OPTYPE_INT,
14 OPTYPE_ADDR,
15 OPTYPE_VALUE
16 };
17
18 struct opcode_entry {
19 const char *token;
20 enum opcode opcode;
21 int arity;
22 enum optype optype;
23 };
24
25 extern struct opcode_entry opcode_table[];
26
27 #endif /* !__INSTRTAB_H_ */
0 /*
1 * lib.c
2 * Common functions.
3 * $Id: lib.c 114 2007-02-27 02:09:02Z catseye $
4 */
5
6 #include "lib.h"
7
8 #ifdef STANDALONE
9 /*
10 * To quote the FreeBSD manpage (despite that this is a reimplementation):
11 * The strncpy() function copies not more than len characters from src into
12 * dst, appending `\0' characters if src is less than len characters long,
13 * and not terminating dst otherwise.
14 */
15 #ifndef USE_SYSTEM_STRNCPY
16 char *
17 strncpy(char *dst, const char *src, unsigned int len)
18 {
19 char *r = dst;
20
21 while (*src != '\0' && len > 0) {
22 *dst = *src;
23 dst++;
24 src++;
25 len--;
26 }
27 while (len > 0) {
28 /* append \0 characters */
29 *dst = '\0';
30 dst++;
31 len--;
32 }
33
34 return r;
35 }
36 #endif /* !USE_SYSTEM_STRNCPY */
37
38 int
39 k_isspace(char c)
40 {
41 return c == ' ' || c == '\t' || c == '\n' || c == '\r';
42 }
43
44 int
45 k_isdigit(char c)
46 {
47 return c >= '0' && c <= '9';
48 }
49
50 int
51 k_isalpha(char c)
52 {
53 return (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z');
54 }
55
56 #ifndef USE_SYSTEM_STRCMP
57 int
58 strcmp(const char *s1, const char *s2)
59 {
60 while (*s1 == *s2 && *s1 != '\0' && *s2 != '\0') {
61 s1++;
62 s2++;
63 }
64 if (*s1 == '\0' && *s2 == '\0') {
65 return 0;
66 }
67 if (*s1 > *s2) {
68 return 1;
69 } else {
70 return -1;
71 }
72 }
73 #endif /* !USE_SYSTEM_STRCMP */
74
75 #endif /* STANDALONE */
76
77 int
78 k_atoi(const char *s, unsigned int len)
79 {
80 int acc = 0;
81
82 while (k_isspace(*s) && len > 0) {
83 s++;
84 len--;
85 }
86 while (k_isdigit(*s) && len > 0) {
87 acc = acc * 10 + (*s - '0');
88 s++;
89 len--;
90 }
91
92 return acc;
93 }
0 /*
1 * lib.h
2 * Common definitions and function prototypes.
3 * $Id: lib.h 145 2008-11-26 10:05:16Z catseye $
4 */
5
6 #ifndef __LIB_H_
7 #define __LIB_H_
8
9 #ifndef NULL
10 #define NULL 0
11 #endif
12
13 #ifndef NDEBUG
14 #include <stdio.h>
15 #define assert(cond) { \
16 if (!(cond)) { \
17 fprintf(stderr, \
18 "assertion failed (" __FILE__ "): " #cond "\n"); \
19 abort(); \
20 } \
21 }
22 #else
23 #define assert(cond)
24 #endif
25
26 #ifdef STANDALONE
27 /* stdlib.h */
28 void *malloc(unsigned int);
29 void free(void *);
30 void exit(int);
31 void abort(void);
32
33 /* string.h */
34 int strcmp(const char *, const char *);
35 int strncmp(const char *, const char *, unsigned int);
36 char *strncpy(char *, const char *, unsigned int);
37 int strlen(const char *);
38 void *memset(void *, int, unsigned int);
39
40 /* ctype.h */
41 int k_isspace(char);
42 int k_isdigit(char);
43 int k_isalpha(char);
44 #else
45 #include <stdlib.h>
46 #include <string.h>
47 #include <ctype.h>
48 #define k_isspace(x) isspace((int)x)
49 #define k_isdigit(x) isdigit((int)x)
50 #define k_isalpha(x) isalpha((int)x)
51 #endif
52
53 int k_atoi(const char *, unsigned int);
54
55 #endif /* !__LIB_H_ */
0 /*
1 * load.c
2 * Load values from a stream-like process.
3 */
4
5 #include "lib.h"
6
7 #include "load.h"
8 #include "value.h"
9 #include "stream.h"
10
11 #ifdef DEBUG
12 #include "cmdline.h"
13 #include "portray.h"
14 #include "render.h"
15 #endif
16
17 int
18 value_load(struct value *value, struct process *p)
19 {
20 unsigned int length, i;
21 char *buffer;
22 unsigned char squeeze;
23
24 stream_read(NULL, p, &squeeze, sizeof(squeeze));
25 value->type = (enum value_type)squeeze;
26
27 #ifdef DEBUG
28 process_render(process_err, "(load:%s ", type_name_table[value->type]);
29 #endif
30
31 if ((value->type & VALUE_STRUCTURED) == 0) {
32 stream_read(NULL, p, &value->value, sizeof(value->value));
33 } else {
34 switch (value->type) {
35 case VALUE_SYMBOL:
36 {
37 stream_read(NULL, p, &length, sizeof(length));
38 buffer = malloc(length);
39 stream_read(NULL, p, buffer, sizeof(char) * length);
40 if (!value_symbol_new(value, buffer, length)) {
41 free(buffer);
42 return 0;
43 }
44 free(buffer);
45 break;
46 }
47 case VALUE_TUPLE:
48 {
49 struct value tag;
50 if (!value_load(&tag, p))
51 return 0;
52 /* XXX should eventually dispatch to a handler based on tag? */
53 if (value_equal(&tag, &tag_dict)) {
54 struct value key, val;
55
56 stream_read(NULL, p, &length, sizeof(length)); /* length is layer_size here */
57 value_dict_new(value, length); /* xxx */
58 stream_read(NULL, p, &length, sizeof(length)); /* length is num entries here */
59 for (i = 0; i < length; i++) {
60 value_load(&key, p);
61 value_load(&val, p);
62 value_dict_store(value, &key, &val);
63 }
64 } else {
65 struct value val;
66
67 stream_read(NULL, p, &length, sizeof(length));
68 value_tuple_new(value, &tag, length);
69 for (i = 0; i < length; i++) {
70 value_load(&val, p);
71 value_tuple_store(value, i, &val);
72 }
73 }
74 break;
75 }
76 default:
77 assert(value->type == VALUE_SYMBOL ||
78 value->type == VALUE_TUPLE);
79 return 0;
80 }
81 }
82
83 #ifdef DEBUG
84 value_portray(process_err, value);
85 process_render(process_err, ")\n");
86 #endif
87 return 1;
88 }
0 /*
1 * load.h
2 * Structures and prototypes for loading values from file-like processes.
3 * $Id: load.h 107 2006-03-16 23:55:56Z catseye $
4 */
5
6 #ifndef __LOAD_H_
7 #define __LOAD_H_
8
9 struct process;
10 struct value;
11
12 int value_load(struct value *, struct process *);
13
14 #endif /* !__LOAD_H_ */
0 /*
1 * portray.c
2 * Routines for parsing and rendering values.
3 * $Id: portray.c 143 2008-07-18 06:42:22Z catseye $
4 */
5
6 #include "lib.h"
7
8 #include "value.h"
9 #include "portray.h"
10 #include "render.h"
11
12 static void value_portray_nodups(struct process *, struct value *, struct value *);
13
14 /*
15 * Portray a value (i.e. render it in a human-readable way) to a process.
16 */
17 void
18 value_portray(struct process *p, struct value *v)
19 {
20 struct value seen;
21 value_dict_new(&seen, 31);
22 value_portray_nodups(p, v, &seen);
23 }
24
25 /*
26 * Recursive portion of value_portray(). Tracks a dictionary of all
27 * tuple values that have been seen, to avoid recursing infinitely
28 * into cyclic chains of nested tuples.
29 */
30 static void
31 value_portray_nodups(struct process *p, struct value *v, struct value *seen)
32 {
33 switch (v->type) {
34 case VALUE_NULL:
35 process_render(p, "[]");
36 break;
37 case VALUE_INTEGER:
38 process_render(p, "%d", value_get_integer(v));
39 break;
40 case VALUE_BOOLEAN:
41 process_render(p, "%s", value_get_boolean(v) ? "true" : "false");
42 break;
43 case VALUE_PROCESS:
44 process_render(p, "PROCESS#[0x%08x]", (long int)value_get_process(v));
45 break;
46 case VALUE_LABEL:
47 process_render(p, "LABEL#[0x%08x]", (long int)value_get_label(v));
48 break;
49 case VALUE_SYMBOL:
50 process_render(p, "%s", value_symbol_get_token(v));
51 break;
52 case VALUE_TUPLE:
53 {
54 struct value *tag = value_tuple_get_tag(v);
55 unsigned int max = value_tuple_get_size(v);
56 unsigned int i;
57
58 if (!value_is_null(seen))
59 value_dict_store(seen, v, &VTRUE);
60
61 /* XXX should eventually dispatch to a handler based on tag. */
62 if (value_equal(tag, &tag_dict)) {
63 struct value dict_iter;
64 struct value *key;
65
66 value_dict_new_iter(&dict_iter, v);
67
68 process_render(p, "{");
69 key = value_dict_iter_get_current_key(&dict_iter);
70 while (!value_is_null(key)) {
71 value_portray_nodups(p, key, seen);
72 process_render(p, "=");
73 /* XXX not so good; use iter */
74 value_portray_nodups(p, value_dict_fetch(v, key), seen);
75 value_dict_iter_advance(&dict_iter);
76 key = value_dict_iter_get_current_key(&dict_iter);
77 if (!value_is_null(key)) {
78 process_render(p, ", ");
79 }
80 }
81 process_render(p, "}");
82 } else {
83 process_render(p, "<");
84 value_portray(p, value_tuple_get_tag(v));
85 process_render(p, ": ");
86 for (i = 0; i < max; i++) {
87 struct value *k = value_tuple_fetch(v, i);
88 if (value_is_null(seen) ||
89 value_is_null(value_dict_fetch(seen, k))) {
90 value_portray_nodups(p, k, seen);
91 } else {
92 process_render(p, "TUPLE#[0x%08x]",
93 value_get_unique_id(v));
94 }
95 if (i < (max - 1))
96 process_render(p, ", ");
97 }
98 process_render(p, ">");
99 }
100 break;
101 }
102 }
103 }
0 /*
1 * portray.h
2 * Prototypes and structures for rendering values to processes.
3 * $Id: portray.h 107 2006-03-16 23:55:56Z catseye $
4 */
5
6 #ifndef __PORTRAY_H_
7 #define __PORTRAY_H_
8
9 struct value;
10 struct process;
11
12 void value_portray(struct process *, struct value *);
13
14 #endif /* !__PORTRAY_H_ */
0 /*
1 * process.c
2 * Cooperative processes.
3 */
4
5
6 #include "lib.h"
7
8 #include "process.h"
9
10 struct process *
11 process_new(void)
12 {
13 struct process *p;
14
15 p = malloc(sizeof(struct process));
16 p->head = NULL;
17 p->tail = NULL;
18 p->run = NULL;
19 p->aux = NULL;
20 p->waiting = 0;
21 p->done = 0;
22 p->next = NULL;
23
24 return p;
25 }
26
27 void
28 process_enqueue(struct process *p, const struct value *v)
29 {
30 struct message *m;
31
32 m = malloc(sizeof(struct message));
33 value_copy(&m->value, v);
34 m->prev = NULL;
35 m->next = p->head;
36 if (p->head != NULL)
37 p->head->prev = m;
38 p->head = m;
39 if (p->tail == NULL)
40 p->tail = m;
41 }
42
43 int
44 process_dequeue(struct process *p, struct value *v)
45 {
46 struct message *m;
47
48 m = p->tail;
49 if (m == NULL)
50 return 0;
51 value_copy(v, &m->value);
52
53 /* remove message from queue */
54 assert(m->next == NULL);
55 if (m->prev == NULL)
56 p->head = NULL;
57 else
58 m->prev->next = NULL;
59 p->tail = m->prev;
60
61 free(m);
62
63 return 1;
64 }
65
66 void
67 process_run(struct process *p)
68 {
69 assert(p->run != NULL);
70 p->run(p);
71 }
72
73 void
74 process_free(struct process *p)
75 {
76 struct message *m, *n;
77
78 /* assert(p->done); */
79 m = p->head;
80 while (m != NULL) {
81 n = m->next;
82 free(m);
83 m = n;
84 }
85 free(p);
86 }
0 /*
1 * process.h
2 * Cooperative concurrent processes.
3 */
4
5 #ifndef __PROCESS_H_
6 #define __PROCESS_H_
7
8 #include "value.h"
9
10 struct process;
11
12 typedef void (*runfunc)(struct process *);
13
14 struct process {
15 int waiting;
16 int done;
17 runfunc run;
18 void *aux;
19 struct value aux_value;
20 struct message *head;
21 struct message *tail;
22 struct process *next;
23 };
24
25 struct message {
26 struct message *next;
27 struct message *prev;
28 struct value value;
29 };
30
31 /* Prototypes */
32
33 struct process *process_new(void);
34
35 /*
36 * places the value in the process's mailbox. This is what the VM instruction SEND
37 * does. SEND also checks if the destination process is currently waiting, (and if
38 * its mailbox is empty?), and if it is, it wakes it up so that it can deal immediately
39 * with the message. Maybe. I mean, this behaviour sounds good, but maybe we shouldn't
40 * guarantee it.
41 *
42 * We should also prevent side-effecting of that value. Maybe values can be "owned"...
43 */
44 void process_enqueue(struct process *, const struct value *);
45
46 /*
47 * retrieves a value from the process's mailbox. p should be self. This is what
48 * the RECV VM instruction does. If there is no message, the process should set its
49 * waiting flag to true, and yield.
50 */
51 int process_dequeue(struct process *, struct value *);
52
53 /*
54 * Let the process p execute for a bit. Concurrency is cooperative here, so p promises
55 * that it will return from this function "in a little while". For the VM, this is not
56 * hard; we return after executing 100 or so instructions. For native code, it should
57 * be carefully written!
58 */
59 void process_run(struct process *);
60
61 void process_free(struct process *);
62
63 #endif /* !__PROCESS_H_ */
64
0 /*
1 * render.c
2 * printf-like formatting to a stream-like process.
3 */
4
5 #include <stdarg.h>
6
7 #include "lib.h"
8 #include "stream.h"
9
10 #include "render.h"
11
12 static unsigned int
13 extract_int(const char *str, unsigned int *pos)
14 {
15 unsigned int val = 0;
16
17 while (k_isdigit(str[*pos])) {
18 val = val * 10 + (str[*pos] - '0');
19 (*pos)++;
20 }
21
22 return val;
23 }
24
25 /*
26 * Note that there is no trailing NUL in the buf!
27 */
28 static unsigned int
29 render_int(char *buf, unsigned int bufsize, int val)
30 {
31 int pos = bufsize - 1;
32 int sign = 0;
33
34 if (val == 0) {
35 buf[pos] = '0';
36 return pos;
37 }
38 if (val < 0) {
39 val *= -1;
40 sign = -1;
41 }
42 while (pos >= 0 && val > 0) {
43 buf[pos] = (char)((val % 10) + '0');
44 pos--;
45 val = val / 10;
46 }
47 if (pos >= 0 && sign == -1) {
48 buf[pos] = '-';
49 pos--;
50 }
51 if (pos < 0) {
52 buf[0] = '?'; /* signify incorrectly rendered number */
53 }
54
55 return pos + 1;
56 }
57
58 #define MAX_DIGITS 32
59
60 /*
61 * Similar to, but different from, C's printf().
62 * The size specifier of each field gives the maximum number
63 * of characters that will be rendered into that field, but
64 * does not (at the moment) cause the field to have a fixed
65 * display width.
66 */
67 void
68 process_render(struct process *p, const char *fmt, ...)
69 {
70 unsigned int pos = 0, length;
71 va_list args;
72
73 assert(p != NULL);
74 va_start(args, fmt);
75
76 while (fmt[pos] != '\0') {
77 if (fmt[pos] != '%') {
78 stream_write(NULL, p, &fmt[pos], 1);
79 pos++;
80 continue;
81 }
82
83 /* found a %. now get length */
84 pos++;
85 length = extract_int(fmt, &pos);
86 length = length;
87 /* find formatting code and select formatting */
88 switch (fmt[pos]) {
89 case '%':
90 stream_write(NULL, p, &fmt[pos], 1);
91 break;
92 case 'c':
93 {
94 char c = (char)va_arg(args, int);
95
96 stream_write(NULL, p, &c, 1);
97 break;
98 }
99 case 's':
100 {
101 char *arg = va_arg(args, char *);
102
103 stream_write(NULL, p, arg, strlen(arg));
104 break;
105 }
106 case 'd': case 'x': /* XXX for now! */
107 {
108 int val = va_arg(args, int);
109 unsigned int digit_pos;
110 char *digits;
111
112 digits = malloc(MAX_DIGITS);
113 digit_pos = render_int(digits, MAX_DIGITS, val);
114 stream_write(NULL, p, (digits + digit_pos), (MAX_DIGITS - digit_pos));
115 free(digits);
116
117 break;
118 }
119 default:
120 assert("undefined formatting code" == NULL);
121 break;
122 }
123
124 pos++;
125 }
126 }
0 /*
1 * render.h
2 * Prototypes for stream rendering (printf-like formatting).
3 * $Id: stream.h 116 2007-03-26 00:43:44Z catseye $
4 */
5
6 #ifndef __RENDER_H_
7 #define __RENDER_H_
8
9 struct process;
10
11 void process_render(struct process *, const char *, ...);
12
13 #endif /* !__RENDER_H_ */
0 /*
1 * report.c
2 * Error/warning reporter.
3 * $Id: report.c 139 2008-07-16 09:56:31Z catseye $
4 */
5
6 #include <stdarg.h>
7
8 #include "lib.h"
9
10 #include "process.h"
11 #include "stream.h"
12 #include "file.h"
13
14 #include "render.h"
15
16 #include "report.h"
17
18 struct reporter {
19 int finished;
20 int verbose;
21 int errors;
22 int warnings;
23 struct process *stream;
24 const char *phase;
25 };
26
27 /*
28 * phase should always point to a literal constant string like "Parsing"
29 */
30 struct reporter *
31 reporter_new(const char *phase, struct process *stream, int verbose)
32 {
33 struct reporter *r;
34
35 if ((r = malloc(sizeof(struct reporter))) == NULL) {
36 return NULL;
37 }
38
39 r->verbose = verbose;
40 r->errors = 0;
41 r->warnings = 0;
42 r->finished = 0;
43 r->stream = stream;
44 if (r->stream == NULL) {
45 r->stream = file_open("*stderr", "w");
46 }
47 r->phase = phase;
48
49 return r;
50
51 if (verbose) {
52 process_render(r->stream, "%s started\n", r->phase);
53 }
54 }
55
56 void
57 reporter_free(struct reporter *r)
58 {
59 if (!r->finished) {
60 reporter_finish(r);
61 }
62 stream_close(NULL, r->stream);
63 free(r);
64 }
65
66 int
67 reporter_finish(struct reporter *r)
68 {
69 if (r->verbose) {
70 process_render(r->stream,
71 "%s finished with %d errors and %d warnings\n",
72 r->phase, r->errors, r->warnings);
73 }
74 r->phase = NULL;
75 r->finished = 1;
76 return r->errors;
77 }
78
79 struct process *
80 reporter_stream(struct reporter *r)
81 {
82 return r->stream;
83 }
84
85 int
86 reporter_has_errors(struct reporter *r)
87 {
88 return r->errors > 0;
89 }
90
91 void
92 report(struct reporter *r, enum report_type rtype, const char *fmt, ...)
93 {
94 va_list args;
95
96 va_start(args, fmt);
97 report_va_list(r, rtype, fmt, args);
98 va_end(args);
99 }
100
101 void
102 report_va_list(struct reporter *r, enum report_type rtype, const char *fmt, va_list args)
103 {
104 int i;
105
106 assert(!r->finished);
107
108 process_render(r->stream, "%s %s: ",
109 r->phase, rtype == REPORT_ERROR ? "Error" : "Warning");
110
111 for (i = 0; fmt[i] != '\0'; i++) {
112 if (fmt[i] == '%') {
113 i++;
114 switch (fmt[i]) {
115 case 's':
116 process_render(r->stream, "%s",
117 va_arg(args, char *));
118 break;
119 case 'd':
120 process_render(r->stream, "%d",
121 va_arg(args, int));
122 break;
123 }
124 } else {
125 process_render(r->stream, "%c", fmt[i]);
126 }
127 }
128
129 process_render(r->stream, ".\n");
130
131 switch (rtype) {
132 case REPORT_ERROR:
133 r->errors++;
134 break;
135 case REPORT_WARNING:
136 r->warnings++;
137 break;
138 }
139 }
0 /*
1 * report.h
2 * Error/warning reporter.
3 * $Id: report.h 139 2008-07-16 09:56:31Z catseye $
4 */
5
6 #ifndef __REPORT_H_
7 #define __REPORT_H_
8
9 #include <stdarg.h>
10
11 struct process;
12
13 enum report_type {
14 REPORT_WARNING,
15 REPORT_ERROR
16 };
17
18 struct reporter;
19
20 struct reporter *reporter_new(const char *, struct process *, int);
21 int reporter_finish(struct reporter *);
22 void reporter_free(struct reporter *);
23
24 struct process *reporter_stream(struct reporter *);
25 int reporter_has_errors(struct reporter *);
26
27 void report(struct reporter *, enum report_type, const char *, ...);
28 void report_va_list(struct reporter *, enum report_type, const char *, va_list);
29
30 #endif /* !__REPORT_H_ */
0 /*
1 * run.c
2 * Main program segment of Kosheri virtual machine.
3 */
4
5 #include "lib.h"
6 #include "file.h"
7 #include "stream.h"
8 #include "cmdline.h"
9
10 #include "process.h"
11 #include "vmproc.h"
12 #include "load.h"
13
14 #include "value.h"
15
16 #ifdef DEBUG
17 #include "render.h"
18 #endif
19
20 static void
21 run_main(struct value *args, struct value *result)
22 {
23 struct value vm; /* virtual machine we will run */
24 struct value vmfile_sym;
25
26 struct value code; /* code for the virtual machine */
27 struct process *in; /* file process we will load it from */
28 struct process *first; /* main process the VM will run in */
29 struct process *curr; /* current process in our schedule */
30 struct process *next;
31 struct value *vmfile;
32
33 value_symbol_new(&vmfile_sym, "vmfile", 6);
34 vmfile = value_dict_fetch(args, &vmfile_sym);
35
36 in = file_open(value_symbol_get_token(vmfile), "r");
37 value_load(&code, in);
38 stream_close(NULL, in);
39
40 value_vm_new(&vm, &code);
41 curr = first = vmproc_new(&vm);
42 while (first != NULL) {
43 #ifdef DEBUG
44 process_render(process_err, "Running process %d\n", curr);
45 #endif
46 process_run(curr);
47 next = curr->next;
48 while (next != NULL && next->done) {
49 curr->next = next->next;
50 process_free(next);
51 next = curr->next;
52 }
53 curr = next;
54 if (curr == NULL) {
55 while (first != NULL && first->done) {
56 next = first->next;
57 process_free(first);
58 first = next;
59 }
60 curr = first;
61 }
62 }
63
64 value_integer_set(result, 0);
65 }
66
67 MAIN(run_main)
0 /*
1 * save.c
2 * Save values to a stream-like process.
3 */
4
5 #include "lib.h"
6 #include "stream.h"
7
8 #include "save.h"
9 #include "value.h"
10
11 #ifdef DEBUG
12 #include "cmdline.h"
13 #include "portray.h"
14 #include "render.h"
15 #endif
16
17 int
18 value_save(struct process *p, struct value *value)
19 {
20 unsigned char squeeze = (unsigned char)value->type;
21
22 #ifdef DEBUG
23 process_render(process_err, "(save:%s ", type_name_table[(int)squeeze]);
24 if (value->type == VALUE_SYMBOL) {
25 process_render(process_err, "[%d] ", value_symbol_get_length(value));
26 }
27 value_portray(process_err, value);
28 process_render(process_err, ")\n");
29 #endif
30
31 stream_write(NULL, p, &squeeze, sizeof(squeeze));
32
33 if ((value->type & VALUE_STRUCTURED) == 0) {
34 stream_write(NULL, p, &value->value, sizeof(value->value));
35 } else {
36 unsigned int length, i;
37
38 switch (value->type) {
39 case VALUE_SYMBOL:
40 {
41 const char *token = value_symbol_get_token(value);
42 length = value_symbol_get_length(value);
43 stream_write(NULL, p, &length, sizeof(length));
44 stream_write(NULL, p, token, sizeof(char) * length);
45 break;
46 }
47 case VALUE_TUPLE:
48 {
49 struct value *tag = value_tuple_get_tag(value);
50 value_save(p, tag);
51 /* XXX should eventually dispatch to a handler based on tag. */
52 if (value_equal(tag, &tag_dict)) {
53 struct value dict_iter;
54 struct value *key;
55
56 value_dict_new_iter(&dict_iter, value);
57
58 length = value_dict_get_layer_size(value);
59 stream_write(NULL, p, &length, sizeof(length));
60 length = value_dict_get_length(value);
61 stream_write(NULL, p, &length, sizeof(length));
62
63 key = value_dict_iter_get_current_key(&dict_iter);
64 while (!value_is_null(key)) {
65 value_save(p, key);
66 value_save(p, value_dict_fetch(value, key)); /* XXX not so good; use iter */
67 value_dict_iter_advance(&dict_iter);
68 key = value_dict_iter_get_current_key(&dict_iter);
69 }
70 } else {
71 length = value_tuple_get_size(value);
72 stream_write(NULL, p, &length, sizeof(length));
73 for (i = 0; i < length; i++) {
74 value_save(p, value_tuple_fetch(value, i));
75 }
76 }
77 break;
78 }
79 default:
80 assert(value->type == VALUE_SYMBOL ||
81 value->type == VALUE_TUPLE);
82 break;
83 }
84 }
85
86 return 1;
87 }
0 /*
1 * save.h
2 * Structures and prototypes for saving values to processes.
3 */
4
5 #ifndef __SAVE_H_
6 #define __SAVE_H_
7
8 struct process;
9 struct value;
10
11 int value_save(struct process *, struct value *);
12
13 #endif /* !__SAVE_H_ */
0 /*
1 * scan.c
2 * Lexical scanner.
3 * $Id: scan.c 139 2008-07-16 09:56:31Z catseye $
4 */
5
6 #include <stdarg.h>
7
8 #include "lib.h"
9
10 #include "stream.h"
11 #include "file.h"
12
13 #include "scan.h"
14 #include "report.h"
15 #include "render.h"
16
17 enum token_type {
18 TOKEN_EOF,
19 TOKEN_NUMBER,
20 TOKEN_BAREWORD,
21 TOKEN_SYMBOL,
22 TOKEN_QUOTED_STRING
23 };
24
25 struct scanner {
26 struct reporter *reporter;
27 struct process *input; /* file process from which we are scanning */
28 const char *filename; /* name of file scanning from */
29 char *token; /* text content of token we just scanned */
30 enum token_type token_type; /* type of token that was scanned */
31 unsigned int token_length; /* length of the token that was scanned */
32 int line; /* current line number, 1-based */
33 int column; /* current column number, 1-based */
34 int last_column; /* for putback */
35 char *putback_buf; /* buffer of characters put back */
36 int putback_pos; /* position within putback buffer */
37 };
38
39 #define PUTBACK_SIZE 80
40
41 struct scanner *
42 scanner_new(struct reporter *r)
43 {
44 struct scanner *sc;
45
46 if ((sc = malloc(sizeof(struct scanner))) == NULL) {
47 return NULL;
48 }
49 if ((sc->token = malloc(256 * sizeof(char))) == NULL) {
50 free(sc);
51 return NULL;
52 }
53
54 sc->reporter = r;
55 sc->filename = NULL;
56 sc->input = NULL;
57 sc->putback_buf = malloc(PUTBACK_SIZE * sizeof(char));
58 sc->putback_pos = 0;
59
60 return sc;
61 }
62
63 void
64 scanner_free(struct scanner *sc)
65 {
66 scanner_close(sc);
67 free(sc->token);
68 free(sc);
69 }
70
71 void
72 scanner_reset(struct scanner *sc)
73 {
74 sc->line = 1;
75 sc->column = 1;
76 sc->last_column = 0;
77 scanner_scan(sc); /* prime the pump */
78 }
79
80 /*
81 * caller is responsible for freeing the filename
82 */
83 int
84 scanner_open(struct scanner *sc, const char *filename)
85 {
86 sc->filename = filename;
87 if ((sc->input = file_open(filename, "r")) == NULL) {
88 scanner_report(sc, REPORT_ERROR,
89 "Can't open '%s' for reading", filename);
90 return 0;
91 }
92 scanner_reset(sc);
93 return 1;
94 }
95
96 /*
97 * caller is responsible for freeing the filename
98 */
99 int
100 scanner_attach(struct scanner *sc, struct process *p, const char *filename)
101 {
102 sc->filename = filename;
103 sc->input = p;
104 scanner_reset(sc);
105 return 1;
106 }
107
108 void
109 scanner_close(struct scanner *sc)
110 {
111 if (sc->filename != NULL) {
112 sc->filename = NULL;
113 }
114 if (sc->input != NULL) {
115 stream_close(NULL, sc->input);
116 sc->input = NULL; /* ? */
117 }
118 }
119
120 /*
121 * x is not a string, it is a pointer to a single character.
122 */
123 static void
124 scan_char(struct scanner *sc, char *x)
125 {
126 sc->last_column = sc->column;
127
128 /* do a 'getc' */
129 if (sc->putback_pos > 0) {
130 *x = sc->putback_buf[sc->putback_pos--];
131 } else {
132 stream_read(NULL, sc->input, x, sizeof(char));
133 }
134
135 if (*x == '\n') {
136 sc->column = 1;
137 sc->line++;
138 } else if (*x == '\t') {
139 sc->column++;
140 while (sc->column % 8 != 0)
141 sc->column++;
142 } else {
143 sc->column++;
144 }
145 }
146
147 static void