OSDN > ソフトウェアを探す > quipu > SCM > hg > quipu > コミット

quipu
Fork

quipu: コミット

quipu mercurial repository

コミットメタ情報

リビジョン	6f30387232be9ec1efba72dfe975c1ff5755f22f (tree)
日時	2018-10-12 11:49:16
作者	Agustina Arzille <avarzille@rise...>
コミッター	Agustina Arzille

ログメッセージ

Merge branch 'package' into 'default'

変更サマリ

modified: Makefile (diff)
modified: array.cpp (diff)
modified: array.h (diff)
modified: builtins.cpp (diff)
modified: builtins.h (diff)
modified: bvector.cpp (diff)
modified: bvector.h (diff)
modified: bytecode.cpp (diff)
modified: bytecode.h (diff)
modified: compiler.cpp (diff)
modified: cons.cpp (diff)
modified: cons.h (diff)
modified: continuation.cpp (diff)
modified: continuation.h (diff)
modified: defs.h (diff)
modified: eval.cpp (diff)
modified: event.cpp (diff)
modified: floatp.cpp (diff)
modified: floatp.h (diff)
modified: function.cpp (diff)
modified: function.h (diff)
modified: integer.cpp (diff)
modified: integer.h (diff)
modified: interp.cpp (diff)
modified: interp.h (diff)
modified: io.cpp (diff)
modified: io.h (diff)
modified: memory.cpp (diff)
modified: misc.cpp (diff)
modified: quipu.cpp (diff)
modified: str.cpp (diff)
modified: str.h (diff)
modified: stream.cpp (diff)
modified: stream.h (diff)
modified: symbol.cpp (diff)
modified: symbol.h (diff)
modified: sysdeps/lwlock-generic.h (diff)
modified: table.cpp (diff)
modified: table.h (diff)
modified: tree.cpp (diff)
modified: tree.h (diff)
modified: utils/opnames (diff)
modified: utils/sorted_list.h (diff)
add: utils/raw_acc.h (diff)
delete: utils/lstack.h

差分

diff -r 1ea5839d5b6d -r 6f30387232be Makefile

--- a/Makefile Tue Jul 17 18:41:09 2018 -0300

+++ b/Makefile Fri Oct 12 02:49:16 2018 +0000

		@@ -1,32 +1,16 @@
1	1	CXXFLAGS += -Wall -g -D_GNU_SOURCE -D_LARGEFILE_SOURCE -std=c++11
2		-OBJS = \
3		- quipu.o \
4		- arith.o \
5		- integer.o \
6		- floatp.o \
7		- memory.o \
8		- stream.o \
9		- str.o \
10		- module.o \
11		- bvector.o \
12		- table.o \
13		- array.o \
14		- cons.o \
15		- thread.o \
16		- interp.o \
17		- misc.o \
18		- symbol.o \
19		- tree.o \
20		- io.o \
21		- builtins.o \
22		- xtime.o \
23		- function.o \
24		- continuation.o \
25		- bytecode.o \
26		- event.o \
27		- initop.o \
28		- compiler.o \
29		- eval.o
	2	+
	3	+HEADERS = arith.h array.h builtins.h bvector.h bytecode.h config.h \
	4	+ cons.h continuation.h defs.h event.h floatp.h function.h \
	5	+ initop.h integer.h interp.h io.h memory.h module.h quipu.h \
	6	+ stream.h str.h symbol.h table.h thread.h tree.h xtime.h \
	7	+ sysdeps/atomic.h utils/chmask.h utils/dlist.h utils/raw_acc.h \
	8	+ utils/sorted_list.h
	9	+
	10	+OBJS = quipu.o arith.o integer.o floatp.o memory.o stream.o str.o \
	11	+ module.o bvector.o table.o array.o cons.o thread.o interp.o misc.o \
	12	+ symbol.o tree.o io.o builtins.o xtime.o function.o continuation.o \
	13	+ bytecode.o event.o initop.o compiler.o eval.o
30	14
31	15	LIBS = -lm -ldl -lpthread
32	16

		@@ -35,7 +19,7 @@
35	19	main: $(OBJS)
36	20	$(CXX) $(OBJS) -o main $(LIBS)
37	21
38		-%.o: %.c
	22	+%.o: %.cpp $(HEADERS)
39	23	$(CXX) $(CXXFLAGS) -c $< -o $@
40	24
41	25	clean:

diff -r 1ea5839d5b6d -r 6f30387232be array.cpp

--- a/array.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/array.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -9,15 +9,13 @@
9	9
10	10	QP_DECLS_BEGIN
11	11
12		-const int array::data_offset = entry_off<array, object> ();
13		-
14	12	static array empty_array;
15	13
16	14	array* array::alloc_raw (uint32_t n)
17	15	{
18		- array ret = (array )alloch (sizeof (ret) + n
19		- sizeof (object) + array::data_offset, typecode::ARRAY);
20		- ret->data = (object )((char )&ret[1] + array::data_offset);
	16	+ array ret = (array )alloch (sizeof (*ret) +
	17	+ n * sizeof (object), typecode::ARRAY);
	18	+ ret->data = (object *)&ret[1];
21	19	ret->len = n;
22	20	return (ret);
23	21	}

		@@ -319,6 +317,34 @@
319	317	return (ret);
320	318	}
321	319
	320	+int serialize_a (interpreter interp, stream strm,
	321	+ object obj, serial_info& info)
	322	+{
	323	+ const array *ap = as_array (obj);
	324	+ int ret = strm->write (interp, &ap->len);
	325	+ for (int i = 0; i < ap->len; ++i)
	326	+ ret += xserialize (interp, strm, ap->data[i], info);
	327	+
	328	+ return (ret);
	329	+}
	330	+
	331	+object deserialize_a (interpreter interp, stream strm, serial_info& info)
	332	+{
	333	+ int len;
	334	+ if (!strm->sread (interp, &len))
	335	+ qp_return (UNBOUND);
	336	+
	337	+ valref ret (interp, alloc_array (interp, len));
	338	+ if (info.output > 0)
	339	+ info.add_ref (interp, *ret, info.output);
	340	+
	341	+ for (int i = 0; i < len; ++i)
	342	+ if ((xaref (*ret, i) = xdeserialize (interp, strm, info)) == UNBOUND)
	343	+ qp_return (UNBOUND);
	344	+
	345	+ qp_return (*ret);
	346	+}
	347	+
322	348	static int
323	349	do_init_array (interpreter *)
324	350	{

diff -r 1ea5839d5b6d -r 6f30387232be array.h

--- a/array.h Tue Jul 17 18:41:09 2018 -0300

+++ b/array.h Fri Oct 12 02:49:16 2018 +0000

		@@ -6,14 +6,33 @@
6	6
7	7	QP_DECLS_BEGIN
8	8
9		-class array : public varobj
	9	+class alignas (object) array : public varobj
10	10	{
11	11	public:
12	12	int len;
13	13	object *data;
14	14
15	15	static array* alloc_raw (uint32_t __nelems);
16		- static const int data_offset;
	16	+
	17	+ // Needed by the raw_acc interface.
	18	+
	19	+ int& len_ref ()
	20	+ {
	21	+ return (this->len);
	22	+ }
	23	+
	24	+ object* data_ptr ()
	25	+ {
	26	+ return (this->data);
	27	+ }
	28	+
	29	+ void local_init (object *__data = nullptr, int __len = 0)
	30	+ {
	31	+ this->full = 0;
	32	+ this->type = typecode::ARRAY;
	33	+ this->data = __data;
	34	+ this->len = __len;
	35	+ }
17	36	};
18	37
19	38	inline array* as_array (object __obj)

		@@ -34,6 +53,7 @@
34	53
35	54	class stream;
36	55	class io_info;
	56	+class serial_info;
37	57
38	58	// Allocate an array of length NELEM, filling it with FILL.
39	59	QP_EXPORT object alloc_array (interpreter *__interp,

		@@ -83,6 +103,14 @@
83	103	QP_EXPORT int write_a (interpreter *__interp,
84	104	stream *__strm, object __obj, io_info& __info);
85	105
	106	+// Serialize an array in a stream.
	107	+QP_EXPORT int serialize_a (interpreter *__interp,
	108	+ stream *__strm, object __obj, serial_info& __info);
	109	+
	110	+// Deserialize an array from a stream.
	111	+QP_EXPORT object deserialize_a (interpreter *__interp,
	112	+ stream *__strm, serial_info& __info);
	113	+
86	114	// Init OP for arrays.
87	115	QP_EXPORT init_op init_array;
88	116

diff -r 1ea5839d5b6d -r 6f30387232be builtins.cpp

--- a/builtins.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/builtins.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -38,6 +38,7 @@
38	38	DISPATCH (SYMBOL, S);
39	39	DISPATCH (FCT, x);
40	40	DISPATCH (CONTINUATION, C);
	41	+ DISPATCH (PKG, P);
41	42	default:
42	43	// XXX: Other objects.
43	44	invalid_arg (interp, "write");

		@@ -47,6 +48,171 @@
47	48	return (strm->err_p () ? -1 : ret);
48	49	}
49	50
	51	+static inline bool
	52	+serial_ref_p (int itype)
	53	+{
	54	+ return (itype == typecode::ARRAY \|\|
	55	+ itype == typecode::CONS \|\|
	56	+ itype == typecode::TABLE \|\|
	57	+ itype == typecode::TREE \|\|
	58	+ itype == typecode::PKG \|\|
	59	+ itype == typecode::SYMBOL /* \|\|
	60	+ itype == typecode::BVECTOR \|\|
	61	+ itype == typecode::STR */);
	62	+}
	63	+
	64	+int xserialize (interpreter interp, stream strm,
	65	+ object obj, serial_info& info)
	66	+{
	67	+ int ret = 0, idx = -1, tp = itype (obj);
	68	+
	69	+ if (qp_unlikely (tp < 0 \|\| tp >= typecode::LAST))
	70	+ invalid_arg (interp, "serialize");
	71	+ else if (obj == NIL)
	72	+ return (strm->putb (interp, SERIAL_NIL));
	73	+ else if (array_p (obj) && as_array(obj)->len == 0)
	74	+ return (strm->putb (interp, SERIAL_NARR));
	75	+ else if ((str_p (obj) \|\| bvector_p (obj)) && as_bvector(obj)->nbytes == 0)
	76	+ return (strm->putb (interp, str_p (obj) ? SERIAL_NSTR : SERIAL_NBVEC));
	77	+ else if (tp == typecode::CHAR && as_char (obj) <= 0xff)
	78	+ {
	79	+ unsigned char data[] = { SERIAL_BCHAR, (unsigned char)as_char (obj) };
	80	+ return (strm->write (interp, data, sizeof (data)));
	81	+ }
	82	+ else if (tp == typecode::INT && as_int (obj) <= 0xff)
	83	+ {
	84	+ unsigned char data[] = { SERIAL_BINT, (unsigned char)as_int (obj) };
	85	+ return (strm->write (interp, data, sizeof (data)));
	86	+ }
	87	+ // The following check must come once we know these aren't trivial objects.
	88	+ else if (serial_ref_p (tp))
	89	+ {
	90	+ bool refd = false;
	91	+ idx = info.add_uniq_ref (interp, obj, refd);
	92	+
	93	+ if (refd)
	94	+ return (strm->putb (interp, SERIAL_REF) +
	95	+ strm->write (interp, &idx));
	96	+ }
	97	+
	98	+ ret += strm->putb (interp, tp);
	99	+ valref pos (interp, UNBOUND);
	100	+
	101	+ if (idx >= 0)
	102	+ {
	103	+ *pos = strm->tell (interp);
	104	+ ret += strm->write (interp, "\0\0\0", 4);
	105	+ }
	106	+
	107	+ switch (tp)
	108	+ {
	109	+#define DISPATCH(type, suffix) \
	110	+ case typecode::type: \
	111	+ ret = serialize_##suffix (interp, strm, obj, info); \
	112	+ break
	113	+
	114	+ DISPATCH (INT, i);
	115	+ DISPATCH (CHAR, c);
	116	+ DISPATCH (CONS, L);
	117	+ DISPATCH (BIGINT, I);
	118	+ DISPATCH (FLOAT, f);
	119	+ DISPATCH (BIGFLOAT, F);
	120	+ DISPATCH (BVECTOR, b);
	121	+ DISPATCH (STR, s);
	122	+ DISPATCH (ARRAY, a);
	123	+ DISPATCH (TABLE, u);
	124	+ DISPATCH (TREE, o);
	125	+ DISPATCH (SYMBOL, S);
	126	+ DISPATCH (FCT, x);
	127	+ DISPATCH (CONTINUATION, C);
	128	+ DISPATCH (PKG, P);
	129	+ default:
	130	+ // XXX: Other objects.
	131	+ invalid_arg (interp, "serialize");
	132	+#undef DISPATCH
	133	+ }
	134	+
	135	+ if ((idx >= 0 && (idx = info.del_ref (idx)) >= 0) \|\|
	136	+ (tp == typecode::CONS && (idx = 0, true)))
	137	+ {
	138	+ valref p2 (interp, strm->tell (interp));
	139	+ if (!strm->seek (interp, *pos, SEEK_SET))
	140	+ return (-1);
	141	+
	142	+ strm->write (interp, &idx);
	143	+ if (tp == typecode::CONS)
	144	+ strm->write (interp, &info.output);
	145	+
	146	+ strm->seek (interp, *p2, SEEK_SET);
	147	+ }
	148	+
	149	+ return (strm->err_p () ? -1 : ret);
	150	+}
	151	+
	152	+object xdeserialize (interpreter interp, stream strm, serial_info& info)
	153	+{
	154	+ int tp = strm->getb (interp);
	155	+ object ret = UNBOUND;
	156	+
	157	+ if (tp < 0)
	158	+ qp_return (ret);
	159	+
	160	+ switch (tp)
	161	+ {
	162	+ case SERIAL_NBVEC:
	163	+ qp_return (alloc_bvector (interp, 0));
	164	+ case SERIAL_NSTR:
	165	+ qp_return (alloc_str (interp, 0));
	166	+ case SERIAL_NARR:
	167	+ qp_return (alloc_array (interp, 0));
	168	+ case SERIAL_NIL:
	169	+ qp_return (NIL);
	170	+ case SERIAL_REF:
	171	+ qp_return (!strm->sread (interp, &tp) ? ret : info.find_id (tp));
	172	+ case SERIAL_BINT:
	173	+ case SERIAL_BCHAR:
	174	+ {
	175	+ int nb = strm->getb (interp);
	176	+ qp_return (nb < 0 ? UNBOUND :
	177	+ (tp == SERIAL_BINT ? intobj (nb) : charobj (nb)));
	178	+ }
	179	+ }
	180	+
	181	+ info.output = 0;
	182	+ if (serial_ref_p (tp) && !strm->sread (interp, &info.output))
	183	+ qp_return (UNBOUND);
	184	+
	185	+ switch (tp)
	186	+ {
	187	+#define DISPATCH(type, suffix) \
	188	+ case typecode::type: \
	189	+ ret = deserialize_##suffix (interp, strm, info); \
	190	+ break
	191	+
	192	+ DISPATCH (INT, i);
	193	+ DISPATCH (CHAR, c);
	194	+ DISPATCH (CONS, L);
	195	+ DISPATCH (BIGINT, I);
	196	+ DISPATCH (FLOAT, f);
	197	+ DISPATCH (BIGFLOAT, F);
	198	+ DISPATCH (BVECTOR, b);
	199	+ DISPATCH (STR, s);
	200	+ DISPATCH (ARRAY, a);
	201	+ DISPATCH (TABLE, u);
	202	+ DISPATCH (TREE, o);
	203	+ DISPATCH (SYMBOL, S);
	204	+ DISPATCH (FCT, x);
	205	+ DISPATCH (CONTINUATION, C);
	206	+ DISPATCH (PKG, P);
	207	+ default:
	208	+ // XXX: Other objects.
	209	+ invalid_arg (interp, "deserialize");
	210	+#undef DISPATCH
	211	+ }
	212	+
	213	+ qp_return (ret);
	214	+}
	215	+
50	216	object copy (interpreter *interp, object obj, bool deep)
51	217	{
52	218	if (immediate_p (obj) \|\| (varobj_p (obj) &&

		@@ -67,7 +233,6 @@
67	233	DISPATCH (SYMBOL, S);
68	234	default:
69	235	invalid_arg (interp, "copy");
70		- qp_return (UNBOUND);
71	236	#undef DISPATCH
72	237	}
73	238	}

		@@ -328,7 +493,6 @@
328	493	default:
329	494	// XXX: Custom types.
330	495	invalid_arg (interp, "div");
331		- qp_return (UNBOUND);
332	496	}
333	497
334	498	#undef DISPATCH_1

		@@ -658,7 +822,7 @@
658	822	if (!(xcmp (interp, argv[i], argv[i + 1]) < 0))
659	823	qp_return (NIL);
660	824
661		- qp_return (QP_S(t));
	825	+ qp_return (symbol::t);
662	826	}
663	827
664	828	// (> arg1 [...args])

		@@ -671,7 +835,7 @@
671	835	if (!(xcmp (interp, argv[i], argv[i + 1]) > 0))
672	836	qp_return (NIL);
673	837
674		- qp_return (QP_S(t));
	838	+ qp_return (symbol::t);
675	839	}
676	840
677	841	// (<= arg1 [...args])

		@@ -684,7 +848,7 @@
684	848	if (!(xcmp (interp, argv[i], argv[i + 1]) <= 0))
685	849	qp_return (NIL);
686	850
687		- qp_return (QP_S(t));
	851	+ qp_return (symbol::t);
688	852	}
689	853
690	854	// (>= arg1 [...args])

		@@ -697,7 +861,7 @@
697	861	if (!(xcmp (interp, argv[i], argv[i + 1]) >= 0))
698	862	qp_return (NIL);
699	863
700		- qp_return (QP_S(t));
	864	+ qp_return (symbol::t);
701	865	}
702	866
703	867	// (nputcar lst val)

		@@ -730,7 +894,7 @@
730	894	if (argc != 2)
731	895	interp->raise_nargs ("#<builtin function is>", 2, 2, argc);
732	896
733		- qp_return (argv[0] == argv[1] ? QP_S(t) : NIL);
	897	+ qp_return (argv[0] == argv[1] ? symbol::t : NIL);
734	898	}
735	899
736	900	// (= x y)

		@@ -743,7 +907,7 @@
743	907	if (!equal (interp, argv[i], argv[i + 1]))
744	908	qp_return (NIL);
745	909
746		- qp_return (QP_S(t));
	910	+ qp_return (symbol::t);
747	911	}
748	912
749	913	// (array [...args])

		@@ -862,7 +1026,7 @@
862	1026
863	1027	if (stream_p (*argv))
864	1028	out = as_stream (*argv);
865		- else if (*argv == QP_S(t))
	1029	+ else if (*argv == symbol::t)
866	1030	out = as_stream (out_stream);
867	1031	else if (str_p (*argv))
868	1032	{

		@@ -870,7 +1034,7 @@
870	1034	allocated = true;
871	1035	}
872	1036
873		- interp->retval = QP_S(t);
	1037	+ interp->retval = symbol::t;
874	1038
875	1039	if (!singlethr_p () && !allocated)
876	1040	out->lock (interp);

		@@ -1005,7 +1169,7 @@
1005	1169	interp->raise_nargs ("disasm", 2, 3, argc);
1006	1170
1007	1171	disasm (interp, *argv, argc < 2 ? out_stream : argv[1]);
1008		- qp_return (QP_S(t));
	1172	+ qp_return (symbol::t);
1009	1173	}
1010	1174
1011	1175	DEFBUILTIN (not_fct)

		@@ -1013,7 +1177,7 @@
1013	1177	if (argc != 1)
1014	1178	interp->raise_nargs ("not", 1, 1, argc);
1015	1179
1016		- qp_return (*argv != NIL ? NIL : QP_S(t));
	1180	+ qp_return (*argv != NIL ? NIL : symbol::t);
1017	1181	}
1018	1182
1019	1183	DEFBUILTIN (len_fct)

		@@ -1032,7 +1196,7 @@
1032	1196
1033	1197	object a1, a2;
1034	1198
1035		- if (argc == 1 \|\| *argv == QP_S(t))
	1199	+ if (argc == 1 \|\| *argv == symbol::t)
1036	1200	a1 = out_stream, a2 = argv[argc - 1];
1037	1201	else
1038	1202	a1 = *argv, a2 = argv[1];

		@@ -1053,7 +1217,7 @@
1053	1217	strm->putb (interp, '\n');
1054	1218
1055	1219	QP_MT_END (strm->unlock (interp));
1056		- qp_return (strm->err_p () ? NIL : QP_S(t));
	1220	+ qp_return (strm->err_p () ? NIL : symbol::t);
1057	1221	}
1058	1222
1059	1223	// XXX: Custom comparators.

		@@ -1138,19 +1302,21 @@
1138	1302	interp->raise2 ("arg-error", "load: path must be a string");
1139	1303
1140	1304	stream_guard sg (interp, open_stream (interp, str_cdata (path), "r"));
1141		- if (!sg.strmp)
	1305	+ if (*sg == nullptr)
1142	1306	qp_return (NIL);
1143	1307
	1308	+ reader rd (interp, sg.as_obj ());
	1309	+
1144	1310	while (true)
1145	1311	{
1146		- object expr = read_sexpr (interp, sg.strmp->as_obj ());
	1312	+ object expr = rd.read_sexpr ();
1147	1313	if (expr == EOS)
1148	1314	break;
1149	1315
1150	1316	eval (interp, expr);
1151	1317	}
1152	1318
1153		- qp_return (QP_S(t));
	1319	+ qp_return (symbol::t);
1154	1320	}
1155	1321
1156	1322	DEFBUILTIN (macroexp_1_fct)

		@@ -1175,7 +1341,7 @@
1175	1341	if (argc != 1)
1176	1342	interp->raise_nargs (1, 1, argc);
1177	1343
1178		- qp_return (itype (obj) == type ? QP_S(t) : NIL);
	1344	+ qp_return (itype (obj) == type ? symbol::t : NIL);
1179	1345	}
1180	1346
1181	1347	static object

		@@ -1185,7 +1351,7 @@
1185	1351	interp->raise_nargs (1, 1, argc);
1186	1352
1187	1353	int tp = itype (obj);
1188		- qp_return (tp == t1 \|\| tp == t2 ? QP_S(t) : NIL);
	1354	+ qp_return (tp == t1 \|\| tp == t2 ? symbol::t : NIL);
1189	1355	}
1190	1356
1191	1357	#define TYPE_P(name, type) \

		@@ -1205,7 +1371,7 @@
1205	1371	if (argc != 1)
1206	1372	interp->raise_nargs (1, 1, argc);
1207	1373
1208		- qp_return (cons_p (*argv) ? QP_S(t) : NIL);
	1374	+ qp_return (cons_p (*argv) ? symbol::t : NIL);
1209	1375	}
1210	1376
1211	1377	DEFBUILTIN (list_pred)

		@@ -1213,7 +1379,7 @@
1213	1379	if (argc != 1)
1214	1380	interp->raise_nargs (1, 1, argc);
1215	1381
1216		- qp_return (xcons_p (*argv) ? QP_S(t) : NIL);
	1382	+ qp_return (xcons_p (*argv) ? symbol::t : NIL);
1217	1383	}
1218	1384
1219	1385	MTYPE_P (int, INT, BIGINT)

		@@ -1409,11 +1575,37 @@
1409	1575	return (get_u);
1410	1576	case typecode::TREE:
1411	1577	return (get_o);
	1578	+ case typecode::PKG:
	1579	+ return (get_P);
1412	1580	default:
1413	1581	return (nullptr);
1414	1582	}
1415	1583	}
1416	1584
	1585	+builtin_iter::builtin_iter () : curp (BUILTIN_NAMES)
	1586	+{
	1587	+}
	1588	+
	1589	+void builtin_iter::adv ()
	1590	+{
	1591	+ this->curp += strlen (this->curp) + 1;
	1592	+}
	1593	+
	1594	+bool builtin_iter::valid () const
	1595	+{
	1596	+ return (*this->curp != 0);
	1597	+}
	1598	+
	1599	+object builtin_fct (interpreter interp, const char name)
	1600	+{
	1601	+ native_function *fp = global_builtins;
	1602	+
	1603	+ for (builtin_iter it; it.valid (); it.adv (), ++fp)
	1604	+ if (strcmp (it.name (), name) == 0)
	1605	+ qp_return (fp->as_obj ());
	1606	+
	1607	+ qp_return (UNBOUND);
	1608	+}
1417	1609
1418	1610	QP_EXPORT init_op init_symbols;
1419	1611

		@@ -1424,15 +1616,11 @@
1424	1616	if (ret != init_op::result_ok)
1425	1617	return (ret);
1426	1618
1427		- const char *names = BUILTIN_NAMES;
1428	1619	const native_function::fn_type *fcts = BUILTINS;
1429	1620	native_function *outp = global_builtins;
1430	1621
1431		- for (; *names; ++fcts, ++outp)
1432		- {
1433		- native_function::add_fct (interp, names, *fcts, 0, outp);
1434		- names += strlen (names) + 1;
1435		- }
	1622	+ for (builtin_iter it; it.valid (); it.adv ())
	1623	+ native_function::add_fct (interp, it.name (), *fcts++, 0, outp++);
1436	1624
1437	1625	return (ret);
1438	1626	}

diff -r 1ea5839d5b6d -r 6f30387232be builtins.h

--- a/builtins.h Tue Jul 17 18:41:09 2018 -0300

+++ b/builtins.h Fri Oct 12 02:49:16 2018 +0000

		@@ -131,6 +131,21 @@
131	131
132	132	QP_EXPORT indexer_t index_seq (object __seq);
133	133
	134	+class builtin_iter
	135	+{
	136	+public:
	137	+ const char *curp;
	138	+
	139	+ builtin_iter ();
	140	+ const char *name () const
	141	+ {
	142	+ return (this->curp);
	143	+ }
	144	+
	145	+ void adv ();
	146	+ bool valid () const;
	147	+};
	148	+
134	149	// Init OP for builtins.
135	150	QP_EXPORT init_op init_builtins;
136	151

diff -r 1ea5839d5b6d -r 6f30387232be bvector.cpp

--- a/bvector.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/bvector.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -3,6 +3,7 @@
3	3	#include "memory.h"
4	4	#include "integer.h"
5	5	#include "stream.h"
	6	+#include "io.h"
6	7	#include <string.h>
7	8
8	9	QP_DECLS_BEGIN

		@@ -357,10 +358,7 @@
357	358	bool eq_bb (interpreter *interp, object b1, object b2)
358	359	{
359	360	const bvector v1 = as_bvector (b1), v2 = as_bvector (b2);
360		- if (v1->nbytes != v2->nbytes)
361		- return (false);
362		-
363		- return (v1->data == v2->data \|\|
	361	+ return (v1->nbytes == v2->nbytes &&
364	362	memcmp (v1->data, v2->data, v2->nbytes) == 0);
365	363	}
366	364

		@@ -450,6 +448,61 @@
450	448	return (ret);
451	449	}
452	450
	451	+int serialize_b (interpreter interp, stream strm, object obj, serial_info&)
	452	+{
	453	+ const bvector *bvp = as_bvector (obj);
	454	+ return (strm->write (interp, &bvp->nbytes) +
	455	+ strm->write (interp, bvp->data, bvp->nbytes));
	456	+}
	457	+
	458	+int serialize_s (interpreter interp, stream strm, object obj, serial_info&)
	459	+{
	460	+ const string *sp = as_str (obj);
	461	+ return (strm->write (interp, &sp->nbytes) +
	462	+ strm->write (interp, &sp->len) +
	463	+ strm->write (interp, &sp->hval) +
	464	+ strm->write (interp, sp->data, sp->nbytes));
	465	+}
	466	+
	467	+object deserialize_b (interpreter interp, stream strm, serial_info& info)
	468	+{
	469	+ int nbytes;
	470	+ if (!strm->sread (interp, &nbytes))
	471	+ qp_return (UNBOUND);
	472	+
	473	+ bvector *bvp = as_bvector (alloc_bvector (interp, nbytes + 1));
	474	+ bvp->nbytes = strm->read (interp, bvp->data, nbytes);
	475	+
	476	+ if (bvp->nbytes != nbytes)
	477	+ qp_return (UNBOUND);
	478	+
	479	+ bvp->data[nbytes] = 0;
	480	+ if (info.output > 0)
	481	+ info.add_ref (interp, bvp->as_obj (), info.output);
	482	+
	483	+ qp_return (bvp->as_obj ());
	484	+}
	485	+
	486	+object deserialize_s (interpreter interp, stream strm, serial_info& info)
	487	+{
	488	+ int vals[2];
	489	+ if (strm->read (interp, vals, sizeof (vals)) != (int)sizeof (vals))
	490	+ qp_return (UNBOUND);
	491	+
	492	+ string *sp = as_str (alloc_str (interp, vals[0]));
	493	+ sp->len = vals[1];
	494	+
	495	+ if (!strm->sread (interp, &sp->hval) \|\|
	496	+ (sp->nbytes = strm->read (interp, sp->data, vals)) != vals)
	497	+ qp_return (UNBOUND);
	498	+
	499	+ sp->data[*vals] = '\0';
	500	+ if (info.output > 0)
	501	+ info.add_ref (interp, sp->as_obj (), info.output);
	502	+
	503	+ qp_return (sp->as_obj ());
	504	+}
	505	+
453	506	// String implementation.
454	507
455	508	static int getidx_s (interpreter *interp,

diff -r 1ea5839d5b6d -r 6f30387232be bvector.h

--- a/bvector.h Tue Jul 17 18:41:09 2018 -0300

+++ b/bvector.h Fri Oct 12 02:49:16 2018 +0000

		@@ -13,6 +13,17 @@
13	13	int nbytes;
14	14
15	15	static bvector* alloc_raw (uint32_t __cap);
	16	+
	17	+ // Needed by the raw_acc interface.
	18	+ int& len_ref ()
	19	+ {
	20	+ return (this->nbytes);
	21	+ }
	22	+
	23	+ unsigned char* data_ptr ()
	24	+ {
	25	+ return (this->data);
	26	+ }
16	27	};
17	28
18	29	inline bvector* as_bvector (object __obj)

		@@ -20,12 +31,18 @@
20	31	return ((bvector *)maskp (__obj));
21	32	}
22	33
	34	+inline constexpr bool bvector_p (object __obj)
	35	+{
	36	+ return (itype (__obj) == typecode::BVECTOR);
	37	+}
	38	+
23	39	/* Byte vectors and strings share a large part of
24	40	* the implementation, since the latter can be considered
25	41	* a subclass of the former. */
26	42
27	43	class stream;
28	44	class io_info;
	45	+class serial_info;
29	46
30	47	QP_EXPORT object alloc_bvector (interpreter *__interp, int __nbytes);
31	48

		@@ -52,6 +69,12 @@
52	69	QP_EXPORT int write_b (interpreter *__interp,
53	70	stream *__strm, object __bvector, io_info& __info);
54	71
	72	+QP_EXPORT int serialize_b (interpreter *__interp,
	73	+ stream *__strm, object __obj, serial_info& __info);
	74	+
	75	+QP_EXPORT object deserialize_b (interpreter *__interp,
	76	+ stream *__strm, serial_info& __info);
	77	+
55	78	QP_EXPORT object add_bb (interpreter *__interp, object __bv1, object __bv2);
56	79
57	80	QP_EXPORT object concat_b (interpreter __interp, object __argv, int __argc);

diff -r 1ea5839d5b6d -r 6f30387232be bytecode.cpp

--- a/bytecode.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/bytecode.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -20,8 +20,8 @@
20	20	"setp.l\0setg\0setg.l\0loadc\0loadc.l\0loada\0loada.l\0loadp\0loadp.l\0"
21	21	"loadg\0loadg.l\0loadv\0loadv.l\0loadx\0loadx.l\0bind\0bind.l\0mkframe\0"
22	22	"mkframe.l\0unwind\0unwind.l\0trybegin\0trybegin.l\0setapop\0setapop.l\0"
23		- "irtjmp\0irtjmp.l\0optargs\0optargs.l\0brbound\0brbound.l\0kwargs\0kwargs.l"
24		-;
	23	+ "irtjmp\0irtjmp.l\0optargs\0optargs.l\0brbound\0brbound.l\0kwargs\0"
	24	+ "kwargs.l\0jmpt\0jmpt.l\0jmpn\0jmpn.l";
25	25
26	26	#define BC_CALL_FORM bcode_instr::BC_CALL_FORM
27	27	#define BC_LOAD_FORM bcode_instr::BC_LOAD_FORM

		@@ -121,6 +121,10 @@
121	121	{ 584, 1 \| BC_LONG_FORM }, // brbound.l
122	122	{ 594, 3 }, // kwargs
123	123	{ 601, 3 \| BC_LONG_FORM }, // kwargs.l
	124	+ { 610, 1 \| BC_BRANCH_FORM }, // jmpt
	125	+ { 615, 1 \| BC_BRANCH_FORM \| BC_LONG_FORM }, // jmpt.l
	126	+ { 622, 1 \| BC_BRANCH_FORM }, // jmpn
	127	+ { 627, 1 \| BC_BRANCH_FORM \| BC_LONG_FORM }, // jmpn.l
124	128	{ 0, 0 }
125	129	};
126	130

		@@ -169,7 +173,7 @@
169	173	{
170	174	strm->nputb (interp, lv * 2, ' ');
171	175	strm->write (interp, "00: builtin-call ", 17);
172		- const char *nm = as_native_fct(fn)->name;
	176	+ const char *nm = fct_sname (fn);
173	177	strm->write (interp, nm, strlen (nm));
174	178	strm->putb (interp, '\n');
175	179	return;

diff -r 1ea5839d5b6d -r 6f30387232be bytecode.h

--- a/bytecode.h Tue Jul 17 18:41:09 2018 -0300

+++ b/bytecode.h Fri Oct 12 02:49:16 2018 +0000

		@@ -97,7 +97,11 @@
97	97	OP_BRBOUND,
98	98	OP_BRBOUNDL,
99	99	OP_KWARGS,
100		- OP_KWARGSL
	100	+ OP_KWARGSL,
	101	+ OP_JMPT,
	102	+ OP_JMPTL,
	103	+ OP_JMPN,
	104	+ OP_JMPNL
101	105	};
102	106
103	107	class bcode_instr

diff -r 1ea5839d5b6d -r 6f30387232be compiler.cpp

--- a/compiler.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/compiler.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -8,6 +8,7 @@
8	8	#include "builtins.h"
9	9	#include "bytecode.h"
10	10	#include "utils/sorted_list.h"
	11	+#include "utils/raw_acc.h"
11	12
12	13	QP_DECLS_BEGIN
13	14

		@@ -107,12 +108,9 @@
107	108	interpreter *interp;
108	109	ctable_t ctable;
109	110	std::vector<object> code;
110		- int nconst = 0;
111	111	int lbl_cnt = 0;
112		- bvector *bytecode = nullptr;
113		- int bc_cap;
114		- int bc_len = 0;
115	112	uint32_t sp;
	113	+ raw_acc<bvector> bytecode;
116	114	object ct_env;
117	115	struct
118	116	{

		@@ -157,7 +155,7 @@
157	155	}
158	156
159	157	bc_compiler (interpreter *ip, bool top = false) :
160		- interp (ip), sp (ip->stklen ())
	158	+ interp (ip), sp (ip->stklen ()), bytecode (16)
161	159	{
162	160	this->xdo.expr.car = UNBOUND;
163	161	this->ct_env = NIL;

		@@ -204,21 +202,25 @@
204	202
205	203	int index (object val)
206	204	{
207		- auto it = this->ctable.find (val);
208		- if (it.valid ())
209		- return (it.val ());
	205	+ auto np = this->ctable.add (val);
	206	+ if (np->val == -1)
	207	+ np->val = this->ctable.len () - 1;
210	208
211		- this->ctable.add (val, this->nconst);
212		- return (this->nconst++);
	209	+ return ((int)np->val);
	210	+ }
	211	+
	212	+ object idxvec (object out)
	213	+ {
	214	+ for (ctable_t::iterator it (this->ctable); it.valid (); it.adv ())
	215	+ xaref(out, it.val ()) = it.key ();
	216	+
	217	+ as_array(out)->len = this->ctable.len ();
	218	+ return (out);
213	219	}
214	220
215	221	object idxvec ()
216		- { // Returns an array with all the constants used by the function.
217		- object ret = alloc_array (this->interp, this->nconst);
218		- for (ctable_t::iterator it (this->ctable); it.valid (); it.adv ())
219		- xaref(ret, it.val ()) = it.key ();
220		-
221		- return (ret);
	222	+ {
	223	+ return (this->idxvec (alloc_array (this->interp, this->ctable.len ())));
222	224	}
223	225
224	226	cons* expr_do ()

		@@ -243,42 +245,15 @@
243	245	return (&this->xdo.expr);
244	246	}
245	247
246		- void bytecode_expand (int nlen)
	248	+ int bc_len () const
247	249	{
248		- bvector *tmp = this->bytecode;
249		- this->bytecode = bvector::alloc_raw (this->bc_cap = nlen);
250		-
251		- if (tmp != nullptr)
252		- {
253		- memcpy (this->bytecode->data, tmp->data, this->bc_len);
254		- xfree (tmp);
255		- }
	250	+ return (as_bvector(this->bytecode.as_obj ())->nbytes);
256	251	}
257	252
258		- void bytecode_write (int32_t code)
259		- {
260		- if (this->bc_len + (int)sizeof (code) >= this->bc_cap)
261		- this->bytecode_expand (this->bc_cap * 2);
262		-
263		- put32 (this->bytecode->data + this->bc_len, code);
264		- this->bc_len += sizeof (code);
265		- }
266		-
267		- void bytecode_write (int16_t code)
	253	+ template <class T>
	254	+ void bytecode_write (T code)
268	255	{
269		- if (this->bc_len + (int)sizeof (code) >= this->bc_cap)
270		- this->bytecode_expand (this->bc_cap * 2);
271		-
272		- put16 (this->bytecode->data + this->bc_len, code);
273		- this->bc_len += sizeof (code);
274		- }
275		-
276		- void bytecode_write (uint8_t code)
277		- {
278		- if (this->bc_len + 1 >= this->bc_cap)
279		- this->bytecode_expand (this->bc_cap * 2);
280		-
281		- this->bytecode->data[this->bc_len++] = code;
	256	+ this->bytecode.add_data (&code, sizeof (code));
282	257	}
283	258
284	259	void emit (object inst, object *argp, int nargs);

		@@ -301,6 +276,7 @@
301	276	this->emit (OPX_(UNWIND), intobj (diff));
302	277	}
303	278
	279	+ bvector* encode (bool release);
304	280	object encode ();
305	281
306	282	int compile_sym (object env, bool tail, object s, const object *ixs);

		@@ -315,15 +291,16 @@
315	291	int compile_and (object env, bool tail, object forms)
316	292	{
317	293	return (this->compile_short_circuit (env,
318		- tail, forms, QP_S(t), OPX_(BRN)));
	294	+ tail, forms, symbol::t, OPX_(JMPN)));
319	295	}
320	296
321	297	int compile_or (object env, bool tail, object forms)
322	298	{
323		- return (this->compile_short_circuit (env, tail, forms, NIL, OPX_(BRT)));
	299	+ return (this->compile_short_circuit (env,
	300	+ tail, forms, NIL, OPX_(JMPT)));
324	301	}
325	302
326		- int compile_arglist (object env, object expr);
	303	+ int compile_arglist (object env, object expr, int off = 1);
327	304	void compile_builtin_call (object env, bool tail,
328	305	object expr, int builtin, int nargs);
329	306

		@@ -471,10 +448,10 @@
471	448	nargs = 0;
472	449	inst = *argp == intobj (0) ? OPX_(LOADA0) : OPX_(LOADA1);
473	450	}
474		- else if (inst == OPX_(LOADC) && as_int (*argp) <= 1 && argp[1] == intobj (0))
475		- {
	451	+ else if (inst == OPX_(LOADC) && *argp == intobj (0) && as_int (argp[1]) <= 1)
	452	+ { // Depth is 0; offset is 0 or 1.
476	453	nargs = 0;
477		- inst = *argp == intobj (0) ? OPX_(LOADC00) : OPX_(LOADC01);
	454	+ inst = argp[1] == intobj (0) ? OPX_(LOADC00) : OPX_(LOADC01);
478	455	}
479	456	else if (inst == OPX_(LOADP) && as_int (*argp) <= 0xff &&
480	457	as_int (argp[1]) <= 1)

		@@ -559,15 +536,16 @@
559	536	}
560	537
561	538	static int
562		-lastjmp (const uint8_t *ip, int off)
	539	+lastjmp (const uint8_t *ip, int off, bool large, int first)
563	540	{
564		- while (true)
565		- if (ip[off] == OP_JMP)
566		- off += (int16_t)get16 (&ip[off + 1]) + 1;
567		- else if (ip[off] == OP_JMPL)
568		- off += (int32_t)get32 (&ip[off + 1]) + 1;
569		- else
570		- break;
	541	+ for (int ijmp = large ? OP_JMPL : OP_JMP ; ; )
	542	+ {
	543	+ int opc = ip[off];
	544	+ if (opc == ijmp \|\| opc == first)
	545	+ off += label_get (large, &ip[off + 1]) + 1;
	546	+ else
	547	+ break;
	548	+ }
571	549
572	550	return (off);
573	551	}

		@@ -578,7 +556,13 @@
578	556	for (sorted_list<>::iterator it (fixup); it.valid (); it.adv ())
579	557	{
580	558	int off = it.key () + label_get (large, &bvp->data[it.key ()]);
581		- int npos = lastjmp (bvp->data, off);
	559	+ int first = bvp->data[it.key () - 1];
	560	+
	561	+ if (first != OP_JMPT && first != OP_JMPTL &&
	562	+ first != OP_JMPN && first != OP_JMPNL)
	563	+ first = -1; // Any non-opcode will do.
	564	+
	565	+ int npos = lastjmp (bvp->data, off, large, first);
582	566
583	567	if (npos != off)
584	568	label_put (large, bvp->data + it.key (), npos - it.key ());

		@@ -676,21 +660,19 @@
676	660	simplify_jmps (bvp, fixup, large);
677	661	}
678	662
679		-object bc_compiler::encode ()
	663	+bvector* bc_compiler::encode (bool release)
680	664	{
681	665	auto& cv = this->code;
682	666	bool large = cv.size () + (3 * cv.size () / 2) >= 0xffff;
683	667
684	668	sorted_list<> lbl_loc, fixup_lbl;
685	669
686		- this->bytecode_expand (16);
687		-
688	670	for (unsigned int it = 0; it < cv.size (); )
689	671	{
690	672	object vi = cv[it++];
691	673	if (vi == OPX_(LABEL))
692	674	{
693		- lbl_loc.add (cv[it++], this->bc_len);
	675	+ lbl_loc.add (cv[it++], this->bc_len ());
694	676	continue;
695	677	}
696	678

		@@ -702,7 +684,7 @@
702	684
703	685	if (instrp->branch_p ())
704	686	{
705		- fixup_lbl.add (this->bc_len, cv[it++]);
	687	+ fixup_lbl.add (this->bc_len (), cv[it++]);
706	688	this->bytecode_write ((int16_t)0);
707	689	if (large)
708	690	this->bytecode_write ((int16_t)0);

		@@ -718,21 +700,28 @@
718	700	it += instrp->nops ();
719	701	}
720	702
	703	+ bvector *bvp = this->bytecode.get ();
	704	+
721	705	// Convert labels to bytecode offsets.
722	706	for (sorted_list<>::iterator it (fixup_lbl); it.valid (); it.adv ())
723		- label_put (large, this->bytecode->data + it.key (),
	707	+ label_put (large, bvp->data + it.key (),
724	708	lbl_loc.get (it.val (), 0) - it.key ());
725	709
726		- this->bytecode->nbytes = this->bc_len;
727		-
728	710	// Minimize the amount of jumps needed.
729		- optimize_jmps (this->bytecode, fixup_lbl, large);
	711	+ optimize_jmps (bvp, fixup_lbl, large);
	712	+ if (release)
	713	+ this->bytecode.release ();
730	714
731		- // Finally, register the bytecode and return.
732		- this->bytecode->full \|= FLAGS_CONST;
733		- interp->alval = this->bytecode->as_obj ();
734		- gcregister (interp, this->bytecode);
735		- return (interp->alval);
	715	+ return (bvp);
	716	+}
	717	+
	718	+object bc_compiler::encode ()
	719	+{
	720	+ bvector *bvp = this->encode (true);
	721	+ bvp->full \|= FLAGS_CONST;
	722	+ this->interp->alval = bvp->as_obj ();
	723	+ gcregister (this->interp, bvp);
	724	+ return (this->interp->alval);
736	725	}
737	726
738	727	static inline int

		@@ -798,7 +787,6 @@
798	787	interp->raise2 ("syntax-error", buf);
799	788	}
800	789
801		-// XXX: Ordered list.
802	790	static const struct
803	791	{
804	792	object code;

		@@ -873,7 +861,7 @@
873	861	object head = xcar (expr), xt;
874	862	int idx;
875	863
876		- if (head == QP_S(quote) && cons_p (xcdr (expr)) && xcddr (expr) == NIL)
	864	+ if (head == symbol::quote && cons_p (xcdr (expr)) && xcddr (expr) == NIL)
877	865	return (xcadr (expr));
878	866	else if (nksymbol_p (head) &&
879	867	(idx = find_builtin (as_str (symname (head)))) >= 0 &&

		@@ -891,12 +879,12 @@
891	879	a2 = cfold (interp, xcar (xcddr (expr)), env, ct_env);
892	880
893	881	if (a1 != UNBOUND && a2 != UNBOUND)
894		- return (a1 == a2 ? QP_S(t) : NIL);
	882	+ return (a1 == a2 ? symbol::t : NIL);
895	883
896	884	object elem = xcadr (expr);
897	885	if (symbol_p (elem) && elem == xcar (xcddr (expr)) &&
898	886	lookup_alias (ct_env, elem) == elem && in_env (elem, env))
899		- return (QP_S(t));
	887	+ return (symbol::t);
900	888	}
901	889	}
902	890

		@@ -937,7 +925,7 @@
937	925	this->emit (OPX_(LOAD1));
938	926	else if (int_p (expr) && as_int (expr) < 0x80 && as_int (expr) >= -128)
939	927	this->emit (OPX_(LOADI8), expr);
940		- else if (expr == QP_S(t))
	928	+ else if (expr == symbol::t)
941	929	this->emit (OPX_(LOADT));
942	930	else if (expr == NIL)
943	931	{

		@@ -979,7 +967,7 @@
979	967	if (loc < 0)
980	968	{
981	969	const varobj *vp = as_varobj (s);
982		- if ((vp->flagged_p (FLAGS_CONST)) && *ixs == OPX_(LOADA))
	970	+ if (vp->flagged_p (FLAGS_CONST) && *ixs == OPX_(LOADA))
983	971	return (this->compile_atom (env, tail, symval (s), true));
984	972	else
985	973	// Dynamic access.

		@@ -988,8 +976,8 @@
988	976	else if (depth >= (int)this->frames.size ())
989	977	{ // Outside this function's scope.
990	978	this->rflags \|= flg_outer_ref;
991		- this->emit (ixs[1], intobj (loc),
992		- intobj (depth - (int)this->frames.size ()));
	979	+ this->emit (ixs[1], intobj (depth -
	980	+ (int)this->frames.size ()), intobj (loc));
993	981	}
994	982	else
995	983	{

		@@ -1150,7 +1138,7 @@
1150	1138	object forms, object dfl, object branch)
1151	1139	{
1152	1140	if (!xcons_p (forms))
1153		- specform_error (bc.interp, dfl == QP_S(t) ?
	1141	+ specform_error (bc.interp, dfl == symbol::t ?
1154	1142	"and" : "or", SPECFORM_DOTTED);
1155	1143	else if (forms == NIL)
1156	1144	return (bc.compile_in (env, tail, dfl));

		@@ -1164,7 +1152,7 @@
1164	1152	return (r);
1165	1153	else if (qp_unlikely (rm == EVR_NIL \|\| rm == EVR_ATOM))
1166	1154	{ // Constant form.
1167		- if ((rm == EVR_NIL && dfl != QP_S(t)) \|\| (rm == EVR_ATOM && dfl != NIL))
	1155	+ if ((rm == EVR_NIL && dfl != symbol::t) \|\| (rm == EVR_ATOM && dfl != NIL))
1168	1156	// Skip constant form.
1169	1157	return (bc.compile_short_circuit (env,
1170	1158	tail, xcdr (forms), dfl, branch));

		@@ -1176,9 +1164,7 @@
1176	1164	}
1177	1165
1178	1166	int end = bc.next_label ();
1179		- bc.emit (OPX_(DUP));
1180	1167	bc.emit (branch, intobj (end));
1181		- bc.emit (OPX_(POP));
1182	1168	bc.compile_short_circuit (env, tail, xcdr (forms), dfl, branch);
1183	1169	bc.mark_label (end);
1184	1170	return (EVR_NONE);

		@@ -1202,19 +1188,20 @@
1202	1188	return (r);
1203	1189	}
1204	1190
1205		-int bc_compiler::compile_arglist (object env, object expr)
	1191	+int bc_compiler::compile_arglist (object env, object expr, int off)
1206	1192	{
1207	1193	int ret = 0;
	1194	+ this->cur_f().stkdisp += off;
1208	1195
1209		- for (++this->cur_f().stkdisp; expr != NIL;
1210		- expr = xcdr (expr), ++ret, ++this->cur_f().stkdisp)
	1196	+ for (; expr != NIL; expr = xcdr (expr),
	1197	+ ++ret, ++this->cur_f().stkdisp)
1211	1198	if (xcons_p (expr))
1212	1199	this->compile_in (env, false, xcar (expr));
1213	1200	else
1214	1201	this->interp->raise2 ("arg-error",
1215	1202	"apply: argument list must not be dotted");
1216	1203
1217		- this->cur_f().stkdisp -= ret + 1;
	1204	+ this->cur_f().stkdisp -= ret + off;
1218	1205	return (ret);
1219	1206	}
1220	1207

		@@ -1262,10 +1249,8 @@
1262	1249	// Evaluate the calling function's definition.
1263	1250	this->compile_in (env, false, h);
1264	1251	}
1265		- else
1266		- --this->cur_f().stkdisp;
1267	1252
1268		- int nargs = this->compile_arglist (env, xcdr (expr));
	1253	+ int nargs = this->compile_arglist (env, xcdr (expr), bidx < 0);
1269	1254	if (!(bidx < 0))
1270	1255	this->compile_builtin_call (env, tail, expr, bidx, nargs);
1271	1256	else

		@@ -1507,6 +1492,8 @@
1507	1492
1508	1493	// Complex expression.
1509	1494	e1 = xcar (expr);
	1495	+ if (!symbol_p (e1))
	1496	+ return (this->compile_app (env, tail, expr));
1510	1497
1511	1498	switch (get_specform (as_str (symname (e1))))
1512	1499	{

		@@ -2298,7 +2285,7 @@
2298	2285	if (!symbol_p (h))
2299	2286	qp_return (expr);
2300	2287	else if ((x = lookup_ctv (env, h)) == h)
2301		- { // XXX: Rewrite once packages are working.
	2288	+ {
2302	2289	if (!(as_symbol(h)->flagged_p (symbol::ctv_flag)) \|\|
2303	2290	!fct_p (interp->retval = symval (h)))
2304	2291	qp_return (expr);

		@@ -2352,4 +2339,59 @@
2352	2339	return (macroexp (interp, expr, NIL));
2353	2340	}
2354	2341
	2342	+object compile_pkg (interpreter *interp, reader& rd)
	2343	+{
	2344	+ bc_compiler::ctable_t ctable;
	2345	+ raw_acc<bvector> bytecode;
	2346	+ raw_acc<array> fvals;
	2347	+ valref expr (interp, NIL);
	2348	+
	2349	+ for (ctable.cmp.ip = interp ; ; )
	2350	+ {
	2351	+ if ((*expr = rd.read_sexpr ()) == EOS)
	2352	+ break;
	2353	+
	2354	+ expr = macroexp (interp, expr);
	2355	+
	2356	+ bc_compiler bc (interp, true);
	2357	+ ctable.swap (bc.ctable);
	2358	+ bc.compile_in (NIL, false, *expr);
	2359	+ bc.emit (OPX_(RET));
	2360	+
	2361	+ local_varobj<function> fn;
	2362	+ fn.local_init ();
	2363	+ fn.bcode = bc.encode(false)->as_obj ();
	2364	+ fn.name = fn.env = NIL;
	2365	+ fn.min_argc = fn.max_argc = 0;
	2366	+
	2367	+ fvals.expand (bc.ctable.len ());
	2368	+ fn.vals = bc.idxvec (fvals.as_obj ());
	2369	+ fn.max_sp = fn.max_stack ();
	2370	+
	2371	+ interp->push (fn.as_obj ());
	2372	+ call_n (interp, 0);
	2373	+ interp->popn ();
	2374	+
	2375	+ bytecode.add_data (as_bvector(fn.bcode)->data,
	2376	+ as_bvector(fn.bcode)->nbytes - 1);
	2377	+
	2378	+ ctable.swap (bc.ctable);
	2379	+ }
	2380	+
	2381	+ unsigned char ret_code[] = { OP_RET };
	2382	+ bytecode.add_data (ret_code, 1);
	2383	+
	2384	+ function *retp = as_fct (alloc_fct (interp, function::artificial_flag));
	2385	+ interp->push (interp->alval);
	2386	+
	2387	+ retp->bcode = interp->alval = bytecode.release()->as_obj ();
	2388	+ gcregister (interp, as_varobj (interp->alval));
	2389	+
	2390	+ retp->vals = interp->alval = fvals.release()->as_obj ();
	2391	+ gcregister (interp, as_varobj (interp->alval));
	2392	+
	2393	+ retp->max_sp = retp->max_stack ();
	2394	+ return (interp->pop ());
	2395	+}
	2396	+
2355	2397	QP_DECLS_END

diff -r 1ea5839d5b6d -r 6f30387232be cons.cpp

--- a/cons.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/cons.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -397,7 +397,7 @@
397	397	{
398	398	if (obj == NIL)
399	399	return (strm->write (interp, "nil", 3));
400		- else if (xcar (obj) == QP_S(quote) &&
	400	+ else if (xcar (obj) == symbol::quote &&
401	401	xcons_p (xcdr (obj)) && xcddr (obj) == NIL)
402	402	{
403	403	strm->putb (interp, '\'');

		@@ -428,6 +428,66 @@
428	428	return (ret);
429	429	}
430	430
	431	+int serialize_L (interpreter interp, stream strm,
	432	+ object obj, serial_info& info)
	433	+{
	434	+ if (obj == NIL)
	435	+ return (strm->putb (interp, SERIAL_NIL));
	436	+
	437	+ valref tmp (interp, obj);
	438	+ int len = 0, ret = 0;
	439	+
	440	+ ret += strm->write (interp, &len);
	441	+ while (true)
	442	+ {
	443	+ if (*tmp == NIL)
	444	+ break;
	445	+
	446	+ valref head (interp, xcar (*tmp));
	447	+ ret += xserialize (interp, strm, *head, info);
	448	+ tmp = xcdr (tmp), ++len;
	449	+
	450	+ if (!xcons_p (*tmp))
	451	+ {
	452	+ ret += xserialize (interp, strm, *tmp, info);
	453	+ len = -len;
	454	+ break;
	455	+ }
	456	+ }
	457	+
	458	+ info.output = len; // Let the caller know our length.
	459	+ return (ret);
	460	+}
	461	+
	462	+object deserialize_L (interpreter interp, stream strm, serial_info& info)
	463	+{
	464	+ int len;
	465	+
	466	+ if (!strm->sread (interp, &len))
	467	+ qp_return (UNBOUND);
	468	+
	469	+ bool dotted = len < 0 ? (len = -len, true) : false;
	470	+ valref ret (interp, alloc_cons (interp, len)), tmp (interp, NIL);
	471	+ object outp = &ret;
	472	+
	473	+ if (info.output > 0)
	474	+ info.add_ref (interp, *outp, info.output);
	475	+
	476	+ for (int i = 0; i < len; ++i)
	477	+ {
	478	+ if ((*tmp = xdeserialize (interp, strm, info)) == UNBOUND)
	479	+ qp_return (*tmp);
	480	+
	481	+ xcar(outp) = tmp;
	482	+ outp = &xcdr(*outp);
	483	+ }
	484	+
	485	+ if (dotted && (*outp = xdeserialize (interp, strm, info)) == UNBOUND)
	486	+ qp_return (*outp);
	487	+
	488	+ qp_return (*ret);
	489	+}
	490	+
431	491	// External definitions.
432	492	object NIL;
433	493

diff -r 1ea5839d5b6d -r 6f30387232be cons.h

--- a/cons.h Tue Jul 17 18:41:09 2018 -0300

+++ b/cons.h Fri Oct 12 02:49:16 2018 +0000

		@@ -92,6 +92,7 @@
92	92
93	93	class stream;
94	94	class io_info;
	95	+class serial_info;
95	96
96	97	QP_EXPORT object alloc_cons (interpreter *__interp);
97	98

		@@ -121,6 +122,12 @@
121	122	QP_EXPORT int write_L (interpreter *__interp,
122	123	stream *__strm, object __obj, io_info& __info);
123	124
	125	+QP_EXPORT int serialize_L (interpreter *__interp,
	126	+ stream *__strm, object __obj, serial_info& __info);
	127	+
	128	+QP_EXPORT object deserialize_L (interpreter *__interp,
	129	+ stream *__strm, serial_info& __info);
	130	+
124	131	QP_EXPORT object reverse_L (interpreter *__interp, object __obj);
125	132
126	133	QP_EXPORT object nreverse_L (interpreter *__interp, object __obj);

diff -r 1ea5839d5b6d -r 6f30387232be continuation.cpp

--- a/continuation.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/continuation.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -5,6 +5,7 @@
5	5	#include "integer.h"
6	6	#include "function.h"
7	7	#include "stream.h"
	8	+#include "io.h"
8	9
9	10	QP_DECLS_BEGIN
10	11

		@@ -127,4 +128,31 @@
127	128	sprintf (buf, "#<continuation at %p>", maskp (obj))));
128	129	}
129	130
	131	+int serialize_C (interpreter interp, stream strm,
	132	+ object obj, serial_info& info)
	133	+{
	134	+ continuation *cnp = as_continuation (obj);
	135	+ return (strm->write (interp, &cnp->ip_offset) +
	136	+ strm->write (interp, &cnp->sp_diff) +
	137	+ strm->write (interp, cnp->sframes, sizeof (cnp->sframes)) +
	138	+ xserialize (interp, strm, cnp->value, info) +
	139	+ xserialize (interp, strm, cnp->argv, info));
	140	+}
	141	+
	142	+object deserialize_C (interpreter interp, stream strm, serial_info& info)
	143	+{
	144	+ valref ret (interp, alloc_continuation (interp));
	145	+ continuation cnp = as_continuation (ret);
	146	+
	147	+ if (!strm->sread (interp, &cnp->ip_offset) \|\|
	148	+ !strm->sread (interp, &cnp->sp_diff) \|\|
	149	+ strm->read (interp, cnp->sframes, sizeof (cnp->sframes)) !=
	150	+ (int)sizeof (cnp->sframes) \|\|
	151	+ (cnp->value = xdeserialize (interp, strm, info)) == UNBOUND \|\|
	152	+ !array_p (cnp->argv = xdeserialize (interp, strm, info)))
	153	+ qp_return (UNBOUND);
	154	+
	155	+ qp_return (*ret);
	156	+}
	157	+
130	158	QP_DECLS_END

diff -r 1ea5839d5b6d -r 6f30387232be continuation.h

--- a/continuation.h Tue Jul 17 18:41:09 2018 -0300

+++ b/continuation.h Fri Oct 12 02:49:16 2018 +0000

		@@ -36,10 +36,17 @@
36	36
37	37	class stream;
38	38	class io_info;
	39	+class serial_info;
39	40
40	41	QP_EXPORT int write_C (interpreter *__interp,
41	42	stream *__strm, object __obj, io_info& __info);
42	43
	44	+QP_EXPORT int serialize_C (interpreter *__interp,
	45	+ stream *__strm, object __obj, serial_info& __info);
	46	+
	47	+QP_EXPORT object deserialize_C (interpreter *__interp,
	48	+ stream *__strm, serial_info& __info);
	49	+
43	50	QP_DECLS_END
44	51
45	52	#endif

diff -r 1ea5839d5b6d -r 6f30387232be defs.h

--- a/defs.h Tue Jul 17 18:41:09 2018 -0300

+++ b/defs.h Fri Oct 12 02:49:16 2018 +0000

		@@ -291,13 +291,6 @@
291	291	# undef QP_HAS_ALLOCA
292	292	#endif
293	293
294		-template <class T1, class T2>
295		-inline constexpr size_t entry_off ()
296		-{
297		- return (((sizeof (T1) + alignof (T2) - 1) &
298		- ~(alignof (T2) - 1)) - sizeof (T1));
299		-}
300		-
301	294	inline constexpr uint32_t hash_rotl (uint32_t __code, uint32_t __nb)
302	295	{
303	296	return ((__code << __nb) \| (__code >> (32 - __nb)));

		@@ -330,9 +323,6 @@
330	323	# define __attribute__(expr)
331	324	#endif
332	325
333		-// XXX: Mangle builtin symbols.
334		-#define QP_S(name) qp_SYMBOL_##name
335		-
336	326	// Necessary assertion for stack-allocated types.
337	327	static_assert (alignof (varobj) % 8 == 0, "invalid alignment for varobjs");
338	328

diff -r 1ea5839d5b6d -r 6f30387232be eval.cpp

--- a/eval.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/eval.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -17,12 +17,10 @@
17	17
18	18	object argv = (object )QP_TALLOC (interp, extra * sizeof (*argv));
19	19	uint32_t ix, ax = 0;
	20	+ object uv, saved_data[4];
20	21	local_varobj<array> saved;
21		- object uv, saved_data[4];
22	22
23		- saved.type = typecode::ARRAY;
24		- saved.len = QP_NELEM (saved_data);
25		- saved.data = saved_data;
	23	+ saved.local_init (saved_data, QP_NELEM (saved_data));
26	24
27	25	saved.data[0] = *(interp->stkend - 1);
28	26	saved.data[1] = *(interp->stkend - 2);

		@@ -86,9 +84,7 @@
86	84	if (qp_unlikely (!va && nrest > 0))
87	85	{
88	86	local_varobj<string> ts;
89		- ts.type = typecode::STR;
90		- ts.data = (unsigned char *)fct_sname (interp->caller ());
91		- ts.nbytes = ustrlen (ts.data, &ts.len);
	87	+ ts.local_init (fct_sname (interp->caller ()));
92	88	interp->raise2 ("arg-error", io_sprintf (interp, "apply: excess "
93	89	"arguments found after keyword arguments in call to %Q",
94	90	ts.as_obj ()));

		@@ -167,9 +163,9 @@
167	163	int sx, ix;
168	164
169	165	if (qp_likely (!bcode_long_p (*(ip - 1))))
170		- ix = ip++, sx = ip++;
	166	+ sx = ip++, ix = ip++;
171	167	else
172		- ix = fetch32 (ip), sx = fetch32 (ip);
	168	+ sx = fetch32 (ip), ix = fetch32 (ip);
173	169
174	170	object env = interp->stack[interp->cur_frame - 5];
175	171	for (; sx != 0; --sx)

		@@ -212,32 +208,25 @@
212	208	captenv (interpreter *interp, uint32_t lastf)
213	209	{
214	210	uint32_t cf = interp->cur_frame;
215		- object dummy, *lp = &dummy;
216		- object *retp = &interp->stack[cf - interpreter::frame_size -
217		- as_int (interp->stack[cf - 3])];
	211	+ object retp = &interp->stack[cf - 5], outp = retp;
218	212
219	213	do
220	214	{
221		- int sx = as_int (interp->stack[cf - 3]);
	215	+ int nargs = as_int (interp->stack[cf - 3]);
	216	+ int nbp = cf - interpreter::frame_size - nargs;
222	217
223	218	if (interp->dynframe_captured (cf - 1))
224	219	break;
225		- else if (sx == 0)
226		- {
227		- cf = as_int (interp->stack[cf - 4]);
228		- continue;
229		- }
230	220
231		- array *ap = as_array (alloc_array (interp, sx + 1, NIL));
232		- int nbp = cf - interpreter::frame_size - sx;
233		- copy_objs (ap->data, &interp->stack[nbp], sx + 1);
234		- interp->stack[nbp] = *lp = interp->alval;
	221	+ array *ap = as_array (alloc_array (interp, nargs + 1, NIL));
	222	+ copy_objs (ap->data, &interp->stack[nbp], nargs);
	223	+ interp->stack[nbp] = *outp = interp->alval;
	224	+ outp = &xaref(*outp, nargs);
235	225
236		- lp = &ap->data[sx];
237	226	interp->dynframe_set_captured (cf - 1);
238	227	cf = as_int (interp->stack[cf - 4]);
239	228	}
240		- while (cf > lastf);
	229	+ while (cf >= lastf);
241	230
242	231	return (*retp);
243	232	}

		@@ -283,7 +272,7 @@
283	272	P_(MKFRAME), P_(MKFRAMEL), P_(UNWIND), P_(UNWINDL), P_(TRYBEGIN),
284	273	P_(TRYBEGINL), P_(SETAPOP), P_(SETAPOPL), P_(IRTJMP), P_(IRTJMPL),
285	274	P_(OPTARGS), P_(OPTARGSL), P_(BRBOUND), P_(BRBOUNDL), P_(KWARGS),
286		- P_(KWARGSL)
	275	+ P_(KWARGSL), P_(JMPT), P_(JMPTL), P_(JMPN), P_(JMPNL)
287	276	};
288	277
289	278	# undef P_

		@@ -325,8 +314,8 @@
325	314	interp->push_frame (as_fct(fn)->env, nargs, 0);
326	315	lastf = interp->cur_frame;
327	316
	317	+ as_fct(fn)->test_nargs (interp, nargs);
328	318	interp->growstk (as_fct(fn)->max_sp);
329		- as_fct(fn)->test_nargs (interp, nargs);
330	319	stack = interp->stack;
331	320	}
332	321

		@@ -382,7 +371,7 @@
382	371
383	372	OP_(BRBOUND):
384	373	OP_(BRBOUNDL):
385		- U_PUSH (stack[bp + ip_ival (ip)] != UNBOUND ? QP_S(t) : NIL);
	374	+ U_PUSH (stack[bp + ip_ival (ip)] != UNBOUND ? symbol::t : NIL);
386	375	NEXT_OP;
387	376
388	377	OP_(DUP):

		@@ -504,6 +493,32 @@
504	493	interp->popn (2);
505	494	NEXT_OP;
506	495
	496	+ OP_(JMPT):
	497	+ OP_(JMPTL):
	498	+ sx = *(ip - 1) == OP_JMPTL;
	499	+ if (r_stkend (1) != NIL)
	500	+ ip += sx ? (int32_t)get32 (ip) : (int16_t)get16 (ip);
	501	+ else
	502	+ {
	503	+ interp->popn ();
	504	+ ip += sizeof (int16_t) << sx;
	505	+ }
	506	+
	507	+ NEXT_OP;
	508	+
	509	+ OP_(JMPN):
	510	+ OP_(JMPNL):
	511	+ sx = *(ip - 1) == OP_JMPNL;
	512	+ if (r_stkend (1) == NIL)
	513	+ ip += sx ? (int32_t)get32 (ip) : (int16_t)get16 (ip);
	514	+ else
	515	+ {
	516	+ interp->popn ();
	517	+ ip += sizeof (int16_t) << sx;
	518	+ }
	519	+
	520	+ NEXT_OP;
	521	+
507	522	OP_(RET):
508	523	retval = r_stkend (1);
509	524	if ((interp->cur_frame = as_int (stack[lastf - 4])) == top_frame)

		@@ -526,12 +541,12 @@
526	541	NEXT_OP;
527	542
528	543	OP_(IS):
529		- r_stkend(2) = r_stkend (2) == r_stkend (1) ? QP_S(t) : NIL;
	544	+ r_stkend(2) = r_stkend (2) == r_stkend (1) ? symbol::t : NIL;
530	545	interp->popn ();
531	546	NEXT_OP;
532	547
533	548	OP_(NOT):
534		- r_stkend(1) = r_stkend (1) == NIL ? QP_S(t) : NIL;
	549	+ r_stkend(1) = r_stkend (1) == NIL ? symbol::t : NIL;
535	550	NEXT_OP;
536	551
537	552	OP_(CONS):

		@@ -604,7 +619,7 @@
604	619	goto do_tcall;
605	620
606	621	OP_(LOADT):
607		- U_PUSH (QP_S(t));
	622	+ U_PUSH (symbol::t);
608	623	NEXT_OP;
609	624
610	625	OP_(LOADNIL):

		@@ -986,7 +1001,7 @@
986	1001	case typecode::CONS:
987	1002	if (expr == NIL)
988	1003	qp_return (expr);
989		- else if (xcar (expr) == QP_S(quote) &&
	1004	+ else if (xcar (expr) == symbol::quote &&
990	1005	cons_p (xcdr (expr)) && xcddr (expr) == NIL)
991	1006	qp_return (xcadr (expr));
992	1007	break;

diff -r 1ea5839d5b6d -r 6f30387232be event.cpp

--- a/event.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/event.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -2,6 +2,7 @@
2	2	#include "thread.h"
3	3	#include "function.h"
4	4	#include "memory.h"
	5	+#include "symbol.h"
5	6
6	7	QP_DECLS_BEGIN
7	8

		@@ -65,7 +66,7 @@
65	66	sigint_fct.flags = native_function::native_flag;
66	67	sigint_fct.type = typecode::FCT;
67	68	sigint_fct.fct = sigint_handler;
68		- sigint_fct.name = "sigint-handler";
	69	+ sigint_fct.name = intern (interp, "sigint-handler");
69	70	ev_handlers[SIGINT - 1] = sigint_fct.as_obj ();
70	71
71	72	struct sigaction sa;

		@@ -80,7 +81,7 @@
80	81	gcreq_fct.flags = native_function::native_flag;
81	82	gcreq_fct.type = typecode::FCT;
82	83	gcreq_fct.fct = gcreq_handler;
83		- gcreq_fct.name = "gc-request";
	84	+ gcreq_fct.name = intern (interp, "gc-request");
84	85	ev_handlers[GCREQ_EV - 1] = gcreq_fct.as_obj ();
85	86
86	87	return (init_op::result_ok);

diff -r 1ea5839d5b6d -r 6f30387232be floatp.cpp

--- a/floatp.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/floatp.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -48,6 +48,8 @@
48	48	FLT_QNAN = DEF_FLOAT (&SF_QNAN);
49	49	FLT_ZERO = DEF_FLOAT (&SF_ZERO);
50	50
	51	+# undef DEF_FLOAT
	52	+
51	53	#else
52	54	SF_NINF.val = -SF_PINF.val;
53	55

		@@ -130,9 +132,11 @@
130	132	{
131	133	sign = fneg_p (val);
132	134	#ifdef QP_ARCH_WIDE
133		- sign ^= varobj_sign (obj);
134		- if (sign != 0)
135		- val = -val;
	135	+ if (varobj_sign (obj))
	136	+ {
	137	+ sign ^= 1;
	138	+ val = -val;
	139	+ }
136	140	#endif
137	141	cls = FP_NORMAL;
138	142	}

		@@ -370,17 +374,31 @@
370	374	return (ret);
371	375	}
372	376
	377	+int serialize_f (interpreter interp, stream strm, object obj, serial_info&)
	378	+{
	379	+ int sign, cls;
	380	+ double v = get_dbl (obj, sign, cls);
	381	+ return (strm->write (interp, &v));
	382	+}
	383	+
	384	+object deserialize_f (interpreter interp, stream strm, serial_info&)
	385	+{
	386	+ double v;
	387	+ qp_return (strm->sread (interp, &v) ? fltobj (interp, v) : UNBOUND);
	388	+}
	389	+
373	390	// Long float implementation.
374	391
375		-const int bigfloat::data_offset = entry_off<bigfloat, limb_t> ();
	392	+static_assert (alignof (bigfloat) % alignof (limb_t) == 0,
	393	+ "invalid alignment for big floats");
376	394
377	395	bigfloat* bigfloat::alloc_raw (int len)
378	396	{
379		- bigfloat retp = (bigfloat )alloch (sizeof (retp) + sizeof (limb_t)
380		- len + bigfloat::data_offset, typecode::BIGFLOAT, TYPE_SHIFT + 1);
	397	+ bigfloat retp = (bigfloat )alloch (sizeof (*retp) +
	398	+ sizeof (limb_t) * len, typecode::BIGFLOAT, TYPE_SHIFT + 1);
381	399
382	400	retp->len = len;
383		- retp->data = (limb_t )((char )&retp[1] + bigfloat::data_offset);
	401	+ retp->data = (limb_t *)&retp[1];
384	402	retp->full = FLAGS_CONST;
385	403
386	404	return (retp);

		@@ -612,7 +630,7 @@
612	630	memcpy (ret->data, xp, xl);
613	631	ret->len = xl;
614	632	expo = ((const bigfloat *)
615		- ((char *)xp - bigfloat::data_offset))->expo;
	633	+ ((char *)xp - sizeof (bigfloat)))->expo;
616	634	goto done;
617	635	}
618	636

		@@ -1210,6 +1228,38 @@
1210	1228	return (ret);
1211	1229	}
1212	1230
	1231	+int serialize_F (interpreter interp, stream strm, object obj, serial_info&)
	1232	+{
	1233	+ const bigfloat *lp = as_bigfloat (obj);
	1234	+ int expo = lp->expo, xl = lp->len;
	1235	+
	1236	+#ifdef QP_ARCH_WIDE
	1237	+ if (obj & SIGN_BIT)
	1238	+ xl = -xl;
	1239	+#endif
	1240	+
	1241	+ return (strm->write (interp, &expo) + strm->write (interp, &xl) +
	1242	+ strm->write (interp, lp->data, F_ABS (lp->len) * sizeof (*lp->data)));
	1243	+}
	1244	+
	1245	+object deserialize_F (interpreter interp, stream strm, serial_info&)
	1246	+{
	1247	+ int vals[2];
	1248	+
	1249	+ if (strm->read (interp, vals, sizeof (vals)) != (int)sizeof (vals))
	1250	+ qp_return (UNBOUND);
	1251	+
	1252	+ int len = abs (vals[1]);
	1253	+ bigfloat *lp = as_bigfloat (alloc_bigfloat (interp, len));
	1254	+
	1255	+ if (strm->read (interp, lp->data, len * sizeof (*lp->data)) !=
	1256	+ len * (int)sizeof (*lp->data))
	1257	+ qp_return (UNBOUND);
	1258	+
	1259	+ lp->expo = vals[0];
	1260	+ qp_return (make_bigfloat (lp, vals[1] < 0));
	1261	+}
	1262	+
1213	1263	// Mixed operations.
1214	1264
1215	1265	static inline object

diff -r 1ea5839d5b6d -r 6f30387232be floatp.h

--- a/floatp.h Tue Jul 17 18:41:09 2018 -0300

+++ b/floatp.h Fri Oct 12 02:49:16 2018 +0000

		@@ -49,8 +49,6 @@
49	49	int expo;
50	50	limb_t *data;
51	51
52		- static const int data_offset;
53		-
54	52	static bigfloat* alloc_raw (int __len);
55	53	};
56	54

		@@ -140,6 +138,7 @@
140	138
141	139	class stream;
142	140	class io_info;
	141	+class serial_info;
143	142
144	143	QP_EXPORT int write_f (interpreter *__interp,
145	144	stream *__strm, object __obj, io_info& __info);

		@@ -147,6 +146,18 @@
147	146	QP_EXPORT int write_F (interpreter *__interp,
148	147	stream *__strm, object __obj, io_info& __info);
149	148
	149	+QP_EXPORT int serialize_f (interpreter *__interp,
	150	+ stream *__strm, object __obj, serial_info& __info);
	151	+
	152	+QP_EXPORT int serialize_F (interpreter *__interp,
	153	+ stream *__strm, object __obj, serial_info& __info);
	154	+
	155	+QP_EXPORT object deserialize_f (interpreter *__interp,
	156	+ stream *__strm, serial_info& __info);
	157	+
	158	+QP_EXPORT object deserialize_F (interpreter *__interp,
	159	+ stream *__strm, serial_info& __info);
	160	+
150	161	// Global objects.
151	162	QP_EXPORT object FLT_PINF; // +INF
152	163	QP_EXPORT object FLT_NINF; // -INF

diff -r 1ea5839d5b6d -r 6f30387232be function.cpp

--- a/function.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/function.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -29,9 +29,8 @@
29	29	outp->type = typecode::FCT;
30	30	outp->full \|= native_function::native_flag;
31	31	outp->fct = fct;
32		- outp->name = name;
33	32
34		- object sym = intern (interp, name);
	33	+ object sym = outp->name = intern (interp, name);
35	34	symval(sym) = outp->as_obj ();
36	35	as_varobj(sym)->set_flag (flag);
37	36	}

		@@ -105,20 +104,11 @@
105	104	int write_x (interpreter interp, stream strm, object obj, io_info&)
106	105	{
107	106	int ret = strm->write (interp, "#<function ", 11);
108		-
109		- if (native_fct_p (obj))
110		- {
111		- const char *s = as_native_fct(obj)->name;
112		- ret += strm->write (interp, s, strlen (s));
113		- }
	107	+ object name = fct_name (obj);
	108	+ if (name == NIL)
	109	+ ret += strm->write (interp, "anonymous", 9);
114	110	else
115		- {
116		- object name = fct_name (obj);
117		- if (name == NIL)
118		- ret += strm->write (interp, "anonymous", 9);
119		- else
120		- ret += xwrite (interp, strm, name);
121		- }
	111	+ ret += xwrite (interp, strm, name);
122	112
123	113	char buf[64];
124	114	ret += strm->write (interp, buf, sprintf (buf, " at %p>", maskp (obj)));

		@@ -126,13 +116,68 @@
126	116	return (ret);
127	117	}
128	118
129		-const char* fct_sname (object obj)
	119	+enum
	120	+{
	121	+ FCT_SERIAL_BUILTIN = 0,
	122	+ FCT_SERIAL_BCODE = 1
	123	+};
	124	+
	125	+int serialize_x (interpreter interp, stream strm,
	126	+ object obj, serial_info& info)
130	127	{
131	128	if (native_fct_p (obj))
132		- return (as_native_fct(obj)->name);
	129	+ {
	130	+ const string *name = as_str (symname (fct_name (obj)));
	131	+ return (strm->putb (interp, FCT_SERIAL_BUILTIN) +
	132	+ strm->write (interp, &name->nbytes) +
	133	+ strm->write (interp, name->data, name->nbytes));
	134	+ }
133	135
134		- object name = fct_p (obj) ? fct_name (obj) : NIL;
	136	+ strm->putb (interp, FCT_SERIAL_BCODE);
	137	+ const function *xp = as_fct (obj);
	138	+ int flags = (int)(xp->full &
	139	+ (function::artificial_flag \| function::kwargs_flag));
	140	+
	141	+ return (strm->write (interp, &flags) +
	142	+ strm->write (interp, &xp->max_sp) +
	143	+ strm->write (interp, &xp->min_argc) +
	144	+ strm->write (interp, &xp->max_argc) +
	145	+ xserialize (interp, strm, xp->bcode, info) +
	146	+ xserialize (interp, strm, xp->vals, info) +
	147	+ xserialize (interp, strm, xp->env, info));
	148	+}
	149	+
	150	+object deserialize_x (interpreter interp, stream strm, serial_info& info)
	151	+{
	152	+ int code = strm->getb (interp);
	153	+
	154	+ if (code == FCT_SERIAL_BUILTIN)
	155	+ {
	156	+ valref sym (interp, xdeserialize (interp, strm));
	157	+ qp_return (builtin_fct (interp, str_cdata (symname (*sym))));
	158	+ }
	159	+
	160	+ int vals[4];
	161	+ if (strm->read (interp, vals, sizeof (vals)) != (int)sizeof (vals))
	162	+ qp_return (UNBOUND);
	163	+
	164	+ valref fn (interp, alloc_fct (interp, vals[0]));
	165	+ function fp = as_fct (fn);
	166	+
	167	+ if (!bvector_p (fp->bcode = xdeserialize (interp, strm, info)) \|\|
	168	+ !array_p (fp->vals = xdeserialize (interp, strm, info)) \|\|
	169	+ (fp->env = xdeserialize (interp, strm, info)) == UNBOUND \|\|
	170	+ fp->env != NIL \|\| !array_p (fp->env))
	171	+ qp_return (UNBOUND);
	172	+
	173	+ qp_return (*fn);
	174	+}
	175	+
	176	+const char* fct_sname (object obj)
	177	+{
	178	+ object name = fct_name (obj);
135	179	return (symbol_p (name) ? str_cdata (symname (name)) : "#<fct>");
136	180	}
137	181
	182	+
138	183	QP_DECLS_END

diff -r 1ea5839d5b6d -r 6f30387232be function.h

--- a/function.h Tue Jul 17 18:41:09 2018 -0300

+++ b/function.h Fri Oct 12 02:49:16 2018 +0000

		@@ -13,7 +13,7 @@
13	13	typedef object (fn_type) (interpreter , object *, int);
14	14
15	15	fn_type fct;
16		- const char *name;
	16	+ object name;
17	17
18	18	object call (interpreter __interp, object __argv, int __argc)
19	19	{

		@@ -63,6 +63,12 @@
63	63	__interp->raise_nargs (fct_sname (this->as_obj ()),
64	64	this->min_argc, this->max_argc, __n);
65	65	}
	66	+
	67	+ void local_init ()
	68	+ {
	69	+ this->full = 0;
	70	+ this->type = typecode::FCT;
	71	+ }
66	72	};
67	73
68	74	// Helper for 'call_fct'

		@@ -109,11 +115,6 @@
109	115	return (as_fct(__obj)->env);
110	116	}
111	117
112		-inline object& fct_name (object __obj)
113		-{
114		- return (as_fct(__obj)->name);
115		-}
116		-
117	118	inline native_function* as_native_fct (object __obj)
118	119	{
119	120	return ((native_function *)maskp (__obj));

		@@ -125,6 +126,12 @@
125	126	as_fct(__obj)->flagged_p (native_function::native_flag));
126	127	}
127	128
	129	+inline object& fct_name (object __obj)
	130	+{
	131	+ return (native_fct_p (__obj) ?
	132	+ as_native_fct(__obj)->name : as_fct(__obj)->name);
	133	+}
	134	+
128	135	QP_EXPORT object alloc_fct (interpreter *__interp, uint32_t __flags = 0);
129	136
130	137	QP_EXPORT bool eq_xx (interpreter *__interp, object __x, object __y);

		@@ -152,12 +159,21 @@
152	159
153	160	class stream;
154	161	class io_info;
	162	+class serial_info;
155	163
156	164	QP_EXPORT int write_x (interpreter *__interp,
157	165	stream *__strm, object __obj, io_info& __info);
158	166
	167	+QP_EXPORT int serialize_x (interpreter *__interp,
	168	+ stream *__strm, object __obj, serial_info& __info);
	169	+
	170	+QP_EXPORT object deserialize_x (interpreter *__interp,
	171	+ stream *__strm, serial_info& __info);
	172	+
159	173	QP_EXPORT void disasm (interpreter *__interp, object __fn, object __out);
160	174
	175	+QP_EXPORT object builtin_fct (interpreter __interp, const char __name);
	176	+
161	177	template <class ...Args>
162	178	object call_fct (interpreter *__interp, object __fn, Args... __args)
163	179	{

diff -r 1ea5839d5b6d -r 6f30387232be integer.cpp

--- a/integer.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/integer.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -121,15 +121,16 @@
121	121
122	122	// Bigint implementation.
123	123
124		-const int bigint::data_offset = entry_off<bigint, limb_t> ();
	124	+static_assert (alignof (bigint) % alignof (limb_t) == 0,
	125	+ "invalid alignment for big integers");
125	126
126	127	bigint* bigint::alloc_raw (int len)
127	128	{
128		- bigint retp = (bigint )alloch (sizeof (retp) + sizeof (limb_t)
129		- len + bigint::data_offset, typecode::BIGINT, TYPE_SHIFT + 1);
	129	+ bigint retp = (bigint )alloch (sizeof (*retp) +
	130	+ sizeof (limb_t) * len, typecode::BIGINT, TYPE_SHIFT + 1);
130	131
131	132	retp->len = len;
132		- retp->data = (limb_t )((char )&retp[1] + bigint::data_offset);
	133	+ retp->data = (limb_t *)&retp[1];
133	134	retp->full \|= FLAGS_CONST;
134	135
135	136	return (retp);

		@@ -957,4 +958,41 @@
957	958	return (ret);
958	959	}
959	960
	961	+int serialize_i (interpreter interp, stream strm, object obj, serial_info&)
	962	+{
	963	+ int val = as_int (obj);
	964	+ return (strm->write (interp, &val));
	965	+}
	966	+
	967	+int serialize_I (interpreter interp, stream strm, object obj, serial_info&)
	968	+{
	969	+ int sv, ret = 0;
	970	+ const bigint *bi = get_bigint (obj, sv);
	971	+
	972	+ sv = sv < 0 ? -bi->len : bi->len;
	973	+ ret += strm->write (interp, &sv);
	974	+ ret += strm->write (interp, bi->data, bi->len * sizeof (*bi->data));
	975	+ return (ret);
	976	+}
	977	+
	978	+object deserialize_i (interpreter interp, stream strm, serial_info&)
	979	+{
	980	+ int val;
	981	+ qp_return (strm->sread (interp, &val) ? intobj (val) : UNBOUND);
	982	+}
	983	+
	984	+object deserialize_I (interpreter interp, stream strm, serial_info&)
	985	+{
	986	+ int len;
	987	+ if (!strm->sread (interp, &len) \|\| len == 0)
	988	+ qp_return (UNBOUND);
	989	+
	990	+ int sign = len < 0 ? (len = -len, 1) : 0;
	991	+ bigint *ret = as_bigint (alloc_bigint (interp, len));
	992	+ int nb = strm->read (interp, ret->data, ret->len * sizeof (*ret->data));
	993	+
	994	+ qp_return (nb < len * (int)sizeof (*ret->data) ?
	995	+ UNBOUND : make_bigint (ret, sign));
	996	+}
	997	+
960	998	QP_DECLS_END

diff -r 1ea5839d5b6d -r 6f30387232be integer.h

--- a/integer.h Tue Jul 17 18:41:09 2018 -0300

+++ b/integer.h Fri Oct 12 02:49:16 2018 +0000

		@@ -64,8 +64,6 @@
64	64	int len;
65	65	limb_t *data;
66	66
67		- static const int data_offset;
68		-
69	67	static bigint* alloc_raw (int len);
70	68
71	69	static object make (interpreter *__interp, int64_t __qval);

		@@ -82,8 +80,6 @@
82	80	return (bigint::make (__interp, (uint64_t)__lval));
83	81	}
84	82	#endif
85		-
86		- bool get_as (uint64_t& __val) const;
87	83	};
88	84
89	85	inline bigint* as_bigint (object __obj)

		@@ -168,6 +164,7 @@
168	164	// I/O with integers.
169	165	class stream;
170	166	class io_info;
	167	+class serial_info;
171	168
172	169	QP_EXPORT int write_i (interpreter *__interp,
173	170	stream *__strm, object __obj, io_info& __info);

		@@ -175,6 +172,18 @@
175	172	QP_EXPORT int write_I (interpreter *__interp,
176	173	stream *__strm, object __obj, io_info& __info);
177	174
	175	+QP_EXPORT int serialize_i (interpreter *__interp,
	176	+ stream *__strm, object __obj, serial_info& __info);
	177	+
	178	+QP_EXPORT int serialize_I (interpreter *__interp,
	179	+ stream *__strm, object __obj, serial_info& __info);
	180	+
	181	+QP_EXPORT object deserialize_i (interpreter *__interp,
	182	+ stream *__strm, serial_info& __info);
	183	+
	184	+QP_EXPORT object deserialize_I (interpreter *__interp,
	185	+ stream *__strm, serial_info& __info);
	186	+
178	187	QP_DECLS_END
179	188
180	189	#endif

diff -r 1ea5839d5b6d -r 6f30387232be interp.cpp

--- a/interp.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/interp.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -154,24 +154,10 @@
154	154	}
155	155
156	156	#ifndef QP_NO_THREADS
157		-
158		-static thread_local interpreter *self_interp;
159		-
160		-#else
161		-
162		-static interpreter *self_interp;
163		-
	157	+ thread_local
164	158	#endif
165	159
166		-interpreter* interpreter::self ()
167		-{
168		- return (self_interp);
169		-}
170		-
171		-void interpreter::set_self (interpreter *interp)
172		-{
173		- self_interp = interp;
174		-}
	160	+interpreter *interpreter::self_interp;
175	161
176	162	#ifndef QP_NO_THREADS
177	163

		@@ -228,7 +214,7 @@
228	214	/* Someone suspended us while we were blocking.
229	215	* We now need to wait on the event they set up for us. */
230	216	this->unlock ();
231		- this->sync_ev()->wait();
	217	+ this->sync_ev()->wait ();
232	218	}
233	219
234	220	this->state = INTERP_RUNNING;

diff -r 1ea5839d5b6d -r 6f30387232be interp.h

--- a/interp.h Tue Jul 17 18:41:09 2018 -0300

+++ b/interp.h Fri Oct 12 02:49:16 2018 +0000

		@@ -171,8 +171,21 @@
171	171	void begin_blocking ();
172	172	void end_blocking ();
173	173
174		- static interpreter* self ();
175		- static void set_self (interpreter *__interp);
	174	+#ifndef QP_NO_THREADS
	175	+ static thread_local interpreter *self_interp;
	176	+#else
	177	+ static interpreter *self_interp;
	178	+#endif
	179	+
	180	+ static interpreter* self ()
	181	+ {
	182	+ return (interpreter::self_interp);
	183	+ }
	184	+
	185	+ static void set_self (interpreter *__interp)
	186	+ {
	187	+ interpreter::self_interp = __interp;
	188	+ }
176	189
177	190	sync_event*& sync_ev ()
178	191	{

diff -r 1ea5839d5b6d -r 6f30387232be io.cpp

--- a/io.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/io.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -5,19 +5,9 @@
5	5	#include <cstdarg>
6	6	#include <cerrno>
7	7
8		-#include "io.h"
9		-#include "floatp.h"
10		-#include "integer.h"
11		-#include "str.h"
12		-#include "memory.h"
13		-#include "symbol.h"
14		-#include "array.h"
15		-#include "cons.h"
16		-#include "table.h"
17		-#include "tree.h"
18		-#include "builtins.h"
19		-#include "function.h"
	8	+#include "quipu.h"
20	9	#include "utils/chmask.h"
	10	+#include "utils/raw_acc.h"
21	11
22	12	QP_DECLS_BEGIN
23	13

		@@ -34,6 +24,12 @@
34	24	interp->raise2 ("parse-error", buf);
35	25	}
36	26
	27	+[[noreturn]] static inline void
	28	+raise_eos (interpreter *interp)
	29	+{
	30	+ interp->raise2 ("parse-error", "read: premature end of input");
	31	+}
	32	+
37	33	enum
38	34	{
39	35	TOK_NONE,

		@@ -214,398 +210,455 @@
214	210	return (nullptr);
215	211	}
216	212
217		-class rdstate
	213	+reader::reader (interpreter ip, object input, package pkg) : interp (ip),
	214	+ pairs_valref (ip, intobj (0)), ipkg (pkg)
218	215	{
219		-public:
220		- interpreter *interp;
221		- valref pairs_valref;
222		- local_varobj<array> pairs;
223		- object stpairs[16];
224		- int pair_cnt;
225		- char stbuf[256];
226		- char *bufp;
227		- int bufcnt;
228		- int bufmax;
229		- int toktype;
230		- stream *src;
231		- int bq_level;
232		- bool unquoted;
	216	+ this->pairs.local_init (this->stpairs, QP_NELEM (this->stpairs));
233	217
234		- rdstate (interpreter *ip, object input_src) : interp (ip),
235		- pairs_valref (ip, intobj (0))
	218	+ this->pair_cnt = 0;
	219	+ for (int i = 0; i < this->pairs.len; ++i)
	220	+ this->pairs.data[i] = UNBOUND;
	221	+
	222	+ this->bufmax = QP_NELEM (this->stbuf);
	223	+ this->bufp = this->stbuf;
	224	+
	225	+ this->take ();
	226	+ this->src = as_stream (input);
	227	+ *this->pairs_valref = this->pairs.as_obj ();
	228	+
	229	+ if (this->ipkg == nullptr)
	230	+ this->ipkg = as_package (root_package);
	231	+}
	232	+
	233	+void reader::take ()
	234	+{
	235	+ this->toktype = TOK_NONE;
	236	+ this->bufcnt = 0;
	237	+}
	238	+
	239	+void reader::push_ch (const schar& ch)
	240	+{
	241	+ if (this->bufcnt + ch.len >= this->bufmax)
236	242	{
237		- this->pairs.type = typecode::ARRAY;
238		- this->pairs.full = 0;
239		- this->pairs.data = this->stpairs;
240		- this->pairs.len = QP_NELEM (this->stpairs);
241		-
242		- this->pair_cnt = 0;
243		- for (int i = 0; i < this->pairs.len; ++i)
244		- this->pairs.data[i] = UNBOUND;
	243	+ int nsize = (int)upsize (this->bufcnt + ch.len + 1);
	244	+ char nbuf = (char )xmalloc (nsize);
245	245
246		- this->bufmax = QP_NELEM (this->stbuf);
247		- this->bufp = this->stbuf;
	246	+ memcpy (nbuf, this->bufp, this->bufcnt);
	247	+ if (this->bufp != this->stbuf)
	248	+ xfree (this->bufp);
248	249
249		- this->take ();
250		- this->src = as_stream (input_src);
251		- this->bq_level = 0;
252		- this->unquoted = false;
253		- *this->pairs_valref = this->pairs.as_obj ();
254		- }
255		-
256		- bool cantread_p () const
257		- {
258		- return (this->src->eos_p () \|\| this->src->err_p ());
	250	+ this->bufp = nbuf;
	251	+ this->bufmax = nsize;
259	252	}
260	253
261		- void take ()
	254	+ fscpy (this->bufp + this->bufcnt, ch.buf, ch.len);
	255	+ this->bufcnt += ch.len;
	256	+}
	257	+
	258	+bool reader::read_token (schar& ch, int digs)
	259	+{
	260	+ bool first = true;
	261	+ int esc_p = 0, sym_p = 0;
	262	+ while (true)
262	263	{
263		- this->toktype = TOK_NONE;
264		- this->bufcnt = 0;
265		- }
	264	+ if (!first && !this->src->sgetc (this->interp, ch))
	265	+ goto term;
266	266
267		- void accum (const schar& ch)
268		- {
269		- if (this->bufcnt + ch.len >= this->bufmax)
	267	+ first = false;
	268	+ if (ch.uc == '\|')
	269	+ esc_p ^= (sym_p = 1);
	270	+ else if (ch.uc == '\\')
270	271	{
271		- int nsize = (int)upsize (this->bufcnt + ch.len + 1);
272		- char nbuf = (char )xmalloc (nsize);
	272	+ sym_p = 1;
	273	+ if (!this->src->sgetc (this->interp, ch))
	274	+ goto term;
273	275
274		- memcpy (nbuf, this->bufp, this->bufcnt);
275		- if (this->bufp != this->stbuf)
276		- xfree (this->bufp);
277		-
278		- this->bufp = nbuf;
279		- this->bufmax = nsize;
	276	+ this->push_ch (ch);
280	277	}
281		-
282		- fscpy (this->bufp + this->bufcnt, ch.buf, ch.len);
283		- this->bufcnt += ch.len;
	278	+ else if (!esc_p && (!symchar_p (ch.uc) &&
	279	+ (!digs \|\| isdigit (ch.uc))))
	280	+ break;
	281	+ else
	282	+ this->push_ch (ch);
284	283	}
285	284
286		- bool read_token (schar& ch, int digs)
287		- {
288		- bool first = true;
289		- int esc_p = 0, sym_p = 0;
290		- while (true)
291		- {
292		- if (!first && !this->src->sgetc (this->interp, ch))
293		- goto term;
	285	+ this->src->ungetuc (ch.buf, ch.len);
	286	+term:
	287	+ this->bufp[this->bufcnt] = '\0';
	288	+ return (sym_p != 0);
	289	+}
294	290
295		- first = false;
296		- if (ch.uc == '\|')
297		- esc_p ^= (sym_p = 1);
298		- else if (ch.uc == '\\')
	291	+void reader::expand ()
	292	+{
	293	+ int nmax = this->pairs.len * 2, mask = (nmax >> 1) - 1;
	294	+ object p2 = (object )xmalloc (nmax * sizeof (*p2));
	295	+
	296	+ for (int i = 0; i < nmax; ++i)
	297	+ p2[i] = UNBOUND;
	298	+
	299	+ for (int i = 0, j = 0; j < this->pair_cnt; i += 2)
	300	+ {
	301	+ object *tmp = &this->pairs.data[i];
	302	+ if (*tmp == UNBOUND)
	303	+ continue;
	304	+
	305	+ for (int pb = 1, bucket = (int)(*tmp & mask) ; ;
	306	+ bucket = (bucket + pb++) & mask)
	307	+ if (p2[bucket * 2] == UNBOUND)
	308	+ {
	309	+ p2[bucket * 2] = *tmp;
	310	+ break;
	311	+ }
	312	+
	313	+ ++j;
	314	+ }
	315	+
	316	+ object *prev = this->pairs.data;
	317	+ this->pairs.data = p2;
	318	+ this->pairs.len = nmax;
	319	+
	320	+ if (prev != this->stpairs)
	321	+ xfree (prev);
	322	+}
	323	+
	324	+object reader::gethash (object lbl) const
	325	+{
	326	+ for (int pb = 1, mask = (this->pairs.len >> 1) - 1,
	327	+ bucket = (int)(lbl & mask) ; ; bucket = (bucket + pb++) & mask)
	328	+ {
	329	+ const object p = &this->pairs.data[bucket 2];
	330	+ if (*p == lbl)
	331	+ return (p[1]);
	332	+ else if (*p != UNBOUND)
	333	+ return (UNBOUND);
	334	+ }
	335	+}
	336	+
	337	+object* reader::puthash (object lbl)
	338	+{
	339	+ for (int pb = 1, mask = (this->pairs.len >> 1) - 1,
	340	+ bucket = (int)(lbl & mask) ; ; bucket = (bucket + pb++) & mask)
	341	+ {
	342	+ object p = &this->pairs.data[bucket 2];
	343	+ if (*p == lbl)
	344	+ return (p + 1);
	345	+ else if (*p == UNBOUND)
	346	+ {
	347	+ *p = lbl;
	348	+ if (this->pairs.len * 75 <= this->pair_cnt * 100)
299	349	{
300		- sym_p = 1;
301		- if (!this->src->sgetc (this->interp, ch))
302		- goto term;
	350	+ this->expand ();
	351	+ return (this->puthash (lbl));
	352	+ }
303	353
304		- this->accum (ch);
305		- }
306		- else if (!esc_p && (!symchar_p (ch.uc) &&
307		- (!digs \|\| isdigit (ch.uc))))
308		- break;
309		- else
310		- this->accum (ch);
	354	+ ++this->pair_cnt;
	355	+ return (p + 1);
	356	+ }
	357	+ }
	358	+}
	359	+
	360	+bool reader::nextc (schar& ch)
	361	+{
	362	+ do
	363	+ {
	364	+ if (!this->src->sgetc (this->interp, ch))
	365	+ return (false);
	366	+ else if (ch.uc == ';')
	367	+ do
	368	+ if (!this->src->sgetc (this->interp, ch))
	369	+ return (false);
	370	+ while (ch.uc != '\n');
	371	+
	372	+ if (ch.uc == '\n')
	373	+ ++this->lineno;
	374	+ }
	375	+ while (isspace (ch.uc));
	376	+
	377	+ return (true);
	378	+}
	379	+
	380	+static inline bool
	381	+check_symname (interpreter interp, const char name, int len)
	382	+{
	383	+ num_info info;
	384	+ return (parse_num (interp, name, len, info) < 0);
	385	+}
	386	+
	387	+static void
	388	+update_pkg_expr (interpreter interp, const char sname,
	389	+ const char *uptr, int len, object& out)
	390	+{
	391	+ valref key (interp, string::make (interp,
	392	+ uptr + 2, len - ((uptr + 2) - sname)));
	393	+
	394	+ if (out == UNBOUND)
	395	+ {
	396	+ out = intern (interp, sname, uptr - sname);
	397	+ out = call_fct (interp, list_fct, out, *key);
	398	+ }
	399	+ else
	400	+ {
	401	+ key = cons::make (interp, key, NIL);
	402	+ out = cons::make (interp, out, *key);
	403	+ }
	404	+}
	405	+
	406	+static object
	407	+make_pkg_expr (interpreter *interp, object name, object ipkg)
	408	+{
	409	+ /* Transform a symbol name of the kind 'a::b::c' into its equivalent
	410	+ * expression: ((a "b") "c").
	411	+ * This is required when the symbol can't be resolved at read-time,
	412	+ * and is therefore delegated to a runtime lookup. */
	413	+ const char *sname = str_cdata (name);
	414	+ int len = as_str(name)->nbytes;
	415	+ valref ret (interp, UNBOUND), key (interp, UNBOUND);
	416	+
	417	+ while (true)
	418	+ {
	419	+ auto uptr = (const char *)memchr (sname, ':', len);
	420	+ if (uptr == nullptr)
	421	+ { // Last name - Append and we're out.
	422	+ *key = cons::make (interp, string::make (interp, sname, len), NIL);
	423	+ ret = cons::make (interp, ret, *key);
	424	+ break;
	425	+ }
	426	+ else if (uptr[1] != *uptr)
	427	+ interp->raise2 ("parse-error", io_sprintf (interp,
	428	+ "read: invalid symbol name: %Q", name));
	429	+
	430	+ auto u2 = (const char *)memchr (uptr + 2, ':', (sname + len - 2) - uptr);
	431	+ if (u2 == nullptr)
	432	+ {
	433	+ update_pkg_expr (interp, sname, uptr, len, *ret);
	434	+ break;
	435	+ }
	436	+ else if (u2[1] != *u2)
	437	+ interp->raise2 ("parse-error", io_sprintf (interp,
	438	+ "read: invalid symbol name: %Q", name));
	439	+
	440	+ update_pkg_expr (interp, sname, uptr, len - 2 - (u2 - uptr), *ret);
	441	+ len -= (u2 + 2) - sname;
	442	+ sname = u2 + 2;
	443	+ }
	444	+
	445	+ qp_return (*ret);
	446	+}
	447	+
	448	+void reader::handle_sym (object pkg, object name)
	449	+{
	450	+ valref xpkg (interp, pkg), tmp (interp, UNBOUND);
	451	+ const char *sname = str_cdata (name);
	452	+ int len = as_str(name)->nbytes;
	453	+
	454	+ while (true)
	455	+ {
	456	+ auto uptr = (const char *)memchr (sname, ':', len);
	457	+ if (uptr == nullptr)
	458	+ {
	459	+ intern (this->interp, sname, len, as_package (*xpkg));
	460	+ return;
	461	+ }
	462	+ else if (uptr[1] != *uptr \|\|
	463	+ !check_symname (interp, sname, uptr - sname))
	464	+ this->interp->raise2 ("parse-error", io_sprintf (interp,
	465	+ "read: invalid symbol name: %Q", name));
	466	+
	467	+ tmp = find_sym (interp, xpkg, sname, uptr - sname);
	468	+ tmp = (tmp & EXTRA_BIT) ? UNBOUND : symval (*tmp);
	469	+
	470	+ if (tmp != UNBOUND && package_p (tmp))
	471	+ // Still reachable at read-time - Update the current package.
	472	+ xpkg = tmp;
	473	+ else
	474	+ {
	475	+ make_pkg_expr (interp, name, *xpkg);
	476	+ return;
311	477	}
312	478
313		- this->src->ungetuc (ch.buf, ch.len);
314		- term:
315		- this->bufp[this->bufcnt] = '\0';
316		- return (sym_p != 0);
317		- }
318		-
319		- void expand ()
320		- {
321		- int nmax = this->pairs.len * 2, mask = (nmax >> 1) - 1;
322		- object p2 = (object )xmalloc (nmax * sizeof (*p2));
323		-
324		- for (int i = 0; i < nmax; ++i)
325		- p2[i] = UNBOUND;
326		-
327		- for (int i = 0, j = 0; j < this->pair_cnt; i += 2)
328		- {
329		- object *tmp = &this->pairs.data[i];
330		- if (*tmp == UNBOUND)
331		- continue;
332		-
333		- for (int pb = 1, bucket = (int)(*tmp & mask) ; ;
334		- bucket = (bucket + pb++) & mask)
335		- if (p2[bucket * 2] == UNBOUND)
336		- {
337		- p2[bucket * 2] = *tmp;
338		- break;
339		- }
340		-
341		- ++j;
342		- }
343		-
344		- object *prev = this->pairs.data;
345		- this->pairs.data = p2;
346		- this->pairs.len = nmax;
347		-
348		- if (prev != this->stpairs)
349		- xfree (prev);
350		- }
351		-
352		- object gethash (object lbl) const
353		- {
354		- for (int pb = 1, mask = (this->pairs.len >> 1) - 1,
355		- bucket = (int)(lbl & mask) ; ; bucket = (bucket + pb++) & mask)
356		- {
357		- const object p = &this->pairs.data[bucket 2];
358		- if (*p == lbl)
359		- return (p[1]);
360		- else if (*p != UNBOUND)
361		- return (UNBOUND);
362		- }
	479	+ len -= (uptr + 2) - sname;
	480	+ sname = uptr + 2;
363	481	}
364		-
365		- object* puthash (object lbl)
366		- {
367		- for (int pb = 1, mask = (this->pairs.len >> 1) - 1,
368		- bucket = (int)(lbl & mask) ; ; bucket = (bucket + pb++) & mask)
369		- {
370		- object p = &this->pairs.data[bucket 2];
371		- if (*p == lbl)
372		- return (p + 1);
373		- else if (*p == UNBOUND)
374		- {
375		- *p = lbl;
376		- if (this->pairs.len * 75 <= this->pair_cnt * 100)
377		- {
378		- this->expand ();
379		- return (this->puthash (lbl));
380		- }
381		-
382		- ++this->pair_cnt;
383		- return (p + 1);
384		- }
385		- }
386		- }
	482	+}
387	483
388		- bool nextc (schar& ch)
	484	+uint32_t reader::peek ()
	485	+{
	486	+ schar ch;
	487	+ if (this->toktype != TOK_NONE)
	488	+ return (this->toktype);
	489	+ else if (!this->nextc (ch))
	490	+ return (TOK_NONE);
	491	+
	492	+ switch (ch.uc)
389	493	{
390		- do
391		- {
392		- if (!this->src->sgetc (this->interp, ch))
393		- return (false);
394		- else if (ch.uc == ';')
395		- do
396		- if (!this->src->sgetc (this->interp, ch))
397		- return (false);
398		- while (ch.uc != '\n');
399		- }
400		- while (isspace (ch.uc));
401		-
402		- return (true);
403		- }
404		-
405		- uint32_t peek ()
406		- {
407		- schar ch;
408		- if (this->toktype != TOK_NONE)
409		- return (this->toktype);
410		- else if (!this->nextc (ch))
411		- return (TOK_NONE);
412		-
413		- switch (ch.uc)
414		- {
415	494	#define DISPATCH(ch, tok) \
416	495	case ch: \
417	496	this->toktype = TOK_##tok; \
418	497	break
419		- DISPATCH ('(', OPEN);
420		- DISPATCH (')', CLOSE);
421		- DISPATCH ('[', OPENB);
422		- DISPATCH (']', CLOSEB);
423		- DISPATCH ('{', OPENBRACE);
424		- DISPATCH ('}', CLOSEBRACE);
425		- DISPATCH ('\'', QUOTE);
426		- DISPATCH ('`', BQ);
427		- DISPATCH (',', COMMA);
428		- DISPATCH ('"', DQUOTE);
429		- DISPATCH ('\\', CHAR);
	498	+
	499	+ DISPATCH ('(', OPEN);
	500	+ DISPATCH (')', CLOSE);
	501	+ DISPATCH ('[', OPENB);
	502	+ DISPATCH (']', CLOSEB);
	503	+ DISPATCH ('{', OPENBRACE);
	504	+ DISPATCH ('}', CLOSEBRACE);
	505	+ DISPATCH ('\'', QUOTE);
	506	+ DISPATCH ('`', BQ);
	507	+ DISPATCH (',', COMMA);
	508	+ DISPATCH ('"', DQUOTE);
	509	+ DISPATCH ('\\', CHAR);
430	510
431		- case '#':
	511	+ case '#':
	512	+ {
	513	+ if (!this->src->sgetc (this->interp, ch))
	514	+ this->interp->raise2 ("parse-error", "read: invalid read macro");
	515	+ else if (ch.uc == '.')
	516	+ this->toktype = TOK_SHARPDOT;
	517	+ else if (ch.uc == '\'')
	518	+ this->toktype = TOK_SHARPQUOTE;
	519	+ else if (ch.uc == '(')
	520	+ this->toktype = TOK_SHARPOPEN;
	521	+ else if (ch.uc == '<')
	522	+ this->interp->raise2 ("parse-error", "read: unreadable object");
	523	+ else if (ch.uc == ':')
432	524	{
433	525	if (!this->src->sgetc (this->interp, ch))
434		- interp->raise2 ("parse-error", "read: invalid read macro");
435		- else if (ch.uc == '.')
436		- toktype = TOK_SHARPDOT;
437		- else if (ch.uc == '\'')
438		- toktype = TOK_SHARPQUOTE;
439		- else if (ch.uc == '(')
440		- this->toktype = TOK_SHARPOPEN;
441		- else if (ch.uc == '<')
442		- interp->raise2 ("parse-error", "read: unreadable object");
443		- else if (ch.uc == ':')
444		- {
445		- if (!this->src->sgetc (this->interp, ch))
446		- interp->raise2 ("parse-error",
447		- "read: premature end of input");
	526	+ raise_eos (this->interp);
448	527
449		- this->read_token (ch, 0);
450		- if (numtok_p (interp, this->bufp, this->bufcnt))
451		- interp->raise2 ("parse-error",
452		- "read: invalid syntax after #: reader macro");
	528	+ this->read_token (ch, 0);
	529	+ if (numtok_p (interp, this->bufp, this->bufcnt))
	530	+ this->interp->raise2 ("parse-error",
	531	+ "read: invalid syntax after #: reader macro");
453	532
454		- this->toktype = TOK_SYM;
455		- interp->push (alloc_sym (interp));
456		- symname(interp->stktop ()) =
457		- string::make (interp, this->bufp, this->bufcnt);
458		- interp->pop ();
459		- }
460		- else if (isdigit (ch.uc))
	533	+ this->toktype = TOK_SYM;
	534	+ this->interp->push (alloc_sym (interp));
	535	+ symname(interp->stktop ()) =
	536	+ string::make (interp, this->bufp, this->bufcnt);
	537	+ this->interp->pop ();
	538	+ }
	539	+ else if (isdigit (ch.uc))
	540	+ {
	541	+ this->read_token (ch, 1);
	542	+ this->src->sgetc (this->interp, ch);
	543	+
	544	+ if (ch.uc == '#')
	545	+ this->toktype = TOK_BACKREF;
	546	+ else if (ch.uc == '=')
	547	+ this->toktype = TOK_LABEL;
	548	+ else
	549	+ this->interp->raise2 ("parse-error", "read: invalid label");
	550	+
	551	+ errno = 0;
	552	+ char *endp;
	553	+ long xv = strtol (bufp, &endp, 10);
	554	+ if (*endp != '\0' \|\| errno != 0)
	555	+ this->interp->raise2 ("parse-error", "read: invalid label");
	556	+
	557	+ this->interp->retval = intobj (xv);
	558	+ }
	559	+ else if (ch.uc == '!')
	560	+ {
	561	+ do
	562	+ this->src->sgetc (this->interp, ch);
	563	+ while (ch.uc != UEOF && ch.uc != '\n');
	564	+
	565	+ return (this->peek ());
	566	+ }
	567	+ else if (ch.uc == '"')
	568	+ this->toktype = TOK_SHARPDQUOT;
	569	+ else if (ch.uc == '\|')
	570	+ {
	571	+ for (int lvl = 1 ; ; )
461	572	{
462		- this->read_token (ch, 1);
463	573	this->src->sgetc (this->interp, ch);
464		-
465		- if (ch.uc == '#')
466		- this->toktype = TOK_BACKREF;
467		- else if (ch.uc == '=')
468		- this->toktype = TOK_LABEL;
469		- else
470		- interp->raise2 ("parse-error", "read: invalid label");
471		-
472		- errno = 0;
473		- char *endp;
474		- long xv = strtol (bufp, &endp, 10);
475		- if (*endp != '\0' \|\| errno != 0)
476		- interp->raise2 ("parse-error", "read: invalid label");
477		-
478		- interp->retval = intobj (xv);
479		- }
480		- else if (ch.uc == '!')
481		- {
482		- do
483		- this->src->sgetc (this->interp, ch);
484		- while (ch.uc != UEOF && ch.uc != '\n');
485		-
486		- return (this->peek ());
487		- }
488		- else if (ch.uc == '"')
489		- this->toktype = TOK_SHARPDQUOT;
490		- else if (ch.uc == '\|')
491		- {
492		- for (int lvl = 1 ; ; )
	574	+ got_hashp:
	575	+ if (ch.uc == UEOF)
	576	+ raise_eos (this->interp);
	577	+ else if (ch.uc == '\|')
493	578	{
494	579	this->src->sgetc (this->interp, ch);
495		- got_hashp:
496		- if (ch.uc == UEOF)
497		- interp->raise2 ("parse-error",
498		- "read: premature end of input");
499		- else if (ch.uc == '\|')
	580	+ if (ch.uc == '#')
500	581	{
501		- this->src->sgetc (this->interp, ch);
502		- if (ch.uc == '#')
503		- {
504		- if (--lvl == 0)
505		- break;
	582	+ if (--lvl == 0)
	583	+ break;
506	584
507		- continue;
508		- }
509		-
510		- goto got_hashp;
	585	+ continue;
511	586	}
512		- else if (ch.uc == '#')
513		- {
514		- this->src->sgetc (this->interp, ch);
515		- if (ch.uc == '\|')
516		- ++lvl;
517		- else
518		- goto got_hashp;
519		- }
	587	+
	588	+ goto got_hashp;
520	589	}
521		-
522		- return (this->peek ());
	590	+ else if (ch.uc == '#')
	591	+ {
	592	+ this->src->sgetc (this->interp, ch);
	593	+ if (ch.uc == '\|')
	594	+ ++lvl;
	595	+ else
	596	+ goto got_hashp;
	597	+ }
523	598	}
524		- else
525		- interp->raise2 ("parse-error", "read: unknown read macro");
526		-
527		- break;
528		- }
529	599
530		- default:
531		- // Number or symbol.
532		- if (!this->read_token (ch, 0))
533		- {
534		- if (*this->bufp == '.' && this->bufp[1] == '\0')
535		- return (this->toktype = TOK_DOT);
536		- else if (numtok_p (interp, this->bufp, this->bufcnt))
537		- return (this->toktype = TOK_NUM);
538		- }
	600	+ return (this->peek ());
	601	+ }
	602	+ else
	603	+ this->interp->raise2 ("parse-error", "read: unknown read macro");
539	604
540		- this->toktype = TOK_SYM;
541		- if (this->bufcnt == 3 && memcmp ("nil", this->bufp, 3) == 0)
542		- interp->retval = NIL;
543		- else if (*this->bufp == 't' && this->bufcnt == 1)
544		- interp->retval = QP_S(t);
545		- else
546		- { // XXX: Use the right package.
547		- if (*this->bufp == ':')
548		- symbol::make_kword (interp, this->bufp + 1);
549		- else
550		- intern (interp, this->bufp, this->bufcnt);
551		- }
552		-
553		- break;
	605	+ break;
554	606	}
555	607
556		-#undef DISPATCH
557		- return (toktype);
	608	+ default:
	609	+ // Number or symbol.
	610	+ if (!this->read_token (ch, 0))
	611	+ {
	612	+ if (*this->bufp == '.' && this->bufp[1] == '\0')
	613	+ return (this->toktype = TOK_DOT);
	614	+ else if (numtok_p (interp, this->bufp, this->bufcnt))
	615	+ return (this->toktype = TOK_NUM);
	616	+ }
	617	+
	618	+ this->toktype = TOK_SYM;
	619	+ if (this->bufcnt == 3 && memcmp ("nil", this->bufp, 3) == 0)
	620	+ this->interp->retval = NIL;
	621	+ else if (*this->bufp == 't' && this->bufcnt == 1)
	622	+ this->interp->retval = symbol::t;
	623	+ else if (*this->bufp == ':')
	624	+ {
	625	+ if (this->bufcnt > 1 && this->bufp[1] == ':')
	626	+ intern (this->interp, this->bufp + 2, this->bufcnt - 2);
	627	+ else
	628	+ symbol::make_kword (this->interp, this->bufp + 1);
	629	+ }
	630	+ else
	631	+ {
	632	+ local_varobj<string> nm;
	633	+ nm.local_init (this->bufp);
	634	+ this->handle_sym (this->ipkg->as_obj (), nm.as_obj ());
	635	+ }
	636	+
	637	+ break;
558	638	}
559	639
560		- object read_sexpr (object);
561		- object read_list (object);
562		- object read_bq (object);
563		- object read_comma (object);
564		- object read_array (object);
565		- object read_table (object);
566		- object read_tree (object);
567		- object read_bvector ();
568		- object read_str ();
569		- object read_char ();
	640	+#undef DISPATCH
	641	+ return (toktype);
	642	+}
570	643
571		- ~rdstate ()
572		- {
573		- *this->pairs_valref = intobj (0);
574		-
575		- if (this->pairs.data != this->stpairs)
576		- xfree (this->pairs.data);
577		- if (this->bufp != this->stbuf)
578		- xfree (this->bufp);
579		- }
580		-};
581		-
582		-object rdstate::read_array (object lbl)
	644	+object reader::read_array (object lbl)
583	645	{
584	646	object dummy, *dstp = lbl != UNBOUND ? this->puthash (lbl) : &dummy;
585		- int asz = 4;
586		- array *ap = array::alloc_raw (asz);
	647	+ raw_acc<array> ar (3);
587	648
588		- ap->len = 0;
589		- *dstp = ap->as_obj ();
	649	+ *dstp = ar.as_obj ();
590	650	while (this->peek () != TOK_CLOSEB)
591	651	{
592		- if (this->cantread_p ())
593		- this->interp->raise2 ("parse-error", "read: premature end of input");
	652	+ if (!this->readable_p ())
	653	+ raise_eos (this->interp);
594	654
595		- if (ap->len >= asz)
596		- {
597		- array *np = array::alloc_raw (asz += asz);
598		- copy_objs (np->data, ap->data, np->len = ap->len);
599		- xfree (ap), ap = np;
600		- *dstp = ap->as_obj ();
601		- }
602		-
603		- ap->data[ap->len++] = this->read_sexpr (UNBOUND);
	655	+ ar.add_obj (this->read_sexpr (UNBOUND));
604	656	}
605	657
606	658	this->take ();
607		- this->interp->retval = ap->as_obj ();
	659	+ this->interp->retval = ar.as_obj ();
608	660
	661	+ array *ap = ar.release ();
609	662	if (ap->len > 0)
610	663	gcregister (this->interp, ap);
611	664	else

		@@ -617,7 +670,7 @@
617	670	return (this->interp->retval);
618	671	}
619	672
620		-object rdstate::read_table (object lbl)
	673	+object reader::read_table (object lbl)
621	674	{
622	675	object dummy, *dstp = lbl != UNBOUND ? this->puthash (lbl) : &dummy;
623	676	valref ret (this->interp, alloc_table (this->interp, 1, NIL, NIL));

		@@ -626,8 +679,8 @@
626	679
627	680	for (dstp = ret; this->peek () != TOK_CLOSEBRACE; )
628	681	{
629		- if (this->cantread_p ())
630		- this->interp->raise2 ("parse-error", "read: premature end of input");
	682	+ if (!this->readable_p ())
	683	+ raise_eos (this->interp);
631	684	else if (both)
632	685	{
633	686	*val = this->read_sexpr (UNBOUND);

		@@ -648,7 +701,7 @@
648	701	qp_return (*ret);
649	702	}
650	703
651		-object rdstate::read_tree (object lbl)
	704	+object reader::read_tree (object lbl)
652	705	{
653	706	object dummy, *dstp = lbl != UNBOUND ? this->puthash (lbl) : &dummy;
654	707	valref ret (this->interp, alloc_tree (this->interp, NIL));

		@@ -656,8 +709,8 @@
656	709
657	710	for (dstp = ret; this->peek () != TOK_CLOSE; )
658	711	{
659		- if (this->cantread_p ())
660		- this->interp->raise2 ("parse-error", "read: premature end of input");
	712	+ if (!this->readable_p ())
	713	+ raise_eos (this->interp);
661	714
662	715	*key = this->read_sexpr (UNBOUND);
663	716	tree_put (interp, ret, key, false);

		@@ -688,23 +741,23 @@
688	741	return (-1);
689	742	}
690	743
691		-object rdstate::read_bvector ()
	744	+[[noreturn]] static inline void
	745	+raise_eilseq (interpreter interp, const char type, int idx)
692	746	{
693		- int bsz = 16;
694		- bvector *ret = bvector::alloc_raw (bsz);
	747	+ char buf[100];
	748	+ sprintf (buf, "read: invalid escape sequence in %s, index: %d", type, idx);
	749	+ interp->raise2 ("parse-error", buf);
	750	+}
695	751
696		- ret->nbytes = 0;
	752	+object reader::read_bvector ()
	753	+{
	754	+ raw_acc<bvector> bv (8);
697	755
698	756	while (true)
699	757	{
700	758	int byte = this->src->getb (this->interp);
701	759	if (byte < 0)
702		- {
703		- eos:
704		- xfree (ret);
705		- this->interp->raise2 ("parse-error",
706		- "read: premature end of input");
707		- }
	760	+ raise_eos (this->interp);
708	761	else if (byte == '"')
709	762	break;
710	763	else if (byte == '\\')

		@@ -712,36 +765,29 @@
712	765	int b1 = 0, b2 = 0;
713	766
714	767	if ((byte = this->src->getb (this->interp)) < 0)
715		- goto eos;
	768	+ raise_eos (this->interp);
716	769	else if (byte == 'x')
717	770	{
718	771	b1 = this->src->getb (this->interp);
719	772	b2 = this->src->getb (this->interp);
	773	+
720	774	if ((b1 \| b2) < 0)
721		- goto eos;
	775	+ raise_eos (this->interp);
722	776	else if (!isxdigit (b1) \|\| !isxdigit (b2))
723		- {
724		- eilseq:
725		- xfree (ret);
726		- lerrorf (this->interp, "read: invalid escape "
727		- "sequence in byte vector, index: %d", ret->nbytes);
728		- }
	777	+ raise_eilseq (this->interp, "byte vector",
	778	+ as_bvector(bv.as_obj ())->nbytes);
729	779
730	780	byte = (b1 - '0') * 16 + (b2 - '0');
731	781	}
732	782	else if ((byte = escape_char (byte)) < 0)
733		- goto eilseq;
	783	+ raise_eilseq (this->interp, "byte vector",
	784	+ as_bvector(bv.as_obj ())->nbytes);
734	785	}
735	786
736		- if (ret->nbytes + 1 >= bsz)
737		- {
738		- bvector *bp = bvector::alloc_raw (bsz += bsz);
739		- memcpy (bp->data, ret->data, bp->nbytes = ret->nbytes);
740		- xfree (ret), ret = bp;
741		- }
	787	+ bv.add_data (&byte, 1);
	788	+ }
742	789
743		- ret->data[ret->nbytes++] = byte;
744		- }
	790	+ bvector *ret = bv.release ();
745	791
746	792	if (ret->nbytes > 0)
747	793	{

		@@ -758,25 +804,18 @@
758	804	return (this->interp->retval);
759	805	}
760	806
761		-object rdstate::read_str ()
	807	+object reader::read_str ()
762	808	{
763		- int bsz = 16;
764		- string *sp = string::alloc_raw (bsz);
765		-
766		- sp->nbytes = 0;
767		- sp->hval = sp->len = 0;
	809	+ raw_acc<string> str (8);
	810	+ as_str(str.as_obj ())->hval = 0;
	811	+ as_str(str.as_obj ())->len = 0;
768	812
769	813	while (true)
770	814	{
771	815	schar ch;
772	816
773	817	if (!this->src->sgetc (this->interp, ch))
774		- {
775		- eos:
776		- xfree (sp);
777		- this->interp->raise2 ("parse-error",
778		- "read: premature end of input");
779		- }
	818	+ raise_eos (this->interp);
780	819	else if (ch.uc == '"')
781	820	break;
782	821	else if (ch.uc == '\\')

		@@ -784,32 +823,28 @@
784	823	int n;
785	824
786	825	if (!this->src->sgetc (this->interp, ch))
787		- goto eos;
	826	+ raise_eos (this->interp);
788	827	else if ((ch.uc == 'x' && (n = 2)) \|\|
789	828	(ch.uc == 'u' && (n = 4)) \|\|
790	829	(ch.uc == 'U' && (n = 8)))
791	830	{
792		- int i;
793	831	char buf[8];
794	832
795		- for (i = 0; i < n; ++i)
	833	+ for (int i = 0; i < n; ++i)
796	834	{
797	835	if (!this->src->sgetc (this->interp, ch))
798		- goto eos;
	836	+ raise_eos (this->interp);
799	837	else if (!isxdigit (ch.buf[0]))
800		- {
801		- eilseq:
802		- xfree (sp);
803		- lerrorf (this->interp, "read: invalid "
804		- "escape sequence in string at index %d", sp->len);
805		- }
	838	+ raise_eilseq (this->interp, "string",
	839	+ as_str(str.as_obj ())->len);
806	840
807	841	buf[i] = ch.buf[0];
808	842	}
809	843
810	844	ch.uc = strtol (buf, nullptr, 16);
811	845	if (ch.uc > 0x10ffff)
812		- goto eilseq;
	846	+ raise_eilseq (this->interp, "string",
	847	+ as_str(str.as_obj ())->len);
813	848
814	849	ch.len = u32tou8 ((unsigned char *)ch.buf, ch.uc);
815	850	}

		@@ -817,22 +852,18 @@
817	852	{
818	853	ch.len = 1;
819	854	if ((n = escape_char (ch.uc)) < 0)
820		- goto eilseq;
	855	+ raise_eilseq (this->interp, "string",
	856	+ as_str(str.as_obj ())->len);
821	857
822	858	*ch.buf = n;
823	859	}
824	860	}
825	861
826		- if (sp->nbytes + ch.len >= bsz)
827		- {
828		- string *np = string::alloc_raw (bsz += bsz);
829		- memcpy (np->data, sp->data, np->nbytes = sp->nbytes);
830		- xfree (sp), sp = np;
831		- }
	862	+ str.add_data (ch.buf, ch.len);
	863	+ ++as_str(str.as_obj ())->len;
	864	+ }
832	865
833		- fscpy (sp->data + sp->nbytes, ch.buf, ch.len);
834		- sp->nbytes += ch.len, ++sp->len;
835		- }
	866	+ string *sp = str.release ();
836	867
837	868	if (sp->len > 0)
838	869	{

		@@ -850,12 +881,11 @@
850	881	return (this->interp->retval);
851	882	}
852	883
853		-object rdstate::read_char ()
	884	+object reader::read_char ()
854	885	{
855	886	schar cv;
856	887	if (!this->src->sgetc (this->interp, cv))
857		- this->interp->raise2 ("parse-error",
858		- "read: premature end of input");
	888	+ raise_eos (this->interp);
859	889	else if (cv.uc == 'u' \|\| cv.uc == 'U' \|\| cv.uc == 'x')
860	890	{
861	891	schar tmp = cv;

		@@ -894,7 +924,7 @@
894	924	qp_return (charobj (cv.uc));
895	925	}
896	926
897		-object rdstate::read_list (object lbl)
	927	+object reader::read_list (object lbl)
898	928	{
899	929	object dummy, *dstp = lbl != UNBOUND ? this->puthash (lbl) : &dummy;
900	930	valref lr (this->interp, NIL);

		@@ -914,8 +944,8 @@
914	944	tok = this->peek ();
915	945	break;
916	946	}
917		- else if (this->cantread_p ())
918		- this->interp->raise2 ("parse-error", "read: premature end of input");
	947	+ else if (!this->readable_p ())
	948	+ raise_eos (this->interp);
919	949	}
920	950
921	951	this->take ();

		@@ -945,7 +975,7 @@
945	975	interp->raise2 ("parse-error", errmsg);
946	976	}
947	977
948		-object rdstate::read_comma (object lbl)
	978	+object reader::read_comma (object lbl)
949	979	{
950	980	if (this->bq_level <= 0)
951	981	this->interp->raise2 ("parse-error", "read: more commas than backquotes");

		@@ -954,14 +984,14 @@
954	984	--this->bq_level;
955	985
956	986	schar next;
957		- object head = QP_S(comma);
	987	+ object head = symbol::comma;
958	988
959	989	if (!this->src->sgetc (this->interp, next))
960		- this->interp->raise2 ("parse-error", "read: unexpected end of input");
	990	+ raise_eos (this->interp);
961	991	else if (*next.buf == '@')
962		- head = QP_S(commaat);
	992	+ head = symbol::comma_at;
963	993	else if (*next.buf == '.')
964		- head = QP_S(commadot);
	994	+ head = symbol::comma_dot;
965	995	else
966	996	this->src->ungetuc (next.buf, next.len);
967	997

		@@ -977,7 +1007,7 @@
977	1007	qp_return (this->interp->alval);
978	1008	}
979	1009
980		-object rdstate::read_bq (object lbl)
	1010	+object reader::read_bq (object lbl)
981	1011	{
982	1012	this->unquoted = false;
983	1013	++this->bq_level;

		@@ -985,14 +1015,15 @@
985	1015	object obj = this->read_sexpr (UNBOUND);
986	1016	if (cons_p (obj))
987	1017	{
988		- object head = xcar (obj), tst = QP_S(commaat);
	1018	+ object head = xcar (obj), tst = symbol::comma_at;
989	1019
990		- if (head == QP_S(commaat) \|\| head == QP_S(commadot))
991		- bq_nonlist_splice_err (interp, head == QP_S(commadot));
992		- else if (bq_member (tst, obj) \|\| bq_member (tst = QP_S(commadot), obj))
	1020	+ if (head == symbol::comma_at \|\| head == symbol::comma_dot)
	1021	+ bq_nonlist_splice_err (interp, head == symbol::comma_dot);
	1022	+ else if (bq_member (tst, obj) \|\|
	1023	+ bq_member (tst = symbol::comma_dot, obj))
993	1024	{
994	1025	char errmsg[] = "read: the syntax `( ... . ,@form) is invalid";
995		- if (tst == QP_S(commadot))
	1026	+ if (tst == symbol::comma_dot)
996	1027	errmsg[27] = '.';
997	1028
998	1029	this->interp->raise2 ("parse-error", errmsg);

		@@ -1003,7 +1034,7 @@
1003	1034	this->interp->raise2 ("parse-error", "read: unquote outside list");
1004	1035
1005	1036	alloc_cons (this->interp, 2);
1006		- xcar(this->interp->alval) = QP_S(backquote);
	1037	+ xcar(this->interp->alval) = symbol::backquote;
1007	1038	xcadr(this->interp->alval) = obj;
1008	1039
1009	1040	if (lbl != UNBOUND)

		@@ -1031,20 +1062,20 @@
1031	1062	}
1032	1063
1033	1064	valref tmp (interp, xcar (form));
1034		- if (*tmp == QP_S(comma))
	1065	+ if (*tmp == symbol::comma)
1035	1066	return (bq_list (interp, *tmp = xcadr (form)));
1036		- else if (*tmp == QP_S(commaat))
	1067	+ else if (*tmp == symbol::comma_at)
1037	1068	qp_return (xcadr (form));
1038		- else if (*tmp == QP_S(commadot))
	1069	+ else if (*tmp == symbol::comma_dot)
1039	1070	{
1040	1071	*tmp = xcadr (form);
1041	1072	return (call_fct (interp, list_fct, BQ_NCONCABLE, *tmp));
1042	1073	}
1043		- else if (*tmp == QP_S(backquote))
	1074	+ else if (*tmp == symbol::backquote)
1044	1075	{
1045	1076	*tmp = xcadr (form);
1046	1077	tmp = expand_bq (interp, tmp);
1047		- tmp = call_fct (interp, list_fct, QP_S(backquote), tmp);
	1078	+ tmp = call_fct (interp, list_fct, symbol::backquote, tmp);
1048	1079	return (bq_list (interp, *tmp));
1049	1080	}
1050	1081	else

		@@ -1069,18 +1100,18 @@
1069	1100	break;
1070	1101	else if (!xcons_p (*tail))
1071	1102	{
1072		- tail = call_fct (interp, list_fct, QP_S(backquote), tail);
	1103	+ tail = call_fct (interp, list_fct, symbol::backquote, tail);
1073	1104	ret = cons::make (interp, tail, *ret);
1074	1105	break;
1075	1106	}
1076		- else if (xcar (*tail) == QP_S(comma))
	1107	+ else if (xcar (*tail) == symbol::comma)
1077	1108	{
1078	1109	ret = cons::make (interp, xcadr (tail), *ret);
1079	1110	break;
1080	1111	}
1081		- else if (xcar (*tail) == QP_S(commaat) \|\|
1082		- xcar (*tail) == QP_S(commadot))
1083		- bq_nonlist_splice_err (interp, xcar (*tail) == QP_S(commadot));
	1112	+ else if (xcar (*tail) == symbol::comma_at \|\|
	1113	+ xcar (*tail) == symbol::comma_dot)
	1114	+ bq_nonlist_splice_err (interp, xcar (*tail) == symbol::comma_dot);
1084	1115	else
1085	1116	tmp = tail;
1086	1117	}

		@@ -1097,14 +1128,14 @@
1097	1128	{
1098	1129	if (!xcons_p (*tmp))
1099	1130	return (false);
1100		- else if (xcar (*tmp) == QP_S(comma))
	1131	+ else if (xcar (*tmp) == symbol::comma)
1101	1132	tmp = xcadr (tmp);
1102	1133	else
1103	1134	break;
1104	1135	}
1105	1136
1106	1137	tmp = xcar (tmp);
1107		- return (tmp == QP_S(commaat) \|\| tmp == QP_S(commadot));
	1138	+ return (tmp == symbol::comma_at \|\| tmp == symbol::comma_dot);
1108	1139	}
1109	1140
1110	1141	static inline object

		@@ -1123,7 +1154,7 @@
1123	1154	interp->aux = form;
1124	1155	valref tmp (interp, NIL);
1125	1156
1126		- return (xcons_p (interp->aux) && xcar (interp->aux) == QP_S(quote) &&
	1157	+ return (xcons_p (interp->aux) && xcar (interp->aux) == symbol::quote &&
1127	1158	xcons_p (xcdr (interp->aux)) && xcddr (interp->aux) == NIL &&
1128	1159	!bq_splicing_p (interp, *tmp = xcadr (interp->aux)));
1129	1160	}

		@@ -1146,7 +1177,7 @@
1146	1177	{
1147	1178	t2 = xcadr (t2), t1 = xcadr (t1);
1148	1179	t1 = cons::make (interp, t1, *t2);
1149		- return (call_fct (interp, list_fct, QP_S(quote), *t1));
	1180	+ return (call_fct (interp, list_fct, symbol::quote, *t1));
1150	1181	}
1151	1182	else
1152	1183	return (call_fct (interp, list_fct, op, t1, *t2));

		@@ -1179,7 +1210,7 @@
1179	1210	}
1180	1211	else if (bq_cons_test (interp, t1) && xcons_p (aux = xcadr (*t1)) &&
1181	1212	xcdr (last_L (interp, *aux)) == NIL &&
1182		- xcar (*aux) != QP_S(comma))
	1213	+ xcar (*aux) != symbol::comma)
1183	1214	{
1184	1215	t2 = bq_non_splicing (interp, t2);
1185	1216	valref lst (interp, reverse_L (interp, *aux));

		@@ -1188,7 +1219,7 @@
1188	1219	for (; lst != NIL; lst = xcdr (*lst))
1189	1220	{
1190	1221	t1 = xcar (lst);
1191		- t1 = call_fct (interp, list_fct, QP_S(quote), t1);
	1222	+ t1 = call_fct (interp, list_fct, symbol::quote, t1);
1192	1223	aux = bq_cons (interp, t1, *aux);
1193	1224	}
1194	1225

		@@ -1332,14 +1363,15 @@
1332	1363	else if (xcons_p (form))
1333	1364	{
1334	1365	interp->aux = xcar (form);
1335		- if (interp->aux == QP_S(comma))
	1366	+ if (interp->aux == symbol::comma)
1336	1367	qp_return (xcadr (form));
1337		- else if (interp->aux == QP_S(commaat) \|\| interp->aux == QP_S(commadot))
1338		- bq_nonlist_splice_err (interp, interp->aux == QP_S(commadot));
1339		- else if (interp->aux == QP_S(backquote))
	1368	+ else if (interp->aux == symbol::comma_at \|\|
	1369	+ interp->aux == symbol::comma_dot)
	1370	+ bq_nonlist_splice_err (interp, interp->aux == symbol::comma_dot);
	1371	+ else if (interp->aux == symbol::backquote)
1340	1372	{
1341	1373	valref tmp (interp, expand_bq (interp, xcadr (interp->aux)));
1342		- return (call_fct (interp, list_fct, QP_S(backquote), *tmp));
	1374	+ return (call_fct (interp, list_fct, symbol::backquote, *tmp));
1343	1375	}
1344	1376	else
1345	1377	{

		@@ -1356,7 +1388,7 @@
1356	1388	if (!nksymbol_p (form) && !cons_p (form))
1357	1389	qp_return (form);
1358	1390
1359		- return (call_fct (interp, list_fct, QP_S(quote), form));
	1391	+ return (call_fct (interp, list_fct, symbol::quote, form));
1360	1392	}
1361	1393
1362	1394	tmp = expand_bq (interp, tmp);

		@@ -1378,7 +1410,7 @@
1378	1410	}
1379	1411	}
1380	1412
1381		-object rdstate::read_sexpr (object lbl)
	1413	+object reader::read_sexpr (object lbl)
1382	1414	{
1383	1415	uint32_t tok = this->peek ();
1384	1416	this->take ();

		@@ -1405,7 +1437,7 @@
1405	1437	object obj = this->read_sexpr (UNBOUND);
1406	1438	alloc_cons (this->interp, 2);
1407	1439
1408		- xcar(this->interp->alval) = QP_S(quote);
	1440	+ xcar(this->interp->alval) = symbol::quote;
1409	1441	xcadr(this->interp->alval) = obj;
1410	1442
1411	1443	if (lbl != UNBOUND)

		@@ -1495,19 +1527,19 @@
1495	1527	return (this->interp->retval);
1496	1528	}
1497	1529
1498		-object read_sexpr (interpreter *interp, object src)
	1530	+object reader::read_sexpr ()
1499	1531	{
1500		- rdstate rd (interp, src);
	1532	+ return (this->read_sexpr (UNBOUND));
	1533	+}
1501	1534
1502		- try
1503		- {
1504		- return (rd.read_sexpr (UNBOUND));
1505		- }
1506		- catch (...)
1507		- {
1508		- rd.src->discard ();
1509		- throw;
1510		- }
	1535	+reader::~reader ()
	1536	+{
	1537	+ *this->pairs_valref = intobj (0);
	1538	+
	1539	+ if (this->pairs.data != this->stpairs)
	1540	+ xfree (this->pairs.data);
	1541	+ if (this->bufp != this->stbuf)
	1542	+ xfree (this->bufp);
1511	1543	}
1512	1544
1513	1545	// String interpolation.

		@@ -1540,7 +1572,7 @@
1540	1572	instrm.ops = ops;
1541	1573	instrm.io_flags = STRM_UTF8 \| STRM_READ;
1542	1574
1543		- rdstate rd (interp, instrm.as_obj ());
	1575	+ reader rd (interp, instrm.as_obj ());
1544	1576	object ret = rd.read_sexpr (UNBOUND);
1545	1577
1546	1578	if (ret != EOS)

		@@ -1678,6 +1710,76 @@
1678	1710	return (expand_bq (interp, *argv));
1679	1711	}
1680	1712
	1713	+// (De)serialization definitions.
	1714	+
	1715	+serial_info::serial_info (interpreter *interp) : ref_table (interp, UNBOUND)
	1716	+{
	1717	+ this->ptable = this->st_table;
	1718	+ this->nalloc = QP_NELEM (this->st_table);
	1719	+
	1720	+ for (int i = 0; i < this->nalloc; ++i)
	1721	+ this->ptable[i] = UNBOUND;
	1722	+
	1723	+ this->tab_obj.local_init (this->ptable, this->nalloc);
	1724	+}
	1725	+
	1726	+void serial_info::resize (interpreter *interp)
	1727	+{
	1728	+ if (this->nobjs * 2 != this->nalloc)
	1729	+ return;
	1730	+
	1731	+ object tmp = alloc_array (interp, this->nalloc *= 2);
	1732	+ copy_objs (&xaref(tmp, 0), this->ptable, this->nobjs);
	1733	+ this->ptable = &xaref(tmp, 0);
	1734	+}
	1735	+
	1736	+int serial_info::add_uniq_ref (interpreter *interp, object obj, bool& refd)
	1737	+{
	1738	+ for (int i = 0; i < this->nobjs * 2; i += 2)
	1739	+ if (this->ptable[i] == obj)
	1740	+ {
	1741	+ if (this->ptable[i + 1] == intobj (0))
	1742	+ this->ptable[i + 1] = intobj (this->nregs++);
	1743	+
	1744	+ refd = true;
	1745	+ return (as_int (this->ptable[i + 1]));
	1746	+ }
	1747	+
	1748	+ this->add_ref (interp, obj, 0);
	1749	+ return (this->nobjs);
	1750	+}
	1751	+
	1752	+void serial_info::add_ref (interpreter *interp, object obj, int idx)
	1753	+{
	1754	+ this->ptable[this->nobjs * 2 + 0] = obj;
	1755	+ this->ptable[this->nobjs * 2 + 1] = intobj (idx);
	1756	+ this->nobjs++;
	1757	+ this->resize (interp);
	1758	+}
	1759	+
	1760	+int serial_info::del_ref (int idx)
	1761	+{
	1762	+ idx = (idx - 1) * 2;
	1763	+ if (this->ptable[idx + 1] == intobj (0))
	1764	+ {
	1765	+ move_objs (&this->ptable[idx], &this->ptable[idx + 2],
	1766	+ this->nobjs * 2 - idx - 2);
	1767	+ --this->nobjs;
	1768	+ return (-1);
	1769	+ }
	1770	+
	1771	+ return (as_int (this->ptable[idx + 1]));
	1772	+}
	1773	+
	1774	+object serial_info::find_id (int id)
	1775	+{
	1776	+ for (int i = 0; i < this->nobjs * 2; i += 2)
	1777	+ if (this->ptable[i + 1] == intobj (id))
	1778	+ return (this->ptable[i]);
	1779	+
	1780	+ return (UNBOUND);
	1781	+}
	1782	+
1681	1783	QP_EXPORT init_op init_symbols;
1682	1784
1683	1785	static int

diff -r 1ea5839d5b6d -r 6f30387232be io.h

--- a/io.h Tue Jul 17 18:41:09 2018 -0300

+++ b/io.h Fri Oct 12 02:49:16 2018 +0000

		@@ -7,10 +7,65 @@
7	7	#include "str.h"
8	8	#include "function.h"
9	9	#include "symbol.h"
	10	+#include "array.h"
10	11
11	12	QP_DECLS_BEGIN
12	13
13		-QP_EXPORT object read_sexpr (interpreter *__interp, object __src);
	14	+class reader
	15	+{
	16	+public:
	17	+ interpreter *interp;
	18	+ valref pairs_valref;
	19	+ local_varobj<array> pairs;
	20	+ object stpairs[16];
	21	+ int pair_cnt;
	22	+ char stbuf[256];
	23	+ char *bufp;
	24	+ int bufcnt;
	25	+ int bufmax;
	26	+ int toktype;
	27	+ stream *src;
	28	+ uint32_t lineno = 0;
	29	+ int bq_level = 0;
	30	+ bool unquoted = false;
	31	+ bool raised = false;
	32	+ package *ipkg;
	33	+
	34	+ reader (interpreter __interp, object __input, package __ipkg = nullptr);
	35	+
	36	+ bool readable_p () const
	37	+ {
	38	+ return (!this->src->eos_p () && !this->src->err_p ());
	39	+ }
	40	+
	41	+ void take ();
	42	+ void handle_sym (object __pkg, object __name);
	43	+
	44	+ bool read_token (schar& __ch, int __digs);
	45	+
	46	+ void expand ();
	47	+
	48	+ object gethash (object __label) const;
	49	+ object* puthash (object __label);
	50	+
	51	+ bool nextc (schar& __ch);
	52	+ void push_ch (const schar& __ch);
	53	+ uint32_t peek ();
	54	+
	55	+ object read_sexpr ();
	56	+ object read_sexpr (object __label);
	57	+ object read_list (object __label);
	58	+ object read_bq (object __label);
	59	+ object read_comma (object __label);
	60	+ object read_array (object __label);
	61	+ object read_table (object __label);
	62	+ object read_tree (object __label);
	63	+ object read_bvector ();
	64	+ object read_str ();
	65	+ object read_char ();
	66	+
	67	+ ~reader ();
	68	+};
14	69
15	70	QP_EXPORT object expand_str (interpreter *__interp, object __str);
16	71

		@@ -35,12 +90,64 @@
35	90	valref __tmp (__interp, symval (intern (__interp, "%fmt-str", 8)));
36	91	local_varobj<string> __sf;
37	92
38		- __sf.type = typecode::STR;
39		- __sf.data = (unsigned char *)__fmt;
40		- __sf.nbytes = ustrlen (__fmt, &__sf.len);
	93	+ __sf.local_init (__fmt);
41	94	return (call_fct (__interp, *__tmp, __sf.as_obj (), __args...));
42	95	}
43	96
	97	+// Object (de)serialization.
	98	+
	99	+class serial_info
	100	+{
	101	+public:
	102	+ object st_table[64];
	103	+ object *ptable;
	104	+ int output = 0; // Used to communicate with exported routines.
	105	+ int nobjs = 0;
	106	+ int nregs = 1;
	107	+ int nalloc;
	108	+ local_varobj<array> tab_obj;
	109	+ valref ref_table;
	110	+
	111	+ serial_info (interpreter *__interp);
	112	+ void resize (interpreter *__interp);
	113	+
	114	+ int add_uniq_ref (interpreter *__interp, object __obj, bool& __refd);
	115	+ void add_ref (interpreter *__interp, object __obj, int __idx);
	116	+ int del_ref (int __idx);
	117	+ object find_id (int __id);
	118	+};
	119	+
	120	+enum
	121	+{
	122	+ SERIAL_NBVEC = 0xf7,
	123	+ SERIAL_NSTR = 0xf8,
	124	+ SERIAL_NARR = 0xf9,
	125	+ SERIAL_BINT = 0xfa,
	126	+ SERIAL_BCHAR = 0xfb,
	127	+ SERIAL_REF = 0xfc,
	128	+ SERIAL_NIL = 0xfd,
	129	+ SERIAL_END = 0xfe
	130	+};
	131	+
	132	+QP_EXPORT int xserialize (interpreter *__interp,
	133	+ stream *__strm, object __obj, serial_info& __info);
	134	+
	135	+inline int xserialize (interpreter *__interp,
	136	+ stream *__strm, object __obj)
	137	+{
	138	+ serial_info __info { __interp };
	139	+ return (xserialize (__interp, __strm, __obj, __info));
	140	+}
	141	+
	142	+QP_EXPORT object xdeserialize (interpreter *__interp,
	143	+ stream *__strm, serial_info& __info);
	144	+
	145	+inline object xdeserialize (interpreter __interp, stream __strm)
	146	+{
	147	+ serial_info __info { __interp };
	148	+ return (xdeserialize (__interp, __strm, __info));
	149	+}
	150	+
44	151	QP_EXPORT init_op init_io;
45	152
46	153	QP_DECLS_END

diff -r 1ea5839d5b6d -r 6f30387232be memory.cpp

--- a/memory.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/memory.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -980,10 +980,6 @@
980	980	as_package(root_package)->full \|= FLAGS_OLDGEN;
981	981	this->mark_pkg (as_package (root_package));
982	982
983		- // Mark the objects in the local package.
984		- as_package(local_package)->full \|= FLAGS_OLDGEN;
985		- this->mark_pkg (as_package (local_package));
986		-
987	983	/* For the keyword package, we only mark the package object and
988	984	* the symbol table. The reason being, keywords will always survive,
989	985	* since their symbol value is aliased to themselves. */

diff -r 1ea5839d5b6d -r 6f30387232be misc.cpp

--- a/misc.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/misc.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -24,6 +24,9 @@
24	24
25	25	uint32_t upsize (uint32_t n)
26	26	{
	27	+ if (n < 8)
	28	+ return (8);
	29	+
27	30	uint32_t ret = n;
28	31
29	32	ret \|= ret >> 1;

diff -r 1ea5839d5b6d -r 6f30387232be quipu.cpp

--- a/quipu.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/quipu.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -43,13 +43,8 @@
43	43	int vl = as_array(vec)->len;
44	44
45	45	strmp->write (interp, " (", 3);
46		-
47		- if (native_fct_p (caller))
48		- {
49		- const char *s = as_native_fct(caller)->name;
50		- strmp->write (interp, s, strlen (s));
51		- }
52		- else if (fct_p (caller))
	46	+
	47	+ if (fct_p (caller))
53	48	{
54	49	object nm = fct_name (caller);
55	50	if (nm == NIL)

		@@ -87,6 +82,7 @@
87	82	}
88	83
89	84	interpreter *interp = main_interp;
	85	+ reader rd (interp, in_stream);
90	86
91	87	while (true)
92	88	{

		@@ -95,7 +91,7 @@
95	91
96	92	try
97	93	{
98		- object expr = read_sexpr (interp, in_stream);
	94	+ object expr = rd.read_sexpr ();
99	95	if (expr == EOS)
100	96	break;
101	97

diff -r 1ea5839d5b6d -r 6f30387232be str.cpp

--- a/str.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/str.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -447,6 +447,18 @@
447	447	return (ret);
448	448	}
449	449
	450	+int serialize_c (interpreter interp, stream strm, object obj, serial_info&)
	451	+{
	452	+ uint32_t ch = as_char (obj);
	453	+ return (strm->write (interp, &ch, sizeof (ch)));
	454	+}
	455	+
	456	+object deserialize_c (interpreter interp, stream strm, serial_info&)
	457	+{
	458	+ uint32_t ch;
	459	+ qp_return (!strm->sread (interp, &ch) ? UNBOUND : charobj (ch));
	460	+}
	461	+
450	462	class fmt_info
451	463	{
452	464	public:

diff -r 1ea5839d5b6d -r 6f30387232be str.h

--- a/str.h Tue Jul 17 18:41:09 2018 -0300

+++ b/str.h Fri Oct 12 02:49:16 2018 +0000

		@@ -17,6 +17,9 @@
17	17	static object make (interpreter __interp, const char __s);
18	18	static object make (interpreter __interp, const char __s, int __len);
19	19	static string* alloc_raw (uint32_t __nb);
	20	+
	21	+ inline void local_init (const void *__ptr);
	22	+ inline void local_init (const void *__ptr, int __nbytes);
20	23	};
21	24
22	25	// Max value for a character (as a UTF-32 codepoint).

		@@ -65,7 +68,7 @@
65	68
66	69	inline constexpr bool str_p (object __obj)
67	70	{
68		- return (varobj_p (__obj) && as_varobj(__obj)->type == typecode::STR);
	71	+ return (itype (__obj) == typecode::STR);
69	72	}
70	73
71	74	inline char* fscpy (void __dstp, const void __srcp, int __n)

		@@ -92,6 +95,7 @@
92	95
93	96	class stream;
94	97	class io_info;
	98	+class serial_info;
95	99
96	100	QP_EXPORT object alloc_str (interpreter *__interp, int __nbytes);
97	101

		@@ -107,6 +111,18 @@
107	111	QP_EXPORT int write_c (interpreter *__interp,
108	112	stream *__strm, object __obj, io_info& __info);
109	113
	114	+QP_EXPORT int serialize_s (interpreter *__interp,
	115	+ stream *__strm, object __obj, serial_info& __info);
	116	+
	117	+QP_EXPORT int serialize_c (interpreter *__interp,
	118	+ stream *__strm, object __obj, serial_info& __info);
	119	+
	120	+QP_EXPORT object deserialize_s (interpreter *__interp,
	121	+ stream *__strm, serial_info& __info);
	122	+
	123	+QP_EXPORT object deserialize_c (interpreter *__interp,
	124	+ stream *__strm, serial_info& __info);
	125	+
110	126	QP_EXPORT object add_ss (interpreter *__interp,
111	127	object __str1, object __str2);
112	128

		@@ -157,6 +173,26 @@
157	173
158	174	QP_EXPORT const char* chobj_repr (uint32_t __ch);
159	175
	176	+// Local initialization methods.
	177	+
	178	+void string::local_init (const void *__ptr)
	179	+{
	180	+ this->full = 0;
	181	+ this->type = typecode::STR;
	182	+ this->data = (unsigned char *)__ptr;
	183	+ this->nbytes = ustrlen (__ptr, &this->len);
	184	+ this->hval = 0;
	185	+}
	186	+
	187	+void string::local_init (const void *__ptr, int __nbytes)
	188	+{
	189	+ this->full = 0;
	190	+ this->type = typecode::STR;
	191	+ this->data = (unsigned char *)__ptr;
	192	+ this->len = ustrnlen (__ptr, this->nbytes = __nbytes);
	193	+ this->hval = 0;
	194	+}
	195	+
160	196	QP_DECLS_END
161	197
162	198	#endif

diff -r 1ea5839d5b6d -r 6f30387232be stream.cpp

--- a/stream.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/stream.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -45,6 +45,21 @@
45	45	return (ret);
46	46	}
47	47
	48	+object spos::encode (interpreter *interp)
	49	+{
	50	+ object ret = fitsint_p (this->offset) ? intobj (this->offset) :
	51	+ bigint::make (interp, this->offset);
	52	+
	53	+ if (this->state != UNBOUND)
	54	+ {
	55	+ valref tmp (interp, ret);
	56	+ ret = alloc_array (interp, 2);
	57	+ xaref(ret, 0) = *tmp, xaref(ret, 1) = this->state;
	58	+ }
	59	+
	60	+ qp_return (ret);
	61	+}
	62	+
48	63	bool stream::xseek (interpreter *interp, const spos& npos, int whence)
49	64	{
50	65	spos tmp = npos;

		@@ -403,6 +418,9 @@
403	418	if (this->ops.seek != seek_stub && (whence == SEEK_SET \|\|
404	419	whence == SEEK_CUR \|\| whence == SEEK_END))
405	420	{
	421	+ if (this->need_wflush () && !this->wflush (interp))
	422	+ return (ret);
	423	+
406	424	ret = this->xseek (interp, spos::decode (off), whence);
407	425	if (ret)
408	426	{

diff -r 1ea5839d5b6d -r 6f30387232be stream.h

--- a/stream.h Tue Jul 17 18:41:09 2018 -0300

+++ b/stream.h Fri Oct 12 02:49:16 2018 +0000

		@@ -29,6 +29,8 @@
29	29
30	30	spos (int64_t off = 0, object st = UNBOUND) : offset (off), state (st) {}
31	31
	32	+ object encode (interpreter *interp);
	33	+
32	34	static spos decode (object obj);
33	35	};
34	36

		@@ -164,6 +166,12 @@
164	166	// Write NB bytes from SRC to the stream.
165	167	int write (interpreter interp, const void __src, uint32_t __nb);
166	168
	169	+ template <class T>
	170	+ int write (interpreter interp, const T outp)
	171	+ {
	172	+ return (this->write (interp, outp, sizeof (T)));
	173	+ }
	174	+
167	175	// Write a single byte into the stream.
168	176	int putb (interpreter *interp, int __byte);
169	177

		@@ -187,6 +195,18 @@
187	195	// Read at most NB bytes from the stream into DST.
188	196	int read (interpreter interp, void __dst, uint32_t __nb);
189	197
	198	+ template <class T>
	199	+ int read (interpreter interp, T outp)
	200	+ {
	201	+ return (this->read (interp, outp, sizeof (T)));
	202	+ }
	203	+
	204	+ template <class T>
	205	+ bool sread (interpreter interp, T outp)
	206	+ {
	207	+ return (this->read (interp, outp) == (int)sizeof(T));
	208	+ }
	209	+
190	210	// Read a unicode character from the stream into CH.
191	211	bool sgetc (interpreter *interp, schar& ch);
192	212

		@@ -199,6 +219,12 @@
199	219	// Move the stream possition according to OFF and WHENCE.
200	220	bool seek (interpreter *interp, object __off, int __whence);
201	221
	222	+ // Get current stream position.
	223	+ object tell (interpreter *interp)
	224	+ {
	225	+ return (this->pos.encode (interp));
	226	+ }
	227	+
202	228	// Flush the contents of the stream.
203	229	bool flush (interpreter *interp);
204	230

		@@ -270,6 +296,21 @@
270	296	stream_guard (interpreter __ip, stream __s) :
271	297	interp (__ip), strmp (__s) {}
272	298
	299	+ stream& operator ()
	300	+ {
	301	+ return (this->strmp);
	302	+ }
	303	+
	304	+ stream* operator* () const
	305	+ {
	306	+ return (this->strmp);
	307	+ }
	308	+
	309	+ object as_obj () const
	310	+ {
	311	+ return (strmp->as_obj ());
	312	+ }
	313	+
273	314	~stream_guard ()
274	315	{
275	316	if (this->strmp)

diff -r 1ea5839d5b6d -r 6f30387232be symbol.cpp

--- a/symbol.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/symbol.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -5,6 +5,8 @@
5	5	#include "integer.h"
6	6	#include "str.h"
7	7	#include "stream.h"
	8	+#include "io.h"
	9	+#include "builtins.h"
8	10
9	11	QP_DECLS_BEGIN
10	12

		@@ -14,7 +16,9 @@
14	16	static const object PKG_EMPTY = intobj (0) \| EXTRA_BIT;
15	17	static const object PKG_DELETED = intobj (1) \| EXTRA_BIT;
16	18
17		-object alloc_pkg (interpreter *interp, object name)
	19	+static void pkg_inherit_builtins (interpreter , package );
	20	+
	21	+object alloc_pkg (interpreter *interp, object name, bool bootstrap)
18	22	{
19	23	evh_guard eg (interp);
20	24	package ret = (package )alloch (sizeof (*ret), typecode::PKG);

		@@ -26,10 +30,12 @@
26	30	ret->syms = alloc_array (interp, PKG_BASE_SIZE + 1, PKG_EMPTY);
27	31	xaref(ret->syms, 0) = intobj (0);
28	32
29		- interp->alval = *--interp->stkend;
30	33	gcregister (interp, ret);
31	34
32		- return (interp->alval);
	35	+ if (!bootstrap)
	36	+ pkg_inherit_builtins (interp, ret);
	37	+
	38	+ return (interp->alval = *--interp->stkend);
33	39	}
34	40
35	41	static void

		@@ -107,11 +113,10 @@
107	113	object pkg, const char *name, int len)
108	114	{
109	115	local_varobj<string> str;
110		-
111		- str.type = typecode::STR;
112		- str.nbytes = len < 0 ? (int)strlen (name) : len;
113		- str.data = (unsigned char *)name;
114		- str.hval = hashbuf (str.data, str.nbytes);
	116	+ if (len < 0)
	117	+ str.local_init (name);
	118	+ else
	119	+ str.local_init (name, len);
115	120
116	121	return (find_sym (interp, pkg, str.as_obj ()));
117	122	}

		@@ -130,7 +135,7 @@
130	135	if (obj & EXTRA_BIT)
131	136	continue;
132	137
133		- uint32_t bucket = as_str(symname (obj))->hval & (nlen - 1);
	138	+ uint32_t bucket = hash_s (interp, symname (obj)) & (nlen - 1);
134	139	uint32_t nprobe = 1;
135	140
136	141	while (true)

		@@ -138,7 +143,9 @@
138	143	if (np->data[bucket + 1] == PKG_EMPTY)
139	144	{
140	145	np->data[bucket + 1] = obj;
141		- as_symbol(obj)->idx = bucket;
	146	+ if (sympkg (obj) == pkg->as_obj ())
	147	+ as_symbol(obj)->idx = bucket;
	148	+
142	149	break;
143	150	}
144	151

		@@ -249,8 +256,7 @@
249	256	return (ret);
250	257	}
251	258
252		-object intern (interpreter *interp,
253		- const char name, int len, package pkgp)
	259	+object intern (interpreter interp, const string name, package *pkgp)
254	260	{
255	261	uint32_t flags = 0;
256	262

		@@ -259,32 +265,61 @@
259	265	else if (pkgp == as_package (kword_package))
260	266	flags = FLAGS_CONST;
261	267
	268	+ return (pkg_insert (interp, pkgp, name->as_obj (), flags));
	269	+}
	270	+
	271	+object intern (interpreter *interp,
	272	+ const char name, int len, package pkgp)
	273	+{
262	274	local_varobj<string> str;
	275	+ if (len < 0)
	276	+ str.local_init (name);
	277	+ else
	278	+ str.local_init (name, len);
	279	+
263	280	str.type = typecode::BVECTOR;
264		- str.data = (unsigned char *)name;
265		- str.nbytes = ustrlen (name, &str.len);
266		- str.hval = hashbuf (str.data, len);
267		-
268		- return (pkg_insert (interp, pkgp, str.as_obj (), flags));
	281	+ return (intern (interp, &str, pkgp));
269	282	}
270	283
271	284	object intern (interpreter interp, const char name, package *pkgp)
272	285	{
273		- return (intern (interp, name, (int)strlen (name), pkgp));
	286	+ return (intern (interp, name, -1, pkgp));
274	287	}
275	288
276	289	bool undef (interpreter interp, const char name,
277	290	int len, package *pkgp)
278	291	{
279	292	local_varobj<string> sname;
280		- sname.type = typecode::STR;
281		- sname.data = (unsigned char *)name;
282		- sname.nbytes = len < 0 ? strlen (name) : len;
	293	+ if (len < 0)
	294	+ sname.local_init (name);
	295	+ else
	296	+ sname.local_init (name, len);
283	297
284	298	return (pkg_remove (interp, pkgp != nullptr ? pkgp :
285	299	as_package (root_package), sname.as_obj ()));
286	300	}
287	301
	302	+package::iterator::iterator (interpreter *interp, object pkg) :
	303	+ idx (1), symtab (interp, as_package(pkg)->syms), cursym (interp, UNBOUND)
	304	+{
	305	+}
	306	+
	307	+bool package::iterator::valid () const
	308	+{
	309	+ return (this->idx < as_array(*this->symtab)->len);
	310	+}
	311	+
	312	+void package::iterator::adv ()
	313	+{
	314	+ array ap = as_array (this->symtab);
	315	+ for (; this->idx < ap->len; ++this->idx)
	316	+ {
	317	+ *this->cursym = ap->data[this->idx];
	318	+ if ((*this->cursym & EXTRA_BIT) == 0)
	319	+ break;
	320	+ }
	321	+}
	322	+
288	323	int write_S (interpreter interp, stream strmp, object obj, io_info&)
289	324	{
290	325	const symbol *sp = as_symbol (obj);

		@@ -318,6 +353,204 @@
318	353	return (ret);
319	354	}
320	355
	356	+enum
	357	+{
	358	+ SERIAL_PKG_ROOT = 1,
	359	+ SERIAL_PKG_KWORD = 2,
	360	+ SERIAL_PKG_NONE = 3,
	361	+ SERIAL_PKG_SELF = 4
	362	+};
	363	+
	364	+static inline int
	365	+pkg_number (object obj)
	366	+{
	367	+ return (obj == root_package ? SERIAL_PKG_ROOT :
	368	+ obj == kword_package ? SERIAL_PKG_KWORD :
	369	+ obj == UNBOUND ? SERIAL_PKG_NONE : 0);
	370	+}
	371	+
	372	+static inline uint32_t
	373	+sym_serial_flags (const symbol *symp)
	374	+{
	375	+ return (symp->full & (FLAGS_CONST \| symbol::special_flag \|
	376	+ symbol::ctv_flag \| symbol::alias_flag));
	377	+}
	378	+
	379	+int serialize_S (interpreter interp, stream strm,
	380	+ object obj, serial_info& info)
	381	+{
	382	+ uint32_t flags = sym_serial_flags (as_symbol (obj));
	383	+ int ret = strm->write (interp, &flags);
	384	+
	385	+ ret += xserialize (interp, strm, symname (obj), info);
	386	+ object pkg = as_symbol(obj)->pkg;
	387	+
	388	+ int pn = pkg_number (pkg);
	389	+ if (pn != 0)
	390	+ ret += strm->putb (interp, pn);
	391	+ else
	392	+ ret += xserialize (interp, strm, as_package(pkg)->name, info);
	393	+
	394	+ return (ret);
	395	+}
	396	+
	397	+int serialize_P (interpreter interp, stream strm,
	398	+ object obj, serial_info& info)
	399	+{
	400	+ package *pkg = as_package (obj);
	401	+ int ret = xserialize (interp, strm, pkg->name, info);
	402	+
	403	+ valref syms (interp, pkg->syms), pos1 (interp, strm->tell (interp));
	404	+ valref s (interp, UNBOUND), v (interp, NIL);
	405	+
	406	+ uint32_t len = as_array(*syms)->len;
	407	+
	408	+ for (uint32_t i = 1; i < len; ++i)
	409	+ {
	410	+ s = xaref (syms, i);
	411	+ if (!symbol_p (s) \|\| (v = symval (*s)) == UNBOUND)
	412	+ continue;
	413	+
	414	+ uint32_t flags = sym_serial_flags (as_symbol (*s));
	415	+ ret += strm->write (interp, &flags);
	416	+
	417	+ const string name = as_str (symname (s));
	418	+ ret += strm->write (interp, &name->nbytes);
	419	+ ret += strm->write (interp, &name->len);
	420	+ ret += strm->write (interp, name->data, name->nbytes);
	421	+
	422	+ int pn = pkg_number (*s);
	423	+ if (pn == 0 && sympkg (*s) == pkg->as_obj ())
	424	+ pn = SERIAL_PKG_SELF;
	425	+
	426	+ strm->putb (interp, pn);
	427	+ if (pn == 0)
	428	+ ret += xserialize (interp, strm, as_package(sympkg (*s))->name, info);
	429	+ else if (pn == SERIAL_PKG_KWORD)
	430	+ continue;
	431	+
	432	+ ret += xserialize (interp, strm, *v, info);
	433	+ }
	434	+
	435	+ ret += strm->putb (interp, SERIAL_END);
	436	+ return (ret);
	437	+}
	438	+
	439	+object deserialize_S (interpreter interp, stream strm, serial_info& info)
	440	+{
	441	+ uint32_t flags;
	442	+ if (strm->read (interp, &flags) != (int)sizeof (flags))
	443	+ qp_return (UNBOUND);
	444	+
	445	+ valref ret (interp, xdeserialize (interp, strm, info));
	446	+ if (!str_p (*ret))
	447	+ qp_return (UNBOUND);
	448	+
	449	+ object pkg = xdeserialize (interp, strm, info);
	450	+ if (int_p (pkg))
	451	+ switch (as_int (pkg))
	452	+ {
	453	+ case SERIAL_PKG_ROOT:
	454	+ pkg = root_package;
	455	+ break;
	456	+ case SERIAL_PKG_KWORD:
	457	+ pkg = kword_package;
	458	+ break;
	459	+ case SERIAL_PKG_NONE:
	460	+ pkg = UNBOUND;
	461	+ break;
	462	+ default:
	463	+ qp_return (UNBOUND);
	464	+ }
	465	+ else if (!str_p (pkg) \|\|
	466	+ (pkg = find_pkg (interp, pkg)) == UNBOUND)
	467	+ qp_return (UNBOUND);
	468	+
	469	+ ret = intern (interp, str_cdata (ret), as_package (pkg));
	470	+ as_symbol(*ret)->set_flag (flags);
	471	+
	472	+ if (info.output > 0)
	473	+ info.add_ref (interp, *ret, info.output);
	474	+
	475	+ qp_return (*ret);
	476	+}
	477	+
	478	+object deserialize_P (interpreter interp, stream strm, serial_info& info)
	479	+{
	480	+ valref ret (interp, xdeserialize (interp, strm, info));
	481	+ if (!str_p (*ret))
	482	+ qp_return (UNBOUND);
	483	+
	484	+ ret = alloc_pkg (interp, ret, true);
	485	+ if (info.output > 0)
	486	+ info.add_ref (interp, *ret, info.output);
	487	+
	488	+ valref name (interp, UNBOUND), sym (interp, UNBOUND), aux (interp, UNBOUND);
	489	+
	490	+ while (true)
	491	+ {
	492	+ if (strm->peekb (interp) == SERIAL_END)
	493	+ {
	494	+ strm->getb (interp);
	495	+ break;
	496	+ }
	497	+
	498	+ uint32_t flags;
	499	+ int data[2];
	500	+
	501	+ if (!strm->sread (interp, &flags) \|\|
	502	+ strm->read (interp, data, sizeof (data)) != (int)sizeof (data))
	503	+ qp_return (UNBOUND);
	504	+
	505	+ *name = alloc_str (interp, alloc_str (interp, data[0]));
	506	+ string np = as_str (name);
	507	+
	508	+ if (strm->read (interp, np->data, data[0]) != data[0])
	509	+ qp_return (UNBOUND);
	510	+
	511	+ np->len = data[1];
	512	+
	513	+ int pn = strm->getb (interp);
	514	+ package *out_pkg;
	515	+
	516	+ switch (pn)
	517	+ {
	518	+ case SERIAL_PKG_ROOT:
	519	+ out_pkg = as_package (root_package);
	520	+ break;
	521	+
	522	+ case SERIAL_PKG_KWORD:
	523	+ out_pkg = as_package (kword_package);
	524	+ break;
	525	+
	526	+ case SERIAL_PKG_SELF:
	527	+ out_pkg = as_package (*ret);
	528	+ break;
	529	+
	530	+ case 0:
	531	+ { // XXX: See if we can speed up this case.
	532	+ *aux = xdeserialize (interp, strm, info);
	533	+ if (!str_p (*aux) \|\|
	534	+ (aux = find_pkg (interp, aux)) == UNBOUND)
	535	+ qp_return (UNBOUND);
	536	+
	537	+ out_pkg = as_package (*aux);
	538	+ }
	539	+ }
	540	+
	541	+ *sym = intern (interp, np, out_pkg);
	542	+ as_symbol(*sym)->flags \|= flags;
	543	+
	544	+ if (pn != SERIAL_PKG_KWORD && pn != SERIAL_PKG_NONE &&
	545	+ (symval(*sym) = xdeserialize (interp, strm, info)) == UNBOUND)
	546	+ qp_return (UNBOUND);
	547	+
	548	+ *aux = UNBOUND;
	549	+ }
	550	+
	551	+ qp_return (*ret);
	552	+}
	553	+
321	554	// XXX: Should we expose this counter?
322	555	static atomic_t gensym_cnt;
323	556

		@@ -354,44 +587,170 @@
354	587	return (ret);
355	588	}
356	589
	590	+object find_pkg (interpreter *interp, object name)
	591	+{
	592	+ // XXX: Implement.
	593	+ qp_return (UNBOUND);
	594	+}
	595	+
	596	+object find_pkg (interpreter interp, const char name, int len)
	597	+{
	598	+ local_varobj<string> nm;
	599	+ if (len < 0)
	600	+ nm.local_init (name);
	601	+ else
	602	+ nm.local_init (name, len);
	603	+
	604	+ return (find_pkg (interp, nm.as_obj ()));
	605	+}
	606	+
	607	+static void
	608	+pkg_inherit_builtins (interpreter interp, package dstp)
	609	+{
	610	+ const array *ap = as_array (dstp->syms);
	611	+
	612	+ for (builtin_iter it; it.valid (); it.adv ())
	613	+ {
	614	+ object sym = intern (interp, it.name ());
	615	+ *pkg_lookup (interp, ap, symname (sym)) = sym;
	616	+
	617	+ ap->data[0] += intobj (1);
	618	+ if (ap->len * 75 <= as_int (ap->data[0]) * 100)
	619	+ {
	620	+ pkg_resize (interp, dstp, (ap->len - 1) * 4);
	621	+ ap = as_array (dstp->syms);
	622	+ }
	623	+ }
	624	+}
	625	+
	626	+static const char*
	627	+path_basename (const char *path, size_t len)
	628	+{
	629	+ const char ret = (const char )memchr (path, '/', len);
	630	+ if (!ret++)
	631	+ return (path);
	632	+
	633	+ for (len -= ret - path ; ; )
	634	+ {
	635	+ const char tmp = (const char )memchr (ret, '/', len);
	636	+ if (!tmp)
	637	+ return (ret);
	638	+
	639	+ len -= tmp - ret;
	640	+ ret = tmp + 1;
	641	+ }
	642	+}
	643	+
	644	+object import_pkg (interpreter *interp, object path, object name)
	645	+{
	646	+ QP_TMARK (interp);
	647	+ int p_len = as_str(path)->nbytes;
	648	+ const char *cdp = str_cdata (path);
	649	+ stream_guard ing (interp, open_stream (interp, cdp, "r"));
	650	+ stream_guard outg (interp, nullptr);
	651	+ object pkg_expr = UNBOUND;
	652	+
	653	+ if (*ing == nullptr)
	654	+ qp_return (pkg_expr);
	655	+ else if (cdp[p_len - 2] == 'q' && cdp[p_len - 1] == 'p')
	656	+ {
	657	+ char tmp = (char )QP_TALLOC (interp, p_len + 2);
	658	+ memcpy (tmp, cdp, p_len);
	659	+ tmp[p_len] = 'c', tmp[p_len + 1] = '\0';
	660	+
	661	+ *outg = open_stream (interp, tmp, "a+");
	662	+ // if ((outg)->st_mtim <= (ing)->st_mtim) XXX: replace
	663	+ if (false)
	664	+ {
	665	+ pkg_expr = xdeserialize (interp, *outg);
	666	+ if (!fct_p (pkg_expr))
	667	+ pkg_expr = UNBOUND;
	668	+ }
	669	+ }
	670	+ // XXX: Handle shared objects (.so and .dll)
	671	+
	672	+ if (name == UNBOUND)
	673	+ name = string::make (interp, path_basename (cdp, p_len));
	674	+
	675	+ valref ret (interp, alloc_pkg (interp, name));
	676	+
	677	+ if (pkg_expr == UNBOUND)
	678	+ {
	679	+ reader rd (interp, (ing)->as_obj (), as_package (ret));
	680	+ pkg_expr = compile_pkg (interp, rd);
	681	+
	682	+ if (*outg != nullptr)
	683	+ {
	684	+ // (*outg)->truncate (0);
	685	+ xserialize (interp, *outg, pkg_expr);
	686	+ }
	687	+ }
	688	+ else
	689	+ {
	690	+ interp->push (pkg_expr);
	691	+ call_n (interp, 0);
	692	+ interp->popn ();
	693	+ }
	694	+
	695	+ qp_return (*ret);
	696	+}
	697	+
	698	+object get_P (interpreter *interp, object pkg,
	699	+ object key, object dfl)
	700	+{
	701	+ if (qp_unlikely (dfl != UNBOUND))
	702	+ interp->raise_nargs ("get:package", 2, 2, 3);
	703	+ else if (keyword_p (key))
	704	+ key = symname (key);
	705	+ else if (!str_p (key))
	706	+ interp->raise2 ("type-error", "get:package: symbol name "
	707	+ "must be string or keyword");
	708	+
	709	+ valref ret (interp, find_sym (interp, pkg, key));
	710	+ ret = (ret & EXTRA_BIT) ? UNBOUND : symval (*ret);
	711	+
	712	+ if (*ret == UNBOUND)
	713	+ interp->raise2 ("unbound-error", io_sprintf (interp,
	714	+ "symbol named %Q is unbound", key));
	715	+
	716	+ qp_return (*ret);
	717	+}
	718	+
357	719	// External definitions.
358	720	object root_package;
359	721	object kword_package;
360		-object local_package;
361	722
362		-object QP_S (t);
363		-object QP_S (comma);
364		-object QP_S (commaat);
365		-object QP_S (commadot);
366		-object QP_S (backquote);
367		-object QP_S (quote);
	723	+object symbol::t;
	724	+object symbol::comma;
	725	+object symbol::comma_at;
	726	+object symbol::comma_dot;
	727	+object symbol::backquote;
	728	+object symbol::quote;
368	729
369	730	static int
370	731	do_init_symbols (interpreter *interp)
371	732	{
372		- root_package = alloc_pkg (interp, string::make (interp, "user"));
373		- kword_package = alloc_pkg (interp, string::make (interp, "keyword"));
374		- local_package = alloc_pkg (interp, string::make (interp, "local"));
	733	+ root_package = alloc_pkg (interp, string::make (interp, "user"), true);
	734	+ kword_package = alloc_pkg (interp, string::make (interp, "keyword"), true);
375	735
376	736	#define INTERN(sym, name) \
377		- QP_S(sym) = pkg_insert (interp, \
	737	+ symbol::sym = pkg_insert (interp, \
378	738	as_package (root_package), string::make (interp, #name), 0)
379	739
380	740	INTERN (comma, unquote);
381		- INTERN (commaat, splice);
382		- INTERN (commadot, nsplice);
	741	+ INTERN (comma_at, splice);
	742	+ INTERN (comma_dot, nsplice);
383	743	INTERN (backquote, backquote);
384	744	INTERN (quote, quote);
385	745
386	746	INTERN (t, t);
387		- as_symbol(QP_S(t))->full \|= FLAGS_CONST;
388		- symval(QP_S(t)) = QP_S(t);
	747	+ as_symbol(symbol::t)->full \|= FLAGS_CONST;
	748	+ symval(symbol::t) = symbol::t;
389	749
390	750	#undef INTERN
391	751	return (init_op::result_ok);
392	752	}
393	753
394		-QP_EXPORT init_op init_memory;
395	754	init_op init_symbols (do_init_symbols, "symbols");
396	755
397	756	QP_DECLS_END

diff -r 1ea5839d5b6d -r 6f30387232be symbol.h

--- a/symbol.h Tue Jul 17 18:41:09 2018 -0300

+++ b/symbol.h Fri Oct 12 02:49:16 2018 +0000

		@@ -19,6 +19,14 @@
19	19	intptr_t idx;
20	20
21	21	static object make_kword (interpreter __interp, const char __name);
	22	+
	23	+ // Some exported symbols.
	24	+ static object t;
	25	+ static object comma;
	26	+ static object comma_at;
	27	+ static object comma_dot;
	28	+ static object backquote;
	29	+ static object quote;
22	30	};
23	31
24	32	class package : public varobj

		@@ -27,6 +35,18 @@
27	35	object syms;
28	36	object name;
29	37	atomic_t lock;
	38	+
	39	+ class iterator
	40	+ {
	41	+ public:
	42	+ int idx;
	43	+ valref symtab;
	44	+ valref cursym;
	45	+
	46	+ iterator (interpreter *__interp, object __pkg);
	47	+ bool valid () const;
	48	+ void adv ();
	49	+ };
30	50	};
31	51
32	52	inline symbol* as_symbol (object __obj)

		@@ -66,15 +86,6 @@
66	86
67	87	QP_EXPORT object root_package;
68	88	QP_EXPORT object kword_package;
69		-QP_EXPORT object local_package;
70		-
71		-// Basic symbols.
72		-QP_EXPORT object QP_S (t);
73		-QP_EXPORT object QP_S (comma);
74		-QP_EXPORT object QP_S (commaat);
75		-QP_EXPORT object QP_S (commadot);
76		-QP_EXPORT object QP_S (backquote);
77		-QP_EXPORT object QP_S (quote);
78	89
79	90	inline bool keyword_p (object __obj)
80	91	{

		@@ -88,8 +99,10 @@
88	99
89	100	class stream;
90	101	class io_info;
	102	+class serial_info;
91	103
92		-QP_EXPORT object alloc_pkg (interpreter *__interp, object __name);
	104	+QP_EXPORT object alloc_pkg (interpreter *__interp,
	105	+ object __name, bool __bootstrap = false);
93	106
94	107	QP_EXPORT object alloc_sym (interpreter *__interp, uint32_t __flags = 0);
95	108

		@@ -119,20 +132,51 @@
119	132	QP_EXPORT object intern (interpreter *__interp,
120	133	const char __name, package __pkgp = 0);
121	134
	135	+class string;
	136	+class reader;
	137	+
	138	+QP_EXPORT object intern (interpreter *__interp,
	139	+ const string __name, package __pkgp = 0);
	140	+
122	141	QP_EXPORT bool undef (interpreter *__interp,
123	142	const char __name, int __len, package __pkgp = 0);
124	143
125	144	QP_EXPORT bool undef (interpreter *__interp, object __sym);
126	145
	146	+QP_EXPORT object get_P (interpreter *__interp,
	147	+ object __pkg, object __key, object __dfl);
	148	+
127	149	QP_EXPORT int write_S (interpreter* __interp,
128	150	stream *__strm, object __obj, io_info& __info);
129	151
130	152	QP_EXPORT int write_P (interpreter *__interp,
131	153	stream *__strm, object __obj, io_info& __info);
132	154
	155	+QP_EXPORT int serialize_S (interpreter *__interp,
	156	+ stream *__strm, object __obj, serial_info& __info);
	157	+
	158	+QP_EXPORT int serialize_P (interpreter *__interp,
	159	+ stream *__strm, object __obj, serial_info& __info);
	160	+
	161	+QP_EXPORT object deserialize_S (interpreter *__interp,
	162	+ stream *__strm, serial_info& __info);
	163	+
	164	+QP_EXPORT object deserialize_P (interpreter *__interp,
	165	+ stream *__strm, serial_info& __info);
	166	+
133	167	QP_EXPORT object gensym (interpreter *__interp,
134	168	object *__argv, int __argc);
135	169
	170	+QP_EXPORT object compile_pkg (interpreter *__interp, reader& __rd);
	171	+
	172	+QP_EXPORT object import_pkg (interpreter *__interp,
	173	+ object __path, object __name = UNBOUND);
	174	+
	175	+QP_EXPORT object find_pkg (interpreter *__interp, object __name);
	176	+
	177	+QP_EXPORT object find_pkg (interpreter *__interp,
	178	+ const char *__name, int __len = -1);
	179	+
136	180	// Init OP for symbols.
137	181	QP_EXPORT init_op init_symbols;
138	182

diff -r 1ea5839d5b6d -r 6f30387232be sysdeps/lwlock-generic.h

--- a/sysdeps/lwlock-generic.h Tue Jul 17 18:41:09 2018 -0300

+++ b/sysdeps/lwlock-generic.h Fri Oct 12 02:49:16 2018 +0000

		@@ -18,19 +18,17 @@
18	18	if (lwlock_trygrab (lockp))
19	19	return;
20	20
21		- /* The lock is still begin contested - Sleep for 1ms. */
	21	+ // The lock is still begin contested - Sleep for 1ms.
	22	+ interp->begin_blocking ();
22	23	#ifdef QP_PLATFORM_UNIX
23		- struct timespec ts;
	24	+ timespec ts;
24	25	ts.tv_sec = 0;
25	26	ts.tv_nsec = 1000000;
26		- interp->begin_blocking ();
27	27	nanosleep (&ts, nullptr);
28		- interp->end_blocking ();
29	28	#else
30		- interp->begin_blocking ();
31	29	SleepEx (1, TRUE);
	30	+#endif
32	31	interp->end_blocking ();
33		-#endif
34	32	}
35	33	}
36	34

diff -r 1ea5839d5b6d -r 6f30387232be table.cpp

--- a/table.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/table.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -35,7 +35,7 @@
35	35
36	36	static const int TABVEC_OVERHEAD = 4;
37	37
38		-static inline int
	38	+static constexpr inline int
39	39	tabvec_idx (int idx)
40	40	{
41	41	return (idx * 2 + TABVEC_OVERHEAD);

		@@ -261,12 +261,10 @@
261	261
262	262	for (int i = tabvec_idx (0); i < oldvp->len; i += 2)
263	263	{
264		- int new_idx;
265		-
266	264	if (!valid_key_p (oldvp->data[i]))
267	265	continue;
268	266
269		- new_idx = growtab_probe (interp, tp, newvp, oldvp->data[i]);
	267	+ int new_idx = growtab_probe (interp, tp, newvp, oldvp->data[i]);
270	268	newvp->data[new_idx + 0] = oldvp->data[i + 0];
271	269	newvp->data[new_idx + 1] = oldvp->data[i + 1];
272	270	}

		@@ -406,15 +404,15 @@
406	404	else
407	405	{
408	406	object oldk = vecp->data[idx + 0];
409		- interp->aux = vecp->data[idx + 1];
	407	+ object oldv = vecp->data[idx + 1];
410	408
411		- if (!(interp->aux & EXTRA_BIT))
	409	+ if (!(oldv & EXTRA_BIT))
412	410	{ /* The table is not being migrated at the moment. Try to
413	411	* delete the entry if it hasn't already been. */
414		- if (oldk == DELETED_KEY \|\| interp->aux == FREE_HASH \|\|
415		- interp->aux == DELETED_VAL)
	412	+ if (oldk == DELETED_KEY \|\| oldv == FREE_HASH \|\|
	413	+ oldv == DELETED_VAL)
416	414	return (false);
417		- else if (setv_cond (vecp, idx, interp->aux, DELETED_VAL))
	415	+ else if (setv_cond (vecp, idx, oldv, DELETED_VAL))
418	416	{
419	417	atomic_add ((atomic_t *)&tabvec_cnt(vecp), intobj (-1));
420	418	// Safe to set the key without atomic ops.

		@@ -570,15 +568,12 @@
570	568	array *np = make_tabvec (interp, 0);
571	569
572	570	lwlock_guard g (&tp->lock);
573		- // Prevent any further insertions.
574		- tp->grow_limit = 0;
575	571
576	572	for (int ix = TABVEC_OVERHEAD; ix < vecp->len; ix += 2)
577	573	{
578	574	vecp->data[ix + 1] = DELETED_VAL \| EXTRA_BIT;
579	575	atomic_mfence_rel ();
580	576	vecp->data[ix + 0] = DELETED_KEY;
581		- atomic_mfence_rel ();
582	577	}
583	578
584	579	#if 0

		@@ -608,7 +603,7 @@
608	603	}
609	604
610	605	table::iterator::iterator (interpreter *interp, object table) :
611		- key (interp, intobj (0)), val (interp, intobj (0)),
	606	+ key (interp, UNBOUND), val (interp, UNBOUND),
612	607	vec (interp, as_table(table)->vector), idx (TABVEC_OVERHEAD)
613	608	{
614	609	this->adv ();

		@@ -616,11 +611,13 @@
616	611
617	612	bool table::iterator::valid ()
618	613	{
619		- return (this->idx < as_array(*this->vec)->len);
	614	+ return (*this->key != UNBOUND);
620	615	}
621	616
622	617	void table::iterator::adv ()
623	618	{
	619	+ *this->key = UNBOUND;
	620	+
624	621	for (array vecp = as_array (this->vec); this->idx < vecp->len; )
625	622	{
626	623	*this->key = vecp->data[idx + 0];

		@@ -699,4 +696,76 @@
699	696	qp_return (*ret);
700	697	}
701	698
	699	+int serialize_u (interpreter interp, stream strm,
	700	+ object obj, serial_info& info)
	701	+{
	702	+ table *tp = as_table (obj);
	703	+ int ret = 0;
	704	+
	705	+ ret += tp->cmpfct == UNBOUND ? strm->putb (interp, SERIAL_NIL) :
	706	+ xserialize (interp, strm, tp->cmpfct, info);
	707	+ ret += tp->hashfct == UNBOUND ? strm->putb (interp, SERIAL_NIL) :
	708	+ xserialize (interp, strm, tp->hashfct, info);
	709	+
	710	+ ret += strm->write (interp, &tp->mv_ratio);
	711	+
	712	+ for (table::iterator it (interp, obj); it.valid (); it.adv ())
	713	+ {
	714	+ ret += xserialize (interp, strm, *it.key, info);
	715	+ ret += xserialize (interp, strm, *it.val, info);
	716	+ }
	717	+
	718	+ ret += strm->putb (interp, SERIAL_END);
	719	+ return (ret);
	720	+}
	721	+
	722	+object deserialize_u (interpreter interp, stream strm, serial_info& info)
	723	+{
	724	+ int tst = strm->peekb (interp);
	725	+ valref e1 (interp, NIL), e2 (interp, NIL);
	726	+
	727	+ if (tst < 0 \|\| (tst != SERIAL_NIL &&
	728	+ (*e1 = xdeserialize (interp, strm, info)) == UNBOUND))
	729	+ qp_return (UNBOUND);
	730	+ else if (tst == SERIAL_NIL)
	731	+ strm->getb (interp);
	732	+
	733	+ tst = strm->peekb (interp);
	734	+ if (tst < 0 \|\| (tst != SERIAL_NIL &&
	735	+ (*e2 = xdeserialize (interp, strm, info)) == UNBOUND))
	736	+ qp_return (UNBOUND);
	737	+ else if (tst == SERIAL_NIL)
	738	+ strm->getb (interp);
	739	+
	740	+ float mv_ratio;
	741	+ if (!strm->sread (interp, &mv_ratio))
	742	+ qp_return (UNBOUND);
	743	+
	744	+ valref ret (interp, alloc_table (interp, 0, e1, e2));
	745	+ table tp = as_table (ret);
	746	+
	747	+ tp->mv_ratio = mv_ratio;
	748	+ tp->grow_limit = (atomic_t)(mv_ratio * as_array(tp->vector)->len);
	749	+
	750	+ if (info.output > 0)
	751	+ info.add_ref (interp, *ret, info.output);
	752	+
	753	+ while (true)
	754	+ {
	755	+ tst = strm->peekb (interp);
	756	+ if (tst == SERIAL_END)
	757	+ {
	758	+ strm->getb (interp);
	759	+ break;
	760	+ }
	761	+ else if ((*e1 = xdeserialize (interp, strm, info)) == UNBOUND \|\|
	762	+ (*e2 = xdeserialize (interp, strm, info)) == UNBOUND)
	763	+ qp_return (UNBOUND);
	764	+
	765	+ table_put_lk (interp, tp, e1, e2);
	766	+ }
	767	+
	768	+ qp_return (*ret);
	769	+}
	770	+
702	771	QP_DECLS_END

diff -r 1ea5839d5b6d -r 6f30387232be table.h

--- a/table.h Tue Jul 17 18:41:09 2018 -0300

+++ b/table.h Fri Oct 12 02:49:16 2018 +0000

		@@ -41,6 +41,7 @@
41	41
42	42	class stream;
43	43	class io_info;
	44	+class serial_info;
44	45
45	46	/* Allocate a table with room for at least SIZE elements,
46	47	* using TST for key lookups and HASHFN to compute the hash codes. */

		@@ -51,7 +52,7 @@
51	52	* return DFL. MTSAFE specifies whether we should use a multi-thread
52	53	* safe routine or not. */
53	54	QP_EXPORT object table_get (interpreter *__interp,
54		- object __tab, object __key, object __dfl, int __mtsafe);
	55	+ object __tab, object __key, object __dfl, bool __mtsafe);
55	56
56	57	/* Associate value VAL to key KEY in table TAB. MTSAFE is used in
57	58	* the same manner as with 'table_get'. Returns true if the key was

		@@ -103,6 +104,13 @@
103	104	QP_EXPORT int write_u (interpreter *__interp,
104	105	stream *__strm, object __obj, io_info& __info);
105	106
	107	+// Serialize a table to a stream.
	108	+QP_EXPORT int serialize_u (interpreter *__interp,
	109	+ stream *__strm, object __obj, serial_info& __info);
	110	+
	111	+QP_EXPORT object deserialize_u (interpreter *__interp,
	112	+ stream *__strm, serial_info& __info);
	113	+
106	114	QP_DECLS_END
107	115
108	116	#endif

diff -r 1ea5839d5b6d -r 6f30387232be tree.cpp

--- a/tree.cpp Tue Jul 17 18:41:09 2018 -0300

+++ b/tree.cpp Fri Oct 12 02:49:16 2018 +0000

		@@ -281,7 +281,7 @@
281	281	}
282	282	}
283	283
284		- return (d == 0 ? node_key (ap.item) : UNBOUND);
	284	+ return (d == 0 && ap.item != UNBOUND ? node_key (ap.item) : UNBOUND);
285	285	}
286	286
287	287	static object

		@@ -342,6 +342,7 @@
342	342	{
343	343	ap.l_preds = ap.l_succs = nullptr;
344	344	find_preds_mt (interp, tp, ap, 0, key, UNLINK_FORCE);
	345	+ return (false);
345	346	}
346	347
347	348	atomic_add (&tp->cnt, 1);

		@@ -384,9 +385,7 @@
384	385	}
385	386
386	387	#define tree_args_init(interp, array, name, sp, prd, scc) \
387		- (array).type = typecode::ARRAY; \
388		- (array).data = sp; \
389		- (array).len = QP_NELEM (sp); \
	388	+ (array).local_init (sp, QP_NELEM (sp)); \
390	389	\
391	390	tree_args name (sp, prd, scc); \
392	391	valref tmp (interp, (array).as_obj ())

		@@ -444,7 +443,7 @@
444	443	{
445	444	bool ret = (val == NIL ? tree_del : tree_put)
446	445	(interp, tr, key, !singlethr_p ());
447		- qp_return (ret ? QP_S(t) : NIL);
	446	+ qp_return (ret ? symbol::t : NIL);
448	447	}
449	448
450	449	uint32_t len_o (interpreter *, object tr)

		@@ -497,6 +496,62 @@
497	496	return (ret);
498	497	}
499	498
	499	+int serialize_o (interpreter interp, stream strm,
	500	+ object obj, serial_info& info)
	501	+{
	502	+ tree *tp = as_tree (obj);
	503	+ int ret = 0;
	504	+
	505	+ ret += tp->test == UNBOUND ? strm->putb (interp, SERIAL_NIL) :
	506	+ xserialize (interp, strm, tp->test, info);
	507	+
	508	+ ret += strm->write (interp, &tp->hi_water);
	509	+
	510	+ for (tree::iterator it (interp, obj); it.valid (); it.adv ())
	511	+ ret += xserialize (interp, strm, it.get_key (), info);
	512	+
	513	+ ret += strm->putb (interp, SERIAL_END);
	514	+ return (ret);
	515	+}
	516	+
	517	+object deserialize_o (interpreter interp, stream strm, serial_info& info)
	518	+{
	519	+ int tst = strm->peekb (interp);
	520	+ valref tmp (interp, NIL);
	521	+
	522	+ if (tst < 0 \|\| (tst != SERIAL_NIL &&
	523	+ (*tmp = xdeserialize (interp, strm, info)) == UNBOUND))
	524	+ qp_return (UNBOUND);
	525	+ else if (tst == SERIAL_NIL)
	526	+ strm->getb (interp);
	527	+
	528	+ atomic_t hw;
	529	+
	530	+ if (!strm->sread (interp, &hw))
	531	+ qp_return (UNBOUND);
	532	+
	533	+ valref ret (interp, alloc_tree (interp, *tmp));
	534	+ as_tree(*ret)->hi_water = hw;
	535	+
	536	+ if (info.output > 0)
	537	+ info.add_ref (interp, *ret, info.output);
	538	+
	539	+ while (true)
	540	+ {
	541	+ if (strm->peekb (interp) == SERIAL_END)
	542	+ {
	543	+ strm->getb (interp);
	544	+ break;
	545	+ }
	546	+ else if ((*tmp = xdeserialize (interp, strm, info)) == UNBOUND)
	547	+ qp_return (*tmp);
	548	+
	549	+ tree_put (interp, ret, tmp, false);
	550	+ }
	551	+
	552	+ qp_return (*ret);
	553	+}
	554	+
500	555	static const uint32_t TREE_HASH_SEED = 1701147252;
501	556
502	557	uint32_t hash_o (interpreter *interp, object obj)

		@@ -539,9 +594,7 @@
539	594	tree_args args (space, 1, 1); \
540	595	local_varobj<array> arr; \
541	596	\
542		- arr.data = space; \
543		- arr.len = QP_NELEM (space); \
544		- arr.type = typecode::ARRAY; \
	597	+ arr.local_init (space, QP_NELEM (space)); \
545	598	arr.data[arr.len - 1] = ret->as_obj (); \
546	599	\
547	600	tree::iterator it1 (interp, t1); \

diff -r 1ea5839d5b6d -r 6f30387232be tree.h

--- a/tree.h Tue Jul 17 18:41:09 2018 -0300

+++ b/tree.h Fri Oct 12 02:49:16 2018 +0000

		@@ -38,6 +38,7 @@
38	38
39	39	class stream;
40	40	class io_info;
	41	+class serial_info;
41	42
42	43	QP_EXPORT object alloc_tree (interpreter *__interp, object __tst);
43	44

		@@ -63,6 +64,12 @@
63	64	QP_EXPORT int write_o (interpreter *__interp,
64	65	stream *__strm, object __tree, io_info& __info);
65	66
	67	+QP_EXPORT int serialize_o (interpreter *__interp,
	68	+ stream *__strm, object __obj, serial_info& __info);
	69	+
	70	+QP_EXPORT object deserialize_o (interpreter *__interp,
	71	+ stream *__strm, serial_info& __info);
	72	+
66	73	QP_EXPORT object copy_o (interpreter *__interp, object __obj, bool __deep);
67	74
68	75	QP_EXPORT void tree_clr (interpreter *__interp, object __tree);

diff -r 1ea5839d5b6d -r 6f30387232be utils/lstack.h

--- a/utils/lstack.h Tue Jul 17 18:41:09 2018 -0300

+++ /dev/null Thu Jan 01 00:00:00 1970 +0000

		@@ -1,60 +0,0 @@
1		-#ifndef __QP_UTILS_LSTACK__
2		-#define __QP_UTILS_LSTACK__ 1
3		-
4		-#include "../interp.h"
5		-
6		-QP_DECLS_BEGIN
7		-
8		-// A 'locals' cache to speed up the LOADAP/SETAP operations.
9		-class locals_stack
10		-{
11		-public:
12		- static const int NELEM = 16;
13		- object *plocals[NELEM];
14		- unsigned int n = 0;
15		- object *prev;
16		- uint32_t size;
17		- interp_hook hook;
18		-
19		- void set_top (object *lp, int idx)
20		- {
21		- if (idx < NELEM)
22		- this->plocals[idx] = lp;
23		- }
24		-
25		- void push (object *lp)
26		- {
27		- this->set_top (lp, this->n++);
28		- }
29		-
30		- void pop (object *lp)
31		- {
32		- this->set_top (lp, --this->n - 1);
33		- }
34		-
35		- static void
36		- lstack_cb (interpreter interp, void arg)
37		- {
38		- locals_stack self = (locals_stack )arg;
39		- for (unsigned int i = 0; i < self->n; ++i)
40		- {
41		- object *lp = self->plocals[i];
42		- if (lp < self->prev \|\| lp >= self->prev + self->size)
43		- continue;
44		-
45		- self->plocals[i] = interp->stack + (lp - self->prev);
46		- }
47		- }
48		-
49		- locals_stack (interpreter *interp) : prev (interp->stack),
50		- size (interp->stkdiff ()), hook (HOOK_TYPE_STKMOV, lstack_cb, this)
51		- {
52		- this->hook.attach (interp);
53		- for (int i = 0; i < NELEM; ++i)
54		- this->plocals[i] = nullptr;
55		- }
56		-};
57		-
58		-QP_DECLS_END
59		-
60		-#endif

diff -r 1ea5839d5b6d -r 6f30387232be utils/opnames

--- a/utils/opnames Tue Jul 17 18:41:09 2018 -0300

+++ b/utils/opnames Fri Oct 12 02:49:16 2018 +0000

		@@ -88,3 +88,7 @@
88	88	brbound.l 1 long
89	89	kwargs 3 0
90	90	kwargs.l 3 long
	91	+jmpt 1 branch
	92	+jmpt.l 1 branch,long
	93	+jmpn 1 branch
	94	+jmpn.l 1 branch,long

diff -r 1ea5839d5b6d -r 6f30387232be utils/raw_acc.h

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/utils/raw_acc.h Fri Oct 12 02:49:16 2018 +0000

		@@ -0,0 +1,76 @@
	1	+#ifndef __UTILS_RAW_ACC_H__
	2	+#define __UTILS_RAW_ACC_H__ 1
	3	+
	4	+#include "../memory.h"
	5	+
	6	+QP_DECLS_BEGIN
	7	+
	8	+template <class T>
	9	+class raw_acc
	10	+{
	11	+public:
	12	+ T *ptr = nullptr;
	13	+ uint32_t alloc = 0;
	14	+
	15	+ raw_acc (uint32_t isz = 0)
	16	+ {
	17	+ this->ptr = T::alloc_raw (this->alloc = upsize (isz));
	18	+ this->ptr->init_vo ();
	19	+ this->ptr->len_ref() = 0;
	20	+ }
	21	+
	22	+ void expand (uint32_t size)
	23	+ {
	24	+ if (size < this->alloc)
	25	+ return;
	26	+
	27	+ T *tmp = T::alloc_raw (this->alloc = upsize (size + 1));
	28	+
	29	+ tmp->len_ref() = this->ptr->len_ref ();
	30	+ memcpy (tmp->data_ptr (), this->ptr->data_ptr (),
	31	+ tmp->len_ref () * sizeof (*tmp->data_ptr ()));
	32	+
	33	+ xfree (this->ptr);
	34	+ this->ptr = tmp;
	35	+ }
	36	+
	37	+ void add_data (const void *data, uint32_t size)
	38	+ {
	39	+ expand (this->ptr->len_ref () + size);
	40	+ memcpy ((char *)this->ptr->data_ptr () +
	41	+ this->ptr->len_ref (), data, size);
	42	+ this->ptr->len_ref() += size;
	43	+ }
	44	+
	45	+ void add_obj (object obj)
	46	+ {
	47	+ expand (this->ptr->len_ref () + 1);
	48	+ ((object *)this->ptr->data_ptr ())[this->ptr->len_ref()++] = obj;
	49	+ }
	50	+
	51	+ object as_obj () const
	52	+ {
	53	+ return (this->ptr->as_obj ());
	54	+ }
	55	+
	56	+ T* get ()
	57	+ {
	58	+ return (this->ptr);
	59	+ }
	60	+
	61	+ T* release ()
	62	+ {
	63	+ T *ret = this->ptr;
	64	+ this->ptr = nullptr;
	65	+ return (ret);
	66	+ }
	67	+
	68	+ ~raw_acc ()
	69	+ {
	70	+ xfree (this->ptr);
	71	+ }
	72	+};
	73	+
	74	+QP_DECLS_END
	75	+
	76	+#endif

diff -r 1ea5839d5b6d -r 6f30387232be utils/sorted_list.h

--- a/utils/sorted_list.h Tue Jul 17 18:41:09 2018 -0300

+++ b/utils/sorted_list.h Fri Oct 12 02:49:16 2018 +0000

		@@ -62,11 +62,11 @@
62	62
63	63	sorted_list_base ()
64	64	{
65		- root.key = root.val = 0;
66		- root.prev = root.next = &root;
	65	+ this->root.key = this->root.val = 0;
	66	+ this->root.prev = this->root.next = &this->root;
67	67	}
68	68
69		- void insert (node *pos, intptr_t key, intptr_t val)
	69	+ node* insert (node *pos, intptr_t key, intptr_t val)
70	70	{
71	71	node tmp = (node )xmalloc (sizeof (*tmp));
72	72	tmp->key = key, tmp->val = val;

		@@ -77,6 +77,12 @@
77	77	pos->next = tmp;
78	78
79	79	++this->root.key;
	80	+ return (tmp);
	81	+ }
	82	+
	83	+ void add_end (intptr_t key, intptr_t val)
	84	+ {
	85	+ this->insert (this->root.prev, key, val);
80	86	}
81	87
82	88	void erase (node *pos)

		@@ -86,7 +92,24 @@
86	92	--this->root.key;
87	93	xfree (pos);
88	94	}
89		-
	95	+
	96	+ void swap (sorted_list_base& sl)
	97	+ {
	98	+ auto adj = this->root.prev;
	99	+ adj->next = adj->prev = &sl.root;
	100	+
	101	+ adj = sl.root.prev;
	102	+ adj->next = adj->prev = &this->root;
	103	+
	104	+ auto tmp = this->root;
	105	+ this->root = sl.root, sl.root = tmp;
	106	+ }
	107	+
	108	+ uint32_t len () const
	109	+ {
	110	+ return ((uint32_t)this->root.key);
	111	+ }
	112	+
90	113	~sorted_list_base ()
91	114	{
92	115	for (node *runp = this->root.next; runp != &this->root; )

		@@ -95,6 +118,9 @@
95	118	xfree (runp);
96	119	runp = tmp;
97	120	}
	121	+
	122	+ this->root.prev = this->root.next = &this->root;
	123	+ this->root.key = 0;
98	124	}
99	125	};
100	126

		@@ -103,6 +129,21 @@
103	129	{
104	130	public:
105	131	Cmp cmp;
	132	+
	133	+ node* add (intptr_t key)
	134	+ {
	135	+ node *runp;
	136	+ for (runp = this->root.next; runp != &this->root; runp = runp->next)
	137	+ {
	138	+ int c = this->cmp (runp->key, key);
	139	+ if (c == 0)
	140	+ return (runp);
	141	+ else if (c > 0)
	142	+ break;
	143	+ }
	144	+
	145	+ return (this->insert (runp->prev, key, -1));
	146	+ }
106	147
107	148	bool add (intptr_t key, intptr_t val)
108	149	{

旧リポジトリブラウザで表示

quipu Fork

quipu: コミット

コミットメタ情報

ログメッセージ

変更サマリ

差分

quipu
Fork