plan9-archive/lua

src/Makefile+6−2

 	lcode.o \
 	ldebug.o \
 	ldo.o \
+	ldump.o \
 	lfunc.o \
 	lgc.o \
 	llex.o \
 	lmem.o \
 	lobject.o \
+	lopcodes.o \
 	lparser.o \
 	lstate.o \
 	lstring.o \
 	lcode.c \
 	ldebug.c \
 	ldo.c \
+	ldump.c \
 	lfunc.c \
 	lgc.c \
 	llex.c \
 	lmem.c \
 	lobject.c \
+	lopcodes.c \
 	lparser.c \
 	lstate.c \
 	lstring.c \
 T= $(LIB)/liblua.a
-all: $T
+all:	$T
-$T: $(OBJS)
+$T:	$(OBJS)
 	$(AR) $@ $(OBJS)
 	$(RANLIB) $@

src/README+5−0

@@ -0,0 +1,5 @@
	1	This is the Lua core.
	2
	3	The standard Lua library are in lib/.
	4	A sample interpreter is in lua/.
	5	A standalone compiler is in luac/.

src/lapi.c+664−236

@@ -1,15 +1,19 @@
1	/*	1	/*
2	** $Id: lapi.c,v 1.110a 2000/10/30 12:50:09 roberto Exp $	2	** $Id: lapi.c,v 1.235 2003/04/07 14:36:08 roberto Exp $
3	** Lua API	3	** Lua API
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
		8	#include <assert.h>
8	#include <string.h>	9	#include <string.h>
9		10
		11	#define lapi_c
		12
10	#include "lua.h"	13	#include "lua.h"
11		14
12	#include "lapi.h"	15	#include "lapi.h"
		16	#include "ldebug.h"
13	#include "ldo.h"	17	#include "ldo.h"
14	#include "lfunc.h"	18	#include "lfunc.h"
15	#include "lgc.h"	19	#include "lgc.h"
@@ -19,43 +23,128 @@ · 3 unmodified lines
19	#include "lstring.h"	23	#include "lstring.h"
20	#include "ltable.h"	24	#include "ltable.h"
21	#include "ltm.h"	25	#include "ltm.h"
		26	#include "lundump.h"
22	#include "lvm.h"	27	#include "lvm.h"
23		28
24		29
25	const char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"	30	const char lua_ident[] =
26	"$Authors: " LUA_AUTHORS " $";	31	"$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"
		32	"$Authors: " LUA_AUTHORS " $\n"
		33	"$URL: www.lua.org $\n";
		34
27		35
28		36
		37	#ifndef api_check
		38	#define api_check(L, o) /{ assert(o); }/
		39	#endif
29		40
30	#define Index(L,i) ((i) >= 0 ? (L->Cbase+((i)-1)) : (L->top+(i)))	41	#define api_checknelems(L, n) api_check(L, (n) <= (L->top - L->base))
31		42
32	#define api_incr_top(L) incr_top	43	#define api_incr_top(L) {api_check(L, L->top < L->ci->top); L->top++;}
33		44
34		45
35		46
36		47
37	TObject luaA_index (lua_State L, int index) {	48	static TObject negindex (lua_State L, int idx) {
38	return Index(L, index);	49	if (idx > LUA_REGISTRYINDEX) {
		50	api_check(L, idx != 0 && -idx <= L->top - L->base);
		51	return L->top+idx;
		52	}
		53	else switch (idx) { /* pseudo-indices */
		54	case LUA_REGISTRYINDEX: return registry(L);
		55	case LUA_GLOBALSINDEX: return gt(L);
		56	default: {
		57	TObject *func = (L->base - 1);
		58	idx = LUA_GLOBALSINDEX - idx;
		59	lua_assert(iscfunction(func));
		60	return (idx <= clvalue(func)->c.nupvalues)
		61	? &clvalue(func)->c.upvalue[idx-1]
		62	: NULL;
		63	}
		64	}
		65	}
		66
		67
		68	static TObject luaA_index (lua_State L, int idx) {
		69	if (idx > 0) {
		70	api_check(L, idx <= L->top - L->base);
		71	return L->base + idx - 1;
		72	}
		73	else {
		74	TObject *o = negindex(L, idx);
		75	api_check(L, o != NULL);
		76	return o;
		77	}
39	}	78	}
40		79
41		80
42	static TObject luaA_indexAcceptable (lua_State L, int index) {	81	static TObject luaA_indexAcceptable (lua_State L, int idx) {
43	if (index >= 0) {	82	if (idx > 0) {
44	TObject *o = L->Cbase+(index-1);	83	TObject *o = L->base+(idx-1);
		84	api_check(L, idx <= L->stack_last - L->base);
45	if (o >= L->top) return NULL;	85	if (o >= L->top) return NULL;
46	else return o;	86	else return o;
47	}	87	}
48	else return L->top+index;	88	else
		89	return negindex(L, idx);
49	}	90	}
50		91
51		92
52	void luaA_pushobject (lua_State L, const TObject o) {	93	void luaA_pushobject (lua_State L, const TObject o) {
53	L->top = o;	94	setobj2s(L->top, o);
54	incr_top;	95	incr_top(L);
		96	}
		97
		98
		99	LUA_API int lua_checkstack (lua_State *L, int size) {
		100	int res;
		101	lua_lock(L);
		102	if ((L->top - L->base + size) > LUA_MAXCSTACK)
		103	res = 0; /* stack overflow */
		104	else {
		105	luaD_checkstack(L, size);
		106	if (L->ci->top < L->top + size)
		107	L->ci->top = L->top + size;
		108	res = 1;
		109	}
		110	lua_unlock(L);
		111	return res;
55	}	112	}
56		113
57	LUA_API int lua_stackspace (lua_State *L) {	114
58	return (L->stack_last - L->top);	115	LUA_API void lua_xmove (lua_State from, lua_State to, int n) {
		116	int i;
		117	lua_lock(to);
		118	api_checknelems(from, n);
		119	from->top -= n;
		120	for (i = 0; i < n; i++) {
		121	setobj2s(to->top, from->top + i);
		122	api_incr_top(to);
		123	}
		124	lua_unlock(to);
		125	}
		126
		127
		128	LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {
		129	lua_CFunction old;
		130	lua_lock(L);
		131	old = G(L)->panic;
		132	G(L)->panic = panicf;
		133	lua_unlock(L);
		134	return old;
		135	}
		136
		137
		138	LUA_API lua_State lua_newthread (lua_State L) {
		139	lua_State *L1;
		140	lua_lock(L);
		141	luaC_checkGC(L);
		142	L1 = luaE_newthread(L);
		143	setthvalue(L->top, L1);
		144	api_incr_top(L);
		145	lua_unlock(L);
		146	lua_userstateopen(L1);
		147	return L1;
59	}	148	}
60		149
61		150
@@ -66,37 +155,61 @@ LUA_API int lua_stackspace (lua_State *L) { · 4 unmodified lines
66		155
67		156
68	LUA_API int lua_gettop (lua_State *L) {	157	LUA_API int lua_gettop (lua_State *L) {
69	return (L->top - L->Cbase);	158	return (L->top - L->base);
70	}	159	}
71		160
72		161
73	LUA_API void lua_settop (lua_State *L, int index) {	162	LUA_API void lua_settop (lua_State *L, int idx) {
74	if (index >= 0)	163	lua_lock(L);
75	luaD_adjusttop(L, L->Cbase, index);	164	if (idx >= 0) {
76	else	165	api_check(L, idx <= L->stack_last - L->base);
77	L->top = L->top+index+1; /* index is negative */	166	while (L->top < L->base + idx)
		167	setnilvalue(L->top++);
		168	L->top = L->base + idx;
		169	}
		170	else {
		171	api_check(L, -(idx+1) <= (L->top - L->base));
		172	L->top += idx+1; /* `subtract' index (index is negative) */
		173	}
		174	lua_unlock(L);
78	}	175	}
79		176
80		177
81	LUA_API void lua_remove (lua_State *L, int index) {	178	LUA_API void lua_remove (lua_State *L, int idx) {
82	StkId p = luaA_index(L, index);	179	StkId p;
83	while (++p < L->top) (p-1) = p;	180	lua_lock(L);
		181	p = luaA_index(L, idx);
		182	while (++p < L->top) setobjs2s(p-1, p);
84	L->top--;	183	L->top--;
		184	lua_unlock(L);
85	}	185	}
86		186
87		187
88	LUA_API void lua_insert (lua_State *L, int index) {	188	LUA_API void lua_insert (lua_State *L, int idx) {
89	StkId p = luaA_index(L, index);	189	StkId p;
90	StkId q;	190	StkId q;
91	for (q = L->top; q>p; q--)	191	lua_lock(L);
92	q = (q-1);	192	p = luaA_index(L, idx);
93	p = L->top;	193	for (q = L->top; q>p; q--) setobjs2s(q, q-1);
		194	setobjs2s(p, L->top);
		195	lua_unlock(L);
94	}	196	}
95		197
96		198
97	LUA_API void lua_pushvalue (lua_State *L, int index) {	199	LUA_API void lua_replace (lua_State *L, int idx) {
98	L->top = luaA_index(L, index);	200	lua_lock(L);
		201	api_checknelems(L, 1);
		202	setobj(luaA_index(L, idx), L->top - 1); /* write barrier */
		203	L->top--;
		204	lua_unlock(L);
		205	}
		206
		207
		208	LUA_API void lua_pushvalue (lua_State *L, int idx) {
		209	lua_lock(L);
		210	setobj2s(L->top, luaA_index(L, idx));
99	api_incr_top(L);	211	api_incr_top(L);
		212	lua_unlock(L);
100	}	213	}
101		214
102		215
@@ -106,93 +219,167 @@ LUA_API void lua_pushvalue (lua_State *L, int index) { · 3 unmodified lines
106	*/	219	*/
107		220
108		221
109	LUA_API int lua_type (lua_State *L, int index) {	222	LUA_API int lua_type (lua_State *L, int idx) {
110	StkId o = luaA_indexAcceptable(L, index);	223	StkId o = luaA_indexAcceptable(L, idx);
111	return (o == NULL) ? LUA_TNONE : ttype(o);	224	return (o == NULL) ? LUA_TNONE : ttype(o);
112	}	225	}
113		226
		227
114	LUA_API const char lua_typename (lua_State L, int t) {	228	LUA_API const char lua_typename (lua_State L, int t) {
115	UNUSED(L);	229	UNUSED(L);
116	return (t == LUA_TNONE) ? "no value" : luaO_typenames[t];	230	return (t == LUA_TNONE) ? "no value" : luaT_typenames[t];
117	}	231	}
118		232
119		233
120	LUA_API int lua_iscfunction (lua_State *L, int index) {	234	LUA_API int lua_iscfunction (lua_State *L, int idx) {
121	StkId o = luaA_indexAcceptable(L, index);	235	StkId o = luaA_indexAcceptable(L, idx);
122	return (o == NULL) ? 0 : iscfunction(o);	236	return (o == NULL) ? 0 : iscfunction(o);
123	}	237	}
124		238
125	LUA_API int lua_isnumber (lua_State *L, int index) {	239
126	TObject *o = luaA_indexAcceptable(L, index);	240	LUA_API int lua_isnumber (lua_State *L, int idx) {
127	return (o == NULL) ? 0 : (tonumber(o) == 0);	241	TObject n;
		242	const TObject *o = luaA_indexAcceptable(L, idx);
		243	return (o != NULL && tonumber(o, &n));
128	}	244	}
129		245
130	LUA_API int lua_isstring (lua_State *L, int index) {	246
131	int t = lua_type(L, index);	247	LUA_API int lua_isstring (lua_State *L, int idx) {
		248	int t = lua_type(L, idx);
132	return (t == LUA_TSTRING \|\| t == LUA_TNUMBER);	249	return (t == LUA_TSTRING \|\| t == LUA_TNUMBER);
133	}	250	}
134		251
135		252
136	LUA_API int lua_tag (lua_State *L, int index) {	253	LUA_API int lua_isuserdata (lua_State *L, int idx) {
137	StkId o = luaA_indexAcceptable(L, index);	254	const TObject *o = luaA_indexAcceptable(L, idx);
138	return (o == NULL) ? LUA_NOTAG : luaT_tag(o);	255	return (o != NULL && (ttisuserdata(o) \|\| ttislightuserdata(o)));
139	}	256	}
140		257
141	LUA_API int lua_equal (lua_State *L, int index1, int index2) {	258
		259	LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {
142	StkId o1 = luaA_indexAcceptable(L, index1);	260	StkId o1 = luaA_indexAcceptable(L, index1);
143	StkId o2 = luaA_indexAcceptable(L, index2);	261	StkId o2 = luaA_indexAcceptable(L, index2);
144	if (o1 == NULL \|\| o2 == NULL) return 0; /* index out-of-range */	262	return (o1 == NULL \|\| o2 == NULL) ? 0 /* index out of range */
145	else return luaO_equalObj(o1, o2);	263	: luaO_rawequalObj(o1, o2);
		264	}
		265
		266
		267	LUA_API int lua_equal (lua_State *L, int index1, int index2) {
		268	StkId o1, o2;
		269	int i;
		270	lua_lock(L); /* may call tag method */
		271	o1 = luaA_indexAcceptable(L, index1);
		272	o2 = luaA_indexAcceptable(L, index2);
		273	i = (o1 == NULL \|\| o2 == NULL) ? 0 /* index out of range */
		274	: equalobj(L, o1, o2);
		275	lua_unlock(L);
		276	return i;
146	}	277	}
147		278
		279
148	LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {	280	LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {
149	StkId o1 = luaA_indexAcceptable(L, index1);	281	StkId o1, o2;
150	StkId o2 = luaA_indexAcceptable(L, index2);	282	int i;
151	if (o1 == NULL \|\| o2 == NULL) return 0; /* index out-of-range */	283	lua_lock(L); /* may call tag method */
152	else return luaV_lessthan(L, o1, o2, L->top);	284	o1 = luaA_indexAcceptable(L, index1);
		285	o2 = luaA_indexAcceptable(L, index2);
		286	i = (o1 == NULL \|\| o2 == NULL) ? 0 /* index out-of-range */
		287	: luaV_lessthan(L, o1, o2);
		288	lua_unlock(L);
		289	return i;
153	}	290	}
154		291
155		292
156		293
157	LUA_API double lua_tonumber (lua_State *L, int index) {	294	LUA_API lua_Number lua_tonumber (lua_State *L, int idx) {
158	StkId o = luaA_indexAcceptable(L, index);	295	TObject n;
159	return (o == NULL \|\| tonumber(o)) ? 0 : nvalue(o);	296	const TObject *o = luaA_indexAcceptable(L, idx);
		297	if (o != NULL && tonumber(o, &n))
		298	return nvalue(o);
		299	else
		300	return 0;
160	}	301	}
161		302
162	LUA_API const char lua_tostring (lua_State L, int index) {	303
163	StkId o = luaA_indexAcceptable(L, index);	304	LUA_API int lua_toboolean (lua_State *L, int idx) {
164	return (o == NULL \|\| tostring(L, o)) ? NULL : svalue(o);	305	const TObject *o = luaA_indexAcceptable(L, idx);
		306	return (o != NULL) && !l_isfalse(o);
165	}	307	}
166		308
167	LUA_API size_t lua_strlen (lua_State *L, int index) {	309
168	StkId o = luaA_indexAcceptable(L, index);	310	LUA_API const char lua_tostring (lua_State L, int idx) {
169	return (o == NULL \|\| tostring(L, o)) ? 0 : tsvalue(o)->len;	311	StkId o = luaA_indexAcceptable(L, idx);
		312	if (o == NULL)
		313	return NULL;
		314	else if (ttisstring(o))
		315	return svalue(o);
		316	else {
		317	const char *s;
		318	lua_lock(L); /* `luaV_tostring' may create a new string */
		319	s = (luaV_tostring(L, o) ? svalue(o) : NULL);
		320	luaC_checkGC(L);
		321	lua_unlock(L);
		322	return s;
		323	}
170	}	324	}
171		325
172	LUA_API lua_CFunction lua_tocfunction (lua_State *L, int index) {	326
173	StkId o = luaA_indexAcceptable(L, index);	327	LUA_API size_t lua_strlen (lua_State *L, int idx) {
174	return (o == NULL \|\| !iscfunction(o)) ? NULL : clvalue(o)->f.c;	328	StkId o = luaA_indexAcceptable(L, idx);
		329	if (o == NULL)
		330	return 0;
		331	else if (ttisstring(o))
		332	return tsvalue(o)->tsv.len;
		333	else {
		334	size_t l;
		335	lua_lock(L); /* `luaV_tostring' may create a new string */
		336	l = (luaV_tostring(L, o) ? tsvalue(o)->tsv.len : 0);
		337	lua_unlock(L);
		338	return l;
		339	}
175	}	340	}
176		341
177	LUA_API void lua_touserdata (lua_State L, int index) {	342
178	StkId o = luaA_indexAcceptable(L, index);	343	LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {
179	return (o == NULL \|\| ttype(o) != LUA_TUSERDATA) ? NULL :	344	StkId o = luaA_indexAcceptable(L, idx);
180	tsvalue(o)->u.d.value;	345	return (o == NULL \|\| !iscfunction(o)) ? NULL : clvalue(o)->c.f;
181	}	346	}
182		347
183	LUA_API const void lua_topointer (lua_State L, int index) {	348
184	StkId o = luaA_indexAcceptable(L, index);	349	LUA_API void lua_touserdata (lua_State L, int idx) {
		350	StkId o = luaA_indexAcceptable(L, idx);
185	if (o == NULL) return NULL;	351	if (o == NULL) return NULL;
186	switch (ttype(o)) {	352	switch (ttype(o)) {
187	case LUA_TTABLE:	353	case LUA_TUSERDATA: return (uvalue(o) + 1);
188	return hvalue(o);	354	case LUA_TLIGHTUSERDATA: return pvalue(o);
189	case LUA_TFUNCTION:
190	return clvalue(o);
191	default: return NULL;	355	default: return NULL;
192	}	356	}
193	}	357	}
194		358
195		359
		360	LUA_API lua_State lua_tothread (lua_State L, int idx) {
		361	StkId o = luaA_indexAcceptable(L, idx);
		362	return (o == NULL \|\| !ttisthread(o)) ? NULL : thvalue(o);
		363	}
		364
		365
		366	LUA_API const void lua_topointer (lua_State L, int idx) {
		367	StkId o = luaA_indexAcceptable(L, idx);
		368	if (o == NULL) return NULL;
		369	else {
		370	switch (ttype(o)) {
		371	case LUA_TTABLE: return hvalue(o);
		372	case LUA_TFUNCTION: return clvalue(o);
		373	case LUA_TTHREAD: return thvalue(o);
		374	case LUA_TUSERDATA:
		375	case LUA_TLIGHTUSERDATA:
		376	return lua_touserdata(L, idx);
		377	default: return NULL;
		378	}
		379	}
		380	}
		381
		382
196		383
197	/*	384	/*
198	** push functions (C -> stack)	385	** push functions (C -> stack)
@@ -200,22 +387,27 @@ LUA_API const void lua_topointer (lua_State L, int index) { · 1 unmodified line
200		387
201		388
202	LUA_API void lua_pushnil (lua_State *L) {	389	LUA_API void lua_pushnil (lua_State *L) {
203	ttype(L->top) = LUA_TNIL;	390	lua_lock(L);
		391	setnilvalue(L->top);
204	api_incr_top(L);	392	api_incr_top(L);
		393	lua_unlock(L);
205	}	394	}
206		395
207		396
208	LUA_API void lua_pushnumber (lua_State *L, double n) {	397	LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {
209	nvalue(L->top) = n;	398	lua_lock(L);
210	ttype(L->top) = LUA_TNUMBER;	399	setnvalue(L->top, n);
211	api_incr_top(L);	400	api_incr_top(L);
		401	lua_unlock(L);
212	}	402	}
213		403
214		404
215	LUA_API void lua_pushlstring (lua_State L, const char s, size_t len) {	405	LUA_API void lua_pushlstring (lua_State L, const char s, size_t len) {
216	tsvalue(L->top) = luaS_newlstr(L, s, len);	406	lua_lock(L);
217	ttype(L->top) = LUA_TSTRING;	407	luaC_checkGC(L);
		408	setsvalue2s(L->top, luaS_newlstr(L, s, len));
218	api_incr_top(L);	409	api_incr_top(L);
		410	lua_unlock(L);
219	}	411	}
220		412
221		413
@@ -227,159 +419,338 @@ LUA_API void lua_pushstring (lua_State L, const char s) { · 5 unmodified lines
227	}	419	}
228		420
229		421
230	LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {	422	LUA_API const char lua_pushvfstring (lua_State L, const char *fmt,
231	luaV_Cclosure(L, fn, n);	423	va_list argp) {
		424	const char *ret;
		425	lua_lock(L);
		426	luaC_checkGC(L);
		427	ret = luaO_pushvfstring(L, fmt, argp);
		428	lua_unlock(L);
		429	return ret;
232	}	430	}
233		431
234		432
235	LUA_API void lua_pushusertag (lua_State L, void u, int tag) {	433	LUA_API const char lua_pushfstring (lua_State L, const char *fmt, ...) {
236	/* ORDER LUA_T */	434	const char *ret;
237	if (!(tag == LUA_ANYTAG \|\| tag == LUA_TUSERDATA \|\| validtag(tag)))	435	va_list argp;
238	luaO_verror(L, "invalid tag for a userdata (%d)", tag);	436	lua_lock(L);
239	tsvalue(L->top) = luaS_createudata(L, u, tag);	437	luaC_checkGC(L);
240	ttype(L->top) = LUA_TUSERDATA;	438	va_start(argp, fmt);
241	api_incr_top(L);	439	ret = luaO_pushvfstring(L, fmt, argp);
		440	va_end(argp);
		441	lua_unlock(L);
		442	return ret;
242	}	443	}
243		444
244		445
245		446	LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
246	/*	447	Closure *cl;
247	** get functions (Lua -> stack)	448	lua_lock(L);
248	*/	449	luaC_checkGC(L);
		450	api_checknelems(L, n);
		451	cl = luaF_newCclosure(L, n);
		452	cl->c.f = fn;
		453	L->top -= n;
		454	while (n--)
		455	setobj2n(&cl->c.upvalue[n], L->top+n);
		456	setclvalue(L->top, cl);
		457	api_incr_top(L);
		458	lua_unlock(L);
		459	}
249		460
250		461
251	LUA_API void lua_getglobal (lua_State L, const char name) {	462	LUA_API void lua_pushboolean (lua_State *L, int b) {
252	StkId top = L->top;	463	lua_lock(L);
253	top = luaV_getglobal(L, luaS_new(L, name));	464	setbvalue(L->top, (b != 0)); /* ensure that true is 1 */
254	L->top = top;
255	api_incr_top(L);	465	api_incr_top(L);
		466	lua_unlock(L);
256	}	467	}
257		468
258		469
259	LUA_API void lua_gettable (lua_State *L, int index) {	470	LUA_API void lua_pushlightuserdata (lua_State L, void p) {
260	StkId t = Index(L, index);	471	lua_lock(L);
261	StkId top = L->top;	472	setpvalue(L->top, p);
262	(top-1) = luaV_gettable(L, t);	473	api_incr_top(L);
263	L->top = top; /* tag method may change top */	474	lua_unlock(L);
264	}	475	}
265		476
266		477
267	LUA_API void lua_rawget (lua_State *L, int index) {
268	StkId t = Index(L, index);
269	LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected");
270	(L->top - 1) = luaH_get(L, hvalue(t), L->top - 1);
271	}
272		478
		479	/*
		480	** get functions (Lua -> stack)
		481	*/
273		482
274	LUA_API void lua_rawgeti (lua_State *L, int index, int n) {	483
275	StkId o = Index(L, index);	484	LUA_API void lua_gettable (lua_State *L, int idx) {
276	LUA_ASSERT(ttype(o) == LUA_TTABLE, "table expected");	485	StkId t;
277	L->top = luaH_getnum(hvalue(o), n);	486	lua_lock(L);
278	api_incr_top(L);	487	t = luaA_index(L, idx);
		488	setobj2s(L->top - 1, luaV_gettable(L, t, L->top - 1, 0));
		489	lua_unlock(L);
279	}	490	}
280		491
281		492
282	LUA_API void lua_getglobals (lua_State *L) {	493	LUA_API void lua_rawget (lua_State *L, int idx) {
283	hvalue(L->top) = L->gt;	494	StkId t;
284	ttype(L->top) = LUA_TTABLE;	495	lua_lock(L);
285	api_incr_top(L);	496	t = luaA_index(L, idx);
		497	api_check(L, ttistable(t));
		498	setobj2s(L->top - 1, luaH_get(hvalue(t), L->top - 1));
		499	lua_unlock(L);
286	}	500	}
287		501
288		502
289	LUA_API int lua_getref (lua_State *L, int ref) {	503	LUA_API void lua_rawgeti (lua_State *L, int idx, int n) {
290	if (ref == LUA_REFNIL)	504	StkId o;
291	ttype(L->top) = LUA_TNIL;	505	lua_lock(L);
292	else if (0 <= ref && ref < L->refSize &&	506	o = luaA_index(L, idx);
293	(L->refArray[ref].st == LOCK \|\| L->refArray[ref].st == HOLD))	507	api_check(L, ttistable(o));
294	*L->top = L->refArray[ref].o;	508	setobj2s(L->top, luaH_getnum(hvalue(o), n));
295	else
296	return 0;
297	api_incr_top(L);	509	api_incr_top(L);
298	return 1;	510	lua_unlock(L);
299	}	511	}
300		512
301		513
302	LUA_API void lua_newtable (lua_State *L) {	514	LUA_API void lua_newtable (lua_State *L) {
303	hvalue(L->top) = luaH_new(L, 0);	515	lua_lock(L);
304	ttype(L->top) = LUA_TTABLE;	516	luaC_checkGC(L);
		517	sethvalue(L->top, luaH_new(L, 0, 0));
305	api_incr_top(L);	518	api_incr_top(L);
		519	lua_unlock(L);
		520	}
		521
		522
		523	LUA_API int lua_getmetatable (lua_State *L, int objindex) {
		524	const TObject *obj;
		525	Table *mt = NULL;
		526	int res;
		527	lua_lock(L);
		528	obj = luaA_indexAcceptable(L, objindex);
		529	if (obj != NULL) {
		530	switch (ttype(obj)) {
		531	case LUA_TTABLE:
		532	mt = hvalue(obj)->metatable;
		533	break;
		534	case LUA_TUSERDATA:
		535	mt = uvalue(obj)->uv.metatable;
		536	break;
		537	}
		538	}
		539	if (mt == NULL \|\| mt == hvalue(defaultmeta(L)))
		540	res = 0;
		541	else {
		542	sethvalue(L->top, mt);
		543	api_incr_top(L);
		544	res = 1;
		545	}
		546	lua_unlock(L);
		547	return res;
306	}	548	}
307		549
308		550
		551	LUA_API void lua_getfenv (lua_State *L, int idx) {
		552	StkId o;
		553	lua_lock(L);
		554	o = luaA_index(L, idx);
		555	setobj2s(L->top, isLfunction(o) ? &clvalue(o)->l.g : gt(L));
		556	api_incr_top(L);
		557	lua_unlock(L);
		558	}
		559
309		560
310	/*	561	/*
311	** set functions (stack -> Lua)	562	** set functions (stack -> Lua)
312	*/	563	*/
313		564
314		565
315	LUA_API void lua_setglobal (lua_State L, const char name) {	566	LUA_API void lua_settable (lua_State *L, int idx) {
316	StkId top = L->top;	567	StkId t;
317	luaV_setglobal(L, luaS_new(L, name));	568	lua_lock(L);
318	L->top = top-1; /* remove element from the top */	569	api_checknelems(L, 2);
		570	t = luaA_index(L, idx);
		571	luaV_settable(L, t, L->top - 2, L->top - 1);
		572	L->top -= 2; /* pop index and value */
		573	lua_unlock(L);
319	}	574	}
320		575
321		576
322	LUA_API void lua_settable (lua_State *L, int index) {	577	LUA_API void lua_rawset (lua_State *L, int idx) {
323	StkId t = Index(L, index);	578	StkId t;
324	StkId top = L->top;	579	lua_lock(L);
325	luaV_settable(L, t, top-2);	580	api_checknelems(L, 2);
326	L->top = top-2; /* pop index and value */	581	t = luaA_index(L, idx);
		582	api_check(L, ttistable(t));
		583	setobj2t(luaH_set(L, hvalue(t), L->top-2), L->top-1); /* write barrier */
		584	L->top -= 2;
		585	lua_unlock(L);
327	}	586	}
328		587
329		588
330	LUA_API void lua_rawset (lua_State *L, int index) {	589	LUA_API void lua_rawseti (lua_State *L, int idx, int n) {
331	StkId t = Index(L, index);	590	StkId o;
332	LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected");	591	lua_lock(L);
333	luaH_set(L, hvalue(t), L->top-2) = (L->top-1);	592	api_checknelems(L, 1);
334	L->top -= 2;	593	o = luaA_index(L, idx);
		594	api_check(L, ttistable(o));
		595	setobj2t(luaH_setnum(L, hvalue(o), n), L->top-1); /* write barrier */
		596	L->top--;
		597	lua_unlock(L);
335	}	598	}
336		599
337		600
338	LUA_API void lua_rawseti (lua_State *L, int index, int n) {	601	LUA_API int lua_setmetatable (lua_State *L, int objindex) {
339	StkId o = Index(L, index);	602	TObject obj, mt;
340	LUA_ASSERT(ttype(o) == LUA_TTABLE, "table expected");	603	int res = 1;
341	luaH_setint(L, hvalue(o), n) = (L->top-1);	604	lua_lock(L);
		605	api_checknelems(L, 1);
		606	obj = luaA_index(L, objindex);
		607	mt = (!ttisnil(L->top - 1)) ? L->top - 1 : defaultmeta(L);
		608	api_check(L, ttistable(mt));
		609	switch (ttype(obj)) {
		610	case LUA_TTABLE: {
		611	hvalue(obj)->metatable = hvalue(mt); /* write barrier */
		612	break;
		613	}
		614	case LUA_TUSERDATA: {
		615	uvalue(obj)->uv.metatable = hvalue(mt); /* write barrier */
		616	break;
		617	}
		618	default: {
		619	res = 0; /* cannot set */
		620	break;
		621	}
		622	}
342	L->top--;	623	L->top--;
		624	lua_unlock(L);
		625	return res;
343	}	626	}
344		627
345		628
346	LUA_API void lua_setglobals (lua_State *L) {	629	LUA_API int lua_setfenv (lua_State *L, int idx) {
347	StkId newtable = --L->top;	630	StkId o;
348	LUA_ASSERT(ttype(newtable) == LUA_TTABLE, "table expected");	631	int res = 0;
349	L->gt = hvalue(newtable);	632	lua_lock(L);
		633	api_checknelems(L, 1);
		634	o = luaA_index(L, idx);
		635	L->top--;
		636	api_check(L, ttistable(L->top));
		637	if (isLfunction(o)) {
		638	res = 1;
		639	clvalue(o)->l.g = *(L->top);
		640	}
		641	lua_unlock(L);
		642	return res;
350	}	643	}
351		644
352		645
353	LUA_API int lua_ref (lua_State *L, int lock) {	646	/*
354	int ref;	647	** `load' and `call' functions (run Lua code)
355	if (ttype(L->top-1) == LUA_TNIL)	648	*/
356	ref = LUA_REFNIL;	649
357	else {	650	LUA_API void lua_call (lua_State *L, int nargs, int nresults) {
358	if (L->refFree != NONEXT) { /* is there a free place? */	651	StkId func;
359	ref = L->refFree;	652	lua_lock(L);
360	L->refFree = L->refArray[ref].st;	653	api_checknelems(L, nargs+1);
361	}	654	func = L->top - (nargs+1);
362	else { /* no more free places */	655	luaD_call(L, func, nresults);
363	luaM_growvector(L, L->refArray, L->refSize, 1, struct Ref,	656	lua_unlock(L);
364	"reference table overflow", MAX_INT);
365	L->nblocks += sizeof(struct Ref);
366	ref = L->refSize++;
367	}
368	L->refArray[ref].o = *(L->top-1);
369	L->refArray[ref].st = lock ? LOCK : HOLD;
370	}
371	L->top--;
372	return ref;
373	}	657	}
374		658
375		659
		660
376	/*	661	/*
377	** "do" functions (run Lua code)	662	** Execute a protected call.
378	** (most of them are in ldo.c)
379	*/	663	*/
		664	struct CallS { /* data to `f_call' */
		665	StkId func;
		666	int nresults;
		667	};
		668
380		669
381	LUA_API void lua_rawcall (lua_State *L, int nargs, int nresults) {	670	static void f_call (lua_State L, void ud) {
382	luaD_call(L, L->top-(nargs+1), nresults);	671	struct CallS c = cast(struct CallS , ud);
		672	luaD_call(L, c->func, c->nresults);
		673	}
		674
		675
		676
		677	LUA_API int lua_pcall (lua_State *L, int nargs, int nresults, int errfunc) {
		678	struct CallS c;
		679	int status;
		680	ptrdiff_t func;
		681	lua_lock(L);
		682	func = (errfunc == 0) ? 0 : savestack(L, luaA_index(L, errfunc));
		683	c.func = L->top - (nargs+1); /* function to be called */
		684	c.nresults = nresults;
		685	status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);
		686	lua_unlock(L);
		687	return status;
		688	}
		689
		690
		691	/*
		692	** Execute a protected C call.
		693	*/
		694	struct CCallS { /* data to `f_Ccall' */
		695	lua_CFunction func;
		696	void *ud;
		697	};
		698
		699
		700	static void f_Ccall (lua_State L, void ud) {
		701	struct CCallS c = cast(struct CCallS , ud);
		702	Closure *cl;
		703	cl = luaF_newCclosure(L, 0);
		704	cl->c.f = c->func;
		705	setclvalue(L->top, cl); /* push function */
		706	incr_top(L);
		707	setpvalue(L->top, c->ud); /* push only argument */
		708	incr_top(L);
		709	luaD_call(L, L->top - 2, 0);
		710	}
		711
		712
		713	LUA_API int lua_cpcall (lua_State L, lua_CFunction func, void ud) {
		714	struct CCallS c;
		715	int status;
		716	lua_lock(L);
		717	c.func = func;
		718	c.ud = ud;
		719	status = luaD_pcall(L, f_Ccall, &c, savestack(L, L->top), 0);
		720	lua_unlock(L);
		721	return status;
		722	}
		723
		724
		725	LUA_API int lua_load (lua_State L, lua_Chunkreader reader, void data,
		726	const char *chunkname) {
		727	ZIO z;
		728	int status;
		729	int c;
		730	lua_lock(L);
		731	if (!chunkname) chunkname = "?";
		732	luaZ_init(&z, reader, data, chunkname);
		733	c = luaZ_lookahead(&z);
		734	status = luaD_protectedparser(L, &z, (c == LUA_SIGNATURE[0]));
		735	lua_unlock(L);
		736	return status;
		737	}
		738
		739
		740	LUA_API int lua_dump (lua_State L, lua_Chunkwriter writer, void data) {
		741	int status;
		742	TObject *o;
		743	lua_lock(L);
		744	api_checknelems(L, 1);
		745	o = L->top - 1;
		746	if (isLfunction(o) && clvalue(o)->l.nupvalues == 0) {
		747	luaU_dump(L, clvalue(o)->l.p, writer, data);
		748	status = 1;
		749	}
		750	else
		751	status = 0;
		752	lua_unlock(L);
		753	return status;
383	}	754	}
384		755
385		756
@@ -388,23 +759,34 @@ LUA_API void lua_rawcall (lua_State *L, int nargs, int nresults) { · 2 unmodified lines
388	*/	759	*/
389		760
390	/* GC values are expressed in Kbytes: #bytes/2^10 */	761	/* GC values are expressed in Kbytes: #bytes/2^10 */
391	#define GCscale(x) ((int)((x)>>10))	762	#define GCscalel(x) ((x)>>10)
392	#define GCunscale(x) ((unsigned long)(x)<<10)	763	#define GCscale(x) (cast(int, GCscalel(x)))
		764	#define GCunscale(x) (cast(lu_mem, x)<<10)
393		765
394	LUA_API int lua_getgcthreshold (lua_State *L) {	766	LUA_API int lua_getgcthreshold (lua_State *L) {
395	return GCscale(L->GCthreshold);	767	int threshold;
		768	lua_lock(L);
		769	threshold = GCscale(G(L)->GCthreshold);
		770	lua_unlock(L);
		771	return threshold;
396	}	772	}
397		773
398	LUA_API int lua_getgccount (lua_State *L) {	774	LUA_API int lua_getgccount (lua_State *L) {
399	return GCscale(L->nblocks);	775	int count;
		776	lua_lock(L);
		777	count = GCscale(G(L)->nblocks);
		778	lua_unlock(L);
		779	return count;
400	}	780	}
401		781
402	LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold) {	782	LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold) {
403	if (newthreshold > GCscale(ULONG_MAX))	783	lua_lock(L);
404	L->GCthreshold = ULONG_MAX;	784	if (cast(lu_mem, newthreshold) > GCscalel(MAX_LUMEM))
		785	G(L)->GCthreshold = MAX_LUMEM;
405	else	786	else
406	L->GCthreshold = GCunscale(newthreshold);	787	G(L)->GCthreshold = GCunscale(newthreshold);
407	luaC_checkGC(L);	788	luaC_checkGC(L);
		789	lua_unlock(L);
408	}	790	}
409		791
410		792
@@ -412,83 +794,129 @@ LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold) { · 1 unmodified line
412	** miscellaneous functions	794	** miscellaneous functions
413	*/	795	*/
414		796
415	LUA_API void lua_settag (lua_State *L, int tag) {	797
416	luaT_realtag(L, tag);	798	LUA_API const char *lua_version (void) {
417	switch (ttype(L->top-1)) {	799	return LUA_VERSION;
418	case LUA_TTABLE:
419	hvalue(L->top-1)->htag = tag;
420	break;
421	case LUA_TUSERDATA:
422	tsvalue(L->top-1)->u.d.tag = tag;
423	break;
424	default:
425	luaO_verror(L, "cannot change the tag of a %.20s",
426	luaO_typename(L->top-1));
427	}
428	}	800	}
429		801
430		802
431	LUA_API void lua_unref (lua_State *L, int ref) {	803	LUA_API int lua_error (lua_State *L) {
432	if (ref >= 0) {	804	lua_lock(L);
433	LUA_ASSERT(ref < L->refSize && L->refArray[ref].st < 0, "invalid ref");	805	api_checknelems(L, 1);
434	L->refArray[ref].st = L->refFree;	806	luaG_errormsg(L);
435	L->refFree = ref;	807	lua_unlock(L);
436	}	808	return 0; /* to avoid warnings */
437	}	809	}
438		810
439		811
440	LUA_API int lua_next (lua_State *L, int index) {	812	LUA_API int lua_next (lua_State *L, int idx) {
441	StkId t = luaA_index(L, index);	813	StkId t;
442	Node *n;	814	int more;
443	LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected");	815	lua_lock(L);
444	n = luaH_next(L, hvalue(t), luaA_index(L, -1));	816	t = luaA_index(L, idx);
445	if (n) {	817	api_check(L, ttistable(t));
446	(L->top-1) = key(n);	818	more = luaH_next(L, hvalue(t), L->top - 1);
447	L->top = val(n);	819	if (more) {
448	api_incr_top(L);	820	api_incr_top(L);
449	return 1;
450	}	821	}
451	else { /* no more elements */	822	else /* no more elements */
452	L->top -= 1; /* remove key */	823	L->top -= 1; /* remove key */
453	return 0;	824	lua_unlock(L);
		825	return more;
		826	}
		827
		828
		829	LUA_API void lua_concat (lua_State *L, int n) {
		830	lua_lock(L);
		831	luaC_checkGC(L);
		832	api_checknelems(L, n);
		833	if (n >= 2) {
		834	luaV_concat(L, n, L->top - L->base - 1);
		835	L->top -= (n-1);
		836	}
		837	else if (n == 0) { /* push empty string */
		838	setsvalue2s(L->top, luaS_newlstr(L, NULL, 0));
		839	api_incr_top(L);
		840	}
		841	/* else n == 1; nothing to do */
		842	lua_unlock(L);
		843	}
		844
		845
		846	LUA_API void lua_newuserdata (lua_State L, size_t size) {
		847	Udata *u;
		848	lua_lock(L);
		849	luaC_checkGC(L);
		850	u = luaS_newudata(L, size);
		851	setuvalue(L->top, u);
		852	api_incr_top(L);
		853	lua_unlock(L);
		854	return u + 1;
		855	}
		856
		857
		858	LUA_API int lua_pushupvalues (lua_State *L) {
		859	Closure *func;
		860	int n, i;
		861	lua_lock(L);
		862	api_check(L, iscfunction(L->base - 1));
		863	func = clvalue(L->base - 1);
		864	n = func->c.nupvalues;
		865	luaD_checkstack(L, n + LUA_MINSTACK);
		866	for (i=0; i<n; i++) {
		867	setobj2s(L->top, &func->c.upvalue[i]);
		868	L->top++;
454	}	869	}
		870	lua_unlock(L);
		871	return n;
455	}	872	}
456		873
457		874
458	LUA_API int lua_getn (lua_State *L, int index) {	875	static const char aux_upvalue (lua_State L, int funcindex, int n,
459	Hash *h = hvalue(luaA_index(L, index));	876	TObject **val) {
460	const TObject value = luaH_getstr(h, luaS_new(L, "n")); / value = h.n */	877	Closure *f;
461	if (ttype(value) == LUA_TNUMBER)	878	StkId fi = luaA_index(L, funcindex);
462	return (int)nvalue(value);	879	if (!ttisfunction(fi)) return NULL;
		880	f = clvalue(fi);
		881	if (f->c.isC) {
		882	if (n > f->c.nupvalues) return NULL;
		883	*val = &f->c.upvalue[n-1];
		884	return "";
		885	}
463	else {	886	else {
464	Number max = 0;	887	Proto *p = f->l.p;
465	int i = h->size;	888	if (n > p->sizeupvalues) return NULL;
466	Node *n = h->node;	889	*val = f->l.upvals[n-1]->v;
467	while (i--) {	890	return getstr(p->upvalues[n-1]);
468	if (ttype(key(n)) == LUA_TNUMBER &&
469	ttype(val(n)) != LUA_TNIL &&
470	nvalue(key(n)) > max)
471	max = nvalue(key(n));
472	n++;
473	}
474	return (int)max;
475	}	891	}
476	}	892	}
477		893
478		894
479	LUA_API void lua_concat (lua_State *L, int n) {	895	LUA_API const char lua_getupvalue (lua_State L, int funcindex, int n) {
480	StkId top = L->top;	896	const char *name;
481	luaV_strconc(L, n, top);	897	TObject *val;
482	L->top = top-(n-1);	898	lua_lock(L);
483	luaC_checkGC(L);	899	name = aux_upvalue(L, funcindex, n, &val);
		900	if (name) {
		901	setobj2s(L->top, val);
		902	api_incr_top(L);
		903	}
		904	lua_unlock(L);
		905	return name;
484	}	906	}
485		907
486		908
487	LUA_API void lua_newuserdata (lua_State L, size_t size) {	909	LUA_API const char lua_setupvalue (lua_State L, int funcindex, int n) {
488	TString *ts = luaS_newudata(L, (size==0) ? 1 : size, NULL);	910	const char *name;
489	tsvalue(L->top) = ts;	911	TObject *val;
490	ttype(L->top) = LUA_TUSERDATA;	912	lua_lock(L);
491	api_incr_top(L);	913	api_checknelems(L, 1);
492	return ts->u.d.value;	914	name = aux_upvalue(L, funcindex, n, &val);
		915	if (name) {
		916	L->top--;
		917	setobj(val, L->top); /* write barrier */
		918	}
		919	lua_unlock(L);
		920	return name;
493	}	921	}
494		922

src/lapi.h+1−2

 /*
-** $Id: lapi.h,v 1.20 2000/08/31 14:08:27 roberto Exp $
+** $Id: lapi.h,v 1.21 2002/03/04 21:29:41 roberto Exp $
 ** Auxiliary functions from Lua API
 ** See Copyright Notice in lua.h
 */
 #include "lobject.h"
-TObject *luaA_index (lua_State *L, int index);
 void luaA_pushobject (lua_State *L, const TObject *o);
 #endif

src/lcode.c+530−517

@@ -1,66 +1,84 @@
1	/*	1	/*
2	** $Id: lcode.c,v 1.51 2000/09/29 12:42:13 roberto Exp $	2	** $Id: lcode.c,v 1.117 2003/04/03 13:35:34 roberto Exp $
3	** Code generator for Lua	3	** Code generator for Lua
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include "stdlib.h"	8	#include <stdlib.h>
		9
		10	#define lcode_c
9		11
10	#include "lua.h"	12	#include "lua.h"
11		13
12	#include "lcode.h"	14	#include "lcode.h"
		15	#include "ldebug.h"
13	#include "ldo.h"	16	#include "ldo.h"
14	#include "llex.h"	17	#include "llex.h"
15	#include "lmem.h"	18	#include "lmem.h"
16	#include "lobject.h"	19	#include "lobject.h"
17	#include "lopcodes.h"	20	#include "lopcodes.h"
18	#include "lparser.h"	21	#include "lparser.h"
		22	#include "ltable.h"
19		23
20		24
21	void luaK_error (LexState ls, const char msg) {	25	#define hasjumps(e) ((e)->t != (e)->f)
22	luaX_error(ls, msg, ls->t.token);
23	}
24		26
25		27
26	/*	28	void luaK_nil (FuncState *fs, int from, int n) {
27	** Returns the the previous instruction, for optimizations.	29	Instruction *previous;
28	** If there is a jump target between this and the current instruction,	30	if (fs->pc > fs->lasttarget && /* no jumps to current position? */
29	** returns a dummy instruction to avoid wrong optimizations.	31	GET_OPCODE(*(previous = &fs->f->code[fs->pc-1])) == OP_LOADNIL) {
30	*/	32	int pfrom = GETARG_A(*previous);
31	static Instruction previous_instruction (FuncState *fs) {	33	int pto = GETARG_B(*previous);
32	if (fs->pc > fs->lasttarget) /* no jumps to current position? */	34	if (pfrom <= from && from <= pto+1) { /* can connect both? */
33	return fs->f->code[fs->pc-1]; /* returns previous instruction */	35	if (from+n-1 > pto)
34	else	36	SETARG_B(*previous, from+n-1);
35	return CREATE_0(OP_END); /* no optimizations after an `END' */	37	return;
		38	}
		39	}
		40	luaK_codeABC(fs, OP_LOADNIL, from, from+n-1, 0); /* else no optimization */
36	}	41	}
37		42
38		43
39	int luaK_jump (FuncState *fs) {	44	int luaK_jump (FuncState *fs) {
40	int j = luaK_code1(fs, OP_JMP, NO_JUMP);	45	int jpc = fs->jpc; /* save list of jumps to here */
41	if (j == fs->lasttarget) { /* possible jumps to this jump? */	46	int j;
42	luaK_concat(fs, &j, fs->jlt); /* keep them on hold */	47	fs->jpc = NO_JUMP;
43	fs->jlt = NO_JUMP;	48	j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP);
44	}	49	luaK_concat(fs, &j, jpc); /* keep them on hold */
45	return j;	50	return j;
46	}	51	}
47		52
48		53
		54	static int luaK_condjump (FuncState *fs, OpCode op, int A, int B, int C) {
		55	luaK_codeABC(fs, op, A, B, C);
		56	return luaK_jump(fs);
		57	}
		58
		59
49	static void luaK_fixjump (FuncState *fs, int pc, int dest) {	60	static void luaK_fixjump (FuncState *fs, int pc, int dest) {
50	Instruction *jmp = &fs->f->code[pc];	61	Instruction *jmp = &fs->f->code[pc];
51	if (dest == NO_JUMP)	62	int offset = dest-(pc+1);
52	SETARG_S(jmp, NO_JUMP); / point to itself to represent end of list */	63	lua_assert(dest != NO_JUMP);
53	else { /* jump is relative to position following jump instruction */	64	if (abs(offset) > MAXARG_sBx)
54	int offset = dest-(pc+1);	65	luaX_syntaxerror(fs->ls, "control structure too long");
55	if (abs(offset) > MAXARG_S)	66	SETARG_sBx(*jmp, offset);
56	luaK_error(fs->ls, "control structure too long");	67	}
57	SETARG_S(*jmp, offset);	68
58	}	69
		70	/*
		71	** returns current `pc' and marks it as a jump target (to avoid wrong
		72	** optimizations with consecutive instructions not in the same basic block).
		73	*/
		74	int luaK_getlabel (FuncState *fs) {
		75	fs->lasttarget = fs->pc;
		76	return fs->pc;
59	}	77	}
60		78
61		79
62	static int luaK_getjump (FuncState *fs, int pc) {	80	static int luaK_getjump (FuncState *fs, int pc) {
63	int offset = GETARG_S(fs->f->code[pc]);	81	int offset = GETARG_sBx(fs->f->code[pc]);
64	if (offset == NO_JUMP) /* point to itself represents end of list */	82	if (offset == NO_JUMP) /* point to itself represents end of list */
65	return NO_JUMP; /* end of list */	83	return NO_JUMP; /* end of list */
66	else	84	else
@@ -68,634 +86,629 @@ static int luaK_getjump (FuncState *fs, int pc) { · 1 unmodified line
68	}	86	}
69		87
70		88
		89	static Instruction getjumpcontrol (FuncState fs, int pc) {
		90	Instruction *pi = &fs->f->code[pc];
		91	if (pc >= 1 && testOpMode(GET_OPCODE(*(pi-1)), OpModeT))
		92	return pi-1;
		93	else
		94	return pi;
		95	}
		96
		97
71	/*	98	/*
72	** returns current `pc' and marks it as a jump target (to avoid wrong	99	** check whether list has any jump that do not produce a value
73	** optimizations with consecutive instructions not in the same basic block).	100	** (or produce an inverted value)
74	** discharge list of jumps to last target.
75	*/	101	*/
76	int luaK_getlabel (FuncState *fs) {	102	static int need_value (FuncState *fs, int list, int cond) {
77	if (fs->pc != fs->lasttarget) {	103	for (; list != NO_JUMP; list = luaK_getjump(fs, list)) {
78	int lasttarget = fs->lasttarget;	104	Instruction i = *getjumpcontrol(fs, list);
79	fs->lasttarget = fs->pc;	105	if (GET_OPCODE(i) != OP_TEST \|\| GETARG_C(i) != cond) return 1;
80	luaK_patchlist(fs, fs->jlt, lasttarget); /* discharge old list `jlt' */
81	fs->jlt = NO_JUMP; /* nobody jumps to this new label (yet) */
82	}	106	}
83	return fs->pc;	107	return 0; /* not found */
84	}	108	}
85		109
86		110
87	void luaK_deltastack (FuncState *fs, int delta) {	111	static void patchtestreg (Instruction *i, int reg) {
88	fs->stacklevel += delta;	112	if (reg == NO_REG) reg = GETARG_B(*i);
89	if (fs->stacklevel > fs->f->maxstacksize) {	113	SETARG_A(*i, reg);
90	if (fs->stacklevel > MAXSTACK)
91	luaK_error(fs->ls, "function or expression too complex");
92	fs->f->maxstacksize = fs->stacklevel;
93	}
94	}	114	}
95		115
96		116
97	void luaK_kstr (LexState *ls, int c) {	117	static void luaK_patchlistaux (FuncState *fs, int list,
98	luaK_code1(ls->fs, OP_PUSHSTRING, c);	118	int ttarget, int treg, int ftarget, int freg, int dtarget) {
		119	while (list != NO_JUMP) {
		120	int next = luaK_getjump(fs, list);
		121	Instruction *i = getjumpcontrol(fs, list);
		122	if (GET_OPCODE(*i) != OP_TEST) {
		123	lua_assert(dtarget != NO_JUMP);
		124	luaK_fixjump(fs, list, dtarget); /* jump to default target */
		125	}
		126	else {
		127	if (GETARG_C(*i)) {
		128	lua_assert(ttarget != NO_JUMP);
		129	patchtestreg(i, treg);
		130	luaK_fixjump(fs, list, ttarget);
		131	}
		132	else {
		133	lua_assert(ftarget != NO_JUMP);
		134	patchtestreg(i, freg);
		135	luaK_fixjump(fs, list, ftarget);
		136	}
		137	}
		138	list = next;
		139	}
99	}	140	}
100		141
101		142
102	static int number_constant (FuncState *fs, Number r) {	143	static void luaK_dischargejpc (FuncState *fs) {
103	/* check whether `r' has appeared within the last LOOKBACKNUMS entries */	144	luaK_patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc, NO_REG, fs->pc);
104	Proto *f = fs->f;	145	fs->jpc = NO_JUMP;
105	int c = f->nknum;
106	int lim = c < LOOKBACKNUMS ? 0 : c-LOOKBACKNUMS;
107	while (--c >= lim)
108	if (f->knum[c] == r) return c;
109	/* not found; create a new entry */
110	luaM_growvector(fs->L, f->knum, f->nknum, 1, Number,
111	"constant table overflow", MAXARG_U);
112	c = f->nknum++;
113	f->knum[c] = r;
114	return c;
115	}
116
117
118	void luaK_number (FuncState *fs, Number f) {
119	if (f <= (Number)MAXARG_S && (Number)(int)f == f)
120	luaK_code1(fs, OP_PUSHINT, (int)f); /* f has a short integer value */
121	else
122	luaK_code1(fs, OP_PUSHNUM, number_constant(fs, f));
123	}	146	}
124		147
125		148
126	void luaK_adjuststack (FuncState *fs, int n) {	149	void luaK_patchlist (FuncState *fs, int list, int target) {
127	if (n > 0)	150	if (target == fs->pc)
128	luaK_code1(fs, OP_POP, n);	151	luaK_patchtohere(fs, list);
129	else	152	else {
130	luaK_code1(fs, OP_PUSHNIL, -n);	153	lua_assert(target < fs->pc);
		154	luaK_patchlistaux(fs, list, target, NO_REG, target, NO_REG, target);
		155	}
131	}	156	}
132		157
133		158
134	int luaK_lastisopen (FuncState *fs) {	159	void luaK_patchtohere (FuncState *fs, int list) {
135	/* check whether last instruction is an open function call */	160	luaK_getlabel(fs);
136	Instruction i = previous_instruction(fs);	161	luaK_concat(fs, &fs->jpc, list);
137	if (GET_OPCODE(i) == OP_CALL && GETARG_B(i) == MULT_RET)
138	return 1;
139	else return 0;
140	}	162	}
141		163
142		164
143	void luaK_setcallreturns (FuncState *fs, int nresults) {	165	void luaK_concat (FuncState fs, int l1, int l2) {
144	if (luaK_lastisopen(fs)) { /* expression is an open function call? */	166	if (l2 == NO_JUMP) return;
145	SETARG_B(fs->f->code[fs->pc-1], nresults); /* set number of results */	167	else if (*l1 == NO_JUMP)
146	luaK_deltastack(fs, nresults); /* push results */	168	*l1 = l2;
		169	else {
		170	int list = *l1;
		171	int next;
		172	while ((next = luaK_getjump(fs, list)) != NO_JUMP) /* find last element */
		173	list = next;
		174	luaK_fixjump(fs, list, l2);
147	}	175	}
148	}	176	}
149		177
150		178
151	static int discharge (FuncState fs, expdesc var) {	179	void luaK_checkstack (FuncState *fs, int n) {
152	switch (var->k) {	180	int newstack = fs->freereg + n;
153	case VLOCAL:	181	if (newstack > fs->f->maxstacksize) {
154	luaK_code1(fs, OP_GETLOCAL, var->u.index);	182	if (newstack >= MAXSTACK)
155	break;	183	luaX_syntaxerror(fs->ls, "function or expression too complex");
156	case VGLOBAL:	184	fs->f->maxstacksize = cast(lu_byte, newstack);
157	luaK_code1(fs, OP_GETGLOBAL, var->u.index);
158	break;
159	case VINDEXED:
160	luaK_code0(fs, OP_GETTABLE);
161	break;
162	case VEXP:
163	return 0; /* nothing to do */
164	}	185	}
165	var->k = VEXP;
166	var->u.l.t = var->u.l.f = NO_JUMP;
167	return 1;
168	}	186	}
169		187
170		188
171	static void discharge1 (FuncState fs, expdesc var) {	189	void luaK_reserveregs (FuncState *fs, int n) {
172	discharge(fs, var);	190	luaK_checkstack(fs, n);
173	/* if it has jumps then it is already discharged */	191	fs->freereg += n;
174	if (var->u.l.t == NO_JUMP && var->u.l.f == NO_JUMP)
175	luaK_setcallreturns(fs, 1); /* call must return 1 value */
176	}	192	}
177		193
178		194
179	void luaK_storevar (LexState ls, const expdesc var) {	195	static void freereg (FuncState *fs, int reg) {
180	FuncState *fs = ls->fs;	196	if (reg >= fs->nactvar && reg < MAXSTACK) {
181	switch (var->k) {	197	fs->freereg--;
182	case VLOCAL:	198	lua_assert(reg == fs->freereg);
183	luaK_code1(fs, OP_SETLOCAL, var->u.index);
184	break;
185	case VGLOBAL:
186	luaK_code1(fs, OP_SETGLOBAL, var->u.index);
187	break;
188	case VINDEXED: /* table is at top-3; pop 3 elements after operation */
189	luaK_code2(fs, OP_SETTABLE, 3, 3);
190	break;
191	default:
192	LUA_INTERNALERROR("invalid var kind to store");
193	}	199	}
194	}	200	}
195		201
196		202
197	static OpCode invertjump (OpCode op) {	203	static void freeexp (FuncState fs, expdesc e) {
198	switch (op) {	204	if (e->k == VNONRELOC)
199	case OP_JMPNE: return OP_JMPEQ;	205	freereg(fs, e->info);
200	case OP_JMPEQ: return OP_JMPNE;
201	case OP_JMPLT: return OP_JMPGE;
202	case OP_JMPLE: return OP_JMPGT;
203	case OP_JMPGT: return OP_JMPLE;
204	case OP_JMPGE: return OP_JMPLT;
205	case OP_JMPT: case OP_JMPONT: return OP_JMPF;
206	case OP_JMPF: case OP_JMPONF: return OP_JMPT;
207	default:
208	LUA_INTERNALERROR("invalid jump instruction");
209	return OP_END; /* to avoid warnings */
210	}
211	}	206	}
212		207
213		208
214	static void luaK_patchlistaux (FuncState *fs, int list, int target,	209	static int addk (FuncState fs, TObject k, TObject *v) {
215	OpCode special, int special_target) {	210	const TObject *idx = luaH_get(fs->h, k);
216	Instruction *code = fs->f->code;	211	if (ttisnumber(idx)) {
217	while (list != NO_JUMP) {	212	lua_assert(luaO_rawequalObj(&fs->f->k[cast(int, nvalue(idx))], v));
218	int next = luaK_getjump(fs, list);	213	return cast(int, nvalue(idx));
219	Instruction *i = &code[list];	214	}
220	OpCode op = GET_OPCODE(*i);	215	else { /* constant not found; create a new entry */
221	if (op == special) /* this `op' already has a value */	216	Proto *f = fs->f;
222	luaK_fixjump(fs, list, special_target);	217	luaM_growvector(fs->L, f->k, fs->nk, f->sizek, TObject,
223	else {	218	MAXARG_Bx, "constant table overflow");
224	luaK_fixjump(fs, list, target); /* do the patch */	219	setobj2n(&f->k[fs->nk], v);
225	if (op == OP_JMPONT) /* remove eventual values */	220	setnvalue(luaH_set(fs->L, fs->h, k), cast(lua_Number, fs->nk));
226	SET_OPCODE(*i, OP_JMPT);	221	return fs->nk++;
227	else if (op == OP_JMPONF)
228	SET_OPCODE(*i, OP_JMPF);
229	}
230	list = next;
231	}	222	}
232	}	223	}
233		224
234		225
235	void luaK_patchlist (FuncState *fs, int list, int target) {	226	int luaK_stringK (FuncState fs, TString s) {
236	if (target == fs->lasttarget) /* same target that list `jlt'? */	227	TObject o;
237	luaK_concat(fs, &fs->jlt, list); /* delay fixing */	228	setsvalue(&o, s);
238	else	229	return addk(fs, &o, &o);
239	luaK_patchlistaux(fs, list, target, OP_END, 0);
240	}	230	}
241		231
242		232
243	static int need_value (FuncState *fs, int list, OpCode hasvalue) {	233	int luaK_numberK (FuncState *fs, lua_Number r) {
244	/* check whether list has a jump without a value */	234	TObject o;
245	for (; list != NO_JUMP; list = luaK_getjump(fs, list))	235	setnvalue(&o, r);
246	if (GET_OPCODE(fs->f->code[list]) != hasvalue) return 1;	236	return addk(fs, &o, &o);
247	return 0; /* not found */
248	}	237	}
249		238
250		239
251	void luaK_concat (FuncState fs, int l1, int l2) {	240	static int nil_constant (FuncState *fs) {
252	if (*l1 == NO_JUMP)	241	TObject k, v;
253	*l1 = l2;	242	setnilvalue(&v);
254	else {	243	sethvalue(&k, fs->h); /* cannot use nil as key; instead use table itself */
255	int list = *l1;	244	return addk(fs, &k, &v);
256	for (;;) { /* traverse `l1' */
257	int next = luaK_getjump(fs, list);
258	if (next == NO_JUMP) { /* end of list? */
259	luaK_fixjump(fs, list, l2);
260	return;
261	}
262	list = next;
263	}
264	}
265	}	245	}
266		246
267		247
268	static void luaK_testgo (FuncState fs, expdesc v, int invert, OpCode jump) {	248	void luaK_setcallreturns (FuncState fs, expdesc e, int nresults) {
269	int prevpos; /* position of last instruction */	249	if (e->k == VCALL) { /* expression is an open function call? */
270	Instruction *previous;	250	SETARG_C(getcode(fs, e), nresults+1);
271	int golist, exitlist;	251	if (nresults == 1) { /* `regular' expression? */
272	if (!invert) {	252	e->k = VNONRELOC;
273	golist = &v->u.l.f; /* go if false */	253	e->info = GETARG_A(getcode(fs, e));
274	exitlist = &v->u.l.t; /* exit if true */	254	}
275	}
276	else {
277	golist = &v->u.l.t; /* go if true */
278	exitlist = &v->u.l.f; /* exit if false */
279	}
280	discharge1(fs, v);
281	prevpos = fs->pc-1;
282	previous = &fs->f->code[prevpos];
283	LUA_ASSERT(*previous==previous_instruction(fs), "no jump allowed here");
284	if (!ISJUMP(GET_OPCODE(*previous)))
285	prevpos = luaK_code1(fs, jump, NO_JUMP);
286	else { /* last instruction is already a jump */
287	if (invert)
288	SET_OPCODE(previous, invertjump(GET_OPCODE(previous)));
289	}	255	}
290	luaK_concat(fs, exitlist, prevpos); /* insert last jump in `exitlist' */
291	luaK_patchlist(fs, *golist, luaK_getlabel(fs));
292	*golist = NO_JUMP;
293	}	256	}
294		257
295		258
296	void luaK_goiftrue (FuncState fs, expdesc v, int keepvalue) {	259	void luaK_dischargevars (FuncState fs, expdesc e) {
297	luaK_testgo(fs, v, 1, keepvalue ? OP_JMPONF : OP_JMPF);	260	switch (e->k) {
		261	case VLOCAL: {
		262	e->k = VNONRELOC;
		263	break;
		264	}
		265	case VUPVAL: {
		266	e->info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->info, 0);
		267	e->k = VRELOCABLE;
		268	break;
		269	}
		270	case VGLOBAL: {
		271	e->info = luaK_codeABx(fs, OP_GETGLOBAL, 0, e->info);
		272	e->k = VRELOCABLE;
		273	break;
		274	}
		275	case VINDEXED: {
		276	freereg(fs, e->aux);
		277	freereg(fs, e->info);
		278	e->info = luaK_codeABC(fs, OP_GETTABLE, 0, e->info, e->aux);
		279	e->k = VRELOCABLE;
		280	break;
		281	}
		282	case VCALL: {
		283	luaK_setcallreturns(fs, e, 1);
		284	break;
		285	}
		286	default: break; /* there is one value available (somewhere) */
		287	}
298	}	288	}
299		289
300		290
301	static void luaK_goiffalse (FuncState fs, expdesc v, int keepvalue) {	291	static int code_label (FuncState *fs, int A, int b, int jump) {
302	luaK_testgo(fs, v, 0, keepvalue ? OP_JMPONT : OP_JMPT);	292	luaK_getlabel(fs); /* those instructions may be jump targets */
		293	return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump);
303	}	294	}
304		295
305		296
306	static int code_label (FuncState *fs, OpCode op, int arg) {	297	static void discharge2reg (FuncState fs, expdesc e, int reg) {
307	luaK_getlabel(fs); /* those instructions may be jump targets */	298	luaK_dischargevars(fs, e);
308	return luaK_code1(fs, op, arg);	299	switch (e->k) {
309	}	300	case VNIL: {
310		301	luaK_nil(fs, reg, 1);
311		302	break;
312	void luaK_tostack (LexState ls, expdesc v, int onlyone) {	303	}
313	FuncState *fs = ls->fs;	304	case VFALSE: case VTRUE: {
314	if (!discharge(fs, v)) { /* `v' is an expression? */	305	luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0);
315	OpCode previous = GET_OPCODE(fs->f->code[fs->pc-1]);	306	break;
316	if (!ISJUMP(previous) && v->u.l.f == NO_JUMP && v->u.l.t == NO_JUMP) {	307	}
317	/* expression has no jumps */	308	case VK: {
318	if (onlyone)	309	luaK_codeABx(fs, OP_LOADK, reg, e->info);
319	luaK_setcallreturns(fs, 1); /* call must return 1 value */	310	break;
320	}	311	}
321	else { /* expression has jumps */	312	case VRELOCABLE: {
322	int final; /* position after whole expression */	313	Instruction *pc = &getcode(fs, e);
323	int j = NO_JUMP; /* eventual jump over values */	314	SETARG_A(*pc, reg);
324	int p_nil = NO_JUMP; /* position of an eventual PUSHNIL */	315	break;
325	int p_1 = NO_JUMP; /* position of an eventual PUSHINT */	316	}
326	if (ISJUMP(previous) \|\| need_value(fs, v->u.l.f, OP_JMPONF)	317	case VNONRELOC: {
327	\|\| need_value(fs, v->u.l.t, OP_JMPONT)) {	318	if (reg != e->info)
328	/* expression needs values */	319	luaK_codeABC(fs, OP_MOVE, reg, e->info, 0);
329	if (ISJUMP(previous))	320	break;
330	luaK_concat(fs, &v->u.l.t, fs->pc-1); /* put `previous' in t. list */	321	}
331	else {	322	default: {
332	j = code_label(fs, OP_JMP, NO_JUMP); /* to jump over both pushes */	323	lua_assert(e->k == VVOID \|\| e->k == VJMP);
333	/* correct stack for compiler and symbolic execution */	324	return; /* nothing to do... */
334	luaK_adjuststack(fs, 1);
335	}
336	p_nil = code_label(fs, OP_PUSHNILJMP, 0);
337	p_1 = code_label(fs, OP_PUSHINT, 1);
338	luaK_patchlist(fs, j, luaK_getlabel(fs));
339	}
340	final = luaK_getlabel(fs);
341	luaK_patchlistaux(fs, v->u.l.f, p_nil, OP_JMPONF, final);
342	luaK_patchlistaux(fs, v->u.l.t, p_1, OP_JMPONT, final);
343	v->u.l.f = v->u.l.t = NO_JUMP;
344	}	325	}
345	}	326	}
		327	e->info = reg;
		328	e->k = VNONRELOC;
346	}	329	}
347		330
348		331
349	void luaK_prefix (LexState ls, UnOpr op, expdesc v) {	332	static void discharge2anyreg (FuncState fs, expdesc e) {
350	FuncState *fs = ls->fs;	333	if (e->k != VNONRELOC) {
351	if (op == OPR_MINUS) {	334	luaK_reserveregs(fs, 1);
352	luaK_tostack(ls, v, 1);	335	discharge2reg(fs, e, fs->freereg-1);
353	luaK_code0(fs, OP_MINUS);
354	}	336	}
355	else { /* op == NOT */	337	}
356	Instruction *previous;	338
357	discharge1(fs, v);	339
358	previous = &fs->f->code[fs->pc-1];	340	static void luaK_exp2reg (FuncState fs, expdesc e, int reg) {
359	if (ISJUMP(GET_OPCODE(*previous)))	341	discharge2reg(fs, e, reg);
360	SET_OPCODE(previous, invertjump(GET_OPCODE(previous)));	342	if (e->k == VJMP)
361	else	343	luaK_concat(fs, &e->t, e->info); /* put this jump in `t' list */
362	luaK_code0(fs, OP_NOT);	344	if (hasjumps(e)) {
363	/* interchange true and false lists */	345	int final; /* position after whole expression */
364	{ int temp = v->u.l.f; v->u.l.f = v->u.l.t; v->u.l.t = temp; }	346	int p_f = NO_JUMP; /* position of an eventual LOAD false */
		347	int p_t = NO_JUMP; /* position of an eventual LOAD true */
		348	if (need_value(fs, e->t, 1) \|\| need_value(fs, e->f, 0)) {
		349	int fj = NO_JUMP; /* first jump (over LOAD ops.) */
		350	if (e->k != VJMP)
		351	fj = luaK_jump(fs);
		352	p_f = code_label(fs, reg, 0, 1);
		353	p_t = code_label(fs, reg, 1, 0);
		354	luaK_patchtohere(fs, fj);
		355	}
		356	final = luaK_getlabel(fs);
		357	luaK_patchlistaux(fs, e->f, p_f, NO_REG, final, reg, p_f);
		358	luaK_patchlistaux(fs, e->t, final, reg, p_t, NO_REG, p_t);
365	}	359	}
		360	e->f = e->t = NO_JUMP;
		361	e->info = reg;
		362	e->k = VNONRELOC;
366	}	363	}
367		364
368		365
369	void luaK_infix (LexState ls, BinOpr op, expdesc v) {	366	void luaK_exp2nextreg (FuncState fs, expdesc e) {
370	FuncState *fs = ls->fs;	367	luaK_dischargevars(fs, e);
371	switch (op) {	368	freeexp(fs, e);
372	case OPR_AND:	369	luaK_reserveregs(fs, 1);
373	luaK_goiftrue(fs, v, 1);	370	luaK_exp2reg(fs, e, fs->freereg - 1);
374	break;	371	}
375	case OPR_OR:	372
376	luaK_goiffalse(fs, v, 1);	373
377	break;	374	int luaK_exp2anyreg (FuncState fs, expdesc e) {
378	default:	375	luaK_dischargevars(fs, e);
379	luaK_tostack(ls, v, 1); /* all other binary operators need a value */	376	if (e->k == VNONRELOC) {
		377	if (!hasjumps(e)) return e->info; /* exp is already in a register */
		378	if (e->info >= fs->nactvar) { /* reg. is not a local? */
		379	luaK_exp2reg(fs, e, e->info); /* put value on it */
		380	return e->info;
		381	}
380	}	382	}
		383	luaK_exp2nextreg(fs, e); /* default */
		384	return e->info;
381	}	385	}
382		386
383		387
		388	void luaK_exp2val (FuncState fs, expdesc e) {
		389	if (hasjumps(e))
		390	luaK_exp2anyreg(fs, e);
		391	else
		392	luaK_dischargevars(fs, e);
		393	}
384		394
385	static const struct {
386	OpCode opcode; /* opcode for each binary operator */
387	int arg; /* default argument for the opcode */
388	} codes[] = { /* ORDER OPR */
389	{OP_ADD, 0}, {OP_SUB, 0}, {OP_MULT, 0}, {OP_DIV, 0},
390	{OP_POW, 0}, {OP_CONCAT, 2},
391	{OP_JMPNE, NO_JUMP}, {OP_JMPEQ, NO_JUMP},
392	{OP_JMPLT, NO_JUMP}, {OP_JMPLE, NO_JUMP},
393	{OP_JMPGT, NO_JUMP}, {OP_JMPGE, NO_JUMP}
394	};
395		395
		396	int luaK_exp2RK (FuncState fs, expdesc e) {
		397	luaK_exp2val(fs, e);
		398	switch (e->k) {
		399	case VNIL: {
		400	if (fs->nk + MAXSTACK <= MAXARG_C) { /* constant fit in argC? */
		401	e->info = nil_constant(fs);
		402	e->k = VK;
		403	return e->info + MAXSTACK;
		404	}
		405	else break;
		406	}
		407	case VK: {
		408	if (e->info + MAXSTACK <= MAXARG_C) /* constant fit in argC? */
		409	return e->info + MAXSTACK;
		410	else break;
		411	}
		412	default: break;
		413	}
		414	/* not a constant in the right range: put it in a register */
		415	return luaK_exp2anyreg(fs, e);
		416	}
396		417
397	void luaK_posfix (LexState ls, BinOpr op, expdesc v1, expdesc *v2) {	418
398	FuncState *fs = ls->fs;	419	void luaK_storevar (FuncState fs, expdesc var, expdesc *exp) {
399	switch (op) {	420	switch (var->k) {
400	case OPR_AND: {	421	case VLOCAL: {
401	LUA_ASSERT(v1->u.l.t == NO_JUMP, "list must be closed");	422	freeexp(fs, exp);
402	discharge1(fs, v2);	423	luaK_exp2reg(fs, exp, var->info);
403	v1->u.l.t = v2->u.l.t;	424	return;
404	luaK_concat(fs, &v1->u.l.f, v2->u.l.f);	425	}
		426	case VUPVAL: {
		427	int e = luaK_exp2anyreg(fs, exp);
		428	luaK_codeABC(fs, OP_SETUPVAL, e, var->info, 0);
405	break;	429	break;
406	}	430	}
407	case OPR_OR: {	431	case VGLOBAL: {
408	LUA_ASSERT(v1->u.l.f == NO_JUMP, "list must be closed");	432	int e = luaK_exp2anyreg(fs, exp);
409	discharge1(fs, v2);	433	luaK_codeABx(fs, OP_SETGLOBAL, e, var->info);
410	v1->u.l.f = v2->u.l.f;	434	break;
411	luaK_concat(fs, &v1->u.l.t, v2->u.l.t);	435	}
		436	case VINDEXED: {
		437	int e = luaK_exp2RK(fs, exp);
		438	luaK_codeABC(fs, OP_SETTABLE, var->info, var->aux, e);
412	break;	439	break;
413	}	440	}
414	default: {	441	default: {
415	luaK_tostack(ls, v2, 1); /* `v2' must be a value */	442	lua_assert(0); /* invalid var kind to store */
416	luaK_code1(fs, codes[op].opcode, codes[op].arg);	443	break;
417	}	444	}
418	}	445	}
		446	freeexp(fs, exp);
419	}	447	}
420		448
421		449
422	static void codelineinfo (FuncState *fs) {	450	void luaK_self (FuncState fs, expdesc e, expdesc *key) {
423	Proto *f = fs->f;	451	int func;
424	LexState *ls = fs->ls;	452	luaK_exp2anyreg(fs, e);
425	if (ls->lastline > fs->lastline) {	453	freeexp(fs, e);
426	luaM_growvector(fs->L, f->lineinfo, f->nlineinfo, 2, int,	454	func = fs->freereg;
427	"line info overflow", MAX_INT);	455	luaK_reserveregs(fs, 2);
428	if (ls->lastline > fs->lastline+1)	456	luaK_codeABC(fs, OP_SELF, func, e->info, luaK_exp2RK(fs, key));
429	f->lineinfo[f->nlineinfo++] = -(ls->lastline - (fs->lastline+1));	457	freeexp(fs, key);
430	f->lineinfo[f->nlineinfo++] = fs->pc;	458	e->info = func;
431	fs->lastline = ls->lastline;	459	e->k = VNONRELOC;
432	}
433	}	460	}
434		461
435		462
436	int luaK_code0 (FuncState *fs, OpCode o) {	463	static void invertjump (FuncState fs, expdesc e) {
437	return luaK_code2(fs, o, 0, 0);	464	Instruction *pc = getjumpcontrol(fs, e->info);
		465	lua_assert(testOpMode(GET_OPCODE(*pc), OpModeT) &&
		466	GET_OPCODE(*pc) != OP_TEST);
		467	SETARG_A(pc, !(GETARG_A(pc)));
438	}	468	}
439		469
440		470
441	int luaK_code1 (FuncState *fs, OpCode o, int arg1) {	471	static int jumponcond (FuncState fs, expdesc e, int cond) {
442	return luaK_code2(fs, o, arg1, 0);	472	if (e->k == VRELOCABLE) {
		473	Instruction ie = getcode(fs, e);
		474	if (GET_OPCODE(ie) == OP_NOT) {
		475	fs->pc--; /* remove previous OP_NOT */
		476	return luaK_condjump(fs, OP_TEST, NO_REG, GETARG_B(ie), !cond);
		477	}
		478	/* else go through */
		479	}
		480	discharge2anyreg(fs, e);
		481	freeexp(fs, e);
		482	return luaK_condjump(fs, OP_TEST, NO_REG, e->info, cond);
443	}	483	}
444		484
445		485
446	int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2) {	486	void luaK_goiftrue (FuncState fs, expdesc e) {
447	Instruction i = previous_instruction(fs);	487	int pc; /* pc of last jump */
448	int delta = luaK_opproperties[o].push - luaK_opproperties[o].pop;	488	luaK_dischargevars(fs, e);
449	int optm = 0; /* 1 when there is an optimization */	489	switch (e->k) {
450	switch (o) {	490	case VK: case VTRUE: {
451	case OP_CLOSURE: {	491	pc = NO_JUMP; /* always true; do nothing */
452	delta = -arg2+1;
453	break;	492	break;
454	}	493	}
455	case OP_SETTABLE: {	494	case VFALSE: {
456	delta = -arg2;	495	pc = luaK_jump(fs); /* always jump */
457	break;	496	break;
458	}	497	}
459	case OP_SETLIST: {	498	case VJMP: {
460	if (arg2 == 0) return NO_JUMP; /* nothing to do */	499	invertjump(fs, e);
461	delta = -arg2;	500	pc = e->info;
462	break;	501	break;
463	}	502	}
464	case OP_SETMAP: {	503	default: {
465	if (arg1 == 0) return NO_JUMP; /* nothing to do */	504	pc = jumponcond(fs, e, 0);
466	delta = -2*arg1;
467	break;	505	break;
468	}	506	}
469	case OP_RETURN: {	507	}
470	if (GET_OPCODE(i) == OP_CALL && GETARG_B(i) == MULT_RET) {	508	luaK_concat(fs, &e->f, pc); /* insert last jump in `f' list */
471	SET_OPCODE(i, OP_TAILCALL);	509	}
472	SETARG_B(i, arg1);	510
473	optm = 1;	511
474	}	512	void luaK_goiffalse (FuncState fs, expdesc e) {
		513	int pc; /* pc of last jump */
		514	luaK_dischargevars(fs, e);
		515	switch (e->k) {
		516	case VNIL: case VFALSE: {
		517	pc = NO_JUMP; /* always false; do nothing */
475	break;	518	break;
476	}	519	}
477	case OP_PUSHNIL: {	520	case VTRUE: {
478	if (arg1 == 0) return NO_JUMP; /* nothing to do */	521	pc = luaK_jump(fs); /* always jump */
479	delta = arg1;
480	switch(GET_OPCODE(i)) {
481	case OP_PUSHNIL: SETARG_U(i, GETARG_U(i)+arg1); optm = 1; break;
482	default: break;
483	}
484	break;	522	break;
485	}	523	}
486	case OP_POP: {	524	case VJMP: {
487	if (arg1 == 0) return NO_JUMP; /* nothing to do */	525	pc = e->info;
488	delta = -arg1;
489	switch(GET_OPCODE(i)) {
490	case OP_SETTABLE: SETARG_B(i, GETARG_B(i)+arg1); optm = 1; break;
491	default: break;
492	}
493	break;	526	break;
494	}	527	}
495	case OP_GETTABLE: {	528	default: {
496	switch(GET_OPCODE(i)) {	529	pc = jumponcond(fs, e, 1);
497	case OP_PUSHSTRING: /* `t.x' */
498	SET_OPCODE(i, OP_GETDOTTED);
499	optm = 1;
500	break;
501	case OP_GETLOCAL: /* `t[i]' */
502	SET_OPCODE(i, OP_GETINDEXED);
503	optm = 1;
504	break;
505	default: break;
506	}
507	break;	530	break;
508	}	531	}
509	case OP_ADD: {	532	}
510	switch(GET_OPCODE(i)) {	533	luaK_concat(fs, &e->t, pc); /* insert last jump in `t' list */
511	case OP_PUSHINT: SET_OPCODE(i, OP_ADDI); optm = 1; break; /* `a+k' */	534	}
512	default: break;	535
513	}	536
		537	static void codenot (FuncState fs, expdesc e) {
		538	luaK_dischargevars(fs, e);
		539	switch (e->k) {
		540	case VNIL: case VFALSE: {
		541	e->k = VTRUE;
514	break;	542	break;
515	}	543	}
516	case OP_SUB: {	544	case VK: case VTRUE: {
517	switch(GET_OPCODE(i)) {	545	e->k = VFALSE;
518	case OP_PUSHINT: /* `a-k' */
519	i = CREATE_S(OP_ADDI, -GETARG_S(i));
520	optm = 1;
521	break;
522	default: break;
523	}
524	break;	546	break;
525	}	547	}
526	case OP_CONCAT: {	548	case VJMP: {
527	delta = -arg1+1;	549	invertjump(fs, e);
528	switch(GET_OPCODE(i)) {
529	case OP_CONCAT: /* `a..b..c' */
530	SETARG_U(i, GETARG_U(i)+1);
531	optm = 1;
532	break;
533	default: break;
534	}
535	break;	550	break;
536	}	551	}
537	case OP_MINUS: {	552	case VRELOCABLE:
538	switch(GET_OPCODE(i)) {	553	case VNONRELOC: {
539	case OP_PUSHINT: /* `-k' */	554	discharge2anyreg(fs, e);
540	SETARG_S(i, -GETARG_S(i));	555	freeexp(fs, e);
541	optm = 1;	556	e->info = luaK_codeABC(fs, OP_NOT, 0, e->info, 0);
542	break;	557	e->k = VRELOCABLE;
543	case OP_PUSHNUM: /* `-k' */
544	SET_OPCODE(i, OP_PUSHNEGNUM);
545	optm = 1;
546	break;
547	default: break;
548	}
549	break;	558	break;
550	}	559	}
551	case OP_JMPNE: {	560	default: {
552	if (i == CREATE_U(OP_PUSHNIL, 1)) { /* `a~=nil' */	561	lua_assert(0); /* cannot happen */
553	i = CREATE_S(OP_JMPT, NO_JUMP);
554	optm = 1;
555	}
556	break;	562	break;
557	}	563	}
558	case OP_JMPEQ: {	564	}
559	if (i == CREATE_U(OP_PUSHNIL, 1)) { /* `a==nil' */	565	/* interchange true and false lists */
560	i = CREATE_0(OP_NOT);	566	{ int temp = e->f; e->f = e->t; e->t = temp; }
561	delta = -1; /* just undo effect of previous PUSHNIL */	567	}
562	optm = 1;	568
563	}	569
564	break;	570	void luaK_indexed (FuncState fs, expdesc t, expdesc *k) {
		571	t->aux = luaK_exp2RK(fs, k);
		572	t->k = VINDEXED;
		573	}
		574
		575
		576	void luaK_prefix (FuncState fs, UnOpr op, expdesc e) {
		577	if (op == OPR_MINUS) {
		578	luaK_exp2val(fs, e);
		579	if (e->k == VK && ttisnumber(&fs->f->k[e->info]))
		580	e->info = luaK_numberK(fs, -nvalue(&fs->f->k[e->info]));
		581	else {
		582	luaK_exp2anyreg(fs, e);
		583	freeexp(fs, e);
		584	e->info = luaK_codeABC(fs, OP_UNM, 0, e->info, 0);
		585	e->k = VRELOCABLE;
565	}	586	}
566	case OP_JMPT:	587	}
567	case OP_JMPONT: {	588	else /* op == NOT */
568	switch (GET_OPCODE(i)) {	589	codenot(fs, e);
569	case OP_NOT: {	590	}
570	i = CREATE_S(OP_JMPF, NO_JUMP);	591
571	optm = 1;	592
572	break;	593	void luaK_infix (FuncState fs, BinOpr op, expdesc v) {
573	}	594	switch (op) {
574	case OP_PUSHINT: {	595	case OPR_AND: {
575	if (o == OP_JMPT) { /* JMPONT must keep original integer value */	596	luaK_goiftrue(fs, v);
576	i = CREATE_S(OP_JMP, NO_JUMP);	597	luaK_patchtohere(fs, v->t);
577	optm = 1;	598	v->t = NO_JUMP;
578	}
579	break;
580	}
581	case OP_PUSHNIL: {
582	if (GETARG_U(i) == 1) {
583	fs->pc--; /* erase previous instruction */
584	luaK_deltastack(fs, -1); /* correct stack */
585	return NO_JUMP;
586	}
587	break;
588	}
589	default: break;
590	}
591	break;	599	break;
592	}	600	}
593	case OP_JMPF:	601	case OPR_OR: {
594	case OP_JMPONF: {	602	luaK_goiffalse(fs, v);
595	switch (GET_OPCODE(i)) {	603	luaK_patchtohere(fs, v->f);
596	case OP_NOT: {	604	v->f = NO_JUMP;
597	i = CREATE_S(OP_JMPT, NO_JUMP);
598	optm = 1;
599	break;
600	}
601	case OP_PUSHINT: { /* `while 1 do ...' */
602	fs->pc--; /* erase previous instruction */
603	luaK_deltastack(fs, -1); /* correct stack */
604	return NO_JUMP;
605	}
606	case OP_PUSHNIL: { /* `repeat ... until nil' */
607	if (GETARG_U(i) == 1) {
608	i = CREATE_S(OP_JMP, NO_JUMP);
609	optm = 1;
610	}
611	break;
612	}
613	default: break;
614	}
615	break;	605	break;
616	}	606	}
617	case OP_GETDOTTED:	607	case OPR_CONCAT: {
618	case OP_GETINDEXED:	608	luaK_exp2nextreg(fs, v); /* operand must be on the `stack' */
619	case OP_TAILCALL:
620	case OP_ADDI: {
621	LUA_INTERNALERROR("instruction used only for optimizations");
622	break;	609	break;
623	}	610	}
624	default: {	611	default: {
625	LUA_ASSERT(delta != VD, "invalid delta");	612	luaK_exp2RK(fs, v);
626	break;	613	break;
627	}	614	}
628	}	615	}
629	luaK_deltastack(fs, delta);	616	}
630	if (optm) { /* optimize: put instruction in place of last one */	617
631	fs->f->code[fs->pc-1] = i; /* change previous instruction */	618
632	return fs->pc-1; /* do not generate new instruction */	619	static void codebinop (FuncState fs, expdesc res, BinOpr op,
		620	int o1, int o2) {
		621	if (op <= OPR_POW) { /* arithmetic operator? */
		622	OpCode opc = cast(OpCode, (op - OPR_ADD) + OP_ADD); /* ORDER OP */
		623	res->info = luaK_codeABC(fs, opc, 0, o1, o2);
		624	res->k = VRELOCABLE;
633	}	625	}
634	/* else build new instruction */	626	else { /* test operator */
635	switch ((enum Mode)luaK_opproperties[o].mode) {	627	static const OpCode ops[] = {OP_EQ, OP_EQ, OP_LT, OP_LE, OP_LT, OP_LE};
636	case iO: i = CREATE_0(o); break;	628	int cond = 1;
637	case iU: i = CREATE_U(o, arg1); break;	629	if (op >= OPR_GT) { /* `>' or `>='? */
638	case iS: i = CREATE_S(o, arg1); break;	630	int temp; /* exchange args and replace by `<' or `<=' */
639	case iAB: i = CREATE_AB(o, arg1, arg2); break;	631	temp = o1; o1 = o2; o2 = temp; /* o1 <==> o2 */
		632	}
		633	else if (op == OPR_NE) cond = 0;
		634	res->info = luaK_condjump(fs, ops[op - OPR_NE], cond, o1, o2);
		635	res->k = VJMP;
640	}	636	}
641	codelineinfo(fs);	637	}
		638
		639
		640	void luaK_posfix (FuncState fs, BinOpr op, expdesc e1, expdesc *e2) {
		641	switch (op) {
		642	case OPR_AND: {
		643	lua_assert(e1->t == NO_JUMP); /* list must be closed */
		644	luaK_dischargevars(fs, e2);
		645	luaK_concat(fs, &e1->f, e2->f);
		646	e1->k = e2->k; e1->info = e2->info; e1->aux = e2->aux; e1->t = e2->t;
		647	break;
		648	}
		649	case OPR_OR: {
		650	lua_assert(e1->f == NO_JUMP); /* list must be closed */
		651	luaK_dischargevars(fs, e2);
		652	luaK_concat(fs, &e1->t, e2->t);
		653	e1->k = e2->k; e1->info = e2->info; e1->aux = e2->aux; e1->f = e2->f;
		654	break;
		655	}
		656	case OPR_CONCAT: {
		657	luaK_exp2val(fs, e2);
		658	if (e2->k == VRELOCABLE && GET_OPCODE(getcode(fs, e2)) == OP_CONCAT) {
		659	lua_assert(e1->info == GETARG_B(getcode(fs, e2))-1);
		660	freeexp(fs, e1);
		661	SETARG_B(getcode(fs, e2), e1->info);
		662	e1->k = e2->k; e1->info = e2->info;
		663	}
		664	else {
		665	luaK_exp2nextreg(fs, e2);
		666	freeexp(fs, e2);
		667	freeexp(fs, e1);
		668	e1->info = luaK_codeABC(fs, OP_CONCAT, 0, e1->info, e2->info);
		669	e1->k = VRELOCABLE;
		670	}
		671	break;
		672	}
		673	default: {
		674	int o1 = luaK_exp2RK(fs, e1);
		675	int o2 = luaK_exp2RK(fs, e2);
		676	freeexp(fs, e2);
		677	freeexp(fs, e1);
		678	codebinop(fs, e1, op, o1, o2);
		679	}
		680	}
		681	}
		682
		683
		684	void luaK_fixline (FuncState *fs, int line) {
		685	fs->f->lineinfo[fs->pc - 1] = line;
		686	}
		687
		688
		689	int luaK_code (FuncState *fs, Instruction i, int line) {
		690	Proto *f = fs->f;
		691	luaK_dischargejpc(fs); /* `pc' will change */
642	/* put new instruction in code array */	692	/* put new instruction in code array */
643	luaM_growvector(fs->L, fs->f->code, fs->pc, 1, Instruction,	693	luaM_growvector(fs->L, f->code, fs->pc, f->sizecode, Instruction,
644	"code size overflow", MAX_INT);	694	MAX_INT, "code size overflow");
645	fs->f->code[fs->pc] = i;	695	f->code[fs->pc] = i;
		696	/* save corresponding line information */
		697	luaM_growvector(fs->L, f->lineinfo, fs->pc, f->sizelineinfo, int,
		698	MAX_INT, "code size overflow");
		699	f->lineinfo[fs->pc] = line;
646	return fs->pc++;	700	return fs->pc++;
647	}	701	}
648		702
649		703
650	const struct OpProperties luaK_opproperties[NUM_OPCODES] = {	704	int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) {
651	{iO, 0, 0}, /* OP_END */	705	lua_assert(getOpMode(o) == iABC);
652	{iU, 0, 0}, /* OP_RETURN */	706	return luaK_code(fs, CREATE_ABC(o, a, b, c), fs->ls->lastline);
653	{iAB, 0, 0}, /* OP_CALL */	707	}
654	{iAB, 0, 0}, /* OP_TAILCALL */	708
655	{iU, VD, 0}, /* OP_PUSHNIL */	709
656	{iU, VD, 0}, /* OP_POP */	710	int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) {
657	{iS, 1, 0}, /* OP_PUSHINT */	711	lua_assert(getOpMode(o) == iABx \|\| getOpMode(o) == iAsBx);
658	{iU, 1, 0}, /* OP_PUSHSTRING */	712	return luaK_code(fs, CREATE_ABx(o, a, bc), fs->ls->lastline);
659	{iU, 1, 0}, /* OP_PUSHNUM */	713	}
660	{iU, 1, 0}, /* OP_PUSHNEGNUM */
661	{iU, 1, 0}, /* OP_PUSHUPVALUE */
662	{iU, 1, 0}, /* OP_GETLOCAL */
663	{iU, 1, 0}, /* OP_GETGLOBAL */
664	{iO, 1, 2}, /* OP_GETTABLE */
665	{iU, 1, 1}, /* OP_GETDOTTED */
666	{iU, 1, 1}, /* OP_GETINDEXED */
667	{iU, 2, 1}, /* OP_PUSHSELF */
668	{iU, 1, 0}, /* OP_CREATETABLE */
669	{iU, 0, 1}, /* OP_SETLOCAL */
670	{iU, 0, 1}, /* OP_SETGLOBAL */
671	{iAB, VD, 0}, /* OP_SETTABLE */
672	{iAB, VD, 0}, /* OP_SETLIST */
673	{iU, VD, 0}, /* OP_SETMAP */
674	{iO, 1, 2}, /* OP_ADD */
675	{iS, 1, 1}, /* OP_ADDI */
676	{iO, 1, 2}, /* OP_SUB */
677	{iO, 1, 2}, /* OP_MULT */
678	{iO, 1, 2}, /* OP_DIV */
679	{iO, 1, 2}, /* OP_POW */
680	{iU, VD, 0}, /* OP_CONCAT */
681	{iO, 1, 1}, /* OP_MINUS */
682	{iO, 1, 1}, /* OP_NOT */
683	{iS, 0, 2}, /* OP_JMPNE */
684	{iS, 0, 2}, /* OP_JMPEQ */
685	{iS, 0, 2}, /* OP_JMPLT */
686	{iS, 0, 2}, /* OP_JMPLE */
687	{iS, 0, 2}, /* OP_JMPGT */
688	{iS, 0, 2}, /* OP_JMPGE */
689	{iS, 0, 1}, /* OP_JMPT */
690	{iS, 0, 1}, /* OP_JMPF */
691	{iS, 0, 1}, /* OP_JMPONT */
692	{iS, 0, 1}, /* OP_JMPONF */
693	{iS, 0, 0}, /* OP_JMP */
694	{iO, 0, 0}, /* OP_PUSHNILJMP */
695	{iS, 0, 0}, /* OP_FORPREP */
696	{iS, 0, 3}, /* OP_FORLOOP */
697	{iS, 2, 0}, /* OP_LFORPREP */
698	{iS, 0, 3}, /* OP_LFORLOOP */
699	{iAB, VD, 0} /* OP_CLOSURE */
700	};
701		714

src/lcode.h+31−27

 /*
-** $Id: lcode.h,v 1.16 2000/08/09 14:49:13 roberto Exp $
+** $Id: lcode.h,v 1.38 2002/12/11 12:34:22 roberto Exp $
 ** Code generator for Lua
 ** See Copyright Notice in lua.h
 */
 typedef enum BinOpr {
   OPR_ADD, OPR_SUB, OPR_MULT, OPR_DIV, OPR_POW,
   OPR_CONCAT,
-  OPR_NE, OPR_EQ, OPR_LT, OPR_LE, OPR_GT, OPR_GE,
+  OPR_NE, OPR_EQ,
+  OPR_LT, OPR_LE, OPR_GT, OPR_GE,
   OPR_AND, OPR_OR,
   OPR_NOBINOPR
 } BinOpr;
-typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_NOUNOPR } UnOpr;
+#define binopistest(op)	((op) >= OPR_NE)
-enum Mode {iO, iU, iS, iAB};  /* instruction format */
+typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_NOUNOPR } UnOpr;
-#define VD	100	/* flag for variable delta */
-extern const struct OpProperties {
+#define getcode(fs,e)	((fs)->f->code[(e)->info])
-  char mode;
-  unsigned char push;
-  unsigned char pop;
-} luaK_opproperties[];
+#define luaK_codeAsBx(fs,o,A,sBx)	luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx)
-void luaK_error (LexState *ls, const char *msg);
+int luaK_code (FuncState *fs, Instruction i, int line);
-int luaK_code0 (FuncState *fs, OpCode o);
+int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx);
-int luaK_code1 (FuncState *fs, OpCode o, int arg1);
+int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C);
-int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2);
+void luaK_fixline (FuncState *fs, int line);
+void luaK_nil (FuncState *fs, int from, int n);
+void luaK_reserveregs (FuncState *fs, int n);
+void luaK_checkstack (FuncState *fs, int n);
+int luaK_stringK (FuncState *fs, TString *s);
+int luaK_numberK (FuncState *fs, lua_Number r);
+void luaK_dischargevars (FuncState *fs, expdesc *e);
+int luaK_exp2anyreg (FuncState *fs, expdesc *e);
+void luaK_exp2nextreg (FuncState *fs, expdesc *e);
+void luaK_exp2val (FuncState *fs, expdesc *e);
+int luaK_exp2RK (FuncState *fs, expdesc *e);
+void luaK_self (FuncState *fs, expdesc *e, expdesc *key);
+void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);
+void luaK_goiftrue (FuncState *fs, expdesc *e);
+void luaK_goiffalse (FuncState *fs, expdesc *e);
+void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);
+void luaK_setcallreturns (FuncState *fs, expdesc *var, int nresults);
 int luaK_jump (FuncState *fs);
 void luaK_patchlist (FuncState *fs, int list, int target);
+void luaK_patchtohere (FuncState *fs, int list);
 void luaK_concat (FuncState *fs, int *l1, int l2);
-void luaK_goiftrue (FuncState *fs, expdesc *v, int keepvalue);
 int luaK_getlabel (FuncState *fs);
-void luaK_deltastack (FuncState *fs, int delta);
+void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v);
-void luaK_kstr (LexState *ls, int c);
+void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
-void luaK_number (FuncState *fs, Number f);
+void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, expdesc *v2);
-void luaK_adjuststack (FuncState *fs, int n);
-int luaK_lastisopen (FuncState *fs);
-void luaK_setcallreturns (FuncState *fs, int nresults);
-void luaK_tostack (LexState *ls, expdesc *v, int onlyone);
-void luaK_storevar (LexState *ls, const expdesc *var);
-void luaK_prefix (LexState *ls, UnOpr op, expdesc *v);
-void luaK_infix (LexState *ls, BinOpr op, expdesc *v);
-void luaK_posfix (LexState *ls, BinOpr op, expdesc *v1, expdesc *v2);
 #endif

src/ldebug.c+409−290

@@ -1,11 +1,14 @@
1	/*	1	/*
2	** $Id: ldebug.c,v 1.50 2000/10/30 12:38:50 roberto Exp $	2	** $Id: ldebug.c,v 1.150 2003/03/19 21:24:04 roberto Exp $
3	** Debug Interface	3	** Debug Interface
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <stdlib.h>	8	#include <stdlib.h>
		9	#include <string.h>
		10
		11	#define ldebug_c
9		12
10	#include "lua.h"	13	#include "lua.h"
11		14
@@ -20,447 +23,563 @@ · 8 unmodified lines
20	#include "lstring.h"	23	#include "lstring.h"
21	#include "ltable.h"	24	#include "ltable.h"
22	#include "ltm.h"	25	#include "ltm.h"
23	#include "luadebug.h"	26	#include "lvm.h"
24		27
25		28
26		29
27	static const char getfuncname (lua_State L, StkId f, const char **name);	30	static const char getfuncname (CallInfo ci, const char **name);
28		31
29		32
30	static void setnormalized (TObject d, const TObject s) {	33	#define isLua(ci) (!((ci)->state & CI_C))
31	if (ttype(s) == LUA_TMARK) {
32	clvalue(d) = infovalue(s)->func;
33	ttype(d) = LUA_TFUNCTION;
34	}
35	else d = s;
36	}
37		34
38		35
39	static int isLmark (StkId o) {	36	static int currentpc (CallInfo *ci) {
40	return (o && ttype(o) == LUA_TMARK && !infovalue(o)->func->isC);	37	if (!isLua(ci)) return -1; /* function is not a Lua function? */
		38	if (ci->state & CI_HASFRAME) /* function has a frame? */
		39	ci->u.l.savedpc = ci->u.l.pc; / use `pc' from there */
		40	/* function's pc is saved */
		41	return pcRel(ci->u.l.savedpc, ci_func(ci)->l.p);
41	}	42	}
42		43
43		44
44	LUA_API lua_Hook lua_setcallhook (lua_State *L, lua_Hook func) {	45	static int currentline (CallInfo *ci) {
45	lua_Hook oldhook = L->callhook;	46	int pc = currentpc(ci);
46	L->callhook = func;	47	if (pc < 0)
47	return oldhook;	48	return -1; /* only active lua functions have current-line information */
		49	else
		50	return getline(ci_func(ci)->l.p, pc);
48	}	51	}
49		52
50		53
51	LUA_API lua_Hook lua_setlinehook (lua_State *L, lua_Hook func) {	54	void luaG_inithooks (lua_State *L) {
52	lua_Hook oldhook = L->linehook;	55	CallInfo *ci;
53	L->linehook = func;	56	for (ci = L->ci; ci != L->base_ci; ci--) /* update all `savedpc's */
54	return oldhook;	57	currentpc(ci);
		58	L->hookinit = 1;
55	}	59	}
56		60
57		61
58	static StkId aux_stackedfunction (lua_State *L, int level, StkId top) {	62	/*
59	int i;	63	** this function can be called asynchronous (e.g. during a signal)
60	for (i = (top-1) - L->stack; i>=0; i--) {	64	*/
61	if (is_T_MARK(L->stack[i].ttype)) {	65	LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
62	if (level == 0)	66	if (func == NULL \|\| mask == 0) { /* turn off hooks? */
63	return L->stack+i;	67	mask = 0;
64	level--;	68	func = NULL;
65	}
66	}	69	}
67	return NULL;	70	L->hook = func;
		71	L->basehookcount = count;
		72	resethookcount(L);
		73	L->hookmask = cast(lu_byte, mask);
		74	L->hookinit = 0;
		75	return 1;
68	}	76	}
69		77
70		78
71	LUA_API int lua_getstack (lua_State L, int level, lua_Debug ar) {	79	LUA_API lua_Hook lua_gethook (lua_State *L) {
72	StkId f = aux_stackedfunction(L, level, L->top);	80	return L->hook;
73	if (f == NULL) return 0; /* there is no such level */
74	else {
75	ar->_func = f;
76	return 1;
77	}
78	}	81	}
79		82
80		83
81	static int nups (StkId f) {	84	LUA_API int lua_gethookmask (lua_State *L) {
82	switch (ttype(f)) {	85	return L->hookmask;
83	case LUA_TFUNCTION:
84	return clvalue(f)->nupvalues;
85	case LUA_TMARK:
86	return infovalue(f)->func->nupvalues;
87	default:
88	return 0;
89	}
90	}	86	}
91		87
92		88
93	int luaG_getline (int lineinfo, int pc, int refline, int prefi) {	89	LUA_API int lua_gethookcount (lua_State *L) {
94	int refi;	90	return L->basehookcount;
95	if (lineinfo == NULL \|\| pc == -1)
96	return -1; /* no line info or function is not active */
97	refi = prefi ? *prefi : 0;
98	if (lineinfo[refi] < 0)
99	refline += -lineinfo[refi++];
100	LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info");
101	while (lineinfo[refi] > pc) {
102	refline--;
103	refi--;
104	if (lineinfo[refi] < 0)
105	refline -= -lineinfo[refi--];
106	LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info");
107	}
108	for (;;) {
109	int nextline = refline + 1;
110	int nextref = refi + 1;
111	if (lineinfo[nextref] < 0)
112	nextline += -lineinfo[nextref++];
113	LUA_ASSERT(lineinfo[nextref] >= 0, "invalid line info");
114	if (lineinfo[nextref] > pc)
115	break;
116	refline = nextline;
117	refi = nextref;
118	}
119	if (prefi) *prefi = refi;
120	return refline;
121	}	91	}
122		92
123		93
124	static int currentpc (StkId f) {	94	LUA_API int lua_getstack (lua_State L, int level, lua_Debug ar) {
125	CallInfo *ci = infovalue(f);	95	int status;
126	LUA_ASSERT(isLmark(f), "function has no pc");	96	CallInfo *ci;
127	if (ci->pc)	97	lua_lock(L);
128	return (*ci->pc - ci->func->f.l->code) - 1;	98	for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) {
129	else	99	level--;
130	return -1; /* function is not active */	100	if (!(ci->state & CI_C)) /* Lua function? */
131	}	101	level -= ci->u.l.tailcalls; /* skip lost tail calls */
132		102	}
133		103	if (level > 0 \|\| ci == L->base_ci) status = 0; /* there is no such level */
134	static int currentline (StkId f) {	104	else if (level < 0) { /* level is of a lost tail call */
135	if (!isLmark(f))	105	status = 1;
136	return -1; /* only active lua functions have current-line information */	106	ar->i_ci = 0;
		107	}
137	else {	108	else {
138	CallInfo *ci = infovalue(f);	109	status = 1;
139	int *lineinfo = ci->func->f.l->lineinfo;	110	ar->i_ci = ci - L->base_ci;
140	return luaG_getline(lineinfo, currentpc(f), 1, NULL);
141	}	111	}
		112	lua_unlock(L);
		113	return status;
142	}	114	}
143		115
144		116
145		117	static Proto getluaproto (CallInfo ci) {
146	static Proto *getluaproto (StkId f) {	118	return (isLua(ci) ? ci_func(ci)->l.p : NULL);
147	return (isLmark(f) ? infovalue(f)->func->f.l : NULL);
148	}	119	}
149		120
150		121
151	LUA_API const char lua_getlocal (lua_State L, const lua_Debug *ar, int n) {	122	LUA_API const char lua_getlocal (lua_State L, const lua_Debug *ar, int n) {
152	const char *name;	123	const char *name;
153	StkId f = ar->_func;	124	CallInfo *ci;
154	Proto *fp = getluaproto(f);	125	Proto *fp;
155	if (!fp) return NULL; /* `f' is not a Lua function? */	126	lua_lock(L);
156	name = luaF_getlocalname(fp, n, currentpc(f));	127	name = NULL;
157	if (!name) return NULL;	128	ci = L->base_ci + ar->i_ci;
158	luaA_pushobject(L, (f+1)+(n-1)); /* push value */	129	fp = getluaproto(ci);
		130	if (fp) { /* is a Lua function? */
		131	name = luaF_getlocalname(fp, n, currentpc(ci));
		132	if (name)
		133	luaA_pushobject(L, ci->base+(n-1)); /* push value */
		134	}
		135	lua_unlock(L);
159	return name;	136	return name;
160	}	137	}
161		138
162		139
163	LUA_API const char lua_setlocal (lua_State L, const lua_Debug *ar, int n) {	140	LUA_API const char lua_setlocal (lua_State L, const lua_Debug *ar, int n) {
164	const char *name;	141	const char *name;
165	StkId f = ar->_func;	142	CallInfo *ci;
166	Proto *fp = getluaproto(f);	143	Proto *fp;
		144	lua_lock(L);
		145	name = NULL;
		146	ci = L->base_ci + ar->i_ci;
		147	fp = getluaproto(ci);
167	L->top--; /* pop new value */	148	L->top--; /* pop new value */
168	if (!fp) return NULL; /* `f' is not a Lua function? */	149	if (fp) { /* is a Lua function? */
169	name = luaF_getlocalname(fp, n, currentpc(f));	150	name = luaF_getlocalname(fp, n, currentpc(ci));
170	if (!name \|\| name[0] == '(') return NULL; /* `(' starts private locals */	151	if (!name \|\| name[0] == '(') /* `(' starts private locals */
171	((f+1)+(n-1)) = L->top;	152	name = NULL;
		153	else
		154	setobjs2s(ci->base+(n-1), L->top);
		155	}
		156	lua_unlock(L);
172	return name;	157	return name;
173	}	158	}
174		159
175		160
176	static void infoLproto (lua_Debug ar, Proto f) {	161	static void funcinfo (lua_Debug *ar, StkId func) {
177	ar->source = f->source->str;	162	Closure *cl = clvalue(func);
178	ar->linedefined = f->lineDefined;	163	if (cl->c.isC) {
179	ar->what = "Lua";	164	ar->source = "=[C]";
180	}
181
182
183	static void funcinfo (lua_State L, lua_Debug ar, StkId func) {
184	Closure *cl = NULL;
185	switch (ttype(func)) {
186	case LUA_TFUNCTION:
187	cl = clvalue(func);
188	break;
189	case LUA_TMARK:
190	cl = infovalue(func)->func;
191	break;
192	default:
193	lua_error(L, "value for `lua_getinfo' is not a function");
194	}
195	if (cl->isC) {
196	ar->source = "=C";
197	ar->linedefined = -1;	165	ar->linedefined = -1;
198	ar->what = "C";	166	ar->what = "C";
199	}	167	}
200	else	168	else {
201	infoLproto(ar, cl->f.l);	169	ar->source = getstr(cl->l.p->source);
202	luaO_chunkid(ar->short_src, ar->source, sizeof(ar->short_src));	170	ar->linedefined = cl->l.p->lineDefined;
203	if (ar->linedefined == 0)	171	ar->what = (ar->linedefined == 0) ? "main" : "Lua";
204	ar->what = "main";
205	}
206
207
208	static const char travtagmethods (lua_State L, const TObject *o) {
209	if (ttype(o) == LUA_TFUNCTION) {
210	int e;
211	for (e=0; e<TM_N; e++) {
212	int t;
213	for (t=0; t<=L->last_tag; t++)
214	if (clvalue(o) == luaT_gettm(L, t, e))
215	return luaT_eventname[e];
216	}
217	}	172	}
218	return NULL;	173	luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
219	}	174	}
220		175
221		176
222	static const char travglobals (lua_State L, const TObject *o) {	177	static const char travglobals (lua_State L, const TObject *o) {
223	Hash *g = L->gt;	178	Table *g = hvalue(gt(L));
224	int i;	179	int i = sizenode(g);
225	for (i=0; i<g->size; i++) {	180	while (i--) {
226	if (luaO_equalObj(o, val(node(g, i))) &&	181	Node *n = gnode(g, i);
227	ttype(key(node(g, i))) == LUA_TSTRING)	182	if (luaO_rawequalObj(o, gval(n)) && ttisstring(gkey(n)))
228	return tsvalue(key(node(g, i)))->str;	183	return getstr(tsvalue(gkey(n)));
229	}	184	}
230	return NULL;	185	return NULL;
231	}	186	}
232		187
233		188
234	static void getname (lua_State L, StkId f, lua_Debug ar) {	189	static void info_tailcall (lua_State L, lua_Debug ar) {
235	TObject o;	190	ar->name = ar->namewhat = "";
236	setnormalized(&o, f);	191	ar->what = "tail";
237	/* try to find a name for given function */	192	ar->linedefined = ar->currentline = -1;
238	if ((ar->name = travglobals(L, &o)) != NULL)	193	ar->source = "=(tail call)";
239	ar->namewhat = "global";	194	luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
240	/* not found: try tag methods */	195	ar->nups = 0;
241	else if ((ar->name = travtagmethods(L, &o)) != NULL)	196	setnilvalue(L->top);
242	ar->namewhat = "tag-method";
243	else ar->namewhat = ""; /* not found at all */
244	}	197	}
245		198
246		199
247	LUA_API int lua_getinfo (lua_State L, const char what, lua_Debug *ar) {	200	static int auxgetinfo (lua_State L, const char what, lua_Debug *ar,
248	StkId func;	201	StkId f, CallInfo *ci) {
249	int isactive = (*what != '>');	202	int status = 1;
250	if (isactive)
251	func = ar->_func;
252	else {
253	what++; /* skip the '>' */
254	func = L->top - 1;
255	}
256	for (; *what; what++) {	203	for (; *what; what++) {
257	switch (*what) {	204	switch (*what) {
258	case 'S': {	205	case 'S': {
259	funcinfo(L, ar, func);	206	funcinfo(ar, f);
260	break;	207	break;
261	}	208	}
262	case 'l': {	209	case 'l': {
263	ar->currentline = currentline(func);	210	ar->currentline = (ci) ? currentline(ci) : -1;
264	break;	211	break;
265	}	212	}
266	case 'u': {	213	case 'u': {
267	ar->nups = nups(func);	214	ar->nups = clvalue(f)->c.nupvalues;
268	break;	215	break;
269	}	216	}
270	case 'n': {	217	case 'n': {
271	ar->namewhat = (isactive) ? getfuncname(L, func, &ar->name) : NULL;	218	ar->namewhat = (ci) ? getfuncname(ci, &ar->name) : NULL;
272	if (ar->namewhat == NULL)	219	if (ar->namewhat == NULL) {
273	getname(L, func, ar);	220	/* try to find a global name */
		221	if ((ar->name = travglobals(L, f)) != NULL)
		222	ar->namewhat = "global";
		223	else ar->namewhat = ""; /* not found */
		224	}
274	break;	225	break;
275	}	226	}
276	case 'f': {	227	case 'f': {
277	setnormalized(L->top, func);	228	setobj2s(L->top, f);
278	incr_top; /* push function */
279	break;	229	break;
280	}	230	}
281	default: return 0; /* invalid option */	231	default: status = 0; /* invalid option */
282	}	232	}
283	}	233	}
284	if (!isactive) L->top--; /* pop function */	234	return status;
285	return 1;	235	}
		236
		237
		238	LUA_API int lua_getinfo (lua_State L, const char what, lua_Debug *ar) {
		239	int status = 1;
		240	lua_lock(L);
		241	if (*what == '>') {
		242	StkId f = L->top - 1;
		243	if (!ttisfunction(f))
		244	luaG_runerror(L, "value for `lua_getinfo' is not a function");
		245	status = auxgetinfo(L, what + 1, ar, f, NULL);
		246	L->top--; /* pop function */
		247	}
		248	else if (ar->i_ci != 0) { /* no tail call? */
		249	CallInfo *ci = L->base_ci + ar->i_ci;
		250	lua_assert(ttisfunction(ci->base - 1));
		251	status = auxgetinfo(L, what, ar, ci->base - 1, ci);
		252	}
		253	else
		254	info_tailcall(L, ar);
		255	if (strchr(what, 'f')) incr_top(L);
		256	lua_unlock(L);
		257	return status;
286	}	258	}
287		259
288		260
289	/*	261	/*
290	** {======================================================	262	** {======================================================
291	** Symbolic Execution	263	** Symbolic Execution and code checker
292	** =======================================================	264	** =======================================================
293	*/	265	*/
294		266
		267	#define check(x) if (!(x)) return 0;
		268
		269	#define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode)
		270
		271	#define checkreg(pt,reg) check((reg) < (pt)->maxstacksize)
		272
		273
295		274
296	static int pushpc (int *stack, int pc, int top, int n) {	275	static int precheck (const Proto *pt) {
297	while (n--)	276	check(pt->maxstacksize <= MAXSTACK);
298	stack[top++] = pc-1;	277	check(pt->sizelineinfo == pt->sizecode \|\| pt->sizelineinfo == 0);
299	return top;	278	lua_assert(pt->numparams+pt->is_vararg <= pt->maxstacksize);
		279	check(GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN);
		280	return 1;
300	}	281	}
301		282
302		283
303	static Instruction luaG_symbexec (const Proto *pt, int lastpc, int stackpos) {	284	static int checkopenop (const Proto *pt, int pc) {
304	int stack[MAXSTACK]; /* stores last instruction that changed a stack entry */	285	Instruction i = pt->code[pc+1];
305	const Instruction *code = pt->code;	286	switch (GET_OPCODE(i)) {
306	int top = pt->numparams;	287	case OP_CALL:
307	int pc = 0;	288	case OP_TAILCALL:
308	if (pt->is_vararg) /* varargs? */	289	case OP_RETURN: {
309	top++; /* `arg' */	290	check(GETARG_B(i) == 0);
310	while (pc < lastpc) {	291	return 1;
311	const Instruction i = code[pc++];	292	}
312	LUA_ASSERT(0 <= top && top <= pt->maxstacksize, "wrong stack");	293	case OP_SETLISTO: return 1;
313	switch (GET_OPCODE(i)) {	294	default: return 0; /* invalid instruction after an open call */
314	case OP_RETURN: {	295	}
315	LUA_ASSERT(top >= GETARG_U(i), "wrong stack");	296	}
316	top = GETARG_U(i);	297
		298
		299	static int checkRK (const Proto *pt, int r) {
		300	return (r < pt->maxstacksize \|\| (r >= MAXSTACK && r-MAXSTACK < pt->sizek));
		301	}
		302
		303
		304	static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) {
		305	int pc;
		306	int last; /* stores position of last instruction that changed `reg' */
		307	last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */
		308	check(precheck(pt));
		309	for (pc = 0; pc < lastpc; pc++) {
		310	const Instruction i = pt->code[pc];
		311	OpCode op = GET_OPCODE(i);
		312	int a = GETARG_A(i);
		313	int b = 0;
		314	int c = 0;
		315	checkreg(pt, a);
		316	switch (getOpMode(op)) {
		317	case iABC: {
		318	b = GETARG_B(i);
		319	c = GETARG_C(i);
		320	if (testOpMode(op, OpModeBreg)) {
		321	checkreg(pt, b);
		322	}
		323	else if (testOpMode(op, OpModeBrk))
		324	check(checkRK(pt, b));
		325	if (testOpMode(op, OpModeCrk))
		326	check(checkRK(pt, c));
317	break;	327	break;
318	}	328	}
319	case OP_TAILCALL: {	329	case iABx: {
320	LUA_ASSERT(top >= GETARG_A(i), "wrong stack");	330	b = GETARG_Bx(i);
321	top = GETARG_B(i);	331	if (testOpMode(op, OpModeK)) check(b < pt->sizek);
		332	break;
		333	}
		334	case iAsBx: {
		335	b = GETARG_sBx(i);
322	break;	336	break;
323	}	337	}
324	case OP_CALL: {	338	}
325	int nresults = GETARG_B(i);	339	if (testOpMode(op, OpModesetA)) {
326	if (nresults == MULT_RET) nresults = 1;	340	if (a == reg) last = pc; /* change register `a' */
327	LUA_ASSERT(top >= GETARG_A(i), "wrong stack");	341	}
328	top = pushpc(stack, pc, GETARG_A(i), nresults);	342	if (testOpMode(op, OpModeT)) {
		343	check(pc+2 < pt->sizecode); /* check skip */
		344	check(GET_OPCODE(pt->code[pc+1]) == OP_JMP);
		345	}
		346	switch (op) {
		347	case OP_LOADBOOL: {
		348	check(c == 0 \|\| pc+2 < pt->sizecode); /* check its jump */
329	break;	349	break;
330	}	350	}
331	case OP_PUSHNIL: {	351	case OP_LOADNIL: {
332	top = pushpc(stack, pc, top, GETARG_U(i));	352	if (a <= reg && reg <= b)
		353	last = pc; /* set registers from `a' to `b' */
333	break;	354	break;
334	}	355	}
335	case OP_POP: {	356	case OP_GETUPVAL:
336	top -= GETARG_U(i);	357	case OP_SETUPVAL: {
		358	check(b < pt->nups);
337	break;	359	break;
338	}	360	}
339	case OP_SETTABLE:	361	case OP_GETGLOBAL:
340	case OP_SETLIST: {	362	case OP_SETGLOBAL: {
341	top -= GETARG_B(i);	363	check(ttisstring(&pt->k[b]));
342	break;	364	break;
343	}	365	}
344	case OP_SETMAP: {	366	case OP_SELF: {
345	top -= 2*GETARG_U(i);	367	checkreg(pt, a+1);
		368	if (reg == a+1) last = pc;
346	break;	369	break;
347	}	370	}
348	case OP_CONCAT: {	371	case OP_CONCAT: {
349	top -= GETARG_U(i);	372	/* `c' is a register, and at least two operands */
350	stack[top++] = pc-1;	373	check(c < MAXSTACK && b < c);
351	break;	374	break;
352	}	375	}
353	case OP_CLOSURE: {	376	case OP_TFORLOOP:
354	top -= GETARG_B(i);	377	checkreg(pt, a+c+5);
355	stack[top++] = pc-1;	378	if (reg >= a) last = pc; /* affect all registers above base */
		379	/* go through */
		380	case OP_FORLOOP:
		381	checkreg(pt, a+2);
		382	/* go through */
		383	case OP_JMP: {
		384	int dest = pc+1+b;
		385	check(0 <= dest && dest < pt->sizecode);
		386	/* not full check and jump is forward and do not skip `lastpc'? */
		387	if (reg != NO_REG && pc < dest && dest <= lastpc)
		388	pc += b; /* do the jump */
356	break;	389	break;
357	}	390	}
358	case OP_JMPONT:	391	case OP_CALL:
359	case OP_JMPONF: {	392	case OP_TAILCALL: {
360	int newpc = pc + GETARG_S(i);	393	if (b != 0) {
361	/* jump is forward and do not skip `lastpc'? */	394	checkreg(pt, a+b-1);
362	if (pc < newpc && newpc <= lastpc) {
363	stack[top-1] = pc-1; /* value comes from `and'/`or' */
364	pc = newpc; /* do the jump */
365	}	395	}
366	else	396	c--; /* c = num. returns */
367	top--; /* do not jump; pop value */	397	if (c == LUA_MULTRET) {
		398	check(checkopenop(pt, pc));
		399	}
		400	else if (c != 0)
		401	checkreg(pt, a+c-1);
		402	if (reg >= a) last = pc; /* affect all registers above base */
368	break;	403	break;
369	}	404	}
370	default: {	405	case OP_RETURN: {
371	OpCode op = GET_OPCODE(i);	406	b--; /* b = num. returns */
372	LUA_ASSERT(luaK_opproperties[op].push != VD,	407	if (b > 0) checkreg(pt, a+b-1);
373	"invalid opcode for default");	408	break;
374	top -= luaK_opproperties[op].pop;	409	}
375	LUA_ASSERT(top >= 0, "wrong stack");	410	case OP_SETLIST: {
376	top = pushpc(stack, pc, top, luaK_opproperties[op].push);	411	checkreg(pt, a + (b&(LFIELDS_PER_FLUSH-1)) + 1);
		412	break;
		413	}
		414	case OP_CLOSURE: {
		415	int nup;
		416	check(b < pt->sizep);
		417	nup = pt->p[b]->nups;
		418	check(pc + nup < pt->sizecode);
		419	for (; nup>0; nup--) {
		420	OpCode op1 = GET_OPCODE(pt->code[pc+nup]);
		421	check(op1 == OP_GETUPVAL \|\| op1 == OP_MOVE);
		422	}
		423	break;
377	}	424	}
		425	default: break;
378	}	426	}
379	}	427	}
380	return code[stack[stackpos]];	428	return pt->code[last];
381	}	429	}
382		430
		431	#undef check
		432	#undef checkjump
		433	#undef checkreg
383		434
384	static const char getobjname (lua_State L, StkId obj, const char **name) {	435	/* }====================================================== */
385	StkId func = aux_stackedfunction(L, 0, obj);	436
386	if (!isLmark(func))	437
387	return NULL; /* not an active Lua function */	438	int luaG_checkcode (const Proto *pt) {
388	else {	439	return luaG_symbexec(pt, pt->sizecode, NO_REG);
389	Proto *p = infovalue(func)->func->f.l;	440	}
390	int pc = currentpc(func);	441
391	int stackpos = obj - (func+1); /* func+1 == function base */	442
392	Instruction i = luaG_symbexec(p, pc, stackpos);	443	static const char kname (Proto p, int c) {
393	LUA_ASSERT(pc != -1, "function must be active");	444	c = c - MAXSTACK;
		445	if (c >= 0 && ttisstring(&p->k[c]))
		446	return svalue(&p->k[c]);
		447	else
		448	return "?";
		449	}
		450
		451
		452	static const char getobjname (CallInfo ci, int stackpos, const char **name) {
		453	if (isLua(ci)) { /* a Lua function? */
		454	Proto *p = ci_func(ci)->l.p;
		455	int pc = currentpc(ci);
		456	Instruction i;
		457	*name = luaF_getlocalname(p, stackpos+1, pc);
		458	if (name) / is a local? */
		459	return "local";
		460	i = luaG_symbexec(p, pc, stackpos); /* try symbolic execution */
		461	lua_assert(pc != -1);
394	switch (GET_OPCODE(i)) {	462	switch (GET_OPCODE(i)) {
395	case OP_GETGLOBAL: {	463	case OP_GETGLOBAL: {
396	*name = p->kstr[GETARG_U(i)]->str;	464	int g = GETARG_Bx(i); /* global index */
		465	lua_assert(ttisstring(&p->k[g]));
		466	*name = svalue(&p->k[g]);
397	return "global";	467	return "global";
398	}	468	}
399	case OP_GETLOCAL: {	469	case OP_MOVE: {
400	*name = luaF_getlocalname(p, GETARG_U(i)+1, pc);	470	int a = GETARG_A(i);
401	LUA_ASSERT(*name, "local must exist");	471	int b = GETARG_B(i); /* move from `b' to `a' */
402	return "local";	472	if (b < a)
		473	return getobjname(ci, b, name); /* get name for `b' */
		474	break;
403	}	475	}
404	case OP_PUSHSELF:	476	case OP_GETTABLE: {
405	case OP_GETDOTTED: {	477	int k = GETARG_C(i); /* key index */
406	*name = p->kstr[GETARG_U(i)]->str;	478	*name = kname(p, k);
407	return "field";	479	return "field";
408	}	480	}
409	default:	481	case OP_SELF: {
410	return NULL; /* no useful name found */	482	int k = GETARG_C(i); /* key index */
		483	*name = kname(p, k);
		484	return "method";
		485	}
		486	default: break;
411	}	487	}
412	}	488	}
		489	return NULL; /* no useful name found */
413	}	490	}
414		491
415		492
416	static const char getfuncname (lua_State L, StkId f, const char **name) {	493	static const char getfuncname (CallInfo ci, const char **name) {
417	StkId func = aux_stackedfunction(L, 0, f); /* calling function */	494	Instruction i;
418	if (!isLmark(func))	495	if ((isLua(ci) && ci->u.l.tailcalls > 0) \|\| !isLua(ci - 1))
419	return NULL; /* not an active Lua function */	496	return NULL; /* calling function is not Lua (or is unknown) */
420	else {	497	ci--; /* calling function */
421	Proto *p = infovalue(func)->func->f.l;	498	i = ci_func(ci)->l.p->code[currentpc(ci)];
422	int pc = currentpc(func);	499	if (GET_OPCODE(i) == OP_CALL \|\| GET_OPCODE(i) == OP_TAILCALL)
423	Instruction i;	500	return getobjname(ci, GETARG_A(i), name);
424	if (pc == -1) return NULL; /* function is not activated */	501	else
425	i = p->code[pc];	502	return NULL; /* no useful name can be found */
426	switch (GET_OPCODE(i)) {
427	case OP_CALL: case OP_TAILCALL:
428	return getobjname(L, (func+1)+GETARG_A(i), name);
429	default:
430	return NULL; /* no useful name found */
431	}
432	}
433	}	503	}
434		504
435		505
436	/* }====================================================== */	506	/* only ANSI way to check whether a pointer points to an array */
		507	static int isinstack (CallInfo ci, const TObject o) {
		508	StkId p;
		509	for (p = ci->base; p < ci->top; p++)
		510	if (o == p) return 1;
		511	return 0;
		512	}
437		513
438		514
439	void luaG_typeerror (lua_State L, StkId o, const char op) {	515	void luaG_typeerror (lua_State L, const TObject o, const char *op) {
440	const char *name;	516	const char *name = NULL;
441	const char *kind = getobjname(L, o, &name);	517	const char *t = luaT_typenames[ttype(o)];
442	const char *t = luaO_typename(o);	518	const char *kind = (isinstack(L->ci, o)) ?
		519	getobjname(L->ci, o - L->base, &name) : NULL;
443	if (kind)	520	if (kind)
444	luaO_verror(L, "attempt to %.30s %.20s `%.40s' (a %.10s value)",	521	luaG_runerror(L, "attempt to %s %s `%s' (a %s value)",
445	op, kind, name, t);	522	op, kind, name, t);
446	else	523	else
447	luaO_verror(L, "attempt to %.30s a %.10s value", op, t);	524	luaG_runerror(L, "attempt to %s a %s value", op, t);
		525	}
		526
		527
		528	void luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
		529	if (ttisstring(p1)) p1 = p2;
		530	lua_assert(!ttisstring(p1));
		531	luaG_typeerror(L, p1, "concatenate");
448	}	532	}
449		533
450		534
451	void luaG_binerror (lua_State L, StkId p1, int t, const char op) {	535	void luaG_aritherror (lua_State L, const TObject p1, const TObject *p2) {
452	if (ttype(p1) == t) p1++;	536	TObject temp;
453	LUA_ASSERT(ttype(p1) != t, "must be an error");	537	if (luaV_tonumber(p1, &temp) == NULL)
454	luaG_typeerror(L, p1, op);	538	p2 = p1; /* first operand is wrong */
		539	luaG_typeerror(L, p2, "perform arithmetic on");
455	}	540	}
456		541
457		542
458	void luaG_ordererror (lua_State *L, StkId top) {	543	int luaG_ordererror (lua_State L, const TObject p1, const TObject *p2) {
459	const char *t1 = luaO_typename(top-2);	544	const char *t1 = luaT_typenames[ttype(p1)];
460	const char *t2 = luaO_typename(top-1);	545	const char *t2 = luaT_typenames[ttype(p2)];
461	if (t1[2] == t2[2])	546	if (t1[2] == t2[2])
462	luaO_verror(L, "attempt to compare two %.10s values", t1);	547	luaG_runerror(L, "attempt to compare two %s values", t1);
463	else	548	else
464	luaO_verror(L, "attempt to compare %.10s with %.10s", t1, t2);	549	luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
		550	return 0;
		551	}
		552
		553
		554	static void addinfo (lua_State L, const char msg) {
		555	CallInfo *ci = L->ci;
		556	if (isLua(ci)) { /* is Lua code? */
		557	char buff[LUA_IDSIZE]; /* add file:line information */
		558	int line = currentline(ci);
		559	luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE);
		560	luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
		561	}
		562	}
		563
		564
		565	void luaG_errormsg (lua_State *L) {
		566	if (L->errfunc != 0) { /* is there an error handling function? */
		567	StkId errfunc = restorestack(L, L->errfunc);
		568	if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR);
		569	setobjs2s(L->top, L->top - 1); /* move argument */
		570	setobjs2s(L->top - 1, errfunc); /* push function */
		571	incr_top(L);
		572	luaD_call(L, L->top - 2, 1); /* call it */
		573	}
		574	luaD_throw(L, LUA_ERRRUN);
		575	}
		576
		577
		578	void luaG_runerror (lua_State L, const char fmt, ...) {
		579	va_list argp;
		580	va_start(argp, fmt);
		581	addinfo(L, luaO_pushvfstring(L, fmt, argp));
		582	va_end(argp);
		583	luaG_errormsg(L);
465	}	584	}
466		585

src/ldebug.h+16−6

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: ldebug.h,v 1.7 2000/10/05 12:14:08 roberto Exp $	2	** $Id: ldebug.h,v 1.32 2002/11/18 11:01:55 roberto Exp $
3	** Auxiliary functions from Debug Interface module	3	** Auxiliary functions from Debug Interface module
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -9,13 +9,23 @@ · 3 unmodified lines
9		9
10		10
11	#include "lstate.h"	11	#include "lstate.h"
12	#include "luadebug.h"
13		12
14		13
15	void luaG_typeerror (lua_State L, StkId o, const char op);	14	#define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1)
16	void luaG_binerror (lua_State L, StkId p1, int t, const char op);	15
17	int luaG_getline (int lineinfo, int pc, int refline, int refi);	16	#define getline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : 0)
18	void luaG_ordererror (lua_State *L, StkId top);	17
		18	#define resethookcount(L) (L->hookcount = L->basehookcount)
		19
		20
		21	void luaG_inithooks (lua_State *L);
		22	void luaG_typeerror (lua_State L, const TObject o, const char *opname);
		23	void luaG_concaterror (lua_State *L, StkId p1, StkId p2);
		24	void luaG_aritherror (lua_State L, const TObject p1, const TObject *p2);
		25	int luaG_ordererror (lua_State L, const TObject p1, const TObject *p2);
		26	void luaG_runerror (lua_State L, const char fmt, ...);
		27	void luaG_errormsg (lua_State *L);
		28	int luaG_checkcode (const Proto *pt);
19		29
20		30
21	#endif	31	#endif

src/ldo.c+347−277

@@ -1,22 +1,25 @@
1	/*	1	/*
2	** $Id: ldo.c,v 1.109a 2000/10/30 12:38:50 roberto Exp $	2	** $Id: ldo.c,v 1.217 2003/04/03 13:35:34 roberto Exp $
3	** Stack and Call structure of Lua	3	** Stack and Call structure of Lua
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <setjmp.h>	8	#include <setjmp.h>
9	#include <stdio.h>
10	#include <stdlib.h>	9	#include <stdlib.h>
11	#include <string.h>	10	#include <string.h>
12		11
		12	#define ldo_c
		13
13	#include "lua.h"	14	#include "lua.h"
14		15
15	#include "ldebug.h"	16	#include "ldebug.h"
16	#include "ldo.h"	17	#include "ldo.h"
		18	#include "lfunc.h"
17	#include "lgc.h"	19	#include "lgc.h"
18	#include "lmem.h"	20	#include "lmem.h"
19	#include "lobject.h"	21	#include "lobject.h"
		22	#include "lopcodes.h"
20	#include "lparser.h"	23	#include "lparser.h"
21	#include "lstate.h"	24	#include "lstate.h"
22	#include "lstring.h"	25	#include "lstring.h"
@@ -27,362 +30,429 @@ · 4 unmodified lines
27	#include "lzio.h"	30	#include "lzio.h"
28		31
29		32
30	/* space to handle stack overflow errors */
31	#define EXTRA_STACK (2*LUA_MINSTACK)
32		33
33		34
34	void luaD_init (lua_State *L, int stacksize) {	35	/*
35	L->stack = luaM_newvector(L, stacksize+EXTRA_STACK, TObject);	36	** {======================================================
36	L->nblocks += stacksize*sizeof(TObject);	37	** Error-recovery functions (based on long jumps)
37	L->stack_last = L->stack+(stacksize-1);	38	** =======================================================
38	L->stacksize = stacksize;	39	*/
39	L->Cbase = L->top = L->stack;
40	}
41		40
42		41
43	void luaD_checkstack (lua_State *L, int n) {	42	/* chain list of long jump buffers */
44	if (L->stack_last - L->top <= n) { /* stack overflow? */	43	struct lua_longjmp {
45	if (L->stack_last-L->stack > (L->stacksize-1)) {	44	struct lua_longjmp *previous;
46	/* overflow while handling overflow */	45	jmp_buf b;
47	luaD_breakrun(L, LUA_ERRERR); /* break run without error message */	46	volatile int status; /* error code */
		47	};
		48
		49
		50	static void seterrorobj (lua_State *L, int errcode, StkId oldtop) {
		51	switch (errcode) {
		52	case LUA_ERRMEM: {
		53	setsvalue2s(oldtop, luaS_new(L, MEMERRMSG));
		54	break;
		55	}
		56	case LUA_ERRERR: {
		57	setsvalue2s(oldtop, luaS_new(L, "error in error handling"));
		58	break;
48	}	59	}
49	else {	60	case LUA_ERRSYNTAX:
50	L->stack_last += EXTRA_STACK; /* to be used by error message */	61	case LUA_ERRRUN: {
51	lua_error(L, "stack overflow");	62	setobjs2s(oldtop, L->top - 1); /* error message on current top */
		63	break;
52	}	64	}
53	}	65	}
		66	L->top = oldtop + 1;
		67	}
		68
		69
		70	void luaD_throw (lua_State *L, int errcode) {
		71	if (L->errorJmp) {
		72	L->errorJmp->status = errcode;
		73	longjmp(L->errorJmp->b, 1);
		74	}
		75	else {
		76	G(L)->panic(L);
		77	exit(EXIT_FAILURE);
		78	}
		79	}
		80
		81
		82	int luaD_rawrunprotected (lua_State L, Pfunc f, void ud) {
		83	struct lua_longjmp lj;
		84	lj.status = 0;
		85	lj.previous = L->errorJmp; /* chain new error handler */
		86	L->errorJmp = &lj;
		87	if (setjmp(lj.b) == 0)
		88	(*f)(L, ud);
		89	L->errorJmp = lj.previous; /* restore old error handler */
		90	return lj.status;
54	}	91	}
55		92
56		93
57	static void restore_stack_limit (lua_State *L) {	94	static void restore_stack_limit (lua_State *L) {
58	if (L->top - L->stack < L->stacksize - 1)	95	L->stack_last = L->stack+L->stacksize-1;
59	L->stack_last = L->stack + (L->stacksize-1);	96	if (L->size_ci > LUA_MAXCALLS) { /* there was an overflow? */
		97	int inuse = (L->ci - L->base_ci);
		98	if (inuse + 1 < LUA_MAXCALLS) /* can `undo' overflow? */
		99	luaD_reallocCI(L, LUA_MAXCALLS);
		100	}
60	}	101	}
61		102
		103	/* }====================================================== */
62		104
63	/*	105
64	** Adjust stack. Set top to base+extra, pushing NILs if needed.	106	static void correctstack (lua_State L, TObject oldstack) {
65	** (we cannot add base+extra unless we are sure it fits in the stack;	107	CallInfo *ci;
66	** otherwise the result of such operation on pointers is undefined)	108	GCObject *up;
67	*/	109	L->top = (L->top - oldstack) + L->stack;
68	void luaD_adjusttop (lua_State *L, StkId base, int extra) {	110	for (up = L->openupval; up != NULL; up = up->gch.next)
69	int diff = extra-(L->top-base);	111	gcotouv(up)->v = (gcotouv(up)->v - oldstack) + L->stack;
70	if (diff <= 0)	112	for (ci = L->base_ci; ci <= L->ci; ci++) {
71	L->top = base+extra;	113	ci->top = (ci->top - oldstack) + L->stack;
72	else {	114	ci->base = (ci->base - oldstack) + L->stack;
73	luaD_checkstack(L, diff);
74	while (diff--)
75	ttype(L->top++) = LUA_TNIL;
76	}	115	}
		116	L->base = L->ci->base;
77	}	117	}
78		118
79		119
80	/*	120	void luaD_reallocstack (lua_State *L, int newsize) {
81	** Open a hole inside the stack at `pos'	121	TObject *oldstack = L->stack;
82	*/	122	luaM_reallocvector(L, L->stack, L->stacksize, newsize, TObject);
83	static void luaD_openstack (lua_State *L, StkId pos) {	123	L->stacksize = newsize;
84	int i = L->top-pos;	124	L->stack_last = L->stack+newsize-1-EXTRA_STACK;
85	while (i--) pos[i+1] = pos[i];	125	correctstack(L, oldstack);
86	incr_top;
87	}	126	}
88		127
89		128
90	static void dohook (lua_State L, lua_Debug ar, lua_Hook hook) {	129	void luaD_reallocCI (lua_State *L, int newsize) {
91	StkId old_Cbase = L->Cbase;	130	CallInfo *oldci = L->base_ci;
92	StkId old_top = L->Cbase = L->top;	131	luaM_reallocvector(L, L->base_ci, L->size_ci, newsize, CallInfo);
93	luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */	132	L->size_ci = cast(unsigned short, newsize);
94	L->allowhooks = 0; /* cannot call hooks inside a hook */	133	L->ci = (L->ci - oldci) + L->base_ci;
95	(*hook)(L, ar);	134	L->end_ci = L->base_ci + L->size_ci;
96	LUA_ASSERT(L->allowhooks == 0, "invalid allow");
97	L->allowhooks = 1;
98	L->top = old_top;
99	L->Cbase = old_Cbase;
100	}	135	}
101		136
102		137
103	void luaD_lineHook (lua_State *L, StkId func, int line, lua_Hook linehook) {	138	void luaD_growstack (lua_State *L, int n) {
104	if (L->allowhooks) {	139	if (n <= L->stacksize) /* double size is enough? */
105	lua_Debug ar;	140	luaD_reallocstack(L, 2*L->stacksize);
106	ar._func = func;	141	else
107	ar.event = "line";	142	luaD_reallocstack(L, L->stacksize + n + EXTRA_STACK);
108	ar.currentline = line;	143	}
109	dohook(L, &ar, linehook);	144
		145
		146	static void luaD_growCI (lua_State *L) {
		147	if (L->size_ci > LUA_MAXCALLS) /* overflow while handling overflow? */
		148	luaD_throw(L, LUA_ERRERR);
		149	else {
		150	luaD_reallocCI(L, 2*L->size_ci);
		151	if (L->size_ci > LUA_MAXCALLS)
		152	luaG_runerror(L, "stack overflow");
110	}	153	}
111	}	154	}
112		155
113		156
114	static void luaD_callHook (lua_State *L, StkId func, lua_Hook callhook,	157	void luaD_callhook (lua_State *L, int event, int line) {
115	const char *event) {	158	lua_Hook hook = L->hook;
116	if (L->allowhooks) {	159	if (hook && L->allowhook) {
		160	ptrdiff_t top = savestack(L, L->top);
		161	ptrdiff_t ci_top = savestack(L, L->ci->top);
117	lua_Debug ar;	162	lua_Debug ar;
118	ar._func = func;
119	ar.event = event;	163	ar.event = event;
120	infovalue(func)->pc = NULL; /* function is not active */	164	ar.currentline = line;
121	dohook(L, &ar, callhook);	165	if (event == LUA_HOOKTAILRET)
		166	ar.i_ci = 0; /* tail call; no debug information about it */
		167	else
		168	ar.i_ci = L->ci - L->base_ci;
		169	luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
		170	L->ci->top = L->top + LUA_MINSTACK;
		171	L->allowhook = 0; /* cannot call hooks inside a hook */
		172	lua_unlock(L);
		173	(*hook)(L, &ar);
		174	lua_lock(L);
		175	lua_assert(!L->allowhook);
		176	L->allowhook = 1;
		177	L->ci->top = restorestack(L, ci_top);
		178	L->top = restorestack(L, top);
122	}	179	}
123	}	180	}
124		181
125		182
126	static StkId callCclosure (lua_State L, const struct Closure cl, StkId base) {	183	static void adjust_varargs (lua_State *L, int nfixargs, StkId base) {
127	int nup = cl->nupvalues; /* number of upvalues */	184	int i;
128	StkId old_Cbase = L->Cbase;	185	Table *htab;
129	int n;	186	TObject nname;
130	L->Cbase = base; /* new base for C function */	187	int actual = L->top - base; /* actual number of arguments */
131	luaD_checkstack(L, nup+LUA_MINSTACK); /* ensure minimum stack size */	188	if (actual < nfixargs) {
132	for (n=0; n<nup; n++) /* copy upvalues as extra arguments */	189	luaD_checkstack(L, nfixargs - actual);
133	*(L->top++) = cl->upvalue[n];	190	for (; actual < nfixargs; ++actual)
134	n = (cl->f.c)(L); / do the actual call */	191	setnilvalue(L->top++);
135	L->Cbase = old_Cbase; /* restore old C base */	192	}
136	return L->top - n; /* return index of first result */	193	actual -= nfixargs; /* number of extra arguments */
		194	htab = luaH_new(L, actual, 1); /* create `arg' table */
		195	for (i=0; i<actual; i++) /* put extra arguments into `arg' table */
		196	setobj2n(luaH_setnum(L, htab, i+1), L->top - actual + i);
		197	/* store counter in field `n' */
		198	setsvalue(&nname, luaS_newliteral(L, "n"));
		199	setnvalue(luaH_set(L, htab, &nname), cast(lua_Number, actual));
		200	L->top -= actual; /* remove extra elements from the stack */
		201	sethvalue(L->top, htab);
		202	incr_top(L);
137	}	203	}
138		204
139		205
140	void luaD_callTM (lua_State L, Closure f, int nParams, int nResults) {	206	static StkId tryfuncTM (lua_State *L, StkId func) {
141	StkId base = L->top - nParams;	207	const TObject *tm = luaT_gettmbyobj(L, func, TM_CALL);
142	luaD_openstack(L, base);	208	StkId p;
143	clvalue(base) = f;	209	ptrdiff_t funcr = savestack(L, func);
144	ttype(base) = LUA_TFUNCTION;	210	if (!ttisfunction(tm))
145	luaD_call(L, base, nResults);	211	luaG_typeerror(L, func, "call");
		212	/* Open a hole inside the stack at `func' */
		213	for (p = L->top; p > func; p--) setobjs2s(p, p-1);
		214	incr_top(L);
		215	func = restorestack(L, funcr); /* previous call may change stack */
		216	setobj2s(func, tm); /* tag method is the new function to be called */
		217	return func;
146	}	218	}
147		219
148		220
149	/*	221	StkId luaD_precall (lua_State *L, StkId func) {
150	** Call a function (C or Lua). The function to be called is at *func.	222	LClosure *cl;
151	** The arguments are on the stack, right after the function.	223	ptrdiff_t funcr = savestack(L, func);
152	** When returns, the results are on the stack, starting at the original	224	if (!ttisfunction(func)) /* `func' is not a function? */
153	** function position.	225	func = tryfuncTM(L, func); /* check the `function' tag method */
154	** The number of results is nResults, unless nResults=LUA_MULTRET.	226	if (L->ci + 1 == L->end_ci) luaD_growCI(L);
155	*/	227	else condhardstacktests(luaD_reallocCI(L, L->size_ci));
156	void luaD_call (lua_State *L, StkId func, int nResults) {	228	cl = &clvalue(func)->l;
157	lua_Hook callhook;	229	if (!cl->isC) { /* Lua function? prepare its call */
158	StkId firstResult;	230	CallInfo *ci;
159	CallInfo ci;	231	Proto *p = cl->p;
160	Closure *cl;	232	if (p->is_vararg) /* varargs? */
161	if (ttype(func) != LUA_TFUNCTION) {	233	adjust_varargs(L, p->numparams, func+1);
162	/* `func' is not a function; check the `function' tag method */	234	luaD_checkstack(L, p->maxstacksize);
163	Closure *tm = luaT_gettmbyObj(L, func, TM_FUNCTION);	235	ci = ++L->ci; /* now `enter' new function */
164	if (tm == NULL)	236	L->base = L->ci->base = restorestack(L, funcr) + 1;
165	luaG_typeerror(L, func, "call");	237	ci->top = L->base + p->maxstacksize;
166	luaD_openstack(L, func);	238	ci->u.l.savedpc = p->code; /* starting point */
167	clvalue(func) = tm; /* tag method is the new function to be called */	239	ci->u.l.tailcalls = 0;
168	ttype(func) = LUA_TFUNCTION;	240	ci->state = CI_SAVEDPC;
		241	while (L->top < ci->top)
		242	setnilvalue(L->top++);
		243	L->top = ci->top;
		244	return NULL;
169	}	245	}
170	cl = clvalue(func);	246	else { /* if is a C function, call it */
171	ci.func = cl;	247	CallInfo *ci;
172	infovalue(func) = &ci;	248	int n;
173	ttype(func) = LUA_TMARK;	249	luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
174	callhook = L->callhook;	250	ci = ++L->ci; /* now `enter' new function */
175	if (callhook)	251	L->base = L->ci->base = restorestack(L, funcr) + 1;
176	luaD_callHook(L, func, callhook, "call");	252	ci->top = L->top + LUA_MINSTACK;
177	firstResult = (cl->isC ? callCclosure(L, cl, func+1) :	253	ci->state = CI_C; /* a C function */
178	luaV_execute(L, cl, func+1));	254	if (L->hookmask & LUA_MASKCALL)
179	if (callhook) /* same hook that was active at entry */	255	luaD_callhook(L, LUA_HOOKCALL, -1);
180	luaD_callHook(L, func, callhook, "return");	256	lua_unlock(L);
181	LUA_ASSERT(ttype(func) == LUA_TMARK, "invalid tag");	257	#ifdef LUA_COMPATUPVALUES
182	/* move results to `func' (to erase parameters and function) */	258	lua_pushupvalues(L);
183	if (nResults == LUA_MULTRET) {	259	#endif
184	while (firstResult < L->top) /* copy all results */	260	n = (clvalue(L->base - 1)->c.f)(L); / do the actual call */
185	func++ = firstResult++;	261	lua_lock(L);
186	L->top = func;	262	return L->top - n;
187	}	263	}
188	else { /* copy at most `nResults' */
189	for (; nResults > 0 && firstResult < L->top; nResults--)
190	func++ = firstResult++;
191	L->top = func;
192	for (; nResults > 0; nResults--) { /* if there are not enough results */
193	ttype(L->top) = LUA_TNIL; /* adjust the stack */
194	incr_top; /* must check stack space */
195	}
196	}
197	luaC_checkGC(L);
198	}	264	}
199		265
200		266
201	/*	267	static StkId callrethooks (lua_State *L, StkId firstResult) {
202	** Execute a protected call.	268	ptrdiff_t fr = savestack(L, firstResult); /* next call may change stack */
203	*/	269	luaD_callhook(L, LUA_HOOKRET, -1);
204	struct CallS { /* data to `f_call' */	270	if (!(L->ci->state & CI_C)) { /* Lua function? */
205	StkId func;	271	while (L->ci->u.l.tailcalls--) /* call hook for eventual tail calls */
206	int nresults;	272	luaD_callhook(L, LUA_HOOKTAILRET, -1);
207	};	273	}
208		274	return restorestack(L, fr);
209	static void f_call (lua_State L, void ud) {
210	struct CallS c = (struct CallS )ud;
211	luaD_call(L, c->func, c->nresults);
212	}	275	}
213		276
214		277
215	LUA_API int lua_call (lua_State *L, int nargs, int nresults) {	278	void luaD_poscall (lua_State *L, int wanted, StkId firstResult) {
216	StkId func = L->top - (nargs+1); /* function to be called */	279	StkId res;
217	struct CallS c;	280	if (L->hookmask & LUA_MASKRET)
218	int status;	281	firstResult = callrethooks(L, firstResult);
219	c.func = func; c.nresults = nresults;	282	res = L->base - 1; /* res == final position of 1st result */
220	status = luaD_runprotected(L, f_call, &c);	283	L->ci--;
221	if (status != 0) /* an error occurred? */	284	L->base = L->ci->base; /* restore base */
222	L->top = func; /* remove parameters from the stack */	285	/* move results to correct place */
223	return status;	286	while (wanted != 0 && firstResult < L->top) {
		287	setobjs2s(res++, firstResult++);
		288	wanted--;
		289	}
		290	while (wanted-- > 0)
		291	setnilvalue(res++);
		292	L->top = res;
224	}	293	}
225		294
226		295
227	/*	296	/*
228	** Execute a protected parser.	297	** Call a function (C or Lua). The function to be called is at *func.
229	*/	298	** The arguments are on the stack, right after the function.
230	struct ParserS { /* data to `f_parser' */	299	** When returns, all the results are on the stack, starting at the original
231	ZIO *z;	300	** function position.
232	int bin;	301	*/
233	};	302	void luaD_call (lua_State *L, StkId func, int nResults) {
234		303	StkId firstResult;
235	static void f_parser (lua_State L, void ud) {	304	lua_assert(!(L->ci->state & CI_CALLING));
236	struct ParserS p = (struct ParserS )ud;	305	if (++L->nCcalls >= LUA_MAXCCALLS) {
237	Proto *tf = p->bin ? luaU_undump(L, p->z) : luaY_parser(L, p->z);	306	if (L->nCcalls == LUA_MAXCCALLS)
238	luaV_Lclosure(L, tf, 0);	307	luaG_runerror(L, "C stack overflow");
		308	else if (L->nCcalls >= (LUA_MAXCCALLS + (LUA_MAXCCALLS>>3)))
		309	luaD_throw(L, LUA_ERRERR); /* error while handing stack error */
		310	}
		311	firstResult = luaD_precall(L, func);
		312	if (firstResult == NULL) /* is a Lua function? */
		313	firstResult = luaV_execute(L); /* call it */
		314	luaD_poscall(L, nResults, firstResult);
		315	L->nCcalls--;
		316	luaC_checkGC(L);
239	}	317	}
240		318
241		319
242	static int protectedparser (lua_State L, ZIO z, int bin) {	320	static void resume (lua_State L, void ud) {
243	struct ParserS p;	321	StkId firstResult;
244	unsigned long old_blocks;	322	int nargs = cast(int , ud);
245	int status;	323	CallInfo *ci = L->ci;
246	p.z = z; p.bin = bin;	324	if (ci == L->base_ci) { /* no activation record? */
247	/* before parsing, give a (good) chance to GC */	325	if (nargs >= L->top - L->base)
248	if (L->nblocks/8 >= L->GCthreshold/10)	326	luaG_runerror(L, "cannot resume dead coroutine");
249	luaC_collectgarbage(L);	327	luaD_precall(L, L->top - (nargs + 1)); /* start coroutine */
250	old_blocks = L->nblocks;
251	status = luaD_runprotected(L, f_parser, &p);
252	if (status == 0) {
253	/* add new memory to threshold (as it probably will stay) */
254	L->GCthreshold += (L->nblocks - old_blocks);
255	}	328	}
256	else if (status == LUA_ERRRUN) /* an error occurred: correct error code */	329	else if (ci->state & CI_YIELD) { /* inside a yield? */
257	status = LUA_ERRSYNTAX;	330	if (ci->state & CI_C) { /* `common' yield? */
258	return status;	331	/* finish interrupted execution of `OP_CALL' */
		332	int nresults;
		333	lua_assert((ci-1)->state & CI_SAVEDPC);
		334	lua_assert(GET_OPCODE(*((ci-1)->u.l.savedpc - 1)) == OP_CALL \|\|
		335	GET_OPCODE(*((ci-1)->u.l.savedpc - 1)) == OP_TAILCALL);
		336	nresults = GETARG_C(*((ci-1)->u.l.savedpc - 1)) - 1;
		337	luaD_poscall(L, nresults, L->top - nargs); /* complete it */
		338	if (nresults >= 0) L->top = L->ci->top;
		339	}
		340	else { /* yielded inside a hook: just continue its execution */
		341	ci->state &= ~CI_YIELD;
		342	}
		343	}
		344	else
		345	luaG_runerror(L, "cannot resume non-suspended coroutine");
		346	firstResult = luaV_execute(L);
		347	if (firstResult != NULL) /* return? */
		348	luaD_poscall(L, LUA_MULTRET, firstResult); /* finalize this coroutine */
259	}	349	}
260		350
261		351
262	static int parse_file (lua_State L, const char filename) {	352	LUA_API int lua_resume (lua_State *L, int nargs) {
263	ZIO z;
264	int status;	353	int status;
265	int bin; /* flag for file mode */	354	lu_byte old_allowhooks;
266	int c; /* look ahead char */	355	lua_lock(L);
267	FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");	356	old_allowhooks = L->allowhook;
268	if (f == NULL) return LUA_ERRFILE; /* unable to open file */	357	lua_assert(L->errfunc == 0 && L->nCcalls == 0);
269	c = fgetc(f);	358	status = luaD_rawrunprotected(L, resume, &nargs);
270	ungetc(c, f);	359	if (status != 0) { /* error? */
271	bin = (c == ID_CHUNK);	360	L->ci = L->base_ci; /* go back to initial level */
272	if (bin && f != stdin) {	361	L->base = L->ci->base;
273	f = freopen(filename, "rb", f); /* set binary mode */	362	L->nCcalls = 0;
274	if (f == NULL) return LUA_ERRFILE; /* unable to reopen file */	363	luaF_close(L, L->base); /* close eventual pending closures */
		364	seterrorobj(L, status, L->base);
		365	L->allowhook = old_allowhooks;
		366	restore_stack_limit(L);
275	}	367	}
276	lua_pushstring(L, "@");	368	lua_unlock(L);
277	lua_pushstring(L, (filename == NULL) ? "(stdin)" : filename);
278	lua_concat(L, 2);
279	c = lua_gettop(L);
280	filename = lua_tostring(L, c); /* filename = '@'..filename */
281	luaZ_Fopen(&z, f, filename);
282	status = protectedparser(L, &z, bin);
283	lua_remove(L, c); /* remove `filename' from the stack */
284	if (f != stdin)
285	fclose(f);
286	return status;
287	}
288
289
290	LUA_API int lua_dofile (lua_State L, const char filename) {
291	int status = parse_file(L, filename);
292	if (status == 0) /* parse OK? */
293	status = lua_call(L, 0, LUA_MULTRET); /* call main */
294	return status;	369	return status;
295	}	370	}
296		371
297		372
298	static int parse_buffer (lua_State L, const char buff, size_t size,	373	LUA_API int lua_yield (lua_State *L, int nresults) {
299	const char *name) {	374	CallInfo *ci;
300	ZIO z;	375	lua_lock(L);
301	if (!name) name = "?";	376	ci = L->ci;
302	luaZ_mopen(&z, buff, size, name);	377	if (L->nCcalls > 0)
303	return protectedparser(L, &z, buff[0]==ID_CHUNK);	378	luaG_runerror(L, "attempt to yield across metamethod/C-call boundary");
		379	if (ci->state & CI_C) { /* usual yield */
		380	if ((ci-1)->state & CI_C)
		381	luaG_runerror(L, "cannot yield a C function");
		382	if (L->top - nresults > L->base) { /* is there garbage in the stack? */
		383	int i;
		384	for (i=0; i<nresults; i++) /* move down results */
		385	setobjs2s(L->base + i, L->top - nresults + i);
		386	L->top = L->base + nresults;
		387	}
		388	} /* else it's an yield inside a hook: nothing to do */
		389	ci->state \|= CI_YIELD;
		390	lua_unlock(L);
		391	return -1;
304	}	392	}
305		393
306		394
307	LUA_API int lua_dobuffer (lua_State L, const char buff, size_t size, const char *name) {	395	int luaD_pcall (lua_State L, Pfunc func, void u,
308	int status = parse_buffer(L, buff, size, name);	396	ptrdiff_t old_top, ptrdiff_t ef) {
309	if (status == 0) /* parse OK? */	397	int status;
310	status = lua_call(L, 0, LUA_MULTRET); /* call main */	398	unsigned short oldnCcalls = L->nCcalls;
		399	ptrdiff_t old_ci = saveci(L, L->ci);
		400	lu_byte old_allowhooks = L->allowhook;
		401	ptrdiff_t old_errfunc = L->errfunc;
		402	L->errfunc = ef;
		403	status = luaD_rawrunprotected(L, func, u);
		404	if (status != 0) { /* an error occurred? */
		405	StkId oldtop = restorestack(L, old_top);
		406	luaF_close(L, oldtop); /* close eventual pending closures */
		407	seterrorobj(L, status, oldtop);
		408	L->nCcalls = oldnCcalls;
		409	L->ci = restoreci(L, old_ci);
		410	L->base = L->ci->base;
		411	L->allowhook = old_allowhooks;
		412	restore_stack_limit(L);
		413	}
		414	L->errfunc = old_errfunc;
311	return status;	415	return status;
312	}	416	}
313		417
314		418
315	LUA_API int lua_dostring (lua_State L, const char str) {
316	return lua_dobuffer(L, str, strlen(str), str);
317	}
318
319		419
320	/*	420	/*
321	** {======================================================	421	** Execute a protected parser.
322	** Error-recover functions (based on long jumps)
323	** =======================================================
324	*/	422	*/
325		423	struct SParser { /* data to `f_parser' */
326	/* chain list of long jump buffers */	424	ZIO *z;
327	struct lua_longjmp {	425	Mbuffer buff; /* buffer to be used by the scanner */
328	jmp_buf b;	426	int bin;
329	struct lua_longjmp *previous;
330	volatile int status; /* error code */
331	};	427	};
332		428
333		429	static void f_parser (lua_State L, void ud) {
334	static void message (lua_State L, const char s) {	430	struct SParser *p;
335	const TObject *em = luaH_getglobal(L, LUA_ERRORMESSAGE);	431	Proto *tf;
336	if (ttype(em) == LUA_TFUNCTION) {	432	Closure *cl;
337	L->top = em;	433	luaC_checkGC(L);
338	incr_top;	434	p = cast(struct SParser *, ud);
339	lua_pushstring(L, s);	435	tf = p->bin ? luaU_undump(L, p->z, &p->buff) : luaY_parser(L, p->z, &p->buff);
340	luaD_call(L, L->top-2, 0);	436	cl = luaF_newLclosure(L, 0, gt(L));
341	}	437	cl->l.p = tf;
342	}	438	setclvalue(L->top, cl);
343		439	incr_top(L);
344
345	/*
346	** Reports an error, and jumps up to the available recovery label
347	*/
348	LUA_API void lua_error (lua_State L, const char s) {
349	if (s) message(L, s);
350	luaD_breakrun(L, LUA_ERRRUN);
351	}
352
353
354	void luaD_breakrun (lua_State *L, int errcode) {
355	if (L->errorJmp) {
356	L->errorJmp->status = errcode;
357	longjmp(L->errorJmp->b, 1);
358	}
359	else {
360	if (errcode != LUA_ERRMEM)
361	message(L, "unable to recover; exiting\n");
362	exit(EXIT_FAILURE);
363	}
364	}	440	}
365		441
366		442
367	int luaD_runprotected (lua_State L, void (f)(lua_State , void ), void *ud) {	443	int luaD_protectedparser (lua_State L, ZIO z, int bin) {
368	StkId oldCbase = L->Cbase;	444	struct SParser p;
369	StkId oldtop = L->top;	445	int status;
370	struct lua_longjmp lj;	446	ptrdiff_t oldtopr = savestack(L, L->top); /* save current top */
371	int allowhooks = L->allowhooks;	447	p.z = z; p.bin = bin;
372	lj.status = 0;	448	luaZ_initbuffer(L, &p.buff);
373	lj.previous = L->errorJmp; /* chain new error handler */	449	status = luaD_rawrunprotected(L, f_parser, &p);
374	L->errorJmp = &lj;	450	luaZ_freebuffer(L, &p.buff);
375	if (setjmp(lj.b) == 0)	451	if (status != 0) { /* error? */
376	(*f)(L, ud);	452	StkId oldtop = restorestack(L, oldtopr);
377	else { /* an error occurred: restore the state */	453	seterrorobj(L, status, oldtop);
378	L->allowhooks = allowhooks;
379	L->Cbase = oldCbase;
380	L->top = oldtop;
381	restore_stack_limit(L);
382	}	454	}
383	L->errorJmp = lj.previous; /* restore old error handler */	455	return status;
384	return lj.status;
385	}	456	}
386		457
387	/* }====================================================== */
388		458

src/ldo.h+40−13

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: ldo.h,v 1.28 2000/10/06 12:45:25 roberto Exp $	2	** $Id: ldo.h,v 1.56 2002/12/04 17:29:32 roberto Exp $
3	** Stack and Call structure of Lua	3	** Stack and Call structure of Lua
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -10,24 +10,51 @@ · 4 unmodified lines
10		10
11	#include "lobject.h"	11	#include "lobject.h"
12	#include "lstate.h"	12	#include "lstate.h"
		13	#include "lzio.h"
13		14
14		15
15	/*	16	/*
16	** macro to increment stack top.	17	** macro to control inclusion of some hard tests on stack reallocation
17	** There must be always an empty slot at the L->stack.top	18	*/
18	*/	19	#ifndef HARDSTACKTESTS
19	#define incr_top {if (L->top == L->stack_last) luaD_checkstack(L, 1); L->top++;}	20	#define condhardstacktests(x) { /* empty */ }
		21	#else
		22	#define condhardstacktests(x) x
		23	#endif
20		24
21		25
22	void luaD_init (lua_State *L, int stacksize);	26	#define luaD_checkstack(L,n) \
23	void luaD_adjusttop (lua_State *L, StkId base, int extra);	27	if ((char )L->stack_last - (char )L->top <= (n)*(int)sizeof(TObject)) \
24	void luaD_lineHook (lua_State *L, StkId func, int line, lua_Hook linehook);	28	luaD_growstack(L, n); \
25	void luaD_call (lua_State *L, StkId func, int nResults);	29	else condhardstacktests(luaD_reallocstack(L, L->stacksize));
26	void luaD_callTM (lua_State L, Closure f, int nParams, int nResults);	30
27	void luaD_checkstack (lua_State *L, int n);	31
		32	#define incr_top(L) {luaD_checkstack(L,1); L->top++;}
28		33
29	void luaD_breakrun (lua_State *L, int errcode);	34	#define savestack(L,p) ((char )(p) - (char )L->stack)
30	int luaD_runprotected (lua_State L, void (f)(lua_State , void ), void *ud);	35	#define restorestack(L,n) ((TObject )((char )L->stack + (n)))
		36
		37	#define saveci(L,p) ((char )(p) - (char )L->base_ci)
		38	#define restoreci(L,n) ((CallInfo )((char )L->base_ci + (n)))
		39
		40
		41	/* type of protected functions, to be ran by `runprotected' */
		42	typedef void (Pfunc) (lua_State L, void *ud);
		43
		44	void luaD_resetprotection (lua_State *L);
		45	int luaD_protectedparser (lua_State L, ZIO z, int bin);
		46	void luaD_callhook (lua_State *L, int event, int line);
		47	StkId luaD_precall (lua_State *L, StkId func);
		48	void luaD_call (lua_State *L, StkId func, int nResults);
		49	int luaD_pcall (lua_State L, Pfunc func, void u,
		50	ptrdiff_t oldtop, ptrdiff_t ef);
		51	void luaD_poscall (lua_State *L, int wanted, StkId firstResult);
		52	void luaD_reallocCI (lua_State *L, int newsize);
		53	void luaD_reallocstack (lua_State *L, int newsize);
		54	void luaD_growstack (lua_State *L, int n);
		55
		56	void luaD_throw (lua_State *L, int errcode);
		57	int luaD_rawrunprotected (lua_State L, Pfunc f, void ud);
31		58
32		59
33	#endif	60	#endif

src/ldump.c+170−0

@@ -0,0 +1,170 @@
	1	/*
	2	** $Id: ldump.c,v 1.4 2003/02/11 23:52:12 lhf Exp $
	3	** save bytecodes
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7	#include <stddef.h>
	8
	9	#define ldump_c
	10
	11	#include "lua.h"
	12
	13	#include "lobject.h"
	14	#include "lopcodes.h"
	15	#include "lstate.h"
	16	#include "lundump.h"
	17
	18	#define DumpVector(b,n,size,D) DumpBlock(b,(n)*(size),D)
	19	#define DumpLiteral(s,D) DumpBlock("" s,(sizeof(s))-1,D)
	20
	21	typedef struct {
	22	lua_State* L;
	23	lua_Chunkwriter write;
	24	void* data;
	25	} DumpState;
	26
	27	static void DumpBlock(const void* b, size_t size, DumpState* D)
	28	{
	29	lua_unlock(D->L);
	30	(*D->write)(D->L,b,size,D->data);
	31	lua_lock(D->L);
	32	}
	33
	34	static void DumpByte(int y, DumpState* D)
	35	{
	36	char x=(char)y;
	37	DumpBlock(&x,sizeof(x),D);
	38	}
	39
	40	static void DumpInt(int x, DumpState* D)
	41	{
	42	DumpBlock(&x,sizeof(x),D);
	43	}
	44
	45	static void DumpSize(size_t x, DumpState* D)
	46	{
	47	DumpBlock(&x,sizeof(x),D);
	48	}
	49
	50	static void DumpNumber(lua_Number x, DumpState* D)
	51	{
	52	DumpBlock(&x,sizeof(x),D);
	53	}
	54
	55	static void DumpString(TString* s, DumpState* D)
	56	{
	57	if (s==NULL \|\| getstr(s)==NULL)
	58	DumpSize(0,D);
	59	else
	60	{
	61	size_t size=s->tsv.len+1; /* include trailing '\0' */
	62	DumpSize(size,D);
	63	DumpBlock(getstr(s),size,D);
	64	}
	65	}
	66
	67	static void DumpCode(const Proto* f, DumpState* D)
	68	{
	69	DumpInt(f->sizecode,D);
	70	DumpVector(f->code,f->sizecode,sizeof(*f->code),D);
	71	}
	72
	73	static void DumpLocals(const Proto* f, DumpState* D)
	74	{
	75	int i,n=f->sizelocvars;
	76	DumpInt(n,D);
	77	for (i=0; i<n; i++)
	78	{
	79	DumpString(f->locvars[i].varname,D);
	80	DumpInt(f->locvars[i].startpc,D);
	81	DumpInt(f->locvars[i].endpc,D);
	82	}
	83	}
	84
	85	static void DumpLines(const Proto* f, DumpState* D)
	86	{
	87	DumpInt(f->sizelineinfo,D);
	88	DumpVector(f->lineinfo,f->sizelineinfo,sizeof(*f->lineinfo),D);
	89	}
	90
	91	static void DumpUpvalues(const Proto* f, DumpState* D)
	92	{
	93	int i,n=f->sizeupvalues;
	94	DumpInt(n,D);
	95	for (i=0; i<n; i++) DumpString(f->upvalues[i],D);
	96	}
	97
	98	static void DumpFunction(const Proto* f, const TString* p, DumpState* D);
	99
	100	static void DumpConstants(const Proto* f, DumpState* D)
	101	{
	102	int i,n;
	103	DumpInt(n=f->sizek,D);
	104	for (i=0; i<n; i++)
	105	{
	106	const TObject* o=&f->k[i];
	107	DumpByte(ttype(o),D);
	108	switch (ttype(o))
	109	{
	110	case LUA_TNUMBER:
	111	DumpNumber(nvalue(o),D);
	112	break;
	113	case LUA_TSTRING:
	114	DumpString(tsvalue(o),D);
	115	break;
	116	case LUA_TNIL:
	117	break;
	118	default:
	119	lua_assert(0); /* cannot happen */
	120	break;
	121	}
	122	}
	123	DumpInt(n=f->sizep,D);
	124	for (i=0; i<n; i++) DumpFunction(f->p[i],f->source,D);
	125	}
	126
	127	static void DumpFunction(const Proto* f, const TString* p, DumpState* D)
	128	{
	129	DumpString((f->source==p) ? NULL : f->source,D);
	130	DumpInt(f->lineDefined,D);
	131	DumpByte(f->nups,D);
	132	DumpByte(f->numparams,D);
	133	DumpByte(f->is_vararg,D);
	134	DumpByte(f->maxstacksize,D);
	135	DumpLines(f,D);
	136	DumpLocals(f,D);
	137	DumpUpvalues(f,D);
	138	DumpConstants(f,D);
	139	DumpCode(f,D);
	140	}
	141
	142	static void DumpHeader(DumpState* D)
	143	{
	144	DumpLiteral(LUA_SIGNATURE,D);
	145	DumpByte(VERSION,D);
	146	DumpByte(luaU_endianness(),D);
	147	DumpByte(sizeof(int),D);
	148	DumpByte(sizeof(size_t),D);
	149	DumpByte(sizeof(Instruction),D);
	150	DumpByte(SIZE_OP,D);
	151	DumpByte(SIZE_A,D);
	152	DumpByte(SIZE_B,D);
	153	DumpByte(SIZE_C,D);
	154	DumpByte(sizeof(lua_Number),D);
	155	DumpNumber(TEST_NUMBER,D);
	156	}
	157
	158	/*
	159	** dump function as precompiled chunk
	160	*/
	161	void luaU_dump (lua_State* L, const Proto* Main, lua_Chunkwriter w, void* data)
	162	{
	163	DumpState D;
	164	D.L=L;
	165	D.write=w;
	166	D.data=data;
	167	DumpHeader(&D);
	168	DumpFunction(Main,NULL,&D);
	169	}
	170

src/lfunc.c+78−52

 /*
-** $Id: lfunc.c,v 1.34 2000/10/30 12:20:29 roberto Exp $
+** $Id: lfunc.c,v 1.67 2003/03/18 12:50:04 roberto Exp $
 ** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
 #include <stdlib.h>
+#define lfunc_c
 #include "lua.h"
 #include "lfunc.h"
+#include "lgc.h"
 #include "lmem.h"
+#include "lobject.h"
 #include "lstate.h"
-#define sizeclosure(n)	((int)sizeof(Closure) + (int)sizeof(TObject)*((n)-1))
+#define sizeCclosure(n)	(cast(int, sizeof(CClosure)) + \
+                         cast(int, sizeof(TObject)*((n)-1)))
+#define sizeLclosure(n)	(cast(int, sizeof(LClosure)) + \
+                         cast(int, sizeof(TObject *)*((n)-1)))
-Closure *luaF_newclosure (lua_State *L, int nelems) {
+Closure *luaF_newCclosure (lua_State *L, int nelems) {
-  int size = sizeclosure(nelems);
+  Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems)));
-  Closure *c = (Closure *)luaM_malloc(L, size);
+  luaC_link(L, valtogco(c), LUA_TFUNCTION);
-  c->next = L->rootcl;
+  c->c.isC = 1;
-  L->rootcl = c;
+  c->c.nupvalues = cast(lu_byte, nelems);
-  c->mark = c;
-  c->nupvalues = nelems;
-  L->nblocks += size;
   return c;
 }
+Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *e) {
+  Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems)));
+  luaC_link(L, valtogco(c), LUA_TFUNCTION);
+  c->l.isC = 0;
+  c->l.g = *e;
+  c->l.nupvalues = cast(lu_byte, nelems);
+  return c;
+}
+UpVal *luaF_findupval (lua_State *L, StkId level) {
+  GCObject **pp = &L->openupval;
+  UpVal *p;
+  UpVal *v;
+  while ((p = ngcotouv(*pp)) != NULL && p->v >= level) {
+    if (p->v == level) return p;
+    pp = &p->next;
+  }
+  v = luaM_new(L, UpVal);  /* not found: create a new one */
+  v->tt = LUA_TUPVAL;
+  v->marked = 1;  /* open upvalues should not be collected */
+  v->v = level;  /* current value lives in the stack */
+  v->next = *pp;  /* chain it in the proper position */
+  *pp = valtogco(v);
+  return v;
+}
+void luaF_close (lua_State *L, StkId level) {
+  UpVal *p;
+  while ((p = ngcotouv(L->openupval)) != NULL && p->v >= level) {
+    setobj(&p->value, p->v);  /* save current value (write barrier) */
+    p->v = &p->value;  /* now current value lives here */
+    L->openupval = p->next;  /* remove from `open' list */
+    luaC_link(L, valtogco(p), LUA_TUPVAL);
+  }
+}
 Proto *luaF_newproto (lua_State *L) {
   Proto *f = luaM_new(L, Proto);
-  f->knum = NULL;
+  luaC_link(L, valtogco(f), LUA_TPROTO);
-  f->nknum = 0;
+  f->k = NULL;
-  f->kstr = NULL;
+  f->sizek = 0;
-  f->nkstr = 0;
+  f->p = NULL;
-  f->kproto = NULL;
+  f->sizep = 0;
-  f->nkproto = 0;
   f->code = NULL;
-  f->ncode = 0;
+  f->sizecode = 0;
+  f->sizelineinfo = 0;
+  f->sizeupvalues = 0;
+  f->nups = 0;
+  f->upvalues = NULL;
   f->numparams = 0;
   f->is_vararg = 0;
   f->maxstacksize = 0;
-  f->marked = 0;
   f->lineinfo = NULL;
-  f->nlineinfo = 0;
+  f->sizelocvars = 0;
-  f->nlocvars = 0;
   f->locvars = NULL;
   f->lineDefined = 0;
   f->source = NULL;
-  f->next = L->rootproto;  /* chain in list of protos */
-  L->rootproto = f;
   return f;
 }
-static size_t protosize (Proto *f) {
-  return sizeof(Proto)
-       + f->nknum*sizeof(Number)
-       + f->nkstr*sizeof(TString *)
-       + f->nkproto*sizeof(Proto *)
-       + f->ncode*sizeof(Instruction)
-       + f->nlocvars*sizeof(struct LocVar)
-       + f->nlineinfo*sizeof(int);
-}
-void luaF_protook (lua_State *L, Proto *f, int pc) {
-  f->ncode = pc;  /* signal that proto was properly created */
-  L->nblocks += protosize(f);
-}
 void luaF_freeproto (lua_State *L, Proto *f) {
-  if (f->ncode > 0)  /* function was properly created? */
+  luaM_freearray(L, f->code, f->sizecode, Instruction);
-    L->nblocks -= protosize(f);
+  luaM_freearray(L, f->p, f->sizep, Proto *);
-  luaM_free(L, f->code);
+  luaM_freearray(L, f->k, f->sizek, TObject);
-  luaM_free(L, f->locvars);
+  luaM_freearray(L, f->lineinfo, f->sizelineinfo, int);
-  luaM_free(L, f->kstr);
+  luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar);
-  luaM_free(L, f->knum);
+  luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *);
-  luaM_free(L, f->kproto);
+  luaM_freelem(L, f);
-  luaM_free(L, f->lineinfo);
-  luaM_free(L, f);
 }
 void luaF_freeclosure (lua_State *L, Closure *c) {
-  L->nblocks -= sizeclosure(c->nupvalues);
+  int size = (c->c.isC) ? sizeCclosure(c->c.nupvalues) :
-  luaM_free(L, c);
+                          sizeLclosure(c->l.nupvalues);
+  luaM_free(L, c, size);
 }
 */
 const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {
   int i;
-  for (i = 0; i<f->nlocvars && f->locvars[i].startpc <= pc; i++) {
+  for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
     if (pc < f->locvars[i].endpc) {  /* is variable active? */
       local_number--;
       if (local_number == 0)
-        return f->locvars[i].varname->str;
+        return getstr(f->locvars[i].varname);
     }
   }
   return NULL;  /* not found */

src/lfunc.h+5−4

 /*
-** $Id: lfunc.h,v 1.13 2000/09/29 12:42:13 roberto Exp $
+** $Id: lfunc.h,v 1.21 2003/03/18 12:50:04 roberto Exp $
 ** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
 #include "lobject.h"
 Proto *luaF_newproto (lua_State *L);
-void luaF_protook (lua_State *L, Proto *f, int pc);
+Closure *luaF_newCclosure (lua_State *L, int nelems);
-Closure *luaF_newclosure (lua_State *L, int nelems);
+Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *e);
+UpVal *luaF_findupval (lua_State *L, StkId level);
+void luaF_close (lua_State *L, StkId level);
 void luaF_freeproto (lua_State *L, Proto *f);
 void luaF_freeclosure (lua_State *L, Closure *c);

src/lgc.c+377−237

@@ -1,11 +1,16 @@
1	/*	1	/*
2	** $Id: lgc.c,v 1.72+ 2000/10/26 12:47:05 roberto Exp $	2	** $Id: lgc.c,v 1.171 2003/04/03 13:35:34 roberto Exp $
3	** Garbage Collector	3	** Garbage Collector
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
		7	#include <string.h>
		8
		9	#define lgc_c
		10
7	#include "lua.h"	11	#include "lua.h"
8		12
		13	#include "ldebug.h"
9	#include "ldo.h"	14	#include "ldo.h"
10	#include "lfunc.h"	15	#include "lfunc.h"
11	#include "lgc.h"	16	#include "lgc.h"
@@ -18,336 +23,471 @@ · 6 unmodified lines
18		23
19		24
20	typedef struct GCState {	25	typedef struct GCState {
21	Hash tmark; / list of marked tables to be visited */	26	GCObject tmark; / list of marked objects to be traversed */
22	Closure cmark; / list of marked closures to be visited */	27	GCObject wk; / list of traversed key-weak tables (to be cleared) */
		28	GCObject wv; / list of traversed value-weak tables */
		29	GCObject wkv; / list of traversed key-value weak tables */
		30	global_State *g;
23	} GCState;	31	} GCState;
24		32
25		33
		34	/*
		35	** some userful bit tricks
		36	*/
		37	#define setbit(x,b) ((x) \|= (1<<(b)))
		38	#define resetbit(x,b) ((x) &= cast(lu_byte, ~(1<<(b))))
		39	#define testbit(x,b) ((x) & (1<<(b)))
26		40
27	static void markobject (GCState st, TObject o);	41	#define unmark(x) resetbit((x)->gch.marked, 0)
		42	#define ismarked(x) ((x)->gch.marked & ((1<<4)\|1))
28		43
		44	#define stringmark(s) setbit((s)->tsv.marked, 0)
29		45
30	/* mark a string; marks larger than 1 cannot be changed */
31	#define strmark(s) {if ((s)->marked == 0) (s)->marked = 1;}
32		46
		47	#define isfinalized(u) (!testbit((u)->uv.marked, 1))
		48	#define markfinalized(u) resetbit((u)->uv.marked, 1)
33		49
34		50
35	static void protomark (Proto *f) {	51	#define KEYWEAKBIT 1
36	if (!f->marked) {	52	#define VALUEWEAKBIT 2
37	int i;	53	#define KEYWEAK (1<<KEYWEAKBIT)
38	f->marked = 1;	54	#define VALUEWEAK (1<<VALUEWEAKBIT)
39	strmark(f->source);
40	for (i=0; i<f->nkstr; i++)
41	strmark(f->kstr[i]);
42	for (i=0; i<f->nkproto; i++)
43	protomark(f->kproto[i]);
44	for (i=0; i<f->nlocvars; i++) /* mark local-variable names */
45	strmark(f->locvars[i].varname);
46	}
47	}
48		55
49		56
50	static void markstack (lua_State L, GCState st) {
51	StkId o;
52	for (o=L->stack; o<L->top; o++)
53	markobject(st, o);
54	}
55		57
		58	#define markobject(st,o) { checkconsistency(o); \
		59	if (iscollectable(o) && !ismarked(gcvalue(o))) reallymarkobject(st,gcvalue(o)); }
56		60
57	static void marklock (lua_State L, GCState st) {	61	#define condmarkobject(st,o,c) { checkconsistency(o); \
58	int i;	62	if (iscollectable(o) && !ismarked(gcvalue(o)) && (c)) \
59	for (i=0; i<L->refSize; i++) {	63	reallymarkobject(st,gcvalue(o)); }
60	if (L->refArray[i].st == LOCK)	64
61	markobject(st, &L->refArray[i].o);	65	#define markvalue(st,t) { if (!ismarked(valtogco(t))) \
		66	reallymarkobject(st, valtogco(t)); }
		67
		68
		69
		70	static void reallymarkobject (GCState st, GCObject o) {
		71	lua_assert(!ismarked(o));
		72	setbit(o->gch.marked, 0); /* mark object */
		73	switch (o->gch.tt) {
		74	case LUA_TUSERDATA: {
		75	markvalue(st, gcotou(o)->uv.metatable);
		76	break;
		77	}
		78	case LUA_TFUNCTION: {
		79	gcotocl(o)->c.gclist = st->tmark;
		80	st->tmark = o;
		81	break;
		82	}
		83	case LUA_TTABLE: {
		84	gcotoh(o)->gclist = st->tmark;
		85	st->tmark = o;
		86	break;
		87	}
		88	case LUA_TTHREAD: {
		89	gcototh(o)->gclist = st->tmark;
		90	st->tmark = o;
		91	break;
		92	}
		93	case LUA_TPROTO: {
		94	gcotop(o)->gclist = st->tmark;
		95	st->tmark = o;
		96	break;
		97	}
		98	default: lua_assert(o->gch.tt == LUA_TSTRING);
62	}	99	}
63	}	100	}
64		101
65		102
66	static void markclosure (GCState st, Closure cl) {	103	static void marktmu (GCState *st) {
67	if (!ismarked(cl)) {	104	GCObject *u;
68	if (!cl->isC)	105	for (u = st->g->tmudata; u; u = u->gch.next) {
69	protomark(cl->f.l);	106	unmark(u); /* may be marked, if left from previous GC */
70	cl->mark = st->cmark; /* chain it for later traversal */	107	reallymarkobject(st, u);
71	st->cmark = cl;
72	}	108	}
73	}	109	}
74		110
75		111
76	static void marktagmethods (lua_State L, GCState st) {	112	/* move `dead' udata that need finalization to list `tmudata' */
77	int e;	113	void luaC_separateudata (lua_State *L) {
78	for (e=0; e<TM_N; e++) {	114	GCObject **p = &G(L)->rootudata;
79	int t;	115	GCObject *curr;
80	for (t=0; t<=L->last_tag; t++) {	116	GCObject collected = NULL; / to collect udata with gc event */
81	Closure *cl = luaT_gettm(L, t, e);	117	GCObject **lastcollected = &collected;
82	if (cl) markclosure(st, cl);	118	while ((curr = *p) != NULL) {
		119	lua_assert(curr->gch.tt == LUA_TUSERDATA);
		120	if (ismarked(curr) \|\| isfinalized(gcotou(curr)))
		121	p = &curr->gch.next; /* don't bother with them */
		122
		123	else if (fasttm(L, gcotou(curr)->uv.metatable, TM_GC) == NULL) {
		124	markfinalized(gcotou(curr)); /* don't need finalization */
		125	p = &curr->gch.next;
		126	}
		127	else { /* must call its gc method */
		128	*p = curr->gch.next;
		129	curr->gch.next = NULL; /* link `curr' at the end of `collected' list */
		130	*lastcollected = curr;
		131	lastcollected = &curr->gch.next;
83	}	132	}
84	}	133	}
		134	/* insert collected udata with gc event into `tmudata' list */
		135	*lastcollected = G(L)->tmudata;
		136	G(L)->tmudata = collected;
85	}	137	}
86		138
87		139
88	static void markobject (GCState st, TObject o) {	140	static void removekey (Node *n) {
89	switch (ttype(o)) {	141	setnilvalue(gval(n)); /* remove corresponding value ... */
90	case LUA_TUSERDATA: case LUA_TSTRING:	142	if (iscollectable(gkey(n)))
91	strmark(tsvalue(o));	143	setttype(gkey(n), LUA_TNONE); /* dead key; remove it */
92	break;
93	case LUA_TMARK:
94	markclosure(st, infovalue(o)->func);
95	break;
96	case LUA_TFUNCTION:
97	markclosure(st, clvalue(o));
98	break;
99	case LUA_TTABLE: {
100	if (!ismarked(hvalue(o))) {
101	hvalue(o)->mark = st->tmark; /* chain it in list of marked */
102	st->tmark = hvalue(o);
103	}
104	break;
105	}
106	default: break; /* numbers, etc */
107	}
108	}	144	}
109		145
110		146
111	static void markall (lua_State *L) {	147	static void traversetable (GCState st, Table h) {
112	GCState st;	148	int i;
113	st.cmark = NULL;	149	int weakkey = 0;
114	st.tmark = L->gt; /* put table of globals in mark list */	150	int weakvalue = 0;
115	L->gt->mark = NULL;	151	const TObject *mode;
116	marktagmethods(L, &st); /* mark tag methods */	152	markvalue(st, h->metatable);
117	markstack(L, &st); /* mark stack objects */	153	lua_assert(h->lsizenode \|\| h->node == st->g->dummynode);
118	marklock(L, &st); /* mark locked objects */	154	mode = gfasttm(st->g, h->metatable, TM_MODE);
119	for (;;) { /* mark tables and closures */	155	if (mode && ttisstring(mode)) { /* is there a weak mode? */
120	if (st.cmark) {	156	weakkey = (strchr(svalue(mode), 'k') != NULL);
121	int i;	157	weakvalue = (strchr(svalue(mode), 'v') != NULL);
122	Closure f = st.cmark; / get first closure from list */	158	if (weakkey \|\| weakvalue) { /* is really weak? */
123	st.cmark = f->mark; /* remove it from list */	159	GCObject **weaklist;
124	for (i=0; i<f->nupvalues; i++) /* mark its upvalues */	160	h->marked &= ~(KEYWEAK \| VALUEWEAK); /* clear bits */
125	markobject(&st, &f->upvalue[i]);	161	h->marked \|= cast(lu_byte, (weakkey << KEYWEAKBIT) \|
		162	(weakvalue << VALUEWEAKBIT));
		163	weaklist = (weakkey && weakvalue) ? &st->wkv :
		164	(weakkey) ? &st->wk :
		165	&st->wv;
		166	h->gclist = weaklist; / must be cleared after GC, ... */
		167	weaklist = valtogco(h); / ... so put in the appropriate list */
126	}	168	}
127	else if (st.tmark) {	169	}
128	int i;	170	if (!weakvalue) {
129	Hash h = st.tmark; / get first table from list */	171	i = h->sizearray;
130	st.tmark = h->mark; /* remove it from list */	172	while (i--)
131	for (i=0; i<h->size; i++) {	173	markobject(st, &h->array[i]);
132	Node *n = node(h, i);	174	}
133	if (ttype(key(n)) != LUA_TNIL) {	175	i = sizenode(h);
134	if (ttype(val(n)) == LUA_TNIL)	176	while (i--) {
135	luaH_remove(h, key(n)); /* dead element; try to remove it */	177	Node *n = gnode(h, i);
136	markobject(&st, &n->key);	178	if (!ttisnil(gval(n))) {
137	markobject(&st, &n->val);	179	lua_assert(!ttisnil(gkey(n)));
138	}	180	condmarkobject(st, gkey(n), !weakkey);
139	}	181	condmarkobject(st, gval(n), !weakvalue);
140	}	182	}
141	else break; /* nothing else to mark */
142	}	183	}
143	}	184	}
144		185
145		186
146	static int hasmark (const TObject *o) {	187	static void traverseproto (GCState st, Proto f) {
147	/* valid only for locked objects */	188	int i;
148	switch (o->ttype) {	189	stringmark(f->source);
149	case LUA_TSTRING: case LUA_TUSERDATA:	190	for (i=0; i<f->sizek; i++) { /* mark literal strings */
150	return tsvalue(o)->marked;	191	if (ttisstring(f->k+i))
151	case LUA_TTABLE:	192	stringmark(tsvalue(f->k+i));
152	return ismarked(hvalue(o));
153	case LUA_TFUNCTION:
154	return ismarked(clvalue(o));
155	default: /* number */
156	return 1;
157	}	193	}
		194	for (i=0; i<f->sizeupvalues; i++) /* mark upvalue names */
		195	stringmark(f->upvalues[i]);
		196	for (i=0; i<f->sizep; i++) /* mark nested protos */
		197	markvalue(st, f->p[i]);
		198	for (i=0; i<f->sizelocvars; i++) /* mark local-variable names */
		199	stringmark(f->locvars[i].varname);
		200	lua_assert(luaG_checkcode(f));
158	}	201	}
159		202
160		203
161	/* macro for internal debugging; check if a link of free refs is valid */
162	#define VALIDLINK(L, st,n) (NONEXT <= (st) && (st) < (n))
163		204
164	static void invalidaterefs (lua_State *L) {	205	static void traverseclosure (GCState st, Closure cl) {
165	int n = L->refSize;	206	if (cl->c.isC) {
166	int i;	207	int i;
167	for (i=0; i<n; i++) {	208	for (i=0; i<cl->c.nupvalues; i++) /* mark its upvalues */
168	struct Ref *r = &L->refArray[i];	209	markobject(st, &cl->c.upvalue[i]);
169	if (r->st == HOLD && !hasmark(&r->o))	210	}
170	r->st = COLLECTED;	211	else {
171	LUA_ASSERT((r->st == LOCK && hasmark(&r->o)) \|\|	212	int i;
172	(r->st == HOLD && hasmark(&r->o)) \|\|	213	lua_assert(cl->l.nupvalues == cl->l.p->nups);
173	r->st == COLLECTED \|\|	214	markvalue(st, hvalue(&cl->l.g));
174	r->st == NONEXT \|\|	215	markvalue(st, cl->l.p);
175	(r->st < n && VALIDLINK(L, L->refArray[r->st].st, n)),	216	for (i=0; i<cl->l.nupvalues; i++) { /* mark its upvalues */
176	"inconsistent ref table");	217	UpVal *u = cl->l.upvals[i];
		218	if (!u->marked) {
		219	markobject(st, &u->value);
		220	u->marked = 1;
		221	}
		222	}
177	}	223	}
178	LUA_ASSERT(VALIDLINK(L, L->refFree, n), "inconsistent ref table");
179	}	224	}
180		225
181		226
		227	static void checkstacksizes (lua_State *L, StkId max) {
		228	int used = L->ci - L->base_ci; /* number of `ci' in use */
		229	if (4used < L->size_ci && 2BASIC_CI_SIZE < L->size_ci)
		230	luaD_reallocCI(L, L->size_ci/2); /* still big enough... */
		231	else condhardstacktests(luaD_reallocCI(L, L->size_ci));
		232	used = max - L->stack; /* part of stack in use */
		233	if (4used < L->stacksize && 2(BASIC_STACK_SIZE+EXTRA_STACK) < L->stacksize)
		234	luaD_reallocstack(L, L->stacksize/2); /* still big enough... */
		235	else condhardstacktests(luaD_reallocstack(L, L->stacksize));
		236	}
182		237
183	static void collectproto (lua_State *L) {	238
184	Proto **p = &L->rootproto;	239	static void traversestack (GCState st, lua_State L1) {
185	Proto *next;	240	StkId o, lim;
186	while ((next = *p) != NULL) {	241	CallInfo *ci;
187	if (next->marked) {	242	markobject(st, gt(L1));
188	next->marked = 0;	243	lim = L1->top;
189	p = &next->next;	244	for (ci = L1->base_ci; ci <= L1->ci; ci++) {
190	}	245	lua_assert(ci->top <= L1->stack_last);
191	else {	246	lua_assert(ci->state & (CI_C \| CI_HASFRAME \| CI_SAVEDPC));
192	*p = next->next;	247	if (!(ci->state & CI_C) && lim < ci->top)
193	luaF_freeproto(L, next);	248	lim = ci->top;
194	}
195	}	249	}
		250	for (o = L1->stack; o < L1->top; o++)
		251	markobject(st, o);
		252	for (; o <= lim; o++)
		253	setnilvalue(o);
		254	checkstacksizes(L1, lim);
196	}	255	}
197		256
198		257
199	static void collectclosure (lua_State *L) {	258	static void propagatemarks (GCState *st) {
200	Closure **p = &L->rootcl;	259	while (st->tmark) { /* traverse marked objects */
201	Closure *next;	260	switch (st->tmark->gch.tt) {
202	while ((next = *p) != NULL) {	261	case LUA_TTABLE: {
203	if (ismarked(next)) {	262	Table *h = gcotoh(st->tmark);
204	next->mark = next; /* unmark */	263	st->tmark = h->gclist;
205	p = &next->next;	264	traversetable(st, h);
		265	break;
		266	}
		267	case LUA_TFUNCTION: {
		268	Closure *cl = gcotocl(st->tmark);
		269	st->tmark = cl->c.gclist;
		270	traverseclosure(st, cl);
		271	break;
		272	}
		273	case LUA_TTHREAD: {
		274	lua_State *th = gcototh(st->tmark);
		275	st->tmark = th->gclist;
		276	traversestack(st, th);
		277	break;
		278	}
		279	case LUA_TPROTO: {
		280	Proto *p = gcotop(st->tmark);
		281	st->tmark = p->gclist;
		282	traverseproto(st, p);
		283	break;
		284	}
		285	default: lua_assert(0);
206	}	286	}
207	else {	287	}
208	*p = next->next;	288	}
209	luaF_freeclosure(L, next);	289
		290
		291	static int valismarked (const TObject *o) {
		292	if (ttisstring(o))
		293	stringmark(tsvalue(o)); /* strings are `values', so are never weak */
		294	return !iscollectable(o) \|\| testbit(o->value.gc->gch.marked, 0);
		295	}
		296
		297
		298	/*
		299	** clear collected keys from weaktables
		300	*/
		301	static void cleartablekeys (GCObject *l) {
		302	while (l) {
		303	Table *h = gcotoh(l);
		304	int i = sizenode(h);
		305	lua_assert(h->marked & KEYWEAK);
		306	while (i--) {
		307	Node *n = gnode(h, i);
		308	if (!valismarked(gkey(n))) /* key was collected? */
		309	removekey(n); /* remove entry from table */
210	}	310	}
		311	l = h->gclist;
211	}	312	}
212	}	313	}
213		314
214		315
215	static void collecttable (lua_State *L) {	316	/*
216	Hash **p = &L->roottable;	317	** clear collected values from weaktables
217	Hash *next;	318	*/
218	while ((next = *p) != NULL) {	319	static void cleartablevalues (GCObject *l) {
219	if (ismarked(next)) {	320	while (l) {
220	next->mark = next; /* unmark */	321	Table *h = gcotoh(l);
221	p = &next->next;	322	int i = h->sizearray;
		323	lua_assert(h->marked & VALUEWEAK);
		324	while (i--) {
		325	TObject *o = &h->array[i];
		326	if (!valismarked(o)) /* value was collected? */
		327	setnilvalue(o); /* remove value */
222	}	328	}
223	else {	329	i = sizenode(h);
224	*p = next->next;	330	while (i--) {
225	luaH_free(L, next);	331	Node *n = gnode(h, i);
		332	if (!valismarked(gval(n))) /* value was collected? */
		333	removekey(n); /* remove entry from table */
226	}	334	}
		335	l = h->gclist;
227	}	336	}
228	}	337	}
229		338
230		339
231	static void checktab (lua_State L, stringtable tb) {	340	static void freeobj (lua_State L, GCObject o) {
232	if (tb->nuse < (lint32)(tb->size/4) && tb->size > 10)	341	switch (o->gch.tt) {
233	luaS_resize(L, tb, tb->size/2); /* table is too big */	342	case LUA_TPROTO: luaF_freeproto(L, gcotop(o)); break;
		343	case LUA_TFUNCTION: luaF_freeclosure(L, gcotocl(o)); break;
		344	case LUA_TUPVAL: luaM_freelem(L, gcotouv(o)); break;
		345	case LUA_TTABLE: luaH_free(L, gcotoh(o)); break;
		346	case LUA_TTHREAD: {
		347	lua_assert(gcototh(o) != L && gcototh(o) != G(L)->mainthread);
		348	luaE_freethread(L, gcototh(o));
		349	break;
		350	}
		351	case LUA_TSTRING: {
		352	luaM_free(L, o, sizestring(gcotots(o)->tsv.len));
		353	break;
		354	}
		355	case LUA_TUSERDATA: {
		356	luaM_free(L, o, sizeudata(gcotou(o)->uv.len));
		357	break;
		358	}
		359	default: lua_assert(0);
		360	}
234	}	361	}
235		362
236		363
237	static void collectstrings (lua_State *L, int all) {	364	static int sweeplist (lua_State L, GCObject *p, int limit) {
238	int i;	365	GCObject *curr;
239	for (i=0; i<L->strt.size; i++) { /* for each list */	366	int count = 0; /* number of collected items */
240	TString **p = &L->strt.hash[i];	367	while ((curr = *p) != NULL) {
241	TString *next;	368	if (curr->gch.marked > limit) {
242	while ((next = *p) != NULL) {	369	unmark(curr);
243	if (next->marked && !all) { /* preserve? */	370	p = &curr->gch.next;
244	if (next->marked < FIXMARK) /* does not change FIXMARKs */	371	}
245	next->marked = 0;	372	else {
246	p = &next->nexthash;	373	count++;
247	}	374	*p = curr->gch.next;
248	else { /* collect */	375	freeobj(L, curr);
249	*p = next->nexthash;
250	L->strt.nuse--;
251	L->nblocks -= sizestring(next->len);
252	luaM_free(L, next);
253	}
254	}	376	}
255	}	377	}
256	checktab(L, &L->strt);	378	return count;
257	}	379	}
258		380
259		381
260	static void collectudata (lua_State *L, int all) {	382	static void sweepstrings (lua_State *L, int all) {
261	int i;	383	int i;
262	for (i=0; i<L->udt.size; i++) { /* for each list */	384	for (i=0; i<G(L)->strt.size; i++) { /* for each list */
263	TString **p = &L->udt.hash[i];	385	G(L)->strt.nuse -= sweeplist(L, &G(L)->strt.hash[i], all);
264	TString *next;
265	while ((next = *p) != NULL) {
266	LUA_ASSERT(next->marked <= 1, "udata cannot be fixed");
267	if (next->marked && !all) { /* preserve? */
268	next->marked = 0;
269	p = &next->nexthash;
270	}
271	else { /* collect */
272	int tag = next->u.d.tag;
273	*p = next->nexthash;
274	next->nexthash = L->TMtable[tag].collected; /* chain udata */
275	L->TMtable[tag].collected = next;
276	L->nblocks -= sizestring(next->len);
277	L->udt.nuse--;
278	}
279	}
280	}	386	}
281	checktab(L, &L->udt);
282	}	387	}
283		388
284		389
285	#define MINBUFFER 256	390	static void checkSizes (lua_State *L) {
286	static void checkMbuffer (lua_State *L) {	391	/* check size of string hash */
287	if (L->Mbuffsize > MINBUFFER2) { / is buffer too big? */	392	if (G(L)->strt.nuse < cast(ls_nstr, G(L)->strt.size/4) &&
288	size_t newsize = L->Mbuffsize/2; /* still larger than MINBUFFER */	393	G(L)->strt.size > MINSTRTABSIZE*2)
289	L->nblocks += (newsize - L->Mbuffsize)*sizeof(char);	394	luaS_resize(L, G(L)->strt.size/2); /* table is too big */
290	L->Mbuffsize = newsize;	395	/* check size of buffer */
291	luaM_reallocvector(L, L->Mbuffer, newsize, char);	396	if (luaZ_sizebuffer(&G(L)->buff) > LUA_MINBUFFER2) { / buffer too big? */
		397	size_t newsize = luaZ_sizebuffer(&G(L)->buff) / 2;
		398	luaZ_resizebuffer(L, &G(L)->buff, newsize);
292	}	399	}
		400	G(L)->GCthreshold = 2G(L)->nblocks; / new threshold */
293	}	401	}
294		402
295		403
296	static void callgcTM (lua_State L, const TObject o) {	404	static void do1gcTM (lua_State L, Udata udata) {
297	Closure *tm = luaT_gettmbyObj(L, o, TM_GC);	405	const TObject *tm = fasttm(L, udata->uv.metatable, TM_GC);
298	if (tm != NULL) {	406	if (tm != NULL) {
299	int oldah = L->allowhooks;	407	setobj2s(L->top, tm);
300	L->allowhooks = 0; /* stop debug hooks during GC tag methods */	408	setuvalue(L->top+1, udata);
301	luaD_checkstack(L, 2);
302	clvalue(L->top) = tm;
303	ttype(L->top) = LUA_TFUNCTION;
304	(L->top+1) = o;
305	L->top += 2;	409	L->top += 2;
306	luaD_call(L, L->top-2, 0);	410	luaD_call(L, L->top - 2, 0);
307	L->allowhooks = oldah; /* restore hooks */
308	}	411	}
309	}	412	}
310		413
311		414
312	static void callgcTMudata (lua_State *L) {	415	void luaC_callGCTM (lua_State *L) {
313	int tag;	416	lu_byte oldah = L->allowhook;
314	TObject o;	417	L->allowhook = 0; /* stop debug hooks during GC tag methods */
315	ttype(&o) = LUA_TUSERDATA;	418	L->top++; /* reserve space to keep udata while runs its gc method */
316	L->GCthreshold = 2L->nblocks; / avoid GC during tag methods */	419	while (G(L)->tmudata != NULL) {
317	for (tag=L->last_tag; tag>=0; tag--) { /* for each tag (in reverse order) */	420	GCObject *o = G(L)->tmudata;
318	TString *udata;	421	Udata *udata = gcotou(o);
319	while ((udata = L->TMtable[tag].collected) != NULL) {	422	G(L)->tmudata = udata->uv.next; /* remove udata from `tmudata' */
320	L->TMtable[tag].collected = udata->nexthash; /* remove it from list */	423	udata->uv.next = G(L)->rootudata; /* return it to `root' list */
321	tsvalue(&o) = udata;	424	G(L)->rootudata = o;
322	callgcTM(L, &o);	425	setuvalue(L->top - 1, udata); /* keep a reference to it */
323	luaM_free(L, udata);	426	unmark(o);
324	}	427	markfinalized(udata);
		428	do1gcTM(L, udata);
325	}	429	}
		430	L->top--;
		431	L->allowhook = oldah; /* restore hooks */
326	}	432	}
327		433
328		434
329	void luaC_collect (lua_State *L, int all) {	435	void luaC_sweep (lua_State *L, int all) {
330	collectudata(L, all);	436	if (all) all = 256; /* larger than any mark */
331	callgcTMudata(L);	437	sweeplist(L, &G(L)->rootudata, all);
332	collectstrings(L, all);	438	sweepstrings(L, all);
333	collecttable(L);	439	sweeplist(L, &G(L)->rootgc, all);
334	collectproto(L);	440	}
335	collectclosure(L);	441
		442
		443	/* mark root set */
		444	static void markroot (GCState st, lua_State L) {
		445	global_State *g = st->g;
		446	markobject(st, defaultmeta(L));
		447	markobject(st, registry(L));
		448	traversestack(st, g->mainthread);
		449	if (L != g->mainthread) /* another thread is running? */
		450	markvalue(st, L); /* cannot collect it */
		451	}
		452
		453
		454	static void mark (lua_State *L) {
		455	GCState st;
		456	GCObject *wkv;
		457	st.g = G(L);
		458	st.tmark = NULL;
		459	st.wkv = st.wk = st.wv = NULL;
		460	markroot(&st, L);
		461	propagatemarks(&st); /* mark all reachable objects */
		462	cleartablevalues(st.wkv);
		463	cleartablevalues(st.wv);
		464	wkv = st.wkv; /* keys must be cleared after preserving udata */
		465	st.wkv = NULL;
		466	st.wv = NULL;
		467	luaC_separateudata(L); /* separate userdata to be preserved */
		468	marktmu(&st); /* mark `preserved' userdata */
		469	propagatemarks(&st); /* remark, to propagate `preserveness' */
		470	cleartablekeys(wkv);
		471	/* `propagatemarks' may resuscitate some weak tables; clear them too */
		472	cleartablekeys(st.wk);
		473	cleartablevalues(st.wv);
		474	cleartablekeys(st.wkv);
		475	cleartablevalues(st.wkv);
336	}	476	}
337		477
338		478
339	void luaC_collectgarbage (lua_State *L) {	479	void luaC_collectgarbage (lua_State *L) {
340	markall(L);	480	mark(L);
341	invalidaterefs(L); /* check unlocked references */	481	luaC_sweep(L, 0);
342	luaC_collect(L, 0);	482	checkSizes(L);
343	checkMbuffer(L);	483	luaC_callGCTM(L);
344	L->GCthreshold = 2L->nblocks; / set new threshold */
345	callgcTM(L, &luaO_nilobject);
346	}	484	}
347		485
348		486
349	void luaC_checkGC (lua_State *L) {	487	void luaC_link (lua_State L, GCObject o, lu_byte tt) {
350	if (L->nblocks >= L->GCthreshold)	488	o->gch.next = G(L)->rootgc;
351	luaC_collectgarbage(L);	489	G(L)->rootgc = o;
		490	o->gch.marked = 0;
		491	o->gch.tt = tt;
352	}	492	}
353		493

src/lgc.h+9−3

 /*
-** $Id: lgc.h,v 1.9 2001/02/02 16:23:20 roberto Exp $
+** $Id: lgc.h,v 1.19 2003/02/28 19:45:15 roberto Exp $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
 #include "lobject.h"
-void luaC_collect (lua_State *L, int all);
+#define luaC_checkGC(L) { lua_assert(!(L->ci->state & CI_CALLING)); \
+	if (G(L)->nblocks >= G(L)->GCthreshold) luaC_collectgarbage(L); }
+void luaC_separateudata (lua_State *L);
+void luaC_callGCTM (lua_State *L);
+void luaC_sweep (lua_State *L, int all);
 void luaC_collectgarbage (lua_State *L);
-void luaC_checkGC (lua_State *L);
+void luaC_link (lua_State *L, GCObject *o, lu_byte tt);
 #endif

src/lib/Makefile+5−6

@@ -4,17 +4,16 @@ LUA= ../.. · 3 unmodified lines
4		4
5	include $(LUA)/config	5	include $(LUA)/config
6		6
7	# actually only used in liolib.c	7	EXTRA_DEFS= $(POPEN) $(TMPNAM) $(DEGREES) $(LOADLIB)
8	EXTRA_DEFS= $(POPEN)
9		8
10	OBJS= lauxlib.o lbaselib.o ldblib.o liolib.o lmathlib.o lstrlib.o	9	OBJS= lauxlib.o lbaselib.o ldblib.o liolib.o lmathlib.o ltablib.o lstrlib.o loadlib.o
11	SRCS= lauxlib.c lbaselib.c ldblib.c liolib.c lmathlib.c lstrlib.c	10	SRCS= lauxlib.c lbaselib.c ldblib.c liolib.c lmathlib.c ltablib.c lstrlib.c loadlib.c
12		11
13	T= $(LIB)/liblualib.a	12	T= $(LIB)/liblualib.a
14		13
15	all: $T	14	all: $T
16		15
17	$T: $(OBJS)	16	$T: $(OBJS)
18	$(AR) $@ $(OBJS)	17	$(AR) $@ $(OBJS)
19	$(RANLIB) $@	18	$(RANLIB) $@
20		19

src/lib/README+6−4

@@ -1,6 +1,8 @@
1	This is the standard Lua library.	1	This is the standard Lua library.
2	It is implemented entirely on top of the official Lua API as declared in lua.h,	2
3	using lauxlib.c, which contains several useful functions for writing libraries.
4	We encourage developers to use lauxlib.c in their own libraries.
5	The code of the standard library can be read as an example of how to export	3	The code of the standard library can be read as an example of how to export
6	C functions to Lua.	4	C functions to Lua. The easiest library to read is lmathlib.c.
		5
		6	The library is implemented entirely on top of the official Lua API as declared
		7	in lua.h, using lauxlib.c, which contains several useful functions for writing
		8	libraries. We encourage developers to use lauxlib.c in their own libraries.

src/lib/lauxlib.c+433−58

@@ -1,25 +1,101 @@
1	/*	1	/*
2	** $Id: lauxlib.c,v 1.43 2000/10/30 13:07:48 roberto Exp $	2	** $Id: lauxlib.c,v 1.100 2003/04/07 14:35:00 roberto Exp $
3	** Auxiliary functions for building Lua libraries	3	** Auxiliary functions for building Lua libraries
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
		8	#include <ctype.h>
		9	#include <errno.h>
8	#include <stdarg.h>	10	#include <stdarg.h>
9	#include <stdio.h>	11	#include <stdio.h>
10	#include <string.h>	12	#include <string.h>
11		13
		14
12	/* This file uses only the official API of Lua.	15	/* This file uses only the official API of Lua.
13	** Any function declared here could be written as an application function.	16	** Any function declared here could be written as an application function.
14	** With care, these functions can be used by other libraries.
15	*/	17	*/
16		18
		19	#define lauxlib_c
		20
17	#include "lua.h"	21	#include "lua.h"
18		22
19	#include "lauxlib.h"	23	#include "lauxlib.h"
20	#include "luadebug.h"
21		24
22		25
		26	/* number of prereserved references (for internal use) */
		27	#define RESERVED_REFS 2
		28
		29	/* reserved references */
		30	#define FREELIST_REF 1 /* free list of references */
		31	#define ARRAYSIZE_REF 2 /* array sizes */
		32
		33
		34	/* convert a stack index to positive */
		35	#define abs_index(L, i) ((i) > 0 \|\| (i) <= LUA_REGISTRYINDEX ? (i) : \
		36	lua_gettop(L) + (i) + 1)
		37
		38
		39	/*
		40	** {======================================================
		41	** Error-report functions
		42	** =======================================================
		43	*/
		44
		45
		46	LUALIB_API int luaL_argerror (lua_State L, int narg, const char extramsg) {
		47	lua_Debug ar;
		48	lua_getstack(L, 0, &ar);
		49	lua_getinfo(L, "n", &ar);
		50	if (strcmp(ar.namewhat, "method") == 0) {
		51	narg--; /* do not count `self' */
		52	if (narg == 0) /* error is in the self argument itself? */
		53	return luaL_error(L, "calling `%s' on bad self (%s)", ar.name, extramsg);
		54	}
		55	if (ar.name == NULL)
		56	ar.name = "?";
		57	return luaL_error(L, "bad argument #%d to `%s' (%s)",
		58	narg, ar.name, extramsg);
		59	}
		60
		61
		62	LUALIB_API int luaL_typerror (lua_State L, int narg, const char tname) {
		63	const char *msg = lua_pushfstring(L, "%s expected, got %s",
		64	tname, lua_typename(L, lua_type(L,narg)));
		65	return luaL_argerror(L, narg, msg);
		66	}
		67
		68
		69	static void tag_error (lua_State *L, int narg, int tag) {
		70	luaL_typerror(L, narg, lua_typename(L, tag));
		71	}
		72
		73
		74	LUALIB_API void luaL_where (lua_State *L, int level) {
		75	lua_Debug ar;
		76	if (lua_getstack(L, level, &ar)) { /* check function at level */
		77	lua_getinfo(L, "Snl", &ar); /* get info about it */
		78	if (ar.currentline > 0) { /* is there info? */
		79	lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);
		80	return;
		81	}
		82	}
		83	lua_pushliteral(L, ""); /* else, no information available... */
		84	}
		85
		86
		87	LUALIB_API int luaL_error (lua_State L, const char fmt, ...) {
		88	va_list argp;
		89	va_start(argp, fmt);
		90	luaL_where(L, 1);
		91	lua_pushvfstring(L, fmt, argp);
		92	va_end(argp);
		93	lua_concat(L, 2);
		94	return lua_error(L);
		95	}
		96
		97	/* }====================================================== */
		98
23		99
24	LUALIB_API int luaL_findstring (const char name, const char const list[]) {	100	LUALIB_API int luaL_findstring (const char name, const char const list[]) {
25	int i;	101	int i;
@@ -29,34 +105,55 @@ LUALIB_API int luaL_findstring (const char name, const char const list[]) { · 3 unmodified lines
29	return -1; /* name not found */	105	return -1; /* name not found */
30	}	106	}
31		107
32	LUALIB_API void luaL_argerror (lua_State L, int narg, const char extramsg) {	108
33	lua_Debug ar;	109	LUALIB_API int luaL_newmetatable (lua_State L, const char tname) {
34	lua_getstack(L, 0, &ar);	110	lua_pushstring(L, tname);
35	lua_getinfo(L, "n", &ar);	111	lua_rawget(L, LUA_REGISTRYINDEX); /* get registry.name */
36	if (ar.name == NULL)	112	if (!lua_isnil(L, -1)) /* name already in use? */
37	ar.name = "?";	113	return 0; /* leave previous value on top, but return 0 */
38	luaL_verror(L, "bad argument #%d to `%.50s' (%.100s)",	114	lua_pop(L, 1);
39	narg, ar.name, extramsg);	115	lua_newtable(L); /* create metatable */
		116	lua_pushstring(L, tname);
		117	lua_pushvalue(L, -2);
		118	lua_rawset(L, LUA_REGISTRYINDEX); /* registry.name = metatable */
		119	lua_pushvalue(L, -1);
		120	lua_pushstring(L, tname);
		121	lua_rawset(L, LUA_REGISTRYINDEX); /* registry[metatable] = name */
		122	return 1;
40	}	123	}
41		124
42		125
43	static void type_error (lua_State *L, int narg, int t) {	126	LUALIB_API void luaL_getmetatable (lua_State L, const char tname) {
44	char buff[50];	127	lua_pushstring(L, tname);
45	sprintf(buff, "%.8s expected, got %.8s", lua_typename(L, t),	128	lua_rawget(L, LUA_REGISTRYINDEX);
46	lua_typename(L, lua_type(L, narg)));	129	}
47	luaL_argerror(L, narg, buff);	130
		131
		132	LUALIB_API void luaL_checkudata (lua_State L, int ud, const char *tname) {
		133	const char *tn;
		134	if (!lua_getmetatable(L, ud)) return NULL; /* no metatable? */
		135	lua_rawget(L, LUA_REGISTRYINDEX); /* get registry[metatable] */
		136	tn = lua_tostring(L, -1);
		137	if (tn && (strcmp(tn, tname) == 0)) {
		138	lua_pop(L, 1);
		139	return lua_touserdata(L, ud);
		140	}
		141	else {
		142	lua_pop(L, 1);
		143	return NULL;
		144	}
48	}	145	}
49		146
50		147
51	LUALIB_API void luaL_checkstack (lua_State L, int space, const char mes) {	148	LUALIB_API void luaL_checkstack (lua_State L, int space, const char mes) {
52	if (space > lua_stackspace(L))	149	if (!lua_checkstack(L, space))
53	luaL_verror(L, "stack overflow (%.30s)", mes);	150	luaL_error(L, "stack overflow (%s)", mes);
54	}	151	}
55		152
56		153
57	LUALIB_API void luaL_checktype(lua_State *L, int narg, int t) {	154	LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) {
58	if (lua_type(L, narg) != t)	155	if (lua_type(L, narg) != t)
59	type_error(L, narg, t);	156	tag_error(L, narg, t);
60	}	157	}
61		158
62		159
@@ -66,55 +163,164 @@ LUALIB_API void luaL_checkany (lua_State *L, int narg) { · 3 unmodified lines
66	}	163	}
67		164
68		165
69	LUALIB_API const char luaL_check_lstr (lua_State L, int narg, size_t *len) {	166	LUALIB_API const char luaL_checklstring (lua_State L, int narg, size_t *len) {
70	const char *s = lua_tostring(L, narg);	167	const char *s = lua_tostring(L, narg);
71	if (!s) type_error(L, narg, LUA_TSTRING);	168	if (!s) tag_error(L, narg, LUA_TSTRING);
72	if (len) *len = lua_strlen(L, narg);	169	if (len) *len = lua_strlen(L, narg);
73	return s;	170	return s;
74	}	171	}
75		172
76		173
77	LUALIB_API const char luaL_opt_lstr (lua_State L, int narg, const char def, size_t len) {	174	LUALIB_API const char luaL_optlstring (lua_State L, int narg,
78	if (lua_isnull(L, narg)) {	175	const char def, size_t len) {
		176	if (lua_isnoneornil(L, narg)) {
79	if (len)	177	if (len)
80	*len = (def ? strlen(def) : 0);	178	*len = (def ? strlen(def) : 0);
81	return def;	179	return def;
82	}	180	}
83	else return luaL_check_lstr(L, narg, len);	181	else return luaL_checklstring(L, narg, len);
84	}	182	}
85		183
86		184
87	LUALIB_API double luaL_check_number (lua_State *L, int narg) {	185	LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) {
88	double d = lua_tonumber(L, narg);	186	lua_Number d = lua_tonumber(L, narg);
89	if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */	187	if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */
90	type_error(L, narg, LUA_TNUMBER);	188	tag_error(L, narg, LUA_TNUMBER);
91	return d;	189	return d;
92	}	190	}
93		191
94		192
95	LUALIB_API double luaL_opt_number (lua_State *L, int narg, double def) {	193	LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) {
96	if (lua_isnull(L, narg)) return def;	194	if (lua_isnoneornil(L, narg)) return def;
97	else return luaL_check_number(L, narg);	195	else return luaL_checknumber(L, narg);
98	}	196	}
99		197
100		198
101	LUALIB_API void luaL_openlib (lua_State L, const struct luaL_reg l, int n) {	199	LUALIB_API int luaL_getmetafield (lua_State L, int obj, const char event) {
102	int i;	200	if (!lua_getmetatable(L, obj)) /* no metatable? */
103	for (i=0; i<n; i++)	201	return 0;
104	lua_register(L, l[i].name, l[i].func);	202	lua_pushstring(L, event);
		203	lua_rawget(L, -2);
		204	if (lua_isnil(L, -1)) {
		205	lua_pop(L, 2); /* remove metatable and metafield */
		206	return 0;
		207	}
		208	else {
		209	lua_remove(L, -2); /* remove only metatable */
		210	return 1;
		211	}
105	}	212	}
106		213
107		214
108	LUALIB_API void luaL_verror (lua_State L, const char fmt, ...) {	215	LUALIB_API int luaL_callmeta (lua_State L, int obj, const char event) {
109	char buff[500];	216	obj = abs_index(L, obj);
110	va_list argp;	217	if (!luaL_getmetafield(L, obj, event)) /* no metafield? */
111	va_start(argp, fmt);	218	return 0;
112	vsprintf(buff, fmt, argp);	219	lua_pushvalue(L, obj);
113	va_end(argp);	220	lua_call(L, 1, 1);
114	lua_error(L, buff);	221	return 1;
115	}	222	}
116		223
117		224
		225	LUALIB_API void luaL_openlib (lua_State L, const char libname,
		226	const luaL_reg *l, int nup) {
		227	if (libname) {
		228	lua_pushstring(L, libname);
		229	lua_gettable(L, LUA_GLOBALSINDEX); /* check whether lib already exists */
		230	if (lua_isnil(L, -1)) { /* no? */
		231	lua_pop(L, 1);
		232	lua_newtable(L); /* create it */
		233	lua_pushstring(L, libname);
		234	lua_pushvalue(L, -2);
		235	lua_settable(L, LUA_GLOBALSINDEX); /* register it with given name */
		236	}
		237	lua_insert(L, -(nup+1)); /* move library table to below upvalues */
		238	}
		239	for (; l->name; l++) {
		240	int i;
		241	lua_pushstring(L, l->name);
		242	for (i=0; i<nup; i++) /* copy upvalues to the top */
		243	lua_pushvalue(L, -(nup+1));
		244	lua_pushcclosure(L, l->func, nup);
		245	lua_settable(L, -(nup+3));
		246	}
		247	lua_pop(L, nup); /* remove upvalues */
		248	}
		249
		250
		251
		252	/*
		253	** {======================================================
		254	** getn-setn: size for arrays
		255	** =======================================================
		256	*/
		257
		258	static int checkint (lua_State *L, int topop) {
		259	int n = (int)lua_tonumber(L, -1);
		260	if (n == 0 && !lua_isnumber(L, -1)) n = -1;
		261	lua_pop(L, topop);
		262	return n;
		263	}
		264
		265
		266	static void getsizes (lua_State *L) {
		267	lua_rawgeti(L, LUA_REGISTRYINDEX, ARRAYSIZE_REF);
		268	if (lua_isnil(L, -1)) { /* no `size' table? */
		269	lua_pop(L, 1); /* remove nil */
		270	lua_newtable(L); /* create it */
		271	lua_pushvalue(L, -1); /* `size' will be its own metatable */
		272	lua_setmetatable(L, -2);
		273	lua_pushliteral(L, "__mode");
		274	lua_pushliteral(L, "k");
		275	lua_rawset(L, -3); /* metatable(N).__mode = "k" */
		276	lua_pushvalue(L, -1);
		277	lua_rawseti(L, LUA_REGISTRYINDEX, ARRAYSIZE_REF); /* store in register */
		278	}
		279	}
		280
		281
		282	void luaL_setn (lua_State *L, int t, int n) {
		283	t = abs_index(L, t);
		284	lua_pushliteral(L, "n");
		285	lua_rawget(L, t);
		286	if (checkint(L, 1) >= 0) { /* is there a numeric field `n'? */
		287	lua_pushliteral(L, "n"); /* use it */
		288	lua_pushnumber(L, (lua_Number)n);
		289	lua_rawset(L, t);
		290	}
		291	else { /* use `sizes' */
		292	getsizes(L);
		293	lua_pushvalue(L, t);
		294	lua_pushnumber(L, (lua_Number)n);
		295	lua_rawset(L, -3); /* sizes[t] = n */
		296	lua_pop(L, 1); /* remove `sizes' */
		297	}
		298	}
		299
		300
		301	int luaL_getn (lua_State *L, int t) {
		302	int n;
		303	t = abs_index(L, t);
		304	lua_pushliteral(L, "n"); /* try t.n */
		305	lua_rawget(L, t);
		306	if ((n = checkint(L, 1)) >= 0) return n;
		307	getsizes(L); /* else try sizes[t] */
		308	lua_pushvalue(L, t);
		309	lua_rawget(L, -2);
		310	if ((n = checkint(L, 2)) >= 0) return n;
		311	for (n = 1; ; n++) { /* else must count elements */
		312	lua_rawgeti(L, t, n);
		313	if (lua_isnil(L, -1)) break;
		314	lua_pop(L, 1);
		315	}
		316	lua_pop(L, 1);
		317	return n - 1;
		318	}
		319
		320	/* }====================================================== */
		321
		322
		323
118	/*	324	/*
119	** {======================================================	325	** {======================================================
120	** Generic Buffer manipulation	326	** Generic Buffer manipulation
@@ -122,7 +328,6 @@ LUALIB_API void luaL_verror (lua_State L, const char fmt, ...) { · 1 unmodified line
122	*/	328	*/
123		329
124		330
125	#define buffempty(B) ((B)->p == (B)->buffer)
126	#define bufflen(B) ((B)->p - (B)->buffer)	331	#define bufflen(B) ((B)->p - (B)->buffer)
127	#define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B)))	332	#define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B)))
128		333
@@ -135,29 +340,27 @@ static int emptybuffer (luaL_Buffer *B) { · 6 unmodified lines
135	else {	340	else {
136	lua_pushlstring(B->L, B->buffer, l);	341	lua_pushlstring(B->L, B->buffer, l);
137	B->p = B->buffer;	342	B->p = B->buffer;
138	B->level++;	343	B->lvl++;
139	return 1;	344	return 1;
140	}	345	}
141	}	346	}
142		347
143		348
144	static void adjuststack (luaL_Buffer *B) {	349	static void adjuststack (luaL_Buffer *B) {
145	if (B->level > 1) {	350	if (B->lvl > 1) {
146	lua_State *L = B->L;	351	lua_State *L = B->L;
147	int toget = 1; /* number of levels to concat */	352	int toget = 1; /* number of levels to concat */
148	size_t toplen = lua_strlen(L, -1);	353	size_t toplen = lua_strlen(L, -1);
149	do {	354	do {
150	size_t l = lua_strlen(L, -(toget+1));	355	size_t l = lua_strlen(L, -(toget+1));
151	if (B->level - toget + 1 >= LIMIT \|\| toplen > l) {	356	if (B->lvl - toget + 1 >= LIMIT \|\| toplen > l) {
152	toplen += l;	357	toplen += l;
153	toget++;	358	toget++;
154	}	359	}
155	else break;	360	else break;
156	} while (toget < B->level);	361	} while (toget < B->lvl);
157	if (toget >= 2) {	362	lua_concat(L, toget);
158	lua_concat(L, toget);	363	B->lvl = B->lvl - toget + 1;
159	B->level = B->level - toget + 1;
160	}
161	}	364	}
162	}	365	}
163		366
@@ -182,11 +385,8 @@ LUALIB_API void luaL_addstring (luaL_Buffer B, const char s) { · 18 unmodified lines
182		385
183	LUALIB_API void luaL_pushresult (luaL_Buffer *B) {	386	LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
184	emptybuffer(B);	387	emptybuffer(B);
185	if (B->level == 0)	388	lua_concat(B->L, B->lvl);
186	lua_pushlstring(B->L, NULL, 0);	389	B->lvl = 1;
187	else if (B->level > 1)
188	lua_concat(B->L, B->level);
189	B->level = 1;
190	}	390	}
191		391
192		392
@@ -201,7 +401,7 @@ LUALIB_API void luaL_addvalue (luaL_Buffer *B) { · 8 unmodified lines
201	else {	401	else {
202	if (emptybuffer(B))	402	if (emptybuffer(B))
203	lua_insert(L, -2); /* put buffer before new value */	403	lua_insert(L, -2); /* put buffer before new value */
204	B->level++; /* add new value into B stack */	404	B->lvl++; /* add new value into B stack */
205	adjuststack(B);	405	adjuststack(B);
206	}	406	}
207	}	407	}
@@ -210,7 +410,182 @@ LUALIB_API void luaL_addvalue (luaL_Buffer *B) { · 2 unmodified lines
210	LUALIB_API void luaL_buffinit (lua_State L, luaL_Buffer B) {	410	LUALIB_API void luaL_buffinit (lua_State L, luaL_Buffer B) {
211	B->L = L;	411	B->L = L;
212	B->p = B->buffer;	412	B->p = B->buffer;
213	B->level = 0;	413	B->lvl = 0;
		414	}
		415
		416	/* }====================================================== */
		417
		418
		419	LUALIB_API int luaL_ref (lua_State *L, int t) {
		420	int ref;
		421	t = abs_index(L, t);
		422	if (lua_isnil(L, -1)) {
		423	lua_pop(L, 1); /* remove from stack */
		424	return LUA_REFNIL; /* `nil' has a unique fixed reference */
		425	}
		426	lua_rawgeti(L, t, FREELIST_REF); /* get first free element */
		427	ref = (int)lua_tonumber(L, -1); /* ref = t[FREELIST_REF] */
		428	lua_pop(L, 1); /* remove it from stack */
		429	if (ref != 0) { /* any free element? */
		430	lua_rawgeti(L, t, ref); /* remove it from list */
		431	lua_rawseti(L, t, FREELIST_REF); /* (t[FREELIST_REF] = t[ref]) */
		432	}
		433	else { /* no free elements */
		434	ref = luaL_getn(L, t);
		435	if (ref < RESERVED_REFS)
		436	ref = RESERVED_REFS; /* skip reserved references */
		437	ref++; /* create new reference */
		438	luaL_setn(L, t, ref);
		439	}
		440	lua_rawseti(L, t, ref);
		441	return ref;
		442	}
		443
		444
		445	LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {
		446	if (ref >= 0) {
		447	t = abs_index(L, t);
		448	lua_rawgeti(L, t, FREELIST_REF);
		449	lua_rawseti(L, t, ref); /* t[ref] = t[FREELIST_REF] */
		450	lua_pushnumber(L, (lua_Number)ref);
		451	lua_rawseti(L, t, FREELIST_REF); /* t[FREELIST_REF] = ref */
		452	}
		453	}
		454
		455
		456
		457	/*
		458	** {======================================================
		459	** Load functions
		460	** =======================================================
		461	*/
		462
		463	typedef struct LoadF {
		464	FILE *f;
		465	char buff[LUAL_BUFFERSIZE];
		466	} LoadF;
		467
		468
		469	static const char getF (lua_State L, void ud, size_t size) {
		470	LoadF lf = (LoadF )ud;
		471	(void)L;
		472	if (feof(lf->f)) return NULL;
		473	*size = fread(lf->buff, 1, LUAL_BUFFERSIZE, lf->f);
		474	return (*size > 0) ? lf->buff : NULL;
		475	}
		476
		477
		478	static int errfile (lua_State *L, int fnameindex) {
		479	const char *filename = lua_tostring(L, fnameindex) + 1;
		480	lua_pushfstring(L, "cannot read %s: %s", filename, strerror(errno));
		481	lua_remove(L, fnameindex);
		482	return LUA_ERRFILE;
		483	}
		484
		485
		486	LUALIB_API int luaL_loadfile (lua_State L, const char filename) {
		487	LoadF lf;
		488	int status, readstatus;
		489	int c;
		490	int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */
		491	if (filename == NULL) {
		492	lua_pushliteral(L, "=stdin");
		493	lf.f = stdin;
		494	}
		495	else {
		496	lua_pushfstring(L, "@%s", filename);
		497	lf.f = fopen(filename, "r");
		498	}
		499	if (lf.f == NULL) return errfile(L, fnameindex); /* unable to open file */
		500	c = ungetc(getc(lf.f), lf.f);
		501	if (!(isspace(c) \|\| isprint(c)) && lf.f != stdin) { /* binary file? */
		502	fclose(lf.f);
		503	lf.f = fopen(filename, "rb"); /* reopen in binary mode */
		504	if (lf.f == NULL) return errfile(L, fnameindex); /* unable to reopen file */
		505	}
		506	status = lua_load(L, getF, &lf, lua_tostring(L, -1));
		507	readstatus = ferror(lf.f);
		508	if (lf.f != stdin) fclose(lf.f); /* close file (even in case of errors) */
		509	if (readstatus) {
		510	lua_settop(L, fnameindex); /* ignore results from `lua_load' */
		511	return errfile(L, fnameindex);
		512	}
		513	lua_remove(L, fnameindex);
		514	return status;
		515	}
		516
		517
		518	typedef struct LoadS {
		519	const char *s;
		520	size_t size;
		521	} LoadS;
		522
		523
		524	static const char getS (lua_State L, void ud, size_t size) {
		525	LoadS ls = (LoadS )ud;
		526	(void)L;
		527	if (ls->size == 0) return NULL;
		528	*size = ls->size;
		529	ls->size = 0;
		530	return ls->s;
		531	}
		532
		533
		534	LUALIB_API int luaL_loadbuffer (lua_State L, const char buff, size_t size,
		535	const char *name) {
		536	LoadS ls;
		537	ls.s = buff;
		538	ls.size = size;
		539	return lua_load(L, getS, &ls, name);
		540	}
		541
		542	/* }====================================================== */
		543
		544
		545	/*
		546	** {======================================================
		547	** compatibility code
		548	** =======================================================
		549	*/
		550
		551
		552	static void callalert (lua_State *L, int status) {
		553	if (status != 0) {
		554	lua_getglobal(L, "_ALERT");
		555	if (lua_isfunction(L, -1)) {
		556	lua_insert(L, -2);
		557	lua_call(L, 1, 0);
		558	}
		559	else { /* no _ALERT function; print it on stderr */
		560	fprintf(stderr, "%s\n", lua_tostring(L, -2));
		561	lua_pop(L, 2); /* remove error message and _ALERT */
		562	}
		563	}
		564	}
		565
		566
		567	static int aux_do (lua_State *L, int status) {
		568	if (status == 0) { /* parse OK? */
		569	status = lua_pcall(L, 0, LUA_MULTRET, 0); /* call main */
		570	}
		571	callalert(L, status);
		572	return status;
		573	}
		574
		575
		576	LUALIB_API int lua_dofile (lua_State L, const char filename) {
		577	return aux_do(L, luaL_loadfile(L, filename));
		578	}
		579
		580
		581	LUALIB_API int lua_dobuffer (lua_State L, const char buff, size_t size,
		582	const char *name) {
		583	return aux_do(L, luaL_loadbuffer(L, buff, size, name));
		584	}
		585
		586
		587	LUALIB_API int lua_dostring (lua_State L, const char str) {
		588	return lua_dobuffer(L, str, strlen(str), str);
214	}	589	}
215		590
216	/* }====================================================== */	591	/* }====================================================== */

src/lib/lbaselib.c+445−422

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lbaselib.c,v 1.17a 2000/11/06 13:45:18 roberto Exp $	2	** $Id: lbaselib.c,v 1.130 2003/04/03 13:35:34 roberto Exp $
3	** Basic library	3	** Basic library
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -11,51 +11,15 @@ · 5 unmodified lines
11	#include <stdlib.h>	11	#include <stdlib.h>
12	#include <string.h>	12	#include <string.h>
13		13
		14	#define lbaselib_c
		15
14	#include "lua.h"	16	#include "lua.h"
15		17
16	#include "lauxlib.h"	18	#include "lauxlib.h"
17	#include "luadebug.h"
18	#include "lualib.h"	19	#include "lualib.h"
19		20
20		21
21		22
22	/*
23	** If your system does not support `stderr', redefine this function, or
24	** redefine _ERRORMESSAGE so that it won't need _ALERT.
25	*/
26	static int luaB__ALERT (lua_State *L) {
27	fputs(luaL_check_string(L, 1), stderr);
28	return 0;
29	}
30
31
32	/*
33	** Basic implementation of _ERRORMESSAGE.
34	** The library `liolib' redefines _ERRORMESSAGE for better error information.
35	*/
36	static int luaB__ERRORMESSAGE (lua_State *L) {
37	luaL_checktype(L, 1, LUA_TSTRING);
38	lua_getglobal(L, LUA_ALERT);
39	if (lua_isfunction(L, -1)) { /* avoid error loop if _ALERT is not defined */
40	lua_Debug ar;
41	lua_pushstring(L, "error: ");
42	lua_pushvalue(L, 1);
43	if (lua_getstack(L, 1, &ar)) {
44	lua_getinfo(L, "Sl", &ar);
45	if (ar.source && ar.currentline > 0) {
46	char buff[100];
47	sprintf(buff, "\n <%.70s: line %d>", ar.short_src, ar.currentline);
48	lua_pushstring(L, buff);
49	lua_concat(L, 2);
50	}
51	}
52	lua_pushstring(L, "\n");
53	lua_concat(L, 3);
54	lua_rawcall(L, 1, 0);
55	}
56	return 0;
57	}
58
59		23
60	/*	24	/*
61	** If your system does not support `stdout', you can just remove this function.	25	** If your system does not support `stdout', you can just remove this function.
@@ -71,10 +35,10 @@ static int luaB_print (lua_State *L) { · 9 unmodified lines
71	const char *s;	35	const char *s;
72	lua_pushvalue(L, -1); /* function to be called */	36	lua_pushvalue(L, -1); /* function to be called */
73	lua_pushvalue(L, i); /* value to print */	37	lua_pushvalue(L, i); /* value to print */
74	lua_rawcall(L, 1, 1);	38	lua_call(L, 1, 1);
75	s = lua_tostring(L, -1); /* get result */	39	s = lua_tostring(L, -1); /* get result */
76	if (s == NULL)	40	if (s == NULL)
77	lua_error(L, "`tostring' must return a string to `print'");	41	return luaL_error(L, "`tostring' must return a string to `print'");
78	if (i>1) fputs("\t", stdout);	42	if (i>1) fputs("\t", stdout);
79	fputs(s, stdout);	43	fputs(s, stdout);
80	lua_pop(L, 1); /* pop result */	44	lua_pop(L, 1); /* pop result */
@@ -85,7 +49,7 @@ static int luaB_print (lua_State *L) { · 4 unmodified lines
85		49
86		50
87	static int luaB_tonumber (lua_State *L) {	51	static int luaB_tonumber (lua_State *L) {
88	int base = luaL_opt_int(L, 2, 10);	52	int base = luaL_optint(L, 2, 10);
89	if (base == 10) { /* standard conversion */	53	if (base == 10) { /* standard conversion */
90	luaL_checkany(L, 1);	54	luaL_checkany(L, 1);
91	if (lua_isnumber(L, 1)) {	55	if (lua_isnumber(L, 1)) {
@@ -94,15 +58,15 @@ static int luaB_tonumber (lua_State *L) { · 2 unmodified lines
94	}	58	}
95	}	59	}
96	else {	60	else {
97	const char *s1 = luaL_check_string(L, 1);	61	const char *s1 = luaL_checkstring(L, 1);
98	char *s2;	62	char *s2;
99	unsigned long n;	63	unsigned long n;
100	luaL_arg_check(L, 2 <= base && base <= 36, 2, "base out of range");	64	luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
101	n = strtoul(s1, &s2, base);	65	n = strtoul(s1, &s2, base);
102	if (s1 != s2) { /* at least one valid digit? */	66	if (s1 != s2) { /* at least one valid digit? */
103	while (isspace((unsigned char)s2)) s2++; / skip trailing spaces */	67	while (isspace((unsigned char)(s2))) s2++; / skip trailing spaces */
104	if (s2 == '\0') { / no invalid trailing characters? */	68	if (s2 == '\0') { / no invalid trailing characters? */
105	lua_pushnumber(L, n);	69	lua_pushnumber(L, (lua_Number)n);
106	return 1;	70	return 1;
107	}	71	}
108	}	72	}
@@ -113,55 +77,99 @@ static int luaB_tonumber (lua_State *L) { · 4 unmodified lines
113		77
114		78
115	static int luaB_error (lua_State *L) {	79	static int luaB_error (lua_State *L) {
116	lua_error(L, luaL_opt_string(L, 1, NULL));	80	int level = luaL_optint(L, 2, 1);
117	return 0; /* to avoid warnings */	81	luaL_checkany(L, 1);
		82	if (!lua_isstring(L, 1) \|\| level == 0)
		83	lua_pushvalue(L, 1); /* propagate error message without changes */
		84	else { /* add extra information */
		85	luaL_where(L, level);
		86	lua_pushvalue(L, 1);
		87	lua_concat(L, 2);
		88	}
		89	return lua_error(L);
118	}	90	}
119		91
120	static int luaB_setglobal (lua_State *L) {	92
121	luaL_checkany(L, 2);	93	static int luaB_getmetatable (lua_State *L) {
122	lua_setglobal(L, luaL_check_string(L, 1));	94	luaL_checkany(L, 1);
123	return 0;	95	if (!lua_getmetatable(L, 1)) {
		96	lua_pushnil(L);
		97	return 1; /* no metatable */
		98	}
		99	luaL_getmetafield(L, 1, "__metatable");
		100	return 1; /* returns either __metatable field (if present) or metatable */
124	}	101	}
125		102
126	static int luaB_getglobal (lua_State *L) {	103
127	lua_getglobal(L, luaL_check_string(L, 1));	104	static int luaB_setmetatable (lua_State *L) {
		105	int t = lua_type(L, 2);
		106	luaL_checktype(L, 1, LUA_TTABLE);
		107	luaL_argcheck(L, t == LUA_TNIL \|\| t == LUA_TTABLE, 2,
		108	"nil or table expected");
		109	if (luaL_getmetafield(L, 1, "__metatable"))
		110	luaL_error(L, "cannot change a protected metatable");
		111	lua_settop(L, 2);
		112	lua_setmetatable(L, 1);
128	return 1;	113	return 1;
129	}	114	}
130		115
131	static int luaB_tag (lua_State *L) {	116
132	luaL_checkany(L, 1);	117	static void getfunc (lua_State *L) {
133	lua_pushnumber(L, lua_tag(L, 1));	118	if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);
134	return 1;	119	else {
		120	lua_Debug ar;
		121	int level = luaL_optint(L, 1, 1);
		122	luaL_argcheck(L, level >= 0, 1, "level must be non-negative");
		123	if (lua_getstack(L, level, &ar) == 0)
		124	luaL_argerror(L, 1, "invalid level");
		125	lua_getinfo(L, "f", &ar);
		126	if (lua_isnil(L, -1))
		127	luaL_error(L, "no function environment for tail call at level %d",
		128	level);
		129	}
135	}	130	}
136		131
137	static int luaB_settag (lua_State *L) {	132
138	luaL_checktype(L, 1, LUA_TTABLE);	133	static int aux_getfenv (lua_State *L) {
139	lua_pushvalue(L, 1); /* push table */	134	lua_getfenv(L, -1);
140	lua_settag(L, luaL_check_int(L, 2));	135	lua_pushliteral(L, "__fenv");
141	return 1; /* return table */	136	lua_rawget(L, -2);
		137	return !lua_isnil(L, -1);
142	}	138	}
143		139
144	static int luaB_newtag (lua_State *L) {	140
145	lua_pushnumber(L, lua_newtag(L));	141	static int luaB_getfenv (lua_State *L) {
		142	getfunc(L);
		143	if (!aux_getfenv(L)) /* __fenv not defined? */
		144	lua_pop(L, 1); /* remove it, to return real environment */
146	return 1;	145	return 1;
147	}	146	}
148		147
149	static int luaB_copytagmethods (lua_State *L) {	148
150	lua_pushnumber(L, lua_copytagmethods(L, luaL_check_int(L, 1),	149	static int luaB_setfenv (lua_State *L) {
151	luaL_check_int(L, 2)));	150	luaL_checktype(L, 2, LUA_TTABLE);
152	return 1;	151	getfunc(L);
		152	if (aux_getfenv(L)) /* __fenv defined? */
		153	luaL_error(L, "`setfenv' cannot change a protected environment");
		154	else
		155	lua_pop(L, 2); /* remove __fenv and real environment table */
		156	lua_pushvalue(L, 2);
		157	if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0)
		158	lua_replace(L, LUA_GLOBALSINDEX);
		159	else if (lua_setfenv(L, -2) == 0)
		160	luaL_error(L, "`setfenv' cannot change environment of given function");
		161	return 0;
153	}	162	}
154		163
155	static int luaB_globals (lua_State *L) {	164
156	lua_getglobals(L); /* value to be returned */	165	static int luaB_rawequal (lua_State *L) {
157	if (!lua_isnull(L, 1)) {	166	luaL_checkany(L, 1);
158	luaL_checktype(L, 1, LUA_TTABLE);	167	luaL_checkany(L, 2);
159	lua_pushvalue(L, 1); /* new table of globals */	168	lua_pushboolean(L, lua_rawequal(L, 1, 2));
160	lua_setglobals(L);
161	}
162	return 1;	169	return 1;
163	}	170	}
164		171
		172
165	static int luaB_rawget (lua_State *L) {	173	static int luaB_rawget (lua_State *L) {
166	luaL_checktype(L, 1, LUA_TTABLE);	174	luaL_checktype(L, 1, LUA_TTABLE);
167	luaL_checkany(L, 2);	175	luaL_checkany(L, 2);
@@ -177,39 +185,16 @@ static int luaB_rawset (lua_State *L) { · 9 unmodified lines
177	return 1;	185	return 1;
178	}	186	}
179		187
180	static int luaB_settagmethod (lua_State *L) {
181	int tag = luaL_check_int(L, 1);
182	const char *event = luaL_check_string(L, 2);
183	luaL_arg_check(L, lua_isfunction(L, 3) \|\| lua_isnil(L, 3), 3,
184	"function or nil expected");
185	if (strcmp(event, "gc") == 0)
186	lua_error(L, "deprecated use: cannot set the `gc' tag method from Lua");
187	lua_gettagmethod(L, tag, event);
188	lua_pushvalue(L, 3);
189	lua_settagmethod(L, tag, event);
190	return 1;
191	}
192
193
194	static int luaB_gettagmethod (lua_State *L) {
195	int tag = luaL_check_int(L, 1);
196	const char *event = luaL_check_string(L, 2);
197	if (strcmp(event, "gc") == 0)
198	lua_error(L, "deprecated use: cannot get the `gc' tag method from Lua");
199	lua_gettagmethod(L, tag, event);
200	return 1;
201	}
202
203		188
204	static int luaB_gcinfo (lua_State *L) {	189	static int luaB_gcinfo (lua_State *L) {
205	lua_pushnumber(L, lua_getgccount(L));	190	lua_pushnumber(L, (lua_Number)lua_getgccount(L));
206	lua_pushnumber(L, lua_getgcthreshold(L));	191	lua_pushnumber(L, (lua_Number)lua_getgcthreshold(L));
207	return 2;	192	return 2;
208	}	193	}
209		194
210		195
211	static int luaB_collectgarbage (lua_State *L) {	196	static int luaB_collectgarbage (lua_State *L) {
212	lua_setgcthreshold(L, luaL_opt_int(L, 1, 0));	197	lua_setgcthreshold(L, luaL_optint(L, 1, 0));
213	return 0;	198	return 0;
214	}	199	}
215		200
@@ -233,83 +218,116 @@ static int luaB_next (lua_State *L) { · 17 unmodified lines
233	}	218	}
234		219
235		220
236	static int passresults (lua_State *L, int status, int oldtop) {	221	static int luaB_pairs (lua_State *L) {
237	static const char *const errornames[] =	222	luaL_checktype(L, 1, LUA_TTABLE);
238	{"ok", "run-time error", "file error", "syntax error",	223	lua_pushliteral(L, "next");
239	"memory error", "error in error handling"};	224	lua_rawget(L, LUA_GLOBALSINDEX); /* return generator, */
240	if (status == 0) {	225	lua_pushvalue(L, 1); /* state, */
241	int nresults = lua_gettop(L) - oldtop;	226	lua_pushnil(L); /* and initial value */
242	if (nresults > 0)	227	return 3;
243	return nresults; /* results are already on the stack */	228	}
244	else {	229
245	lua_pushuserdata(L, NULL); /* at least one result to signal no errors */	230
246	return 1;	231	static int luaB_ipairs (lua_State *L) {
247	}	232	lua_Number i = lua_tonumber(L, 2);
		233	luaL_checktype(L, 1, LUA_TTABLE);
		234	if (i == 0 && lua_isnone(L, 2)) { /* `for' start? */
		235	lua_pushliteral(L, "ipairs");
		236	lua_rawget(L, LUA_GLOBALSINDEX); /* return generator, */
		237	lua_pushvalue(L, 1); /* state, */
		238	lua_pushnumber(L, 0); /* and initial value */
		239	return 3;
		240	}
		241	else { /* `for' step */
		242	i++; /* next value */
		243	lua_pushnumber(L, i);
		244	lua_rawgeti(L, 1, (int)i);
		245	return (lua_isnil(L, -1)) ? 0 : 2;
248	}	246	}
249	else { /* error */	247	}
		248
		249
		250	static int load_aux (lua_State *L, int status) {
		251	if (status == 0) /* OK? */
		252	return 1;
		253	else {
250	lua_pushnil(L);	254	lua_pushnil(L);
251	lua_pushstring(L, errornames[status]); /* error code */	255	lua_insert(L, -2); /* put before error message */
252	return 2;	256	return 2; /* return nil plus error message */
253	}	257	}
254	}	258	}
255		259
256	static int luaB_dostring (lua_State *L) {	260
257	int oldtop = lua_gettop(L);	261	static int luaB_loadstring (lua_State *L) {
258	size_t l;	262	size_t l;
259	const char *s = luaL_check_lstr(L, 1, &l);	263	const char *s = luaL_checklstring(L, 1, &l);
260	if (s == '\33') / binary files start with ESC... */	264	const char *chunkname = luaL_optstring(L, 2, s);
261	lua_error(L, "`dostring' cannot run pre-compiled code");	265	return load_aux(L, luaL_loadbuffer(L, s, l, chunkname));
262	return passresults(L, lua_dobuffer(L, s, l, luaL_opt_string(L, 2, s)), oldtop);	266	}
		267
		268
		269	static int luaB_loadfile (lua_State *L) {
		270	const char *fname = luaL_optstring(L, 1, NULL);
		271	return load_aux(L, luaL_loadfile(L, fname));
263	}	272	}
264		273
265		274
266	static int luaB_dofile (lua_State *L) {	275	static int luaB_dofile (lua_State *L) {
267	int oldtop = lua_gettop(L);	276	const char *fname = luaL_optstring(L, 1, NULL);
268	const char *fname = luaL_opt_string(L, 1, NULL);	277	int status = luaL_loadfile(L, fname);
269	return passresults(L, lua_dofile(L, fname), oldtop);	278	if (status != 0) lua_error(L);
		279	lua_call(L, 0, LUA_MULTRET);
		280	return lua_gettop(L) - 1;
270	}	281	}
271		282
272		283
273	static int luaB_call (lua_State *L) {	284	static int luaB_assert (lua_State *L) {
274	int oldtop;	285	luaL_checkany(L, 1);
275	const char *options = luaL_opt_string(L, 3, "");	286	if (!lua_toboolean(L, 1))
276	int err = 0; /* index of old error method */	287	return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));
277	int i, status;	288	lua_settop(L, 1);
278	int n;	289	return 1;
279	luaL_checktype(L, 2, LUA_TTABLE);	290	}
280	n = lua_getn(L, 2);	291
281	if (!lua_isnull(L, 4)) { /* set new error method */	292
282	lua_getglobal(L, LUA_ERRORMESSAGE);	293	static int luaB_unpack (lua_State *L) {
283	err = lua_gettop(L); /* get index */	294	int n, i;
284	lua_pushvalue(L, 4);	295	luaL_checktype(L, 1, LUA_TTABLE);
285	lua_setglobal(L, LUA_ERRORMESSAGE);	296	n = luaL_getn(L, 1);
286	}	297	luaL_checkstack(L, n, "table too big to unpack");
287	oldtop = lua_gettop(L); /* top before function-call preparation */	298	for (i=1; i<=n; i++) /* push arg[1...n] */
288	/* push function */	299	lua_rawgeti(L, 1, i);
289	lua_pushvalue(L, 1);	300	return n;
290	luaL_checkstack(L, n, "too many arguments");	301	}
291	for (i=0; i<n; i++) /* push arg[1...n] */	302
292	lua_rawgeti(L, 2, i+1);	303
293	status = lua_call(L, n, LUA_MULTRET);	304	static int luaB_pcall (lua_State *L) {
294	if (err != 0) { /* restore old error method */	305	int status;
295	lua_pushvalue(L, err);	306	luaL_checkany(L, 1);
296	lua_setglobal(L, LUA_ERRORMESSAGE);	307	status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);
297	}	308	lua_pushboolean(L, (status == 0));
298	if (status != 0) { /* error in call? */	309	lua_insert(L, 1);
299	if (strchr(options, 'x'))	310	return lua_gettop(L); /* return status + all results */
300	lua_pushnil(L); /* return nil to signal the error */	311	}
301	else	312
302	lua_error(L, NULL); /* propagate error without additional messages */	313
303	return 1;	314	static int luaB_xpcall (lua_State *L) {
304	}	315	int status;
305	if (strchr(options, 'p')) /* pack results? */	316	luaL_checkany(L, 2);
306	lua_error(L, "deprecated option `p' in `call'");	317	lua_settop(L, 2);
307	return lua_gettop(L) - oldtop; /* results are already on the stack */	318	lua_insert(L, 1); /* put error function under function to be called */
		319	status = lua_pcall(L, 0, LUA_MULTRET, 1);
		320	lua_pushboolean(L, (status == 0));
		321	lua_replace(L, 1);
		322	return lua_gettop(L); /* return status + all results */
308	}	323	}
309		324
310		325
311	static int luaB_tostring (lua_State *L) {	326	static int luaB_tostring (lua_State *L) {
312	char buff[64];	327	char buff[64];
		328	luaL_checkany(L, 1);
		329	if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */
		330	return 1; /* use its value */
313	switch (lua_type(L, 1)) {	331	switch (lua_type(L, 1)) {
314	case LUA_TNUMBER:	332	case LUA_TNUMBER:
315	lua_pushstring(L, lua_tostring(L, 1));	333	lua_pushstring(L, lua_tostring(L, 1));
@@ -317,6 +335,9 @@ static int luaB_tostring (lua_State *L) { · 1 unmodified line
317	case LUA_TSTRING:	335	case LUA_TSTRING:
318	lua_pushvalue(L, 1);	336	lua_pushvalue(L, 1);
319	return 1;	337	return 1;
		338	case LUA_TBOOLEAN:
		339	lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));
		340	return 1;
320	case LUA_TTABLE:	341	case LUA_TTABLE:
321	sprintf(buff, "table: %p", lua_topointer(L, 1));	342	sprintf(buff, "table: %p", lua_topointer(L, 1));
322	break;	343	break;
@@ -324,328 +345,330 @@ static int luaB_tostring (lua_State *L) { · 1 unmodified line
324	sprintf(buff, "function: %p", lua_topointer(L, 1));	345	sprintf(buff, "function: %p", lua_topointer(L, 1));
325	break;	346	break;
326	case LUA_TUSERDATA:	347	case LUA_TUSERDATA:
327	sprintf(buff, "userdata(%d): %p", lua_tag(L, 1), lua_touserdata(L, 1));	348	case LUA_TLIGHTUSERDATA:
		349	sprintf(buff, "userdata: %p", lua_touserdata(L, 1));
		350	break;
		351	case LUA_TTHREAD:
		352	sprintf(buff, "thread: %p", (void *)lua_tothread(L, 1));
328	break;	353	break;
329	case LUA_TNIL:	354	case LUA_TNIL:
330	lua_pushstring(L, "nil");	355	lua_pushliteral(L, "nil");
331	return 1;	356	return 1;
332	default:
333	luaL_argerror(L, 1, "value expected");
334	}	357	}
335	lua_pushstring(L, buff);	358	lua_pushstring(L, buff);
336	return 1;	359	return 1;
337	}	360	}
338		361
339		362
340	static int luaB_foreachi (lua_State *L) {	363	static int luaB_newproxy (lua_State *L) {
341	int n, i;	364	lua_settop(L, 1);
342	luaL_checktype(L, 1, LUA_TTABLE);	365	lua_newuserdata(L, 0); /* create proxy */
343	luaL_checktype(L, 2, LUA_TFUNCTION);	366	if (lua_toboolean(L, 1) == 0)
344	n = lua_getn(L, 1);	367	return 1; /* no metatable */
345	for (i=1; i<=n; i++) {	368	else if (lua_isboolean(L, 1)) {
346	lua_pushvalue(L, 2); /* function */	369	lua_newtable(L); /* create a new metatable `m' ... */
347	lua_pushnumber(L, i); /* 1st argument */	370	lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */
348	lua_rawgeti(L, 1, i); /* 2nd argument */	371	lua_pushboolean(L, 1);
349	lua_rawcall(L, 2, 1);	372	lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */
350	if (!lua_isnil(L, -1))
351	return 1;
352	lua_pop(L, 1); /* remove nil result */
353	}	373	}
354	return 0;	374	else {
355	}	375	int validproxy = 0; /* to check if weaktable[metatable(u)] == true */
356		376	if (lua_getmetatable(L, 1)) {
357		377	lua_rawget(L, lua_upvalueindex(1));
358	static int luaB_foreach (lua_State *L) {	378	validproxy = lua_toboolean(L, -1);
359	luaL_checktype(L, 1, LUA_TTABLE);	379	lua_pop(L, 1); /* remove value */
360	luaL_checktype(L, 2, LUA_TFUNCTION);	380	}
361	lua_pushnil(L); /* first index */	381	luaL_argcheck(L, validproxy, 1, "boolean or proxy expected");
362	for (;;) {	382	lua_getmetatable(L, 1); /* metatable is valid; get it */
363	if (lua_next(L, 1) == 0)
364	return 0;
365	lua_pushvalue(L, 2); /* function */
366	lua_pushvalue(L, -3); /* key */
367	lua_pushvalue(L, -3); /* value */
368	lua_rawcall(L, 2, 1);
369	if (!lua_isnil(L, -1))
370	return 1;
371	lua_pop(L, 2); /* remove value and result */
372	}	383	}
373	}	384	lua_setmetatable(L, 2);
374
375
376	static int luaB_assert (lua_State *L) {
377	luaL_checkany(L, 1);
378	if (lua_isnil(L, 1))
379	luaL_verror(L, "assertion failed! %.90s", luaL_opt_string(L, 2, ""));
380	return 0;
381	}
382
383
384	static int luaB_getn (lua_State *L) {
385	luaL_checktype(L, 1, LUA_TTABLE);
386	lua_pushnumber(L, lua_getn(L, 1));
387	return 1;	385	return 1;
388	}	386	}
389		387
390		388
391	static int luaB_tinsert (lua_State *L) {	389	/*
392	int v = lua_gettop(L); /* last argument: to be inserted */	390	** {======================================================
393	int n, pos;	391	** `require' function
394	luaL_checktype(L, 1, LUA_TTABLE);	392	** =======================================================
395	n = lua_getn(L, 1);	393	*/
396	if (v == 2) /* called with only 2 arguments */
397	pos = n+1;
398	else
399	pos = luaL_check_int(L, 2); /* 2nd argument is the position */
400	lua_pushstring(L, "n");
401	lua_pushnumber(L, n+1);
402	lua_rawset(L, 1); /* t.n = n+1 */
403	for (; n>=pos; n--) {
404	lua_rawgeti(L, 1, n);
405	lua_rawseti(L, 1, n+1); /* t[n+1] = t[n] */
406	}
407	lua_pushvalue(L, v);
408	lua_rawseti(L, 1, pos); /* t[pos] = v */
409	return 0;
410	}
411
412		394
413	static int luaB_tremove (lua_State *L) {
414	int pos, n;
415	luaL_checktype(L, 1, LUA_TTABLE);
416	n = lua_getn(L, 1);
417	pos = luaL_opt_int(L, 2, n);
418	if (n <= 0) return 0; /* table is "empty" */
419	lua_rawgeti(L, 1, pos); /* result = t[pos] */
420	for ( ;pos<n; pos++) {
421	lua_rawgeti(L, 1, pos+1);
422	lua_rawseti(L, 1, pos); /* a[pos] = a[pos+1] */
423	}
424	lua_pushstring(L, "n");
425	lua_pushnumber(L, n-1);
426	lua_rawset(L, 1); /* t.n = n-1 */
427	lua_pushnil(L);
428	lua_rawseti(L, 1, n); /* t[n] = nil */
429	return 1;
430	}
431		395
		396	/* name of global that holds table with loaded packages */
		397	#define REQTAB "_LOADED"
432		398
		399	/* name of global that holds the search path for packages */
		400	#define LUA_PATH "LUA_PATH"
433		401
		402	#ifndef LUA_PATH_SEP
		403	#define LUA_PATH_SEP ';'
		404	#endif
434		405
435	/*	406	#ifndef LUA_PATH_MARK
436	** {======================================================	407	#define LUA_PATH_MARK '?'
437	** Quicksort	408	#endif
438	** (based on `Algorithms in MODULA-3', Robert Sedgewick;
439	** Addison-Wesley, 1993.)
440	*/
441		409
		410	#ifndef LUA_PATH_DEFAULT
		411	#define LUA_PATH_DEFAULT "?;?.lua"
		412	#endif
442		413
443	static void set2 (lua_State *L, int i, int j) {
444	lua_rawseti(L, 1, i);
445	lua_rawseti(L, 1, j);
446	}
447		414
448	static int sort_comp (lua_State *L, int a, int b) {	415	static const char getpath (lua_State L) {
449	/* WARNING: the caller (auxsort) must ensure stack space */	416	const char *path;
450	if (!lua_isnil(L, 2)) { /* function? */	417	lua_getglobal(L, LUA_PATH); /* try global variable */
451	int res;	418	path = lua_tostring(L, -1);
452	lua_pushvalue(L, 2);	419	lua_pop(L, 1);
453	lua_pushvalue(L, a-1); /* -1 to compensate function */	420	if (path) return path;
454	lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */	421	path = getenv(LUA_PATH); /* else try environment variable */
455	lua_rawcall(L, 2, 1);	422	if (path) return path;
456	res = !lua_isnil(L, -1);	423	return LUA_PATH_DEFAULT; /* else use default */
457	lua_pop(L, 1);	424	}
458	return res;	425
		426
		427	static const char pushnextpath (lua_State L, const char *path) {
		428	const char *l;
		429	if (path == '\0') return NULL; / no more paths */
		430	if (path == LUA_PATH_SEP) path++; / skip separator */
		431	l = strchr(path, LUA_PATH_SEP); /* find next separator */
		432	if (l == NULL) l = path+strlen(path);
		433	lua_pushlstring(L, path, l - path); /* directory name */
		434	return l;
		435	}
		436
		437
		438	static void pushcomposename (lua_State *L) {
		439	const char *path = lua_tostring(L, -1);
		440	const char *wild;
		441	int n = 1;
		442	while ((wild = strchr(path, LUA_PATH_MARK)) != NULL) {
		443	/* is there stack space for prefix, name, and eventual last sufix? */
		444	luaL_checkstack(L, 3, "too many marks in a path component");
		445	lua_pushlstring(L, path, wild - path); /* push prefix */
		446	lua_pushvalue(L, 1); /* push package name (in place of MARK) */
		447	path = wild + 1; /* continue after MARK */
		448	n += 2;
459	}	449	}
460	else /* a < b? */	450	lua_pushstring(L, path); /* push last sufix (`n' already includes this) */
461	return lua_lessthan(L, a, b);	451	lua_concat(L, n);
462	}	452	}
463		453
464	static void auxsort (lua_State *L, int l, int u) {	454
465	while (l < u) { /* for tail recursion */	455	static int luaB_require (lua_State *L) {
466	int i, j;	456	const char *path;
467	/* sort elements a[l], a[(l+u)/2] and a[u] */	457	int status = LUA_ERRFILE; /* not found (yet) */
468	lua_rawgeti(L, 1, l);	458	luaL_checkstring(L, 1);
469	lua_rawgeti(L, 1, u);	459	lua_settop(L, 1);
470	if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */	460	lua_getglobal(L, REQTAB);
471	set2(L, l, u); /* swap a[l] - a[u] */	461	if (!lua_istable(L, 2)) return luaL_error(L, "`" REQTAB "' is not a table");
472	else	462	path = getpath(L);
473	lua_pop(L, 2);	463	lua_pushvalue(L, 1); /* check package's name in book-keeping table */
474	if (u-l == 1) break; /* only 2 elements */	464	lua_rawget(L, 2);
475	i = (l+u)/2;	465	if (lua_toboolean(L, -1)) /* is it there? */
476	lua_rawgeti(L, 1, i);	466	return 1; /* package is already loaded; return its result */
477	lua_rawgeti(L, 1, l);	467	else { /* must load it */
478	if (sort_comp(L, -2, -1)) /* a[i]<a[l]? */	468	while (status == LUA_ERRFILE) {
479	set2(L, i, l);	469	lua_settop(L, 3); /* reset stack position */
480	else {	470	if ((path = pushnextpath(L, path)) == NULL) break;
481	lua_pop(L, 1); /* remove a[l] */	471	pushcomposename(L);
482	lua_rawgeti(L, 1, u);	472	status = luaL_loadfile(L, lua_tostring(L, -1)); /* try to load it */
483	if (sort_comp(L, -1, -2)) /* a[u]<a[i]? */
484	set2(L, i, u);
485	else
486	lua_pop(L, 2);
487	}	473	}
488	if (u-l == 2) break; /* only 3 elements */	474	}
489	lua_rawgeti(L, 1, i); /* Pivot */	475	switch (status) {
490	lua_pushvalue(L, -1);	476	case 0: {
491	lua_rawgeti(L, 1, u-1);	477	lua_getglobal(L, "_REQUIREDNAME"); /* save previous name */
492	set2(L, i, u-1);	478	lua_insert(L, -2); /* put it below function */
493	/* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */	479	lua_pushvalue(L, 1);
494	i = l; j = u-1;	480	lua_setglobal(L, "_REQUIREDNAME"); /* set new name */
495	for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */	481	lua_call(L, 0, 1); /* run loaded module */
496	/* repeat ++i until a[i] >= P */	482	lua_insert(L, -2); /* put result below previous name */
497	while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) {	483	lua_setglobal(L, "_REQUIREDNAME"); /* reset to previous name */
498	if (i>u) lua_error(L, "invalid order function for sorting");	484	if (lua_isnil(L, -1)) { /* no/nil return? */
499	lua_pop(L, 1); /* remove a[i] */	485	lua_pushboolean(L, 1);
500	}	486	lua_replace(L, -2); /* replace to true */
501	/* repeat --j until a[j] <= P */
502	while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) {
503	if (j<l) lua_error(L, "invalid order function for sorting");
504	lua_pop(L, 1); /* remove a[j] */
505	}
506	if (j<i) {
507	lua_pop(L, 3); /* pop pivot, a[i], a[j] */
508	break;
509	}	487	}
510	set2(L, i, j);	488	lua_pushvalue(L, 1);
		489	lua_pushvalue(L, -2);
		490	lua_rawset(L, 2); /* mark it as loaded */
		491	return 1; /* return value */
511	}	492	}
512	lua_rawgeti(L, 1, u-1);	493	case LUA_ERRFILE: { /* file not found */
513	lua_rawgeti(L, 1, i);	494	return luaL_error(L, "could not load package `%s' from path `%s'",
514	set2(L, u-1, i); /* swap pivot (a[u-1]) with a[i] */	495	lua_tostring(L, 1), getpath(L));
515	/* a[l..i-1] <= a[i] == P <= a[i+1..u] */
516	/* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */
517	if (i-l < u-i) {
518	j=l; i=i-1; l=i+2;
519	}	496	}
520	else {	497	default: {
521	j=i+1; i=u; u=j-2;	498	return luaL_error(L, "error loading package `%s' (%s)",
		499	lua_tostring(L, 1), lua_tostring(L, -1));
522	}	500	}
523	auxsort(L, j, i); /* call recursively the smaller one */	501	}
524	} /* repeat the routine for the larger one */
525	}
526
527	static int luaB_sort (lua_State *L) {
528	int n;
529	luaL_checktype(L, 1, LUA_TTABLE);
530	n = lua_getn(L, 1);
531	if (!lua_isnull(L, 2)) /* is there a 2nd argument? */
532	luaL_checktype(L, 2, LUA_TFUNCTION);
533	lua_settop(L, 2); /* make sure there is two arguments */
534	auxsort(L, 1, n);
535	return 0;
536	}	502	}
537		503
538	/* }====================================================== */	504	/* }====================================================== */
539		505
540		506
		507	static const luaL_reg base_funcs[] = {
		508	{"error", luaB_error},
		509	{"getmetatable", luaB_getmetatable},
		510	{"setmetatable", luaB_setmetatable},
		511	{"getfenv", luaB_getfenv},
		512	{"setfenv", luaB_setfenv},
		513	{"next", luaB_next},
		514	{"ipairs", luaB_ipairs},
		515	{"pairs", luaB_pairs},
		516	{"print", luaB_print},
		517	{"tonumber", luaB_tonumber},
		518	{"tostring", luaB_tostring},
		519	{"type", luaB_type},
		520	{"assert", luaB_assert},
		521	{"unpack", luaB_unpack},
		522	{"rawequal", luaB_rawequal},
		523	{"rawget", luaB_rawget},
		524	{"rawset", luaB_rawset},
		525	{"pcall", luaB_pcall},
		526	{"xpcall", luaB_xpcall},
		527	{"collectgarbage", luaB_collectgarbage},
		528	{"gcinfo", luaB_gcinfo},
		529	{"loadfile", luaB_loadfile},
		530	{"dofile", luaB_dofile},
		531	{"loadstring", luaB_loadstring},
		532	{"require", luaB_require},
		533	{NULL, NULL}
		534	};
		535
541		536
542	/*	537	/*
543	** {======================================================	538	** {======================================================
544	** Deprecated functions to manipulate global environment.	539	** Coroutine library
545	** =======================================================	540	** =======================================================
546	*/	541	*/
547		542
		543	static int auxresume (lua_State L, lua_State co, int narg) {
		544	int status;
		545	if (!lua_checkstack(co, narg))
		546	luaL_error(L, "too many arguments to resume");
		547	lua_xmove(L, co, narg);
		548	status = lua_resume(co, narg);
		549	if (status == 0) {
		550	int nres = lua_gettop(co);
		551	if (!lua_checkstack(L, nres))
		552	luaL_error(L, "too many results to resume");
		553	lua_xmove(co, L, nres); /* move yielded values */
		554	return nres;
		555	}
		556	else {
		557	lua_xmove(co, L, 1); /* move error message */
		558	return -1; /* error flag */
		559	}
		560	}
548		561
549	#define num_deprecated 4
550
551	static const struct luaL_reg deprecated_names [num_deprecated] = {
552	{"foreachvar", luaB_foreach},
553	{"nextvar", luaB_next},
554	{"rawgetglobal", luaB_rawget},
555	{"rawsetglobal", luaB_rawset}
556	};
557		562
		563	static int luaB_coresume (lua_State *L) {
		564	lua_State *co = lua_tothread(L, 1);
		565	int r;
		566	luaL_argcheck(L, co, 1, "coroutine expected");
		567	r = auxresume(L, co, lua_gettop(L) - 1);
		568	if (r < 0) {
		569	lua_pushboolean(L, 0);
		570	lua_insert(L, -2);
		571	return 2; /* return false + error message */
		572	}
		573	else {
		574	lua_pushboolean(L, 1);
		575	lua_insert(L, -(r + 1));
		576	return r + 1; /* return true + `resume' returns */
		577	}
		578	}
558		579
559	#ifdef LUA_DEPRECATEDFUNCS
560		580
561	/*	581	static int luaB_auxwrap (lua_State *L) {
562	** call corresponding function inserting `globals' as first argument	582	lua_State *co = lua_tothread(L, lua_upvalueindex(1));
563	*/	583	int r = auxresume(L, co, lua_gettop(L));
564	static int deprecated_func (lua_State *L) {	584	if (r < 0) {
565	lua_insert(L, 1); /* upvalue is the function to be called */	585	if (lua_isstring(L, -1)) { /* error object is a string? */
566	lua_getglobals(L);	586	luaL_where(L, 1); /* add extra info */
567	lua_insert(L, 2); /* table of globals is 1o argument */	587	lua_insert(L, -2);
568	lua_rawcall(L, lua_gettop(L)-1, LUA_MULTRET);	588	lua_concat(L, 2);
569	return lua_gettop(L); /* return all results */	589	}
		590	lua_error(L); /* propagate error */
		591	}
		592	return r;
570	}	593	}
571		594
572		595
573	static void deprecated_funcs (lua_State *L) {	596	static int luaB_cocreate (lua_State *L) {
574	int i;	597	lua_State *NL = lua_newthread(L);
575	for (i=0; i<num_deprecated; i++) {	598	luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,
576	lua_pushcfunction(L, deprecated_names[i].func);	599	"Lua function expected");
577	lua_pushcclosure(L, deprecated_func, 1);	600	lua_pushvalue(L, 1); /* move function to top */
578	lua_setglobal(L, deprecated_names[i].name);	601	lua_xmove(L, NL, 1); /* move function from L to NL */
579	}	602	return 1;
580	}	603	}
581		604
582		605
583	#else	606	static int luaB_cowrap (lua_State *L) {
		607	luaB_cocreate(L);
		608	lua_pushcclosure(L, luaB_auxwrap, 1);
		609	return 1;
		610	}
584		611
585	/*	612
586	** gives an explicit error in any attempt to call a deprecated function	613	static int luaB_yield (lua_State *L) {
587	*/	614	return lua_yield(L, lua_gettop(L));
588	static int deprecated_func (lua_State *L) {
589	luaL_verror(L, "function `%.20s' is deprecated", lua_tostring(L, -1));
590	return 0; /* to avoid warnings */
591	}	615	}
592		616
593		617
594	static void deprecated_funcs (lua_State *L) {	618	static int luaB_costatus (lua_State *L) {
595	int i;	619	lua_State *co = lua_tothread(L, 1);
596	for (i=0; i<num_deprecated; i++) {	620	luaL_argcheck(L, co, 1, "coroutine expected");
597	lua_pushstring(L, deprecated_names[i].name);	621	if (L == co) lua_pushliteral(L, "running");
598	lua_pushcclosure(L, deprecated_func, 1);	622	else {
599	lua_setglobal(L, deprecated_names[i].name);	623	lua_Debug ar;
		624	if (lua_getstack(co, 0, &ar) == 0 && lua_gettop(co) == 0)
		625	lua_pushliteral(L, "dead");
		626	else
		627	lua_pushliteral(L, "suspended");
600	}	628	}
		629	return 1;
601	}	630	}
602		631
603	#endif
604
605	/* }====================================================== */
606		632
607	static const struct luaL_reg base_funcs[] = {	633	static const luaL_reg co_funcs[] = {
608	{LUA_ALERT, luaB__ALERT},	634	{"create", luaB_cocreate},
609	{LUA_ERRORMESSAGE, luaB__ERRORMESSAGE},	635	{"wrap", luaB_cowrap},
610	{"call", luaB_call},	636	{"resume", luaB_coresume},
611	{"collectgarbage", luaB_collectgarbage},	637	{"yield", luaB_yield},
612	{"copytagmethods", luaB_copytagmethods},	638	{"status", luaB_costatus},
613	{"dofile", luaB_dofile},	639	{NULL, NULL}
614	{"dostring", luaB_dostring},
615	{"error", luaB_error},
616	{"foreach", luaB_foreach},
617	{"foreachi", luaB_foreachi},
618	{"gcinfo", luaB_gcinfo},
619	{"getglobal", luaB_getglobal},
620	{"gettagmethod", luaB_gettagmethod},
621	{"globals", luaB_globals},
622	{"newtag", luaB_newtag},
623	{"next", luaB_next},
624	{"print", luaB_print},
625	{"rawget", luaB_rawget},
626	{"rawset", luaB_rawset},
627	{"rawgettable", luaB_rawget}, /* for compatibility */
628	{"rawsettable", luaB_rawset}, /* for compatibility */
629	{"setglobal", luaB_setglobal},
630	{"settag", luaB_settag},
631	{"settagmethod", luaB_settagmethod},
632	{"tag", luaB_tag},
633	{"tonumber", luaB_tonumber},
634	{"tostring", luaB_tostring},
635	{"type", luaB_type},
636	{"assert", luaB_assert},
637	{"getn", luaB_getn},
638	{"sort", luaB_sort},
639	{"tinsert", luaB_tinsert},
640	{"tremove", luaB_tremove}
641	};	640	};
642		641
		642	/* }====================================================== */
		643
643		644
644		645
645	LUALIB_API void lua_baselibopen (lua_State *L) {	646	static void base_open (lua_State *L) {
646	luaL_openl(L, base_funcs);	647	lua_pushliteral(L, "_G");
647	lua_pushstring(L, LUA_VERSION);	648	lua_pushvalue(L, LUA_GLOBALSINDEX);
648	lua_setglobal(L, "_VERSION");	649	luaL_openlib(L, NULL, base_funcs, 0); /* open lib into global table */
649	deprecated_funcs(L);	650	lua_pushliteral(L, "_VERSION");
		651	lua_pushliteral(L, LUA_VERSION);
		652	lua_rawset(L, -3); /* set global _VERSION */
		653	/* `newproxy' needs a weaktable as upvalue */
		654	lua_pushliteral(L, "newproxy");
		655	lua_newtable(L); /* new table `w' */
		656	lua_pushvalue(L, -1); /* `w' will be its own metatable */
		657	lua_setmetatable(L, -2);
		658	lua_pushliteral(L, "__mode");
		659	lua_pushliteral(L, "k");
		660	lua_rawset(L, -3); /* metatable(w).__mode = "k" */
		661	lua_pushcclosure(L, luaB_newproxy, 1);
		662	lua_rawset(L, -3); /* set global `newproxy' */
		663	lua_rawset(L, -1); /* set global _G */
		664	}
		665
		666
		667	LUALIB_API int luaopen_base (lua_State *L) {
		668	base_open(L);
		669	luaL_openlib(L, LUA_COLIBNAME, co_funcs, 0);
		670	lua_newtable(L);
		671	lua_setglobal(L, REQTAB);
		672	return 0;
650	}	673	}
651		674

src/lib/ldblib.c+176−65

 /*
-** $Id: ldblib.c,v 1.29 2000/11/06 17:58:38 roberto Exp $
+** $Id: ldblib.c,v 1.80 2003/04/03 13:35:34 roberto Exp $
 ** Interface from Lua to its debug API
 ** See Copyright Notice in lua.h
 */
 #include <stdlib.h>
 #include <string.h>
+#define ldblib_c
 #include "lua.h"
 #include "lauxlib.h"
-#include "luadebug.h"
 #include "lualib.h"
 static void settabss (lua_State *L, const char *i, const char *v) {
   lua_pushstring(L, i);
   lua_pushstring(L, v);
-  lua_settable(L, -3);
+  lua_rawset(L, -3);
 }
 static void settabsi (lua_State *L, const char *i, int v) {
   lua_pushstring(L, i);
-  lua_pushnumber(L, v);
+  lua_pushnumber(L, (lua_Number)v);
-  lua_settable(L, -3);
+  lua_rawset(L, -3);
 }
 static int getinfo (lua_State *L) {
   lua_Debug ar;
-  const char *options = luaL_opt_string(L, 2, "flnSu");
+  const char *options = luaL_optstring(L, 2, "flnSu");
-  char buff[20];
   if (lua_isnumber(L, 1)) {
-    if (!lua_getstack(L, (int)lua_tonumber(L, 1), &ar)) {
+    if (!lua_getstack(L, (int)(lua_tonumber(L, 1)), &ar)) {
       lua_pushnil(L);  /* level out of range */
       return 1;
     }
   }
   else if (lua_isfunction(L, 1)) {
+    lua_pushfstring(L, ">%s", options);
+    options = lua_tostring(L, -1);
     lua_pushvalue(L, 1);
-    sprintf(buff, ">%.10s", options);
-    options = buff;
   }
   else
-    luaL_argerror(L, 1, "function or level expected");
+    return luaL_argerror(L, 1, "function or level expected");
   if (!lua_getinfo(L, options, &ar))
-    luaL_argerror(L, 2, "invalid option");
+    return luaL_argerror(L, 2, "invalid option");
   lua_newtable(L);
   for (; *options; options++) {
     switch (*options) {
       case 'S':
         settabss(L, "source", ar.source);
-        if (ar.source)
+        settabss(L, "short_src", ar.short_src);
-          settabss(L, "short_src", ar.short_src);
         settabsi(L, "linedefined", ar.linedefined);
         settabss(L, "what", ar.what);
         break;
         settabss(L, "namewhat", ar.namewhat);
         break;
       case 'f':
-        lua_pushstring(L, "func");
+        lua_pushliteral(L, "func");
         lua_pushvalue(L, -3);
-        lua_settable(L, -3);
+        lua_rawset(L, -3);
         break;
     }
   }
 static int getlocal (lua_State *L) {
   lua_Debug ar;
   const char *name;
-  if (!lua_getstack(L, luaL_check_int(L, 1), &ar))  /* level out of range? */
+  if (!lua_getstack(L, luaL_checkint(L, 1), &ar))  /* level out of range? */
-    luaL_argerror(L, 1, "level out of range");
+    return luaL_argerror(L, 1, "level out of range");
-  name = lua_getlocal(L, &ar, luaL_check_int(L, 2));
+  name = lua_getlocal(L, &ar, luaL_checkint(L, 2));
   if (name) {
     lua_pushstring(L, name);
     lua_pushvalue(L, -2);
 static int setlocal (lua_State *L) {
   lua_Debug ar;
-  if (!lua_getstack(L, luaL_check_int(L, 1), &ar))  /* level out of range? */
+  if (!lua_getstack(L, luaL_checkint(L, 1), &ar))  /* level out of range? */
-    luaL_argerror(L, 1, "level out of range");
+    return luaL_argerror(L, 1, "level out of range");
   luaL_checkany(L, 3);
-  lua_pushstring(L, lua_setlocal(L, &ar, luaL_check_int(L, 2)));
+  lua_pushstring(L, lua_setlocal(L, &ar, luaL_checkint(L, 2)));
   return 1;
 }
+static int auxupvalue (lua_State *L, int get) {
+  const char *name;
+  int n = luaL_checkint(L, 2);
+  luaL_checktype(L, 1, LUA_TFUNCTION);
+  if (lua_iscfunction(L, 1)) return 0;  /* cannot touch C upvalues from Lua */
+  name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n);
+  if (name == NULL) return 0;
+  lua_pushstring(L, name);
+  lua_insert(L, -(get+1));
+  return get + 1;
+}
+static int getupvalue (lua_State *L) {
+  return auxupvalue(L, 1);
+}
+static int setupvalue (lua_State *L) {
+  luaL_checkany(L, 3);
+  return auxupvalue(L, 0);
+}
-/* dummy variables (to define unique addresses) */
+static const char KEY_HOOK = 'h';
-static char key1, key2;
-#define KEY_CALLHOOK	(&key1)
-#define KEY_LINEHOOK	(&key2)
-static void hookf (lua_State *L, void *key) {
+static void hookf (lua_State *L, lua_Debug *ar) {
-  lua_getregistry(L);
+  static const char *const hooknames[] =
-  lua_pushuserdata(L, key);
+    {"call", "return", "line", "count", "tail return"};
-  lua_gettable(L, -2);
+  lua_pushlightuserdata(L, (void *)&KEY_HOOK);
+  lua_rawget(L, LUA_REGISTRYINDEX);
   if (lua_isfunction(L, -1)) {
-    lua_pushvalue(L, 1);
+    lua_pushstring(L, hooknames[(int)ar->event]);
-    lua_rawcall(L, 1, 0);
+    if (ar->currentline >= 0)
+      lua_pushnumber(L, (lua_Number)ar->currentline);
+    else lua_pushnil(L);
+    lua_assert(lua_getinfo(L, "lS", ar));
+    lua_call(L, 2, 0);
   }
   else
     lua_pop(L, 1);  /* pop result from gettable */
-  lua_pop(L, 1);  /* pop table */
 }
-static void callf (lua_State *L, lua_Debug *ar) {
+static int makemask (const char *smask, int count) {
-  lua_pushstring(L, ar->event);
+  int mask = 0;
-  hookf(L, KEY_CALLHOOK);
+  if (strchr(smask, 'c')) mask |= LUA_MASKCALL;
+  if (strchr(smask, 'r')) mask |= LUA_MASKRET;
+  if (strchr(smask, 'l')) mask |= LUA_MASKLINE;
+  if (count > 0) mask |= LUA_MASKCOUNT;
+  return mask;
 }
-static void linef (lua_State *L, lua_Debug *ar) {
+static char *unmakemask (int mask, char *smask) {
-  lua_pushnumber(L, ar->currentline);
+  int i = 0;
-  hookf(L, KEY_LINEHOOK);
+  if (mask & LUA_MASKCALL) smask[i++] = 'c';
+  if (mask & LUA_MASKRET) smask[i++] = 'r';
+  if (mask & LUA_MASKLINE) smask[i++] = 'l';
+  smask[i] = '\0';
+  return smask;
 }
-static void sethook (lua_State *L, void *key, lua_Hook hook,
+static int sethook (lua_State *L) {
-                     lua_Hook (*sethookf)(lua_State * L, lua_Hook h)) {
+  if (lua_isnoneornil(L, 1)) {
-  lua_settop(L, 1);
+    lua_settop(L, 1);
-  if (lua_isnil(L, 1))
+    lua_sethook(L, NULL, 0, 0);  /* turn off hooks */
-    (*sethookf)(L, NULL);
+  }
-  else if (lua_isfunction(L, 1))
+  else {
-    (*sethookf)(L, hook);
+    const char *smask = luaL_checkstring(L, 2);
-  else
+    int count = luaL_optint(L, 3, 0);
-    luaL_argerror(L, 1, "function expected");
+    luaL_checktype(L, 1, LUA_TFUNCTION);
-  lua_getregistry(L);
+    lua_sethook(L, hookf, makemask(smask, count), count);
-  lua_pushuserdata(L, key);
+  }
-  lua_pushvalue(L, -1);  /* dup key */
+  lua_pushlightuserdata(L, (void *)&KEY_HOOK);
-  lua_gettable(L, -3);   /* get old value */
-  lua_pushvalue(L, -2);  /* key (again) */
   lua_pushvalue(L, 1);
-  lua_settable(L, -5);  /* set new value */
+  lua_rawset(L, LUA_REGISTRYINDEX);  /* set new hook */
+  return 0;
 }
-static int setcallhook (lua_State *L) {
+static int gethook (lua_State *L) {
-  sethook(L, KEY_CALLHOOK, callf, lua_setcallhook);
+  char buff[5];
-  return 1;
+  int mask = lua_gethookmask(L);
+  lua_Hook hook = lua_gethook(L);
+  if (hook != NULL && hook != hookf)  /* external hook? */
+    lua_pushliteral(L, "external hook");
+  else {
+    lua_pushlightuserdata(L, (void *)&KEY_HOOK);
+    lua_rawget(L, LUA_REGISTRYINDEX);   /* get hook */
+  }
+  lua_pushstring(L, unmakemask(mask, buff));
+  lua_pushnumber(L, (lua_Number)lua_gethookcount(L));
+  return 3;
+}
+static int debug (lua_State *L) {
+  for (;;) {
+    char buffer[250];
+    fputs("lua_debug> ", stderr);
+    if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
+        strcmp(buffer, "cont\n") == 0)
+      return 0;
+    lua_dostring(L, buffer);
+    lua_settop(L, 0);  /* remove eventual returns */
+  }
 }
-static int setlinehook (lua_State *L) {
+#define LEVELS1	12	/* size of the first part of the stack */
-  sethook(L, KEY_LINEHOOK, linef, lua_setlinehook);
+#define LEVELS2	10	/* size of the second part of the stack */
+static int errorfb (lua_State *L) {
+  int level = 1;  /* skip level 0 (it's this function) */
+  int firstpart = 1;  /* still before eventual `...' */
+  lua_Debug ar;
+  if (lua_gettop(L) == 0)
+    lua_pushliteral(L, "");
+  else if (!lua_isstring(L, 1)) return 1;  /* no string message */
+  else lua_pushliteral(L, "\n");
+  lua_pushliteral(L, "stack traceback:");
+  while (lua_getstack(L, level++, &ar)) {
+    if (level > LEVELS1 && firstpart) {
+      /* no more than `LEVELS2' more levels? */
+      if (!lua_getstack(L, level+LEVELS2, &ar))
+        level--;  /* keep going */
+      else {
+        lua_pushliteral(L, "\n\t...");  /* too many levels */
+        while (lua_getstack(L, level+LEVELS2, &ar))  /* find last levels */
+          level++;
+      }
+      firstpart = 0;
+      continue;
+    }
+    lua_pushliteral(L, "\n\t");
+    lua_getinfo(L, "Snl", &ar);
+    lua_pushfstring(L, "%s:", ar.short_src);
+    if (ar.currentline > 0)
+      lua_pushfstring(L, "%d:", ar.currentline);
+    switch (*ar.namewhat) {
+      case 'g':  /* global */
+      case 'l':  /* local */
+      case 'f':  /* field */
+      case 'm':  /* method */
+        lua_pushfstring(L, " in function `%s'", ar.name);
+        break;
+      default: {
+        if (*ar.what == 'm')  /* main? */
+          lua_pushfstring(L, " in main chunk");
+        else if (*ar.what == 'C' || *ar.what == 't')
+          lua_pushliteral(L, " ?");  /* C function or tail call */
+        else
+          lua_pushfstring(L, " in function <%s:%d>",
+                             ar.short_src, ar.linedefined);
+      }
+    }
+    lua_concat(L, lua_gettop(L));
+  }
+  lua_concat(L, lua_gettop(L));
   return 1;
 }
-static const struct luaL_reg dblib[] = {
+static const luaL_reg dblib[] = {
   {"getlocal", getlocal},
   {"getinfo", getinfo},
-  {"setcallhook", setcallhook},
+  {"gethook", gethook},
-  {"setlinehook", setlinehook},
+  {"getupvalue", getupvalue},
-  {"setlocal", setlocal}
+  {"sethook", sethook},
+  {"setlocal", setlocal},
+  {"setupvalue", setupvalue},
+  {"debug", debug},
+  {"traceback", errorfb},
+  {NULL, NULL}
 };
-LUALIB_API void lua_dblibopen (lua_State *L) {
+LUALIB_API int luaopen_debug (lua_State *L) {
-  luaL_openl(L, dblib);
+  luaL_openlib(L, LUA_DBLIBNAME, dblib, 0);
+  lua_pushliteral(L, "_TRACEBACK");
+  lua_pushcfunction(L, errorfb);
+  lua_settable(L, LUA_GLOBALSINDEX);
+  return 1;
 }

src/lib/liolib.c+509−477

@@ -1,302 +1,309 @@
1	/*	1	/*
2	** $Id: liolib.c,v 1.91 2000/10/31 13:10:24 roberto Exp $	2	** $Id: liolib.c,v 2.39 2003/03/19 21:16:12 roberto Exp $
3	** Standard I/O (and system) library	3	** Standard I/O (and system) library
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <ctype.h>	8	#include <errno.h>
		9	#include <locale.h>
9	#include <stdio.h>	10	#include <stdio.h>
10	#include <stdlib.h>	11	#include <stdlib.h>
11	#include <string.h>	12	#include <string.h>
12	#include <time.h>	13	#include <time.h>
13		14
		15	#define liolib_c
		16
14	#include "lua.h"	17	#include "lua.h"
15		18
16	#include "lauxlib.h"	19	#include "lauxlib.h"
17	#include "luadebug.h"
18	#include "lualib.h"	20	#include "lualib.h"
19		21
20		22
21	#ifndef OLD_ANSI	23
22	#include <errno.h>	24	/*
23	#include <locale.h>	25	** by default, gcc does not get `tmpname'
24	#define realloc(b,s) ((b) == NULL ? malloc(s) : (realloc)(b, s))	26	*/
25	#define free(b) if (b) (free)(b)	27	#ifndef USE_TMPNAME
		28	#ifdef __GNUC__
		29	#define USE_TMPNAME 0
26	#else	30	#else
27	/* no support for locale and for strerror: fake them */	31	#define USE_TMPNAME 1
28	#define setlocale(a,b) ((void)a, strcmp((b),"C")==0?"C":NULL)	32	#endif
29	#define LC_ALL 0
30	#define LC_COLLATE 0
31	#define LC_CTYPE 0
32	#define LC_MONETARY 0
33	#define LC_NUMERIC 0
34	#define LC_TIME 0
35	#define strerror(e) "generic I/O error"
36	#define errno (-1)
37	#endif	33	#endif
38		34
39		35
		36	/*
		37	** by default, posix systems get `popen'
		38	*/
		39	#ifndef USE_POPEN
		40	#ifdef _POSIX_C_SOURCE
		41	#if _POSIX_C_SOURCE >= 2
		42	#define USE_POPEN 1
		43	#endif
		44	#endif
		45	#endif
40		46
41	#ifdef POPEN	47	#ifndef USE_POPEN
42	/* FILE *popen();	48	#define USE_POPEN 0
43	int pclose(); */
44	#define CLOSEFILE(L, f) ((pclose(f) == -1) ? fclose(f) : 0)
45	#else
46	/* no support for popen */
47	#define popen(x,y) NULL /* that is, popen always fails */
48	#define CLOSEFILE(L, f) (fclose(f))
49	#endif	49	#endif
50		50
51		51
52	#define INFILE 0
53	#define OUTFILE 1
54		52
55	typedef struct IOCtrl {	53
56	int ref[2]; /* ref for strings _INPUT/_OUTPUT */	54	/*
57	int iotag; /* tag for file handles */	55	** {======================================================
58	int closedtag; /* tag for closed handles */	56	** FILE Operations
59	} IOCtrl;	57	** =======================================================
		58	*/
		59
		60
		61	#if !USE_POPEN
		62	#define pclose(f) (-1)
		63	#endif
60		64
61		65
		66	#define FILEHANDLE "FILE*"
62		67
63	static const char *const filenames[] = {"_INPUT", "_OUTPUT"};	68	#define IO_INPUT "_input"
		69	#define IO_OUTPUT "_output"
64		70
65		71
66	static int pushresult (lua_State *L, int i) {	72	static int pushresult (lua_State L, int i, const char filename) {
67	if (i) {	73	if (i) {
68	lua_pushuserdata(L, NULL);	74	lua_pushboolean(L, 1);
69	return 1;	75	return 1;
70	}	76	}
71	else {	77	else {
72	lua_pushnil(L);	78	lua_pushnil(L);
73	lua_pushstring(L, strerror(errno));	79	if (filename)
		80	lua_pushfstring(L, "%s: %s", filename, strerror(errno));
		81	else
		82	lua_pushfstring(L, "%s", strerror(errno));
74	lua_pushnumber(L, errno);	83	lua_pushnumber(L, errno);
75	return 3;;	84	return 3;
76	}
77	}
78
79
80	/*
81	** {======================================================
82	** FILE Operations
83	** =======================================================
84	*/
85
86
87	static FILE gethandle (lua_State L, IOCtrl *ctrl, int f) {
88	void *p = lua_touserdata(L, f);
89	if (p != NULL) { /* is `f' a userdata ? */
90	int ftag = lua_tag(L, f);
91	if (ftag == ctrl->iotag) /* does it have the correct tag? */
92	return (FILE *)p;
93	else if (ftag == ctrl->closedtag)
94	lua_error(L, "cannot access a closed file");
95	/* else go through */
96	}	85	}
97	return NULL;
98	}	86	}
99		87
100		88
101	static FILE getnonullfile (lua_State L, IOCtrl *ctrl, int arg) {	89	static FILE *topfile (lua_State L, int findex) {
102	FILE *f = gethandle(L, ctrl, arg);	90	FILE f = (FILE )luaL_checkudata(L, findex, FILEHANDLE);
103	luaL_arg_check(L, f, arg, "invalid file handle");	91	if (f == NULL) luaL_argerror(L, findex, "bad file");
104	return f;	92	return f;
105	}	93	}
106		94
107		95
108	static FILE getfilebyref (lua_State L, IOCtrl *ctrl, int inout) {	96	static int io_type (lua_State *L) {
109	FILE *f;	97	FILE f = (FILE )luaL_checkudata(L, 1, FILEHANDLE);
110	lua_getglobals(L);	98	if (f == NULL) lua_pushnil(L);
111	lua_getref(L, ctrl->ref[inout]);	99	else if (*f == NULL)
112	lua_rawget(L, -2);	100	lua_pushliteral(L, "closed file");
113	f = gethandle(L, ctrl, -1);	101	else
114	if (f == NULL)	102	lua_pushliteral(L, "file");
115	luaL_verror(L, "global variable `%.10s' is not a file handle",	103	return 1;
116	filenames[inout]);
117	return f;
118	}	104	}
119		105
120		106
121	static void setfilebyname (lua_State L, IOCtrl ctrl, FILE *f,	107	static FILE tofile (lua_State L, int findex) {
122	const char *name) {	108	FILE **f = topfile(L, findex);
123	lua_pushusertag(L, f, ctrl->iotag);	109	if (*f == NULL)
124	lua_setglobal(L, name);	110	luaL_error(L, "attempt to use a closed file");
		111	return *f;
125	}	112	}
126		113
127		114
128	#define setfile(L,ctrl,f,inout) (setfilebyname(L,ctrl,f,filenames[inout]))
129		115
		116	/*
		117	** When creating file handles, always creates a `closed' file handle
		118	** before opening the actual file; so, if there is a memory error, the
		119	** file is not left opened.
		120	*/
		121	static FILE *newfile (lua_State L) {
		122	FILE pf = (FILE )lua_newuserdata(L, sizeof(FILE *));
		123	pf = NULL; / file handle is currently `closed' */
		124	luaL_getmetatable(L, FILEHANDLE);
		125	lua_setmetatable(L, -2);
		126	return pf;
		127	}
130		128
131	static int setreturn (lua_State L, IOCtrl ctrl, FILE *f, int inout) {	129
132	if (f == NULL)	130	/*
133	return pushresult(L, 0);	131	** assumes that top of the stack is the `io' library, and next is
134	else {	132	** the `io' metatable
135	setfile(L, ctrl, f, inout);	133	*/
136	lua_pushusertag(L, f, ctrl->iotag);	134	static void registerfile (lua_State L, FILE f, const char *name,
137	return 1;	135	const char *impname) {
		136	lua_pushstring(L, name);
		137	*newfile(L) = f;
		138	if (impname) {
		139	lua_pushstring(L, impname);
		140	lua_pushvalue(L, -2);
		141	lua_settable(L, -6); /* metatable[impname] = file */
138	}	142	}
		143	lua_settable(L, -3); /* io[name] = file */
139	}	144	}
140		145
141		146
142	static int closefile (lua_State L, IOCtrl ctrl, FILE *f) {	147	static int aux_close (lua_State *L) {
		148	FILE *f = tofile(L, 1);
143	if (f == stdin \|\| f == stdout \|\| f == stderr)	149	if (f == stdin \|\| f == stdout \|\| f == stderr)
144	return 1;	150	return 0; /* file cannot be closed */
145	else {	151	else {
146	lua_pushusertag(L, f, ctrl->iotag);	152	int ok = (pclose(f) != -1) \|\| (fclose(f) == 0);
147	lua_settag(L, ctrl->closedtag);	153	if (ok)
148	return (CLOSEFILE(L, f) == 0);	154	(FILE )lua_touserdata(L, 1) = NULL; / mark file as closed */
		155	return ok;
149	}	156	}
150	}	157	}
151		158
152		159
153	static int io_close (lua_State *L) {	160	static int io_close (lua_State *L) {
154	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);	161	if (lua_isnone(L, 1)) {
155	lua_pop(L, 1); /* remove upvalue */	162	lua_pushstring(L, IO_OUTPUT);
156	return pushresult(L, closefile(L, ctrl, getnonullfile(L, ctrl, 1)));	163	lua_rawget(L, lua_upvalueindex(1));
		164	}
		165	return pushresult(L, aux_close(L), NULL);
157	}	166	}
158		167
159		168
160	static int file_collect (lua_State *L) {	169	static int io_gc (lua_State *L) {
161	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);	170	FILE **f = topfile(L, 1);
162	FILE *f = getnonullfile(L, ctrl, 1);	171	if (f != NULL) / ignore closed files */
163	if (f != stdin && f != stdout && f != stderr)	172	aux_close(L);
164	CLOSEFILE(L, f);
165	return 0;	173	return 0;
166	}	174	}
167		175
168		176
169	static int io_open (lua_State *L) {	177	static int io_tostring (lua_State *L) {
170	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);	178	char buff[32];
171	FILE *f;	179	FILE **f = topfile(L, 1);
172	lua_pop(L, 1); /* remove upvalue */	180	if (*f == NULL)
173	f = fopen(luaL_check_string(L, 1), luaL_check_string(L, 2));	181	strcpy(buff, "closed");
174	if (f) {
175	lua_pushusertag(L, f, ctrl->iotag);
176	return 1;
177	}
178	else	182	else
179	return pushresult(L, 0);	183	sprintf(buff, "%p", lua_touserdata(L, 1));
		184	lua_pushfstring(L, "file (%s)", buff);
		185	return 1;
180	}	186	}
181		187
182		188
		189	static int io_open (lua_State *L) {
		190	const char *filename = luaL_checkstring(L, 1);
		191	const char *mode = luaL_optstring(L, 2, "r");
		192	FILE **pf = newfile(L);
		193	*pf = fopen(filename, mode);
		194	return (*pf == NULL) ? pushresult(L, 0, filename) : 1;
		195	}
183		196
184	static int io_fromto (lua_State L, int inout, const char mode) {	197
185	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);	198	static int io_popen (lua_State *L) {
186	FILE *current;	199	#if !USE_POPEN
187	lua_pop(L, 1); /* remove upvalue */	200	luaL_error(L, "`popen' not supported");
188	if (lua_isnull(L, 1)) {	201	return 0;
189	closefile(L, ctrl, getfilebyref(L, ctrl, inout));	202	#else
190	current = (inout == 0) ? stdin : stdout;	203	const char *filename = luaL_checkstring(L, 1);
191	}	204	const char *mode = luaL_optstring(L, 2, "r");
192	else if (lua_tag(L, 1) == ctrl->iotag) /* deprecated option */	205	FILE **pf = newfile(L);
193	current = (FILE *)lua_touserdata(L, 1);	206	*pf = popen(filename, mode);
194	else {	207	return (*pf == NULL) ? pushresult(L, 0, filename) : 1;
195	const char *s = luaL_check_string(L, 1);	208	#endif
196	current = (*s == '\|') ? popen(s+1, mode) : fopen(s, mode);
197	}
198	return setreturn(L, ctrl, current, inout);
199	}	209	}
200		210
201		211
202	static int io_readfrom (lua_State *L) {	212	static int io_tmpfile (lua_State *L) {
203	return io_fromto(L, INFILE, "r");	213	FILE **pf = newfile(L);
		214	*pf = tmpfile();
		215	return (*pf == NULL) ? pushresult(L, 0, NULL) : 1;
204	}	216	}
205		217
206		218
207	static int io_writeto (lua_State *L) {	219	static FILE getiofile (lua_State L, const char *name) {
208	return io_fromto(L, OUTFILE, "w");	220	lua_pushstring(L, name);
		221	lua_rawget(L, lua_upvalueindex(1));
		222	return tofile(L, -1);
209	}	223	}
210		224
211		225
212	static int io_appendto (lua_State *L) {	226	static int g_iofile (lua_State L, const char name, const char *mode) {
213	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);	227	if (!lua_isnoneornil(L, 1)) {
214	FILE *current;	228	const char *filename = lua_tostring(L, 1);
215	lua_pop(L, 1); /* remove upvalue */	229	lua_pushstring(L, name);
216	current = fopen(luaL_check_string(L, 1), "a");	230	if (filename) {
217	return setreturn(L, ctrl, current, OUTFILE);	231	FILE **pf = newfile(L);
		232	*pf = fopen(filename, mode);
		233	if (*pf == NULL) {
		234	lua_pushfstring(L, "%s: %s", filename, strerror(errno));
		235	luaL_argerror(L, 1, lua_tostring(L, -1));
		236	}
		237	}
		238	else {
		239	tofile(L, 1); /* check that it's a valid file handle */
		240	lua_pushvalue(L, 1);
		241	}
		242	lua_rawset(L, lua_upvalueindex(1));
		243	}
		244	/* return current value */
		245	lua_pushstring(L, name);
		246	lua_rawget(L, lua_upvalueindex(1));
		247	return 1;
218	}	248	}
219		249
220		250
		251	static int io_input (lua_State *L) {
		252	return g_iofile(L, IO_INPUT, "r");
		253	}
221		254
222	/*
223	** {======================================================
224	** READ
225	** =======================================================
226	*/
227		255
		256	static int io_output (lua_State *L) {
		257	return g_iofile(L, IO_OUTPUT, "w");
		258	}
228		259
229		260
230	#ifdef LUA_COMPAT_READPATTERN	261	static int io_readline (lua_State *L);
231		262
232	/*
233	** We cannot lookahead without need, because this can lock stdin.
234	** This flag signals when we need to read a next char.
235	*/
236	#define NEED_OTHER (EOF-1) /* just some flag different from EOF */
237		263
		264	static void aux_lines (lua_State *L, int idx, int close) {
		265	lua_pushliteral(L, FILEHANDLE);
		266	lua_rawget(L, LUA_REGISTRYINDEX);
		267	lua_pushvalue(L, idx);
		268	lua_pushboolean(L, close); /* close/not close file when finished */
		269	lua_pushcclosure(L, io_readline, 3);
		270	}
238		271
239	static int read_pattern (lua_State L, FILE f, const char *p) {	272
240	int inskip = 0; /* {skip} level */	273	static int f_lines (lua_State *L) {
241	int c = NEED_OTHER;	274	tofile(L, 1); /* check that it's a valid file handle */
242	luaL_Buffer b;	275	aux_lines(L, 1, 0);
243	luaL_buffinit(L, &b);	276	return 1;
244	while (*p != '\0') {
245	switch (*p) {
246	case '{':
247	inskip++;
248	p++;
249	continue;
250	case '}':
251	if (!inskip) lua_error(L, "unbalanced braces in read pattern");
252	inskip--;
253	p++;
254	continue;
255	default: {
256	const char ep = luaI_classend(L, p); / get what is next */
257	int m; /* match result */
258	if (c == NEED_OTHER) c = getc(f);
259	m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep);
260	if (m) {
261	if (!inskip) luaL_putchar(&b, c);
262	c = NEED_OTHER;
263	}
264	switch (*ep) {
265	case '+': /* repetition (1 or more) */
266	if (!m) goto break_while; /* pattern fails? */
267	/* else go through */
268	case '': / repetition (0 or more) */
269	while (m) { /* reads the same item until it fails */
270	c = getc(f);
271	m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep);
272	if (m && !inskip) luaL_putchar(&b, c);
273	}
274	/* go through to continue reading the pattern */
275	case '?': /* optional */
276	p = ep+1; /* continues reading the pattern */
277	continue;
278	default:
279	if (!m) goto break_while; /* pattern fails? */
280	p = ep; /* else continues reading the pattern */
281	}
282	}
283	}
284	} break_while:
285	if (c != NEED_OTHER) ungetc(c, f);
286	luaL_pushresult(&b); /* close buffer */
287	return (*p == '\0');
288	}	277	}
289		278
290	#else
291		279
292	#define read_pattern(L, f, p) (lua_error(L, "read patterns are deprecated"), 0)	280	static int io_lines (lua_State *L) {
		281	if (lua_isnoneornil(L, 1)) { /* no arguments? */
		282	lua_pushstring(L, IO_INPUT);
		283	lua_rawget(L, lua_upvalueindex(1)); /* will iterate over default input */
		284	return f_lines(L);
		285	}
		286	else {
		287	const char *filename = luaL_checkstring(L, 1);
		288	FILE **pf = newfile(L);
		289	*pf = fopen(filename, "r");
		290	luaL_argcheck(L, *pf, 1, strerror(errno));
		291	aux_lines(L, lua_gettop(L), 1);
		292	return 1;
		293	}
		294	}
		295
293		296
294	#endif	297	/*
		298	** {======================================================
		299	** READ
		300	** =======================================================
		301	*/
295		302
296		303
297	static int read_number (lua_State L, FILE f) {	304	static int read_number (lua_State L, FILE f) {
298	double d;	305	lua_Number d;
299	if (fscanf(f, "%lf", &d) == 1) {	306	if (fscanf(f, LUA_NUMBER_SCAN, &d) == 1) {
300	lua_pushnumber(L, d);	307	lua_pushnumber(L, d);
301	return 1;	308	return 1;
302	}	309	}
@@ -304,175 +311,167 @@ static int read_number (lua_State L, FILE f) { · 1 unmodified line
304	}	311	}
305		312
306		313
307	static int read_word (lua_State L, FILE f) {	314	static int test_eof (lua_State L, FILE f) {
308	int c;	315	int c = getc(f);
309	luaL_Buffer b;
310	luaL_buffinit(L, &b);
311	do { c = fgetc(f); } while (isspace(c)); /* skip spaces */
312	while (c != EOF && !isspace(c)) {
313	luaL_putchar(&b, c);
314	c = fgetc(f);
315	}
316	ungetc(c, f);	316	ungetc(c, f);
317	luaL_pushresult(&b); /* close buffer */	317	lua_pushlstring(L, NULL, 0);
318	return (lua_strlen(L, -1) > 0);	318	return (c != EOF);
319	}	319	}
320		320
321		321
322	static int read_line (lua_State L, FILE f) {	322	static int read_line (lua_State L, FILE f) {
323	int n = 0;
324	luaL_Buffer b;	323	luaL_Buffer b;
325	luaL_buffinit(L, &b);	324	luaL_buffinit(L, &b);
326	for (;;) {	325	for (;;) {
		326	size_t l;
327	char *p = luaL_prepbuffer(&b);	327	char *p = luaL_prepbuffer(&b);
328	if (!fgets(p, LUAL_BUFFERSIZE, f)) /* read fails? */	328	if (fgets(p, LUAL_BUFFERSIZE, f) == NULL) { /* eof? */
329	break;	329	luaL_pushresult(&b); /* close buffer */
330	n = strlen(p);	330	return (lua_strlen(L, -1) > 0); /* check whether read something */
331	if (p[n-1] != '\n')
332	luaL_addsize(&b, n);
333	else {
334	luaL_addsize(&b, n-1); /* do not add the `\n' */
335	break;
336	}	331	}
337	}	332	l = strlen(p);
338	luaL_pushresult(&b); /* close buffer */	333	if (p[l-1] != '\n')
339	return (n > 0); /* read something? */	334	luaL_addsize(&b, l);
340	}	335	else {
341		336	luaL_addsize(&b, l - 1); /* do not include `eol' */
342		337	luaL_pushresult(&b); /* close buffer */
343	static void read_file (lua_State L, FILE f) {	338	return 1; /* read at least an `eol' */
344	size_t len = 0;
345	size_t size = BUFSIZ;
346	char *buffer = NULL;
347	for (;;) {
348	char newbuffer = (char )realloc(buffer, size);
349	if (newbuffer == NULL) {
350	free(buffer);
351	lua_error(L, "not enough memory to read a file");
352	}	339	}
353	buffer = newbuffer;
354	len += fread(buffer+len, sizeof(char), size-len, f);
355	if (len < size) break; /* did not read all it could */
356	size *= 2;
357	}	340	}
358	lua_pushlstring(L, buffer, len);
359	free(buffer);
360	}	341	}
361		342
362		343
363	static int read_chars (lua_State L, FILE f, size_t n) {	344	static int read_chars (lua_State L, FILE f, size_t n) {
364	char *buffer;	345	size_t rlen; /* how much to read */
365	size_t n1;	346	size_t nr; /* number of chars actually read */
366	char statbuff[BUFSIZ];	347	luaL_Buffer b;
367	if (n <= BUFSIZ)	348	luaL_buffinit(L, &b);
368	buffer = statbuff;	349	rlen = LUAL_BUFFERSIZE; /* try to read that much each time */
369	else {	350	do {
370	buffer = (char *)malloc(n);	351	char *p = luaL_prepbuffer(&b);
371	if (buffer == NULL)	352	if (rlen > n) rlen = n; /* cannot read more than asked */
372	lua_error(L, "not enough memory to read a file");	353	nr = fread(p, sizeof(char), rlen, f);
373	}	354	luaL_addsize(&b, nr);
374	n1 = fread(buffer, sizeof(char), n, f);	355	n -= nr; /* still have to read `n' chars */
375	lua_pushlstring(L, buffer, n1);	356	} while (n > 0 && nr == rlen); /* until end of count or eof */
376	if (buffer != statbuff) free(buffer);	357	luaL_pushresult(&b); /* close buffer */
377	return (n1 > 0 \|\| n == 0);	358	return (n == 0 \|\| lua_strlen(L, -1) > 0);
378	}	359	}
379		360
380		361
381	static int io_read (lua_State *L) {	362	static int g_read (lua_State L, FILE f, int first) {
382	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);	363	int nargs = lua_gettop(L) - 1;
383	int lastarg = lua_gettop(L) - 1;	364	int success;
384	int firstarg = 1;
385	FILE *f = gethandle(L, ctrl, firstarg);
386	int n;	365	int n;
387	if (f) firstarg++;	366	if (nargs == 0) { /* no arguments? */
388	else f = getfilebyref(L, ctrl, INFILE); /* get _INPUT */	367	success = read_line(L, f);
389	lua_pop(L, 1);	368	n = first+1; /* to return 1 result */
390	if (firstarg > lastarg) { /* no arguments? */
391	lua_settop(L, 0); /* erase upvalue and other eventual garbage */
392	firstarg = lastarg = 1; /* correct indices */
393	lua_pushstring(L, "l"); / push default argument */
394	}	369	}
395	else /* ensure stack space for all results and for auxlib's buffer */	370	else { /* ensure stack space for all results and for auxlib's buffer */
396	luaL_checkstack(L, lastarg-firstarg+1+LUA_MINSTACK, "too many arguments");	371	luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments");
397	for (n = firstarg; n<=lastarg; n++) {	372	success = 1;
398	int success;	373	for (n = first; nargs-- && success; n++) {
399	if (lua_isnumber(L, n))	374	if (lua_type(L, n) == LUA_TNUMBER) {
400	success = read_chars(L, f, (size_t)lua_tonumber(L, n));	375	size_t l = (size_t)lua_tonumber(L, n);
401	else {	376	success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l);
402	const char *p = luaL_check_string(L, n);	377	}
403	if (p[0] != '*')
404	success = read_pattern(L, f, p); /* deprecated! */
405	else {	378	else {
		379	const char *p = lua_tostring(L, n);
		380	luaL_argcheck(L, p && p[0] == '*', n, "invalid option");
406	switch (p[1]) {	381	switch (p[1]) {
407	case 'n': /* number */	382	case 'n': /* number */
408	if (!read_number(L, f)) goto endloop; /* read fails */	383	success = read_number(L, f);
409	continue; /* number is already pushed; avoid the "pushstring" */	384	break;
410	case 'l': /* line */	385	case 'l': /* line */
411	success = read_line(L, f);	386	success = read_line(L, f);
412	break;	387	break;
413	case 'a': /* file */	388	case 'a': /* file */
414	read_file(L, f);	389	read_chars(L, f, ~((size_t)0)); /* read MAX_SIZE_T chars */
415	success = 1; /* always success */	390	success = 1; /* always success */
416	break;	391	break;
417	case 'w': /* word */	392	case 'w': /* word */
418	success = read_word(L, f);	393	return luaL_error(L, "obsolete option `*w' to `read'");
419	break;
420	default:	394	default:
421	luaL_argerror(L, n, "invalid format");	395	return luaL_argerror(L, n, "invalid format");
422	success = 0; /* to avoid warnings */
423	}	396	}
424	}	397	}
425	}	398	}
426	if (!success) {	399	}
427	lua_pop(L, 1); /* remove last result */	400	if (!success) {
428	break; /* read fails */	401	lua_pop(L, 1); /* remove last result */
		402	lua_pushnil(L); /* push nil instead */
		403	}
		404	return n - first;
		405	}
		406
		407
		408	static int io_read (lua_State *L) {
		409	return g_read(L, getiofile(L, IO_INPUT), 1);
		410	}
		411
		412
		413	static int f_read (lua_State *L) {
		414	return g_read(L, tofile(L, 1), 2);
		415	}
		416
		417
		418	static int io_readline (lua_State *L) {
		419	FILE f = (FILE **)lua_touserdata(L, lua_upvalueindex(2));
		420	if (f == NULL) /* file is already closed? */
		421	luaL_error(L, "file is already closed");
		422	if (read_line(L, f)) return 1;
		423	else { /* EOF */
		424	if (lua_toboolean(L, lua_upvalueindex(3))) { /* generator created file? */
		425	lua_settop(L, 0);
		426	lua_pushvalue(L, lua_upvalueindex(2));
		427	aux_close(L); /* close it */
429	}	428	}
430	} endloop:	429	return 0;
431	return n - firstarg;	430	}
432	}	431	}
433		432
434	/* }====================================================== */	433	/* }====================================================== */
435		434
436		435
437	static int io_write (lua_State *L) {	436	static int g_write (lua_State L, FILE f, int arg) {
438	int lastarg = lua_gettop(L) - 1;	437	int nargs = lua_gettop(L) - 1;
439	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
440	int arg = 1;
441	int status = 1;	438	int status = 1;
442	FILE *f = gethandle(L, ctrl, arg);	439	for (; nargs--; arg++) {
443	if (f) arg++;	440	if (lua_type(L, arg) == LUA_TNUMBER) {
444	else f = getfilebyref(L, ctrl, OUTFILE); /* get _OUTPUT */
445	for (; arg <= lastarg; arg++) {
446	if (lua_type(L, arg) == LUA_TNUMBER) { /* LUA_NUMBER */
447	/* optimization: could be done exactly as for strings */	441	/* optimization: could be done exactly as for strings */
448	status = status && fprintf(f, "%.16g", lua_tonumber(L, arg)) > 0;	442	status = status &&
		443	fprintf(f, LUA_NUMBER_FMT, lua_tonumber(L, arg)) > 0;
449	}	444	}
450	else {	445	else {
451	size_t l;	446	size_t l;
452	const char *s = luaL_check_lstr(L, arg, &l);	447	const char *s = luaL_checklstring(L, arg, &l);
453	status = status && (fwrite(s, sizeof(char), l, f) == l);	448	status = status && (fwrite(s, sizeof(char), l, f) == l);
454	}	449	}
455	}	450	}
456	pushresult(L, status);	451	return pushresult(L, status, NULL);
457	return 1;	452	}
		453
		454
		455	static int io_write (lua_State *L) {
		456	return g_write(L, getiofile(L, IO_OUTPUT), 1);
458	}	457	}
459		458
460		459
461	static int io_seek (lua_State *L) {	460	static int f_write (lua_State *L) {
		461	return g_write(L, tofile(L, 1), 2);
		462	}
		463
		464
		465	static int f_seek (lua_State *L) {
462	static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};	466	static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
463	static const char *const modenames[] = {"set", "cur", "end", NULL};	467	static const char *const modenames[] = {"set", "cur", "end", NULL};
464	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);	468	FILE *f = tofile(L, 1);
465	FILE *f;	469	int op = luaL_findstring(luaL_optstring(L, 2, "cur"), modenames);
466	int op;	470	long offset = luaL_optlong(L, 3, 0);
467	long offset;	471	luaL_argcheck(L, op != -1, 2, "invalid mode");
468	lua_pop(L, 1); /* remove upvalue */
469	f = getnonullfile(L, ctrl, 1);
470	op = luaL_findstring(luaL_opt_string(L, 2, "cur"), modenames);
471	offset = luaL_opt_long(L, 3, 0);
472	luaL_arg_check(L, op != -1, 2, "invalid mode");
473	op = fseek(f, offset, mode[op]);	472	op = fseek(f, offset, mode[op]);
474	if (op)	473	if (op)
475	return pushresult(L, 0); /* error */	474	return pushresult(L, 0, NULL); /* error */
476	else {	475	else {
477	lua_pushnumber(L, ftell(f));	476	lua_pushnumber(L, ftell(f));
478	return 1;	477	return 1;
@@ -481,12 +480,51 @@ static int io_seek (lua_State *L) { · 2 unmodified lines
481		480
482		481
483	static int io_flush (lua_State *L) {	482	static int io_flush (lua_State *L) {
484	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);	483	return pushresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL);
485	FILE *f;	484	}
486	lua_pop(L, 1); /* remove upvalue */	485
487	f = gethandle(L, ctrl, 1);	486
488	luaL_arg_check(L, f \|\| lua_isnull(L, 1), 1, "invalid file handle");	487	static int f_flush (lua_State *L) {
489	return pushresult(L, fflush(f) == 0);	488	return pushresult(L, fflush(tofile(L, 1)) == 0, NULL);
		489	}
		490
		491
		492	static const luaL_reg iolib[] = {
		493	{"input", io_input},
		494	{"output", io_output},
		495	{"lines", io_lines},
		496	{"close", io_close},
		497	{"flush", io_flush},
		498	{"open", io_open},
		499	{"popen", io_popen},
		500	{"read", io_read},
		501	{"tmpfile", io_tmpfile},
		502	{"type", io_type},
		503	{"write", io_write},
		504	{NULL, NULL}
		505	};
		506
		507
		508	static const luaL_reg flib[] = {
		509	{"flush", f_flush},
		510	{"read", f_read},
		511	{"lines", f_lines},
		512	{"seek", f_seek},
		513	{"write", f_write},
		514	{"close", io_close},
		515	{"__gc", io_gc},
		516	{"__tostring", io_tostring},
		517	{NULL, NULL}
		518	};
		519
		520
		521	static void createmeta (lua_State *L) {
		522	luaL_newmetatable(L, FILEHANDLE); /* create new metatable for file handles */
		523	/* file methods */
		524	lua_pushliteral(L, "__index");
		525	lua_pushvalue(L, -2); /* push metatable */
		526	lua_rawset(L, -3); /* metatable.__index = metatable */
		527	luaL_openlib(L, NULL, flib, 0);
490	}	528	}
491		529
492	/* }====================================================== */	530	/* }====================================================== */
@@ -499,220 +537,214 @@ static int io_flush (lua_State *L) { · 6 unmodified lines
499	*/	537	*/
500		538
501	static int io_execute (lua_State *L) {	539	static int io_execute (lua_State *L) {
502	lua_pushnumber(L, system(luaL_check_string(L, 1)));	540	lua_pushnumber(L, system(luaL_checkstring(L, 1)));
503	return 1;	541	return 1;
504	}	542	}
505		543
506		544
507	static int io_remove (lua_State *L) {	545	static int io_remove (lua_State *L) {
508	return pushresult(L, remove(luaL_check_string(L, 1)) == 0);	546	const char *filename = luaL_checkstring(L, 1);
		547	return pushresult(L, remove(filename) == 0, filename);
509	}	548	}
510		549
511		550
512	static int io_rename (lua_State *L) {	551	static int io_rename (lua_State *L) {
513	return pushresult(L, rename(luaL_check_string(L, 1),	552	const char *fromname = luaL_checkstring(L, 1);
514	luaL_check_string(L, 2)) == 0);	553	const char *toname = luaL_checkstring(L, 2);
		554	return pushresult(L, rename(fromname, toname) == 0, fromname);
515	}	555	}
516		556
517		557
518	static int io_tmpname (lua_State *L) {	558	static int io_tmpname (lua_State *L) {
519	lua_pushstring(L, tmpnam(NULL));	559	#if !USE_TMPNAME
		560	luaL_error(L, "`tmpname' not supported");
		561	return 0;
		562	#else
		563	char buff[L_tmpnam];
		564	if (tmpnam(buff) != buff)
		565	return luaL_error(L, "unable to generate a unique filename in `tmpname'");
		566	lua_pushstring(L, buff);
520	return 1;	567	return 1;
		568	#endif
521	}	569	}
522		570
523		571
524
525	static int io_getenv (lua_State *L) {	572	static int io_getenv (lua_State *L) {
526	lua_pushstring(L, getenv(luaL_check_string(L, 1))); /* if NULL push nil */	573	lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */
527	return 1;	574	return 1;
528	}	575	}
529		576
530		577
531	static int io_clock (lua_State *L) {	578	static int io_clock (lua_State *L) {
532	lua_pushnumber(L, ((double)clock())/CLOCKS_PER_SEC);	579	lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC);
533	return 1;	580	return 1;
534	}	581	}
535		582
536		583
		584	/*
		585	** {======================================================
		586	** Time/Date operations
		587	** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S,
		588	** wday=%w+1, yday=%j, isdst=? }
		589	** =======================================================
		590	*/
		591
		592	static void setfield (lua_State L, const char key, int value) {
		593	lua_pushstring(L, key);
		594	lua_pushnumber(L, value);
		595	lua_rawset(L, -3);
		596	}
		597
		598	static void setboolfield (lua_State L, const char key, int value) {
		599	lua_pushstring(L, key);
		600	lua_pushboolean(L, value);
		601	lua_rawset(L, -3);
		602	}
		603
		604	static int getboolfield (lua_State L, const char key) {
		605	int res;
		606	lua_pushstring(L, key);
		607	lua_gettable(L, -2);
		608	res = lua_toboolean(L, -1);
		609	lua_pop(L, 1);
		610	return res;
		611	}
		612
		613
		614	static int getfield (lua_State L, const char key, int d) {
		615	int res;
		616	lua_pushstring(L, key);
		617	lua_gettable(L, -2);
		618	if (lua_isnumber(L, -1))
		619	res = (int)(lua_tonumber(L, -1));
		620	else {
		621	if (d == -2)
		622	return luaL_error(L, "field `%s' missing in date table", key);
		623	res = d;
		624	}
		625	lua_pop(L, 1);
		626	return res;
		627	}
		628
		629
537	static int io_date (lua_State *L) {	630	static int io_date (lua_State *L) {
538	char b[256];	631	const char *s = luaL_optstring(L, 1, "%c");
539	const char *s = luaL_opt_string(L, 1, "%c");	632	time_t t = (time_t)(luaL_optnumber(L, 2, -1));
540	struct tm *stm;	633	struct tm *stm;
541	time_t t;	634	if (t == (time_t)(-1)) /* no time given? */
542	time(&t); stm = localtime(&t);	635	t = time(NULL); /* use current time */
543	if (strftime(b, sizeof(b), s, stm))	636	if (s == '!') { / UTC? */
544	lua_pushstring(L, b);	637	stm = gmtime(&t);
		638	s++; /* skip `!' */
		639	}
545	else	640	else
546	lua_error(L, "invalid `date' format");	641	stm = localtime(&t);
		642	if (stm == NULL) /* invalid date? */
		643	lua_pushnil(L);
		644	else if (strcmp(s, "*t") == 0) {
		645	lua_newtable(L);
		646	setfield(L, "sec", stm->tm_sec);
		647	setfield(L, "min", stm->tm_min);
		648	setfield(L, "hour", stm->tm_hour);
		649	setfield(L, "day", stm->tm_mday);
		650	setfield(L, "month", stm->tm_mon+1);
		651	setfield(L, "year", stm->tm_year+1900);
		652	setfield(L, "wday", stm->tm_wday+1);
		653	setfield(L, "yday", stm->tm_yday+1);
		654	setboolfield(L, "isdst", stm->tm_isdst);
		655	}
		656	else {
		657	char b[256];
		658	if (strftime(b, sizeof(b), s, stm))
		659	lua_pushstring(L, b);
		660	else
		661	return luaL_error(L, "`date' format too long");
		662	}
547	return 1;	663	return 1;
548	}	664	}
549		665
550		666
551	static int setloc (lua_State *L) {	667	static int io_time (lua_State *L) {
552	static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,	668	if (lua_isnoneornil(L, 1)) /* called without args? */
553	LC_NUMERIC, LC_TIME};	669	lua_pushnumber(L, time(NULL)); /* return current time */
554	static const char *const catnames[] = {"all", "collate", "ctype", "monetary",	670	else {
555	"numeric", "time", NULL};	671	time_t t;
556	int op = luaL_findstring(luaL_opt_string(L, 2, "all"), catnames);	672	struct tm ts;
557	luaL_arg_check(L, op != -1, 2, "invalid option");	673	luaL_checktype(L, 1, LUA_TTABLE);
558	lua_pushstring(L, setlocale(cat[op], luaL_check_string(L, 1)));	674	lua_settop(L, 1); /* make sure table is at the top */
		675	ts.tm_sec = getfield(L, "sec", 0);
		676	ts.tm_min = getfield(L, "min", 0);
		677	ts.tm_hour = getfield(L, "hour", 12);
		678	ts.tm_mday = getfield(L, "day", -2);
		679	ts.tm_mon = getfield(L, "month", -2) - 1;
		680	ts.tm_year = getfield(L, "year", -2) - 1900;
		681	ts.tm_isdst = getboolfield(L, "isdst");
		682	t = mktime(&ts);
		683	if (t == (time_t)(-1))
		684	lua_pushnil(L);
		685	else
		686	lua_pushnumber(L, t);
		687	}
559	return 1;	688	return 1;
560	}	689	}
561		690
562		691
563	static int io_exit (lua_State *L) {	692	static int io_difftime (lua_State *L) {
564	exit(luaL_opt_int(L, 1, EXIT_SUCCESS));	693	lua_pushnumber(L, difftime((time_t)(luaL_checknumber(L, 1)),
565	return 0; /* to avoid warnings */	694	(time_t)(luaL_optnumber(L, 2, 0))));
		695	return 1;
566	}	696	}
567		697
568	/* }====================================================== */	698	/* }====================================================== */
569		699
570		700
571		701	static int io_setloc (lua_State *L) {
572	static int io_debug (lua_State *L) {	702	static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,
573	for (;;) {	703	LC_NUMERIC, LC_TIME};
574	char buffer[250];	704	static const char *const catnames[] = {"all", "collate", "ctype", "monetary",
575	fprintf(stderr, "lua_debug> ");	705	"numeric", "time", NULL};
576	if (fgets(buffer, sizeof(buffer), stdin) == 0 \|\|	706	const char *l = lua_tostring(L, 1);
577	strcmp(buffer, "cont\n") == 0)	707	int op = luaL_findstring(luaL_optstring(L, 2, "all"), catnames);
578	return 0;	708	luaL_argcheck(L, l \|\| lua_isnoneornil(L, 1), 1, "string expected");
579	lua_dostring(L, buffer);	709	luaL_argcheck(L, op != -1, 2, "invalid option");
580	lua_settop(L, 0); /* remove eventual returns */	710	lua_pushstring(L, setlocale(cat[op], l));
581	}	711	return 1;
582	}	712	}
583		713
584		714
585	#define LEVELS1 12 /* size of the first part of the stack */	715	static int io_exit (lua_State *L) {
586	#define LEVELS2 10 /* size of the second part of the stack */	716	exit(luaL_optint(L, 1, EXIT_SUCCESS));
587		717	return 0; /* to avoid warnings */
588	static int errorfb (lua_State *L) {
589	int level = 1; /* skip level 0 (it's this function) */
590	int firstpart = 1; /* still before eventual `...' */
591	lua_Debug ar;
592	luaL_Buffer b;
593	luaL_buffinit(L, &b);
594	luaL_addstring(&b, "error: ");
595	luaL_addstring(&b, luaL_check_string(L, 1));
596	luaL_addstring(&b, "\n");
597	while (lua_getstack(L, level++, &ar)) {
598	char buff[120]; /* enough to fit following `sprintf's */
599	if (level == 2)
600	luaL_addstring(&b, "stack traceback:\n");
601	else if (level > LEVELS1 && firstpart) {
602	/* no more than `LEVELS2' more levels? */
603	if (!lua_getstack(L, level+LEVELS2, &ar))
604	level--; /* keep going */
605	else {
606	luaL_addstring(&b, " ...\n"); /* too many levels */
607	while (lua_getstack(L, level+LEVELS2, &ar)) /* find last levels */
608	level++;
609	}
610	firstpart = 0;
611	continue;
612	}
613	sprintf(buff, "%4d: ", level-1);
614	luaL_addstring(&b, buff);
615	lua_getinfo(L, "Snl", &ar);
616	switch (*ar.namewhat) {
617	case 'g': case 'l': /* global, local */
618	sprintf(buff, "function `%.50s'", ar.name);
619	break;
620	case 'f': /* field */
621	sprintf(buff, "method `%.50s'", ar.name);
622	break;
623	case 't': /* tag method */
624	sprintf(buff, "`%.50s' tag method", ar.name);
625	break;
626	default: {
627	if (ar.what == 'm') / main? */
628	sprintf(buff, "main of %.70s", ar.short_src);
629	else if (ar.what == 'C') / C function? */
630	sprintf(buff, "%.70s", ar.short_src);
631	else
632	sprintf(buff, "function <%d:%.70s>", ar.linedefined, ar.short_src);
633	ar.source = NULL; /* do not print source again */
634	}
635	}
636	luaL_addstring(&b, buff);
637	if (ar.currentline > 0) {
638	sprintf(buff, " at line %d", ar.currentline);
639	luaL_addstring(&b, buff);
640	}
641	if (ar.source) {
642	sprintf(buff, " [%.70s]", ar.short_src);
643	luaL_addstring(&b, buff);
644	}
645	luaL_addstring(&b, "\n");
646	}
647	luaL_pushresult(&b);
648	lua_getglobal(L, LUA_ALERT);
649	if (lua_isfunction(L, -1)) { /* avoid loop if _ALERT is not defined */
650	lua_pushvalue(L, -2); /* error message */
651	lua_rawcall(L, 1, 0);
652	}
653	return 0;
654	}	718	}
655		719
656		720	static const luaL_reg syslib[] = {
657
658	static const struct luaL_reg iolib[] = {
659	{LUA_ERRORMESSAGE, errorfb},
660	{"clock", io_clock},	721	{"clock", io_clock},
661	{"date", io_date},	722	{"date", io_date},
662	{"debug", io_debug},	723	{"difftime", io_difftime},
663	{"execute", io_execute},	724	{"execute", io_execute},
664	{"exit", io_exit},	725	{"exit", io_exit},
665	{"getenv", io_getenv},	726	{"getenv", io_getenv},
666	{"remove", io_remove},	727	{"remove", io_remove},
667	{"rename", io_rename},	728	{"rename", io_rename},
668	{"setlocale", setloc},	729	{"setlocale", io_setloc},
669	{"tmpname", io_tmpname}	730	{"time", io_time},
		731	{"tmpname", io_tmpname},
		732	{NULL, NULL}
670	};	733	};
671		734
		735	/* }====================================================== */
672		736
673	static const struct luaL_reg iolibtag[] = {
674	{"appendto", io_appendto},
675	{"closefile", io_close},
676	{"flush", io_flush},
677	{"openfile", io_open},
678	{"read", io_read},
679	{"readfrom", io_readfrom},
680	{"seek", io_seek},
681	{"write", io_write},
682	{"writeto", io_writeto}
683	};
684		737
685		738
686	static void openwithcontrol (lua_State *L) {	739	LUALIB_API int luaopen_io (lua_State *L) {
687	IOCtrl ctrl = (IOCtrl )lua_newuserdata(L, sizeof(IOCtrl));	740	luaL_openlib(L, LUA_OSLIBNAME, syslib, 0);
688	unsigned int i;	741	createmeta(L);
689	ctrl->iotag = lua_newtag(L);	742	lua_pushvalue(L, -1);
690	ctrl->closedtag = lua_newtag(L);	743	luaL_openlib(L, LUA_IOLIBNAME, iolib, 1);
691	for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) {	744	/* put predefined file handles into `io' table */
692	/* put `ctrl' as upvalue for these functions */	745	registerfile(L, stdin, "stdin", IO_INPUT);
693	lua_pushvalue(L, -1);	746	registerfile(L, stdout, "stdout", IO_OUTPUT);
694	lua_pushcclosure(L, iolibtag[i].func, 1);	747	registerfile(L, stderr, "stderr", NULL);
695	lua_setglobal(L, iolibtag[i].name);	748	return 1;
696	}
697	/* create references to variable names */
698	lua_pushstring(L, filenames[INFILE]);
699	ctrl->ref[INFILE] = lua_ref(L, 1);
700	lua_pushstring(L, filenames[OUTFILE]);
701	ctrl->ref[OUTFILE] = lua_ref(L, 1);
702	/* predefined file handles */
703	setfile(L, ctrl, stdin, INFILE);
704	setfile(L, ctrl, stdout, OUTFILE);
705	setfilebyname(L, ctrl, stdin, "_STDIN");
706	setfilebyname(L, ctrl, stdout, "_STDOUT");
707	setfilebyname(L, ctrl, stderr, "_STDERR");
708	/* close files when collected */
709	lua_pushcclosure(L, file_collect, 1); /* pops `ctrl' from stack */
710	lua_settagmethod(L, ctrl->iotag, "gc");
711	}
712
713
714	LUALIB_API void lua_iolibopen (lua_State *L) {
715	luaL_openl(L, iolib);
716	openwithcontrol(L);
717	}	749	}
718		750

src/lib/lmathlib.c+80−72

 /*
-** $Id: lmathlib.c,v 1.32 2000/10/31 13:10:24 roberto Exp $
+** $Id: lmathlib.c,v 1.56 2003/03/11 12:30:37 roberto Exp $
 ** Standard mathematical library
 ** See Copyright Notice in lua.h
 */
 #include <stdlib.h>
 #include <math.h>
+#define lmathlib_c
 #include "lua.h"
 #include "lauxlib.h"
 /*
-** If you want Lua to operate in radians (instead of degrees),
+** If you want Lua to operate in degrees (instead of radians),
-** define RADIANS
+** define USE_DEGREES
 */
-#ifdef RADIANS
+#ifdef USE_DEGREES
-#define FROMRAD(a)	(a)
-#define TORAD(a)	(a)
-#else
 #define FROMRAD(a)	((a)/RADIANS_PER_DEGREE)
 #define TORAD(a)	((a)*RADIANS_PER_DEGREE)
+#else
+#define FROMRAD(a)	(a)
+#define TORAD(a)	(a)
 #endif
 static int math_abs (lua_State *L) {
-  lua_pushnumber(L, fabs(luaL_check_number(L, 1)));
+  lua_pushnumber(L, fabs(luaL_checknumber(L, 1)));
   return 1;
 }
 static int math_sin (lua_State *L) {
-  lua_pushnumber(L, sin(TORAD(luaL_check_number(L, 1))));
+  lua_pushnumber(L, sin(TORAD(luaL_checknumber(L, 1))));
   return 1;
 }
 static int math_cos (lua_State *L) {
-  lua_pushnumber(L, cos(TORAD(luaL_check_number(L, 1))));
+  lua_pushnumber(L, cos(TORAD(luaL_checknumber(L, 1))));
   return 1;
 }
 static int math_tan (lua_State *L) {
-  lua_pushnumber(L, tan(TORAD(luaL_check_number(L, 1))));
+  lua_pushnumber(L, tan(TORAD(luaL_checknumber(L, 1))));
   return 1;
 }
 static int math_asin (lua_State *L) {
-  lua_pushnumber(L, FROMRAD(asin(luaL_check_number(L, 1))));
+  lua_pushnumber(L, FROMRAD(asin(luaL_checknumber(L, 1))));
   return 1;
 }
 static int math_acos (lua_State *L) {
-  lua_pushnumber(L, FROMRAD(acos(luaL_check_number(L, 1))));
+  lua_pushnumber(L, FROMRAD(acos(luaL_checknumber(L, 1))));
   return 1;
 }
 static int math_atan (lua_State *L) {
-  lua_pushnumber(L, FROMRAD(atan(luaL_check_number(L, 1))));
+  lua_pushnumber(L, FROMRAD(atan(luaL_checknumber(L, 1))));
   return 1;
 }
 static int math_atan2 (lua_State *L) {
-  lua_pushnumber(L, FROMRAD(atan2(luaL_check_number(L, 1), luaL_check_number(L, 2))));
+  lua_pushnumber(L, FROMRAD(atan2(luaL_checknumber(L, 1), luaL_checknumber(L, 2))));
   return 1;
 }
 static int math_ceil (lua_State *L) {
-  lua_pushnumber(L, ceil(luaL_check_number(L, 1)));
+  lua_pushnumber(L, ceil(luaL_checknumber(L, 1)));
   return 1;
 }
 static int math_floor (lua_State *L) {
-  lua_pushnumber(L, floor(luaL_check_number(L, 1)));
+  lua_pushnumber(L, floor(luaL_checknumber(L, 1)));
   return 1;
 }
 static int math_mod (lua_State *L) {
-  lua_pushnumber(L, fmod(luaL_check_number(L, 1), luaL_check_number(L, 2)));
+  lua_pushnumber(L, fmod(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
   return 1;
 }
 static int math_sqrt (lua_State *L) {
-  lua_pushnumber(L, sqrt(luaL_check_number(L, 1)));
+  lua_pushnumber(L, sqrt(luaL_checknumber(L, 1)));
   return 1;
 }
 static int math_pow (lua_State *L) {
-  lua_pushnumber(L, pow(luaL_check_number(L, 1), luaL_check_number(L, 2)));
+  lua_pushnumber(L, pow(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
   return 1;
 }
 static int math_log (lua_State *L) {
-  lua_pushnumber(L, log(luaL_check_number(L, 1)));
+  lua_pushnumber(L, log(luaL_checknumber(L, 1)));
   return 1;
 }
 static int math_log10 (lua_State *L) {
-  lua_pushnumber(L, log10(luaL_check_number(L, 1)));
+  lua_pushnumber(L, log10(luaL_checknumber(L, 1)));
   return 1;
 }
 static int math_exp (lua_State *L) {
-  lua_pushnumber(L, exp(luaL_check_number(L, 1)));
+  lua_pushnumber(L, exp(luaL_checknumber(L, 1)));
   return 1;
 }
 static int math_deg (lua_State *L) {
-  lua_pushnumber(L, luaL_check_number(L, 1)/RADIANS_PER_DEGREE);
+  lua_pushnumber(L, luaL_checknumber(L, 1)/RADIANS_PER_DEGREE);
   return 1;
 }
 static int math_rad (lua_State *L) {
-  lua_pushnumber(L, luaL_check_number(L, 1)*RADIANS_PER_DEGREE);
+  lua_pushnumber(L, luaL_checknumber(L, 1)*RADIANS_PER_DEGREE);
   return 1;
 }
 static int math_frexp (lua_State *L) {
   int e;
-  lua_pushnumber(L, frexp(luaL_check_number(L, 1), &e));
+  lua_pushnumber(L, frexp(luaL_checknumber(L, 1), &e));
   lua_pushnumber(L, e);
   return 2;
 }
 static int math_ldexp (lua_State *L) {
-  lua_pushnumber(L, ldexp(luaL_check_number(L, 1), luaL_check_int(L, 2)));
+  lua_pushnumber(L, ldexp(luaL_checknumber(L, 1), luaL_checkint(L, 2)));
   return 1;
 }
 static int math_min (lua_State *L) {
   int n = lua_gettop(L);  /* number of arguments */
-  double dmin = luaL_check_number(L, 1);
+  lua_Number dmin = luaL_checknumber(L, 1);
   int i;
   for (i=2; i<=n; i++) {
-    double d = luaL_check_number(L, i);
+    lua_Number d = luaL_checknumber(L, i);
     if (d < dmin)
       dmin = d;
   }
 static int math_max (lua_State *L) {
   int n = lua_gettop(L);  /* number of arguments */
-  double dmax = luaL_check_number(L, 1);
+  lua_Number dmax = luaL_checknumber(L, 1);
   int i;
   for (i=2; i<=n; i++) {
-    double d = luaL_check_number(L, i);
+    lua_Number d = luaL_checknumber(L, i);
     if (d > dmax)
       dmax = d;
   }
 static int math_random (lua_State *L) {
-  /* the '%' avoids the (rare) case of r==1, and is needed also because on
+  /* the `%' avoids the (rare) case of r==1, and is needed also because on
-     some systems (SunOS!) "rand()" may return a value larger than RAND_MAX */
+     some systems (SunOS!) `rand()' may return a value larger than RAND_MAX */
-  double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX;
+  lua_Number r = (lua_Number)(rand()%RAND_MAX) / (lua_Number)RAND_MAX;
   switch (lua_gettop(L)) {  /* check number of arguments */
     case 0: {  /* no arguments */
       lua_pushnumber(L, r);  /* Number between 0 and 1 */
       break;
     }
     case 1: {  /* only upper limit */
-      int u = luaL_check_int(L, 1);
+      int u = luaL_checkint(L, 1);
-      luaL_arg_check(L, 1<=u, 1, "interval is empty");
+      luaL_argcheck(L, 1<=u, 1, "interval is empty");
-      lua_pushnumber(L, (int)(r*u)+1);  /* integer between 1 and `u' */
+      lua_pushnumber(L, (int)floor(r*u)+1);  /* int between 1 and `u' */
       break;
     }
     case 2: {  /* lower and upper limits */
-      int l = luaL_check_int(L, 1);
+      int l = luaL_checkint(L, 1);
-      int u = luaL_check_int(L, 2);
+      int u = luaL_checkint(L, 2);
-      luaL_arg_check(L, l<=u, 2, "interval is empty");
+      luaL_argcheck(L, l<=u, 2, "interval is empty");
-      lua_pushnumber(L, (int)(r*(u-l+1))+l);  /* integer between `l' and `u' */
+      lua_pushnumber(L, (int)floor(r*(u-l+1))+l);  /* int between `l' and `u' */
       break;
     }
-    default: lua_error(L, "wrong number of arguments");
+    default: return luaL_error(L, "wrong number of arguments");
   }
   return 1;
 }
 static int math_randomseed (lua_State *L) {
-  srand(luaL_check_int(L, 1));
+  srand(luaL_checkint(L, 1));
   return 0;
 }
-static const struct luaL_reg mathlib[] = {
+static const luaL_reg mathlib[] = {
-{"abs",   math_abs},
+  {"abs",   math_abs},
-{"sin",   math_sin},
+  {"sin",   math_sin},
-{"cos",   math_cos},
+  {"cos",   math_cos},
-{"tan",   math_tan},
+  {"tan",   math_tan},
-{"asin",  math_asin},
+  {"asin",  math_asin},
-{"acos",  math_acos},
+  {"acos",  math_acos},
-{"atan",  math_atan},
+  {"atan",  math_atan},
-{"atan2", math_atan2},
+  {"atan2", math_atan2},
-{"ceil",  math_ceil},
+  {"ceil",  math_ceil},
-{"floor", math_floor},
+  {"floor", math_floor},
-{"mod",   math_mod},
+  {"mod",   math_mod},
-{"frexp", math_frexp},
+  {"frexp", math_frexp},
-{"ldexp", math_ldexp},
+  {"ldexp", math_ldexp},
-{"sqrt",  math_sqrt},
+  {"sqrt",  math_sqrt},
-{"min",   math_min},
+  {"min",   math_min},
-{"max",   math_max},
+  {"max",   math_max},
-{"log",   math_log},
+  {"log",   math_log},
-{"log10", math_log10},
+  {"log10", math_log10},
-{"exp",   math_exp},
+  {"exp",   math_exp},
-{"deg",   math_deg},
+  {"deg",   math_deg},
-{"rad",   math_rad},
+  {"pow",   math_pow},
-{"random",     math_random},
+  {"rad",   math_rad},
-{"randomseed", math_randomseed}
+  {"random",     math_random},
+  {"randomseed", math_randomseed},
+  {NULL, NULL}
 };
 /*
 ** Open math library
 */
-LUALIB_API void lua_mathlibopen (lua_State *L) {
+LUALIB_API int luaopen_math (lua_State *L) {
-  luaL_openl(L, mathlib);
+  luaL_openlib(L, LUA_MATHLIBNAME, mathlib, 0);
-  lua_pushcfunction(L, math_pow);
+  lua_pushliteral(L, "pi");
-  lua_settagmethod(L, LUA_TNUMBER, "pow");
   lua_pushnumber(L, PI);
-  lua_setglobal(L, "PI");
+  lua_settable(L, -3);
+  lua_pushliteral(L, "__pow");
+  lua_pushcfunction(L, math_pow);
+  lua_settable(L, LUA_GLOBALSINDEX);
+  return 1;
 }

src/lib/loadlib.c+205−0

@@ -0,0 +1,205 @@
	1	/*
	2	** $Id: loadlib.c,v 1.4 2003/04/07 20:11:53 roberto Exp $
	3	** Dynamic library loader for Lua
	4	** See Copyright Notice in lua.h
	5	*
	6	* This Lua library exports a single function, called loadlib, which is
	7	* called from Lua as loadlib(lib,init), where lib is the full name of the
	8	* library to be loaded (including the complete path) and init is the name
	9	* of a function to be called after the library is loaded. Typically, this
	10	* function will register other functions, thus making the complete library
	11	* available to Lua. The init function is not automatically called by
	12	* loadlib. Instead, loadlib returns the init function as a Lua function
	13	* that the client can call when it thinks is appropriate. In the case of
	14	* errors, loadlib returns nil and two strings describing the error.
	15	* The first string is supplied by the operating system; it should be
	16	* informative and useful for error messages. The second string is "open",
	17	* "init", or "absent" to identify the error and is meant to be used for
	18	* making decisions without having to look into the first string (whose
	19	* format is system-dependent).
	20	*
	21	* This module contains an implementation of loadlib for Unix systems that
	22	* have dlfcn, an implementation for Windows, and a stub for other systems.
	23	* See the list at the end of this file for some links to available
	24	* implementations of dlfcn and interfaces to other native dynamic loaders
	25	* on top of which loadlib could be implemented.
	26	*
	27	*/
	28
	29	#include "lua.h"
	30	#include "lauxlib.h"
	31	#include "lualib.h"
	32
	33
	34	#undef LOADLIB
	35
	36
	37	#ifdef USE_DLOPEN
	38	#define LOADLIB
	39	/*
	40	* This is an implementation of loadlib based on the dlfcn interface.
	41	* The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,
	42	* NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least
	43	* as an emulation layer on top of native functions.
	44	*/
	45
	46	#include <dlfcn.h>
	47
	48	static int loadlib(lua_State *L)
	49	{
	50	const char *path=luaL_checkstring(L,1);
	51	const char *init=luaL_checkstring(L,2);
	52	void *lib=dlopen(path,RTLD_NOW);
	53	if (lib!=NULL)
	54	{
	55	lua_CFunction f=(lua_CFunction) dlsym(lib,init);
	56	if (f!=NULL)
	57	{
	58	lua_pushlightuserdata(L,lib);
	59	lua_pushcclosure(L,f,1);
	60	return 1;
	61	}
	62	}
	63	/* else return appropriate error messages */
	64	lua_pushnil(L);
	65	lua_pushstring(L,dlerror());
	66	lua_pushstring(L,(lib!=NULL) ? "init" : "open");
	67	if (lib!=NULL) dlclose(lib);
	68	return 3;
	69	}
	70
	71	#endif
	72
	73
	74
	75	/*
	76	** In Windows, default is to use dll; otherwise, default is not to use dll
	77	*/
	78	#ifndef USE_DLL
	79	#ifdef _WIN32
	80	#define USE_DLL 1
	81	#else
	82	#define USE_DLL 0
	83	#endif
	84	#endif
	85
	86
	87	#if USE_DLL
	88	#define LOADLIB
	89	/*
	90	* This is an implementation of loadlib for Windows using native functions.
	91	*/
	92
	93	#include <windows.h>
	94
	95	static void pusherror(lua_State *L)
	96	{
	97	int error=GetLastError();
	98	char buffer[128];
	99	if (FormatMessage(FORMAT_MESSAGE_IGNORE_INSERTS \| FORMAT_MESSAGE_FROM_SYSTEM,
	100	0, error, 0, buffer, sizeof(buffer), 0))
	101	lua_pushstring(L,buffer);
	102	else
	103	lua_pushfstring(L,"system error %d\n",error);
	104	}
	105
	106	static int loadlib(lua_State *L)
	107	{
	108	const char *path=luaL_checkstring(L,1);
	109	const char *init=luaL_checkstring(L,2);
	110	HINSTANCE lib=LoadLibrary(path);
	111	if (lib!=NULL)
	112	{
	113	lua_CFunction f=(lua_CFunction) GetProcAddress(lib,init);
	114	if (f!=NULL)
	115	{
	116	lua_pushlightuserdata(L,lib);
	117	lua_pushcclosure(L,f,1);
	118	return 1;
	119	}
	120	}
	121	lua_pushnil(L);
	122	pusherror(L);
	123	lua_pushstring(L,(lib!=NULL) ? "init" : "open");
	124	if (lib!=NULL) FreeLibrary(lib);
	125	return 3;
	126	}
	127
	128	#endif
	129
	130
	131
	132	#ifndef LOADLIB
	133	/* Fallback for other systems */
	134
	135	/*
	136	** Those systems support dlopen, so they should have defined USE_DLOPEN.
	137	** The default (no)implementation gives them a special error message.
	138	*/
	139	#ifdef linux
	140	#define LOADLIB
	141	#endif
	142
	143	#ifdef sun
	144	#define LOADLIB
	145	#endif
	146
	147	#ifdef sgi
	148	#define LOADLIB
	149	#endif
	150
	151	#ifdef BSD
	152	#define LOADLIB
	153	#endif
	154
	155	#ifdef _WIN32
	156	#define LOADLIB
	157	#endif
	158
	159	#ifdef LOADLIB
	160	#undef LOADLIB
	161	#define LOADLIB "`loadlib' not installed (check your Lua configuration)"
	162	#else
	163	#define LOADLIB "`loadlib' not supported"
	164	#endif
	165
	166	static int loadlib(lua_State *L)
	167	{
	168	lua_pushnil(L);
	169	lua_pushliteral(L,LOADLIB);
	170	lua_pushliteral(L,"absent");
	171	return 3;
	172	}
	173	#endif
	174
	175	LUALIB_API int luaopen_loadlib (lua_State *L)
	176	{
	177	lua_register(L,"loadlib",loadlib);
	178	return 0;
	179	}
	180
	181	/*
	182	* Here are some links to available implementations of dlfcn and
	183	* interfaces to other native dynamic loaders on top of which loadlib
	184	* could be implemented. Please send contributions and corrections to us.
	185	*
	186	* AIX
	187	* Starting with AIX 4.2, dlfcn is included in the base OS.
	188	* There is also an emulation package available.
	189	* http://www.faqs.org/faqs/aix-faq/part4/section-21.html
	190	*
	191	* HPUX
	192	* HPUX 11 has dlfcn. For HPUX 10 use shl_*.
	193	* http://www.geda.seul.org/mailinglist/geda-dev37/msg00094.html
	194	* http://www.stat.umn.edu/~luke/xls/projects/dlbasics/dlbasics.html
	195	*
	196	* Macintosh, Windows
	197	* http://www.stat.umn.edu/~luke/xls/projects/dlbasics/dlbasics.html
	198	*
	199	* Mac OS X/Darwin
	200	* http://www.opendarwin.org/projects/dlcompat/
	201	*
	202	* GLIB has wrapper code for BeOS, OS2, Unix and Windows
	203	* http://cvs.gnome.org/lxr/source/glib/gmodule/
	204	*
	205	*/

src/lib/lstrlib.c+374−225

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lstrlib.c,v 1.56 2000/10/27 16:15:53 roberto Exp $	2	** $Id: lstrlib.c,v 1.98 2003/04/03 13:35:34 roberto Exp $
3	** Standard library for string operations and pattern-matching	3	** Standard library for string operations and pattern-matching
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -11,37 +11,47 @@ · 5 unmodified lines
11	#include <stdlib.h>	11	#include <stdlib.h>
12	#include <string.h>	12	#include <string.h>
13		13
		14	#define lstrlib_c
		15
14	#include "lua.h"	16	#include "lua.h"
15		17
16	#include "lauxlib.h"	18	#include "lauxlib.h"
17	#include "lualib.h"	19	#include "lualib.h"
18		20
19		21
		22	/* macro to `unsign' a character */
		23	#ifndef uchar
		24	#define uchar(c) ((unsigned char)(c))
		25	#endif
		26
		27
		28	typedef long sint32; /* a signed version for size_t */
		29
20		30
21	static int str_len (lua_State *L) {	31	static int str_len (lua_State *L) {
22	size_t l;	32	size_t l;
23	luaL_check_lstr(L, 1, &l);	33	luaL_checklstring(L, 1, &l);
24	lua_pushnumber(L, l);	34	lua_pushnumber(L, (lua_Number)l);
25	return 1;	35	return 1;
26	}	36	}
27		37
28		38
29	static long posrelat (long pos, size_t len) {	39	static sint32 posrelat (sint32 pos, size_t len) {
30	/* relative string position: negative means back from end */	40	/* relative string position: negative means back from end */
31	return (pos>=0) ? pos : (long)len+pos+1;	41	return (pos>=0) ? pos : (sint32)len+pos+1;
32	}	42	}
33		43
34		44
35	static int str_sub (lua_State *L) {	45	static int str_sub (lua_State *L) {
36	size_t l;	46	size_t l;
37	const char *s = luaL_check_lstr(L, 1, &l);	47	const char *s = luaL_checklstring(L, 1, &l);
38	long start = posrelat(luaL_check_long(L, 2), l);	48	sint32 start = posrelat(luaL_checklong(L, 2), l);
39	long end = posrelat(luaL_opt_long(L, 3, -1), l);	49	sint32 end = posrelat(luaL_optlong(L, 3, -1), l);
40	if (start < 1) start = 1;	50	if (start < 1) start = 1;
41	if (end > (long)l) end = l;	51	if (end > (sint32)l) end = (sint32)l;
42	if (start <= end)	52	if (start <= end)
43	lua_pushlstring(L, s+start-1, end-start+1);	53	lua_pushlstring(L, s+start-1, end-start+1);
44	else lua_pushstring(L, "");	54	else lua_pushliteral(L, "");
45	return 1;	55	return 1;
46	}	56	}
47		57
@@ -50,10 +60,10 @@ static int str_lower (lua_State *L) { · 2 unmodified lines
50	size_t l;	60	size_t l;
51	size_t i;	61	size_t i;
52	luaL_Buffer b;	62	luaL_Buffer b;
53	const char *s = luaL_check_lstr(L, 1, &l);	63	const char *s = luaL_checklstring(L, 1, &l);
54	luaL_buffinit(L, &b);	64	luaL_buffinit(L, &b);
55	for (i=0; i<l; i++)	65	for (i=0; i<l; i++)
56	luaL_putchar(&b, tolower((unsigned char)(s[i])));	66	luaL_putchar(&b, tolower(uchar(s[i])));
57	luaL_pushresult(&b);	67	luaL_pushresult(&b);
58	return 1;	68	return 1;
59	}	69	}
@@ -63,10 +73,10 @@ static int str_upper (lua_State *L) { · 3 unmodified lines
63	size_t l;	73	size_t l;
64	size_t i;	74	size_t i;
65	luaL_Buffer b;	75	luaL_Buffer b;
66	const char *s = luaL_check_lstr(L, 1, &l);	76	const char *s = luaL_checklstring(L, 1, &l);
67	luaL_buffinit(L, &b);	77	luaL_buffinit(L, &b);
68	for (i=0; i<l; i++)	78	for (i=0; i<l; i++)
69	luaL_putchar(&b, toupper((unsigned char)(s[i])));	79	luaL_putchar(&b, toupper(uchar(s[i])));
70	luaL_pushresult(&b);	80	luaL_pushresult(&b);
71	return 1;	81	return 1;
72	}	82	}
@@ -74,8 +84,8 @@ static int str_upper (lua_State *L) { · 1 unmodified line
74	static int str_rep (lua_State *L) {	84	static int str_rep (lua_State *L) {
75	size_t l;	85	size_t l;
76	luaL_Buffer b;	86	luaL_Buffer b;
77	const char *s = luaL_check_lstr(L, 1, &l);	87	const char *s = luaL_checklstring(L, 1, &l);
78	int n = luaL_check_int(L, 2);	88	int n = luaL_checkint(L, 2);
79	luaL_buffinit(L, &b);	89	luaL_buffinit(L, &b);
80	while (n-- > 0)	90	while (n-- > 0)
81	luaL_addlstring(&b, s, l);	91	luaL_addlstring(&b, s, l);
@@ -86,10 +96,11 @@ static int str_rep (lua_State *L) { · 4 unmodified lines
86		96
87	static int str_byte (lua_State *L) {	97	static int str_byte (lua_State *L) {
88	size_t l;	98	size_t l;
89	const char *s = luaL_check_lstr(L, 1, &l);	99	const char *s = luaL_checklstring(L, 1, &l);
90	long pos = posrelat(luaL_opt_long(L, 2, 1), l);	100	sint32 pos = posrelat(luaL_optlong(L, 2, 1), l);
91	luaL_arg_check(L, 0<pos && (size_t)pos<=l, 2, "out of range");	101	if (pos <= 0 \|\| (size_t)(pos) > l) /* index out of range? */
92	lua_pushnumber(L, (unsigned char)s[pos-1]);	102	return 0; /* no answer */
		103	lua_pushnumber(L, uchar(s[pos-1]));
93	return 1;	104	return 1;
94	}	105	}
95		106
@@ -100,15 +111,33 @@ static int str_char (lua_State *L) { · 4 unmodified lines
100	luaL_Buffer b;	111	luaL_Buffer b;
101	luaL_buffinit(L, &b);	112	luaL_buffinit(L, &b);
102	for (i=1; i<=n; i++) {	113	for (i=1; i<=n; i++) {
103	int c = luaL_check_int(L, i);	114	int c = luaL_checkint(L, i);
104	luaL_arg_check(L, (unsigned char)c == c, i, "invalid value");	115	luaL_argcheck(L, uchar(c) == c, i, "invalid value");
105	luaL_putchar(&b, (unsigned char)c);	116	luaL_putchar(&b, uchar(c));
106	}	117	}
107	luaL_pushresult(&b);	118	luaL_pushresult(&b);
108	return 1;	119	return 1;
109	}	120	}
110		121
111		122
		123	static int writer (lua_State L, const void b, size_t size, void* B) {
		124	(void)L;
		125	luaL_addlstring((luaL_Buffer) B, (const char )b, size);
		126	return 1;
		127	}
		128
		129
		130	static int str_dump (lua_State *L) {
		131	luaL_Buffer b;
		132	luaL_checktype(L, 1, LUA_TFUNCTION);
		133	luaL_buffinit(L,&b);
		134	if (!lua_dump(L, writer, &b))
		135	luaL_error(L, "unable to dump given function");
		136	luaL_pushresult(&b);
		137	return 1;
		138	}
		139
		140
112		141
113	/*	142	/*
114	** {======================================================	143	** {======================================================
@@ -121,51 +150,61 @@ static int str_char (lua_State *L) { · 6 unmodified lines
121	#endif	150	#endif
122		151
123		152
124	struct Capture {	153	#define CAP_UNFINISHED (-1)
125	const char src_end; / end ('\0') of source string */	154	#define CAP_POSITION (-2)
		155
		156	typedef struct MatchState {
		157	const char src_init; / init of source string */
		158	const char src_end; / end (`\0') of source string */
		159	lua_State *L;
126	int level; /* total number of captures (finished or unfinished) */	160	int level; /* total number of captures (finished or unfinished) */
127	struct {	161	struct {
128	const char *init;	162	const char *init;
129	long len; /* -1 signals unfinished capture */	163	sint32 len;
130	} capture[MAX_CAPTURES];	164	} capture[MAX_CAPTURES];
131	};	165	} MatchState;
132		166
133		167
134	#define ESC '%'	168	#define ESC '%'
135	#define SPECIALS "^$*+?.([%-"	169	#define SPECIALS "^$*+?.([%-"
136		170
137		171
138	static int check_capture (lua_State L, int l, struct Capture cap) {	172	static int check_capture (MatchState *ms, int l) {
139	l -= '1';	173	l -= '1';
140	if (!(0 <= l && l < cap->level && cap->capture[l].len != -1))	174	if (l < 0 \|\| l >= ms->level \|\| ms->capture[l].len == CAP_UNFINISHED)
141	lua_error(L, "invalid capture index");	175	return luaL_error(ms->L, "invalid capture index");
142	return l;	176	return l;
143	}	177	}
144		178
145		179
146	static int capture_to_close (lua_State L, struct Capture cap) {	180	static int capture_to_close (MatchState *ms) {
147	int level = cap->level;	181	int level = ms->level;
148	for (level--; level>=0; level--)	182	for (level--; level>=0; level--)
149	if (cap->capture[level].len == -1) return level;	183	if (ms->capture[level].len == CAP_UNFINISHED) return level;
150	lua_error(L, "invalid pattern capture");	184	return luaL_error(ms->L, "invalid pattern capture");
151	return 0; /* to avoid warnings */
152	}	185	}
153		186
154		187
155	const char luaI_classend (lua_State L, const char *p) {	188	static const char luaI_classend (MatchState ms, const char *p) {
156	switch (*p++) {	189	switch (*p++) {
157	case ESC:	190	case ESC: {
158	if (*p == '\0') lua_error(L, "malformed pattern (ends with `%')");	191	if (*p == '\0')
		192	luaL_error(ms->L, "malformed pattern (ends with `%')");
159	return p+1;	193	return p+1;
160	case '[':	194	}
		195	case '[': {
161	if (*p == '^') p++;	196	if (*p == '^') p++;
162	do { /* look for a ']' */	197	do { /* look for a `]' */
163	if (*p == '\0') lua_error(L, "malformed pattern (missing `]')");	198	if (*p == '\0')
164	if ((p++) == ESC && p != '\0') p++; /* skip escapes (e.g. '%]') */	199	luaL_error(ms->L, "malformed pattern (missing `]')");
		200	if ((p++) == ESC && p != '\0')
		201	p++; /* skip escapes (e.g. `%]') */
165	} while (*p != ']');	202	} while (*p != ']');
166	return p+1;	203	return p+1;
167	default:	204	}
		205	default: {
168	return p;	206	return p;
		207	}
169	}	208	}
170	}	209	}
171		210
@@ -182,66 +221,59 @@ static int match_class (int c, int cl) { · 10 unmodified lines
182	case 'u' : res = isupper(c); break;	221	case 'u' : res = isupper(c); break;
183	case 'w' : res = isalnum(c); break;	222	case 'w' : res = isalnum(c); break;
184	case 'x' : res = isxdigit(c); break;	223	case 'x' : res = isxdigit(c); break;
185	case 'z' : res = (c == '\0'); break;	224	case 'z' : res = (c == 0); break;
186	default: return (cl == c);	225	default: return (cl == c);
187	}	226	}
188	return (islower(cl) ? res : !res);	227	return (islower(cl) ? res : !res);
189	}	228	}
190		229
191		230
192		231	static int matchbracketclass (int c, const char p, const char ec) {
193	static int matchbracketclass (int c, const char p, const char endclass) {
194	int sig = 1;	232	int sig = 1;
195	if (*(p+1) == '^') {	233	if (*(p+1) == '^') {
196	sig = 0;	234	sig = 0;
197	p++; /* skip the '^' */	235	p++; /* skip the `^' */
198	}	236	}
199	while (++p < endclass) {	237	while (++p < ec) {
200	if (*p == ESC) {	238	if (*p == ESC) {
201	p++;	239	p++;
202	if (match_class(c, (unsigned char)*p))	240	if (match_class(c, *p))
203	return sig;	241	return sig;
204	}	242	}
205	else if ((*(p+1) == '-') && (p+2 < endclass)) {	243	else if ((*(p+1) == '-') && (p+2 < ec)) {
206	p+=2;	244	p+=2;
207	if ((int)(unsigned char)(p-2) <= c && c <= (int)(unsigned char)p)	245	if (uchar((p-2)) <= c && c <= uchar(p))
208	return sig;	246	return sig;
209	}	247	}
210	else if ((int)(unsigned char)*p == c) return sig;	248	else if (uchar(*p) == c) return sig;
211	}	249	}
212	return !sig;	250	return !sig;
213	}	251	}
214		252
215		253
216		254	static int luaI_singlematch (int c, const char p, const char ep) {
217	int luaI_singlematch (int c, const char p, const char ep) {
218	switch (*p) {	255	switch (*p) {
219	case '.': /* matches any char */	256	case '.': return 1; /* matches any char */
220	return 1;	257	case ESC: return match_class(c, *(p+1));
221	case ESC:	258	case '[': return matchbracketclass(c, p, ep-1);
222	return match_class(c, (unsigned char)*(p+1));	259	default: return (uchar(*p) == c);
223	case '[':
224	return matchbracketclass(c, p, ep-1);
225	default:
226	return ((unsigned char)*p == c);
227	}	260	}
228	}	261	}
229		262
230		263
231	static const char match (lua_State L, const char s, const char p,	264	static const char match (MatchState ms, const char s, const char p);
232	struct Capture *cap);
233		265
234		266
235	static const char matchbalance (lua_State L, const char s, const char p,	267	static const char matchbalance (MatchState ms, const char *s,
236	struct Capture *cap) {	268	const char *p) {
237	if (p == 0 \|\| (p+1) == 0)	269	if (p == 0 \|\| (p+1) == 0)
238	lua_error(L, "unbalanced pattern");	270	luaL_error(ms->L, "unbalanced pattern");
239	if (s != p) return NULL;	271	if (s != p) return NULL;
240	else {	272	else {
241	int b = *p;	273	int b = *p;
242	int e = *(p+1);	274	int e = *(p+1);
243	int cont = 1;	275	int cont = 1;
244	while (++s < cap->src_end) {	276	while (++s < ms->src_end) {
245	if (*s == e) {	277	if (*s == e) {
246	if (--cont == 0) return s+1;	278	if (--cont == 0) return s+1;
247	}	279	}
@@ -252,14 +284,14 @@ static const char matchbalance (lua_State L, const char s, const char p, · 4 unmodified lines
252	}	284	}
253		285
254		286
255	static const char max_expand (lua_State L, const char s, const char p,	287	static const char max_expand (MatchState ms, const char *s,
256	const char ep, struct Capture cap) {	288	const char p, const char ep) {
257	long i = 0; /* counts maximum expand for item */	289	sint32 i = 0; /* counts maximum expand for item */
258	while ((s+i)<cap->src_end && luaI_singlematch((unsigned char)*(s+i), p, ep))	290	while ((s+i)<ms->src_end && luaI_singlematch(uchar(*(s+i)), p, ep))
259	i++;	291	i++;
260	/* keeps trying to match with the maximum repetitions */	292	/* keeps trying to match with the maximum repetitions */
261	while (i>=0) {	293	while (i>=0) {
262	const char *res = match(L, (s+i), ep+1, cap);	294	const char *res = match(ms, (s+i), ep+1);
263	if (res) return res;	295	if (res) return res;
264	i--; /* else didn't match; reduce 1 repetition to try again */	296	i--; /* else didn't match; reduce 1 repetition to try again */
265	}	297	}
@@ -267,100 +299,126 @@ static const char max_expand (lua_State L, const char s, const char p, · 1 unmodified line
267	}	299	}
268		300
269		301
270	static const char min_expand (lua_State L, const char s, const char p,	302	static const char min_expand (MatchState ms, const char *s,
271	const char ep, struct Capture cap) {	303	const char p, const char ep) {
272	for (;;) {	304	for (;;) {
273	const char *res = match(L, s, ep+1, cap);	305	const char *res = match(ms, s, ep+1);
274	if (res != NULL)	306	if (res != NULL)
275	return res;	307	return res;
276	else if (s<cap->src_end && luaI_singlematch((unsigned char)*s, p, ep))	308	else if (s<ms->src_end && luaI_singlematch(uchar(*s), p, ep))
277	s++; /* try with one more repetition */	309	s++; /* try with one more repetition */
278	else return NULL;	310	else return NULL;
279	}	311	}
280	}	312	}
281		313
282		314
283	static const char start_capture (lua_State L, const char s, const char p,	315	static const char start_capture (MatchState ms, const char *s,
284	struct Capture *cap) {	316	const char *p, int what) {
285	const char *res;	317	const char *res;
286	int level = cap->level;	318	int level = ms->level;
287	if (level >= MAX_CAPTURES) lua_error(L, "too many captures");	319	if (level >= MAX_CAPTURES) luaL_error(ms->L, "too many captures");
288	cap->capture[level].init = s;	320	ms->capture[level].init = s;
289	cap->capture[level].len = -1;	321	ms->capture[level].len = what;
290	cap->level = level+1;	322	ms->level = level+1;
291	if ((res=match(L, s, p+1, cap)) == NULL) /* match failed? */	323	if ((res=match(ms, s, p)) == NULL) /* match failed? */
292	cap->level--; /* undo capture */	324	ms->level--; /* undo capture */
293	return res;	325	return res;
294	}	326	}
295		327
296		328
297	static const char end_capture (lua_State L, const char s, const char p,	329	static const char end_capture (MatchState ms, const char *s,
298	struct Capture *cap) {	330	const char *p) {
299	int l = capture_to_close(L, cap);	331	int l = capture_to_close(ms);
300	const char *res;	332	const char *res;
301	cap->capture[l].len = s - cap->capture[l].init; /* close capture */	333	ms->capture[l].len = s - ms->capture[l].init; /* close capture */
302	if ((res = match(L, s, p+1, cap)) == NULL) /* match failed? */	334	if ((res = match(ms, s, p)) == NULL) /* match failed? */
303	cap->capture[l].len = -1; /* undo capture */	335	ms->capture[l].len = CAP_UNFINISHED; /* undo capture */
304	return res;	336	return res;
305	}	337	}
306		338
307		339
308	static const char match_capture (lua_State L, const char *s, int level,	340	static const char match_capture (MatchState ms, const char *s, int l) {
309	struct Capture *cap) {	341	size_t len;
310	int l = check_capture(L, level, cap);	342	l = check_capture(ms, l);
311	size_t len = cap->capture[l].len;	343	len = ms->capture[l].len;
312	if ((size_t)(cap->src_end-s) >= len &&	344	if ((size_t)(ms->src_end-s) >= len &&
313	memcmp(cap->capture[l].init, s, len) == 0)	345	memcmp(ms->capture[l].init, s, len) == 0)
314	return s+len;	346	return s+len;
315	else return NULL;	347	else return NULL;
316	}	348	}
317		349
318		350
319	static const char match (lua_State L, const char s, const char p,	351	static const char match (MatchState ms, const char s, const char p) {
320	struct Capture *cap) {
321	init: /* using goto's to optimize tail recursion */	352	init: /* using goto's to optimize tail recursion */
322	switch (*p) {	353	switch (*p) {
323	case '(': /* start capture */	354	case '(': { /* start capture */
324	return start_capture(L, s, p, cap);	355	if ((p+1) == ')') / position capture? */
325	case ')': /* end capture */	356	return start_capture(ms, s, p+2, CAP_POSITION);
326	return end_capture(L, s, p, cap);	357	else
327	case ESC: /* may be %[0-9] or %b */	358	return start_capture(ms, s, p+1, CAP_UNFINISHED);
328	if (isdigit((unsigned char)((p+1)))) { / capture? */	359	}
329	s = match_capture(L, s, *(p+1), cap);	360	case ')': { /* end capture */
330	if (s == NULL) return NULL;	361	return end_capture(ms, s, p+1);
331	p+=2; goto init; /* else return match(L, s, p+2, cap) */	362	}
332	}	363	case ESC: {
333	else if ((p+1) == 'b') { / balanced string? */	364	switch (*(p+1)) {
334	s = matchbalance(L, s, p+2, cap);	365	case 'b': { /* balanced string? */
335	if (s == NULL) return NULL;	366	s = matchbalance(ms, s, p+2);
336	p+=4; goto init; /* else return match(L, s, p+4, cap); */	367	if (s == NULL) return NULL;
		368	p+=4; goto init; /* else return match(ms, s, p+4); */
		369	}
		370	case 'f': { /* frontier? */
		371	const char *ep; char previous;
		372	p += 2;
		373	if (*p != '[')
		374	luaL_error(ms->L, "missing `[' after `%%f' in pattern");
		375	ep = luaI_classend(ms, p); /* points to what is next */
		376	previous = (s == ms->src_init) ? '\0' : *(s-1);
		377	if (matchbracketclass(uchar(previous), p, ep-1) \|\|
		378	!matchbracketclass(uchar(*s), p, ep-1)) return NULL;
		379	p=ep; goto init; /* else return match(ms, s, ep); */
		380	}
		381	default: {
		382	if (isdigit(uchar((p+1)))) { / capture results (%0-%9)? */
		383	s = match_capture(ms, s, *(p+1));
		384	if (s == NULL) return NULL;
		385	p+=2; goto init; /* else return match(ms, s, p+2) */
		386	}
		387	goto dflt; /* case default */
		388	}
337	}	389	}
338	else goto dflt; /* case default */	390	}
339	case '\0': /* end of pattern */	391	case '\0': { /* end of pattern */
340	return s; /* match succeeded */	392	return s; /* match succeeded */
341	case '$':	393	}
342	if ((p+1) == '\0') / is the '$' the last char in pattern? */	394	case '$': {
343	return (s == cap->src_end) ? s : NULL; /* check end of string */	395	if ((p+1) == '\0') / is the `$' the last char in pattern? */
		396	return (s == ms->src_end) ? s : NULL; /* check end of string */
344	else goto dflt;	397	else goto dflt;
		398	}
345	default: dflt: { /* it is a pattern item */	399	default: dflt: { /* it is a pattern item */
346	const char ep = luaI_classend(L, p); / points to what is next */	400	const char ep = luaI_classend(ms, p); / points to what is next */
347	int m = s<cap->src_end && luaI_singlematch((unsigned char)*s, p, ep);	401	int m = s<ms->src_end && luaI_singlematch(uchar(*s), p, ep);
348	switch (*ep) {	402	switch (*ep) {
349	case '?': { /* optional */	403	case '?': { /* optional */
350	const char *res;	404	const char *res;
351	if (m && ((res=match(L, s+1, ep+1, cap)) != NULL))	405	if (m && ((res=match(ms, s+1, ep+1)) != NULL))
352	return res;	406	return res;
353	p=ep+1; goto init; /* else return match(L, s, ep+1, cap); */	407	p=ep+1; goto init; /* else return match(ms, s, ep+1); */
		408	}
		409	case '': { / 0 or more repetitions */
		410	return max_expand(ms, s, p, ep);
		411	}
		412	case '+': { /* 1 or more repetitions */
		413	return (m ? max_expand(ms, s+1, p, ep) : NULL);
		414	}
		415	case '-': { /* 0 or more repetitions (minimum) */
		416	return min_expand(ms, s, p, ep);
354	}	417	}
355	case '': / 0 or more repetitions */	418	default: {
356	return max_expand(L, s, p, ep, cap);
357	case '+': /* 1 or more repetitions */
358	return (m ? max_expand(L, s+1, p, ep, cap) : NULL);
359	case '-': /* 0 or more repetitions (minimum) */
360	return min_expand(L, s, p, ep, cap);
361	default:
362	if (!m) return NULL;	419	if (!m) return NULL;
363	s++; p=ep; goto init; /* else return match(L, s+1, ep, cap); */	420	s++; p=ep; goto init; /* else return match(ms, s+1, ep); */
		421	}
364	}	422	}
365	}	423	}
366	}	424	}
@@ -369,7 +427,7 @@ static const char match (lua_State L, const char s, const char p, · 2 unmodified lines
369		427
370		428
371	static const char lmemfind (const char s1, size_t l1,	429	static const char lmemfind (const char s1, size_t l1,
372	const char *s2, size_t l2) {	430	const char *s2, size_t l2) {
373	if (l2 == 0) return s1; /* empty strings are everywhere */	431	if (l2 == 0) return s1; /* empty strings are everywhere */
374	else if (l2 > l1) return NULL; /* avoids a negative `l1' */	432	else if (l2 > l1) return NULL; /* avoids a negative `l1' */
375	else {	433	else {
@@ -390,54 +448,109 @@ static const char lmemfind (const char s1, size_t l1, · 14 unmodified lines
390	}	448	}
391		449
392		450
393	static int push_captures (lua_State L, struct Capture cap) {	451	static void push_onecapture (MatchState *ms, int i) {
		452	int l = ms->capture[i].len;
		453	if (l == CAP_UNFINISHED) luaL_error(ms->L, "unfinished capture");
		454	if (l == CAP_POSITION)
		455	lua_pushnumber(ms->L, (lua_Number)(ms->capture[i].init - ms->src_init + 1));
		456	else
		457	lua_pushlstring(ms->L, ms->capture[i].init, l);
		458	}
		459
		460
		461	static int push_captures (MatchState ms, const char s, const char *e) {
394	int i;	462	int i;
395	luaL_checkstack(L, cap->level, "too many captures");	463	luaL_checkstack(ms->L, ms->level, "too many captures");
396	for (i=0; i<cap->level; i++) {	464	if (ms->level == 0 && s) { /* no explicit captures? */
397	int l = cap->capture[i].len;	465	lua_pushlstring(ms->L, s, e-s); /* return whole match */
398	if (l == -1) lua_error(L, "unfinished capture");	466	return 1;
399	lua_pushlstring(L, cap->capture[i].init, l);	467	}
		468	else { /* return all captures */
		469	for (i=0; i<ms->level; i++)
		470	push_onecapture(ms, i);
		471	return ms->level; /* number of strings pushed */
400	}	472	}
401	return cap->level; /* number of strings pushed */
402	}	473	}
403		474
404		475
405	static int str_find (lua_State *L) {	476	static int str_find (lua_State *L) {
406	size_t l1, l2;	477	size_t l1, l2;
407	const char *s = luaL_check_lstr(L, 1, &l1);	478	const char *s = luaL_checklstring(L, 1, &l1);
408	const char *p = luaL_check_lstr(L, 2, &l2);	479	const char *p = luaL_checklstring(L, 2, &l2);
409	long init = posrelat(luaL_opt_long(L, 3, 1), l1) - 1;	480	sint32 init = posrelat(luaL_optlong(L, 3, 1), l1) - 1;
410	struct Capture cap;	481	if (init < 0) init = 0;
411	luaL_arg_check(L, 0 <= init && (size_t)init <= l1, 3, "out of range");	482	else if ((size_t)(init) > l1) init = (sint32)l1;
412	if (lua_gettop(L) > 3 \|\| /* extra argument? */	483	if (lua_toboolean(L, 4) \|\| /* explicit request? */
413	strpbrk(p, SPECIALS) == NULL) { /* or no special characters? */	484	strpbrk(p, SPECIALS) == NULL) { /* or no special characters? */
		485	/* do a plain search */
414	const char *s2 = lmemfind(s+init, l1-init, p, l2);	486	const char *s2 = lmemfind(s+init, l1-init, p, l2);
415	if (s2) {	487	if (s2) {
416	lua_pushnumber(L, s2-s+1);	488	lua_pushnumber(L, (lua_Number)(s2-s+1));
417	lua_pushnumber(L, s2-s+l2);	489	lua_pushnumber(L, (lua_Number)(s2-s+l2));
418	return 2;	490	return 2;
419	}	491	}
420	}	492	}
421	else {	493	else {
		494	MatchState ms;
422	int anchor = (*p == '^') ? (p++, 1) : 0;	495	int anchor = (*p == '^') ? (p++, 1) : 0;
423	const char *s1=s+init;	496	const char *s1=s+init;
424	cap.src_end = s+l1;	497	ms.L = L;
		498	ms.src_init = s;
		499	ms.src_end = s+l1;
425	do {	500	do {
426	const char *res;	501	const char *res;
427	cap.level = 0;	502	ms.level = 0;
428	if ((res=match(L, s1, p, &cap)) != NULL) {	503	if ((res=match(&ms, s1, p)) != NULL) {
429	lua_pushnumber(L, s1-s+1); /* start */	504	lua_pushnumber(L, (lua_Number)(s1-s+1)); /* start */
430	lua_pushnumber(L, res-s); /* end */	505	lua_pushnumber(L, (lua_Number)(res-s)); /* end */
431	return push_captures(L, &cap) + 2;	506	return push_captures(&ms, NULL, 0) + 2;
432	}	507	}
433	} while (s1++<cap.src_end && !anchor);	508	} while (s1++<ms.src_end && !anchor);
434	}	509	}
435	lua_pushnil(L); /* not found */	510	lua_pushnil(L); /* not found */
436	return 1;	511	return 1;
437	}	512	}
438		513
439		514
440	static void add_s (lua_State L, luaL_Buffer b, struct Capture *cap) {	515	static int gfind_aux (lua_State *L) {
		516	MatchState ms;
		517	const char *s = lua_tostring(L, lua_upvalueindex(1));
		518	size_t ls = lua_strlen(L, lua_upvalueindex(1));
		519	const char *p = lua_tostring(L, lua_upvalueindex(2));
		520	const char *src;
		521	ms.L = L;
		522	ms.src_init = s;
		523	ms.src_end = s+ls;
		524	for (src = s + (size_t)lua_tonumber(L, lua_upvalueindex(3));
		525	src <= ms.src_end;
		526	src++) {
		527	const char *e;
		528	ms.level = 0;
		529	if ((e = match(&ms, src, p)) != NULL) {
		530	int newstart = e-s;
		531	if (e == src) newstart++; /* empty match? go at least one position */
		532	lua_pushnumber(L, (lua_Number)newstart);
		533	lua_replace(L, lua_upvalueindex(3));
		534	return push_captures(&ms, src, e);
		535	}
		536	}
		537	return 0; /* not found */
		538	}
		539
		540
		541	static int gfind (lua_State *L) {
		542	luaL_checkstring(L, 1);
		543	luaL_checkstring(L, 2);
		544	lua_settop(L, 2);
		545	lua_pushnumber(L, 0);
		546	lua_pushcclosure(L, gfind_aux, 3);
		547	return 1;
		548	}
		549
		550
		551	static void add_s (MatchState ms, luaL_Buffer b,
		552	const char s, const char e) {
		553	lua_State *L = ms->L;
441	if (lua_isstring(L, 3)) {	554	if (lua_isstring(L, 3)) {
442	const char *news = lua_tostring(L, 3);	555	const char *news = lua_tostring(L, 3);
443	size_t l = lua_strlen(L, 3);	556	size_t l = lua_strlen(L, 3);
@@ -447,11 +560,12 @@ static void add_s (lua_State L, luaL_Buffer b, struct Capture *cap) { · 3 unmodified lines
447	luaL_putchar(b, news[i]);	560	luaL_putchar(b, news[i]);
448	else {	561	else {
449	i++; /* skip ESC */	562	i++; /* skip ESC */
450	if (!isdigit((unsigned char)news[i]))	563	if (!isdigit(uchar(news[i])))
451	luaL_putchar(b, news[i]);	564	luaL_putchar(b, news[i]);
452	else {	565	else {
453	int level = check_capture(L, news[i], cap);	566	int level = check_capture(ms, news[i]);
454	luaL_addlstring(b, cap->capture[level].init, cap->capture[level].len);	567	push_onecapture(ms, level);
		568	luaL_addvalue(b); /* add capture to accumulated result */
455	}	569	}
456	}	570	}
457	}	571	}
@@ -459,8 +573,8 @@ static void add_s (lua_State L, luaL_Buffer b, struct Capture *cap) { · 1 unmodified line
459	else { /* is a function */	573	else { /* is a function */
460	int n;	574	int n;
461	lua_pushvalue(L, 3);	575	lua_pushvalue(L, 3);
462	n = push_captures(L, cap);	576	n = push_captures(ms, s, e);
463	lua_rawcall(L, n, 1);	577	lua_call(L, n, 1);
464	if (lua_isstring(L, -1))	578	if (lua_isstring(L, -1))
465	luaL_addvalue(b); /* add return to accumulated result */	579	luaL_addvalue(b); /* add return to accumulated result */
466	else	580	else
@@ -471,124 +585,155 @@ static void add_s (lua_State L, luaL_Buffer b, struct Capture *cap) { · 4 unmodified lines
471		585
472	static int str_gsub (lua_State *L) {	586	static int str_gsub (lua_State *L) {
473	size_t srcl;	587	size_t srcl;
474	const char *src = luaL_check_lstr(L, 1, &srcl);	588	const char *src = luaL_checklstring(L, 1, &srcl);
475	const char *p = luaL_check_string(L, 2);	589	const char *p = luaL_checkstring(L, 2);
476	int max_s = luaL_opt_int(L, 4, srcl+1);	590	int max_s = luaL_optint(L, 4, srcl+1);
477	int anchor = (*p == '^') ? (p++, 1) : 0;	591	int anchor = (*p == '^') ? (p++, 1) : 0;
478	int n = 0;	592	int n = 0;
479	struct Capture cap;	593	MatchState ms;
480	luaL_Buffer b;	594	luaL_Buffer b;
481	luaL_arg_check(L,	595	luaL_argcheck(L,
482	lua_gettop(L) >= 3 && (lua_isstring(L, 3) \|\| lua_isfunction(L, 3)),	596	lua_gettop(L) >= 3 && (lua_isstring(L, 3) \|\| lua_isfunction(L, 3)),
483	3, "string or function expected");	597	3, "string or function expected");
484	luaL_buffinit(L, &b);	598	luaL_buffinit(L, &b);
485	cap.src_end = src+srcl;	599	ms.L = L;
		600	ms.src_init = src;
		601	ms.src_end = src+srcl;
486	while (n < max_s) {	602	while (n < max_s) {
487	const char *e;	603	const char *e;
488	cap.level = 0;	604	ms.level = 0;
489	e = match(L, src, p, &cap);	605	e = match(&ms, src, p);
490	if (e) {	606	if (e) {
491	n++;	607	n++;
492	add_s(L, &b, &cap);	608	add_s(&ms, &b, src, e);
493	}	609	}
494	if (e && e>src) /* non empty match? */	610	if (e && e>src) /* non empty match? */
495	src = e; /* skip it */	611	src = e; /* skip it */
496	else if (src < cap.src_end)	612	else if (src < ms.src_end)
497	luaL_putchar(&b, *src++);	613	luaL_putchar(&b, *src++);
498	else break;	614	else break;
499	if (anchor) break;	615	if (anchor) break;
500	}	616	}
501	luaL_addlstring(&b, src, cap.src_end-src);	617	luaL_addlstring(&b, src, ms.src_end-src);
502	luaL_pushresult(&b);	618	luaL_pushresult(&b);
503	lua_pushnumber(L, n); /* number of substitutions */	619	lua_pushnumber(L, (lua_Number)n); /* number of substitutions */
504	return 2;	620	return 2;
505	}	621	}
506		622
507	/* }====================================================== */	623	/* }====================================================== */
508		624
509		625
		626	/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */
		627	#define MAX_ITEM 512
		628	/* maximum size of each format specification (such as '%-099.99d') */
		629	#define MAX_FORMAT 20
		630
		631
510	static void luaI_addquoted (lua_State L, luaL_Buffer b, int arg) {	632	static void luaI_addquoted (lua_State L, luaL_Buffer b, int arg) {
511	size_t l;	633	size_t l;
512	const char *s = luaL_check_lstr(L, arg, &l);	634	const char *s = luaL_checklstring(L, arg, &l);
513	luaL_putchar(b, '"');	635	luaL_putchar(b, '"');
514	while (l--) {	636	while (l--) {
515	switch (*s) {	637	switch (*s) {
516	case '"': case '\\': case '\n':	638	case '"': case '\\': case '\n': {
517	luaL_putchar(b, '\\');	639	luaL_putchar(b, '\\');
518	luaL_putchar(b, *s);	640	luaL_putchar(b, *s);
519	break;	641	break;
520	case '\0': luaL_addlstring(b, "\\000", 4); break;	642	}
521	default: luaL_putchar(b, *s);	643	case '\0': {
		644	luaL_addlstring(b, "\\000", 4);
		645	break;
		646	}
		647	default: {
		648	luaL_putchar(b, *s);
		649	break;
		650	}
522	}	651	}
523	s++;	652	s++;
524	}	653	}
525	luaL_putchar(b, '"');	654	luaL_putchar(b, '"');
526	}	655	}
527		656
528	/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */	657
529	#define MAX_ITEM 512	658	static const char scanformat (lua_State L, const char *strfrmt,
530	/* maximum size of each format specification (such as '%-099.99d') */	659	char form, int hasprecision) {
531	#define MAX_FORMAT 20	660	const char *p = strfrmt;
		661	while (strchr("-+ #0", p)) p++; / skip flags */
		662	if (isdigit(uchar(p))) p++; / skip width */
		663	if (isdigit(uchar(p))) p++; / (2 digits at most) */
		664	if (*p == '.') {
		665	p++;
		666	*hasprecision = 1;
		667	if (isdigit(uchar(p))) p++; / skip precision */
		668	if (isdigit(uchar(p))) p++; / (2 digits at most) */
		669	}
		670	if (isdigit(uchar(*p)))
		671	luaL_error(L, "invalid format (width or precision too long)");
		672	if (p-strfrmt+2 > MAX_FORMAT) /* +2 to include `%' and the specifier */
		673	luaL_error(L, "invalid format (too long)");
		674	form[0] = '%';
		675	strncpy(form+1, strfrmt, p-strfrmt+1);
		676	form[p-strfrmt+2] = 0;
		677	return p;
		678	}
		679
532		680
533	static int str_format (lua_State *L) {	681	static int str_format (lua_State *L) {
534	int arg = 1;	682	int arg = 1;
535	const char *strfrmt = luaL_check_string(L, arg);	683	size_t sfl;
		684	const char *strfrmt = luaL_checklstring(L, arg, &sfl);
		685	const char *strfrmt_end = strfrmt+sfl;
536	luaL_Buffer b;	686	luaL_Buffer b;
537	luaL_buffinit(L, &b);	687	luaL_buffinit(L, &b);
538	while (*strfrmt) {	688	while (strfrmt < strfrmt_end) {
539	if (*strfrmt != '%')	689	if (*strfrmt != '%')
540	luaL_putchar(&b, *strfrmt++);	690	luaL_putchar(&b, *strfrmt++);
541	else if (*++strfrmt == '%')	691	else if (*++strfrmt == '%')
542	luaL_putchar(&b, strfrmt++); / %% */	692	luaL_putchar(&b, strfrmt++); / %% */
543	else { /* format item */	693	else { /* format item */
544	struct Capture cap;	694	char form[MAX_FORMAT]; /* to store the format (`%...') */
545	char form[MAX_FORMAT]; /* to store the format ('%...') */
546	char buff[MAX_ITEM]; /* to store the formatted item */	695	char buff[MAX_ITEM]; /* to store the formatted item */
547	const char *initf = strfrmt;	696	int hasprecision = 0;
548	form[0] = '%';	697	if (isdigit(uchar(strfrmt)) && (strfrmt+1) == '$')
549	if (isdigit((unsigned char)initf) && (initf+1) == '$') {	698	return luaL_error(L, "obsolete option (d$) to `format'");
550	arg = *initf - '0';
551	initf += 2; /* skip the 'n$' */
552	}
553	arg++;	699	arg++;
554	cap.src_end = strfrmt+strlen(strfrmt)+1;	700	strfrmt = scanformat(L, strfrmt, form, &hasprecision);
555	cap.level = 0;
556	strfrmt = match(L, initf, "[-+ #0](%d)%.?(%d*)", &cap);
557	if (cap.capture[0].len > 2 \|\| cap.capture[1].len > 2 \|\| /* < 100? */
558	strfrmt-initf > MAX_FORMAT-2)
559	lua_error(L, "invalid format (width or precision too long)");
560	strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */
561	form[strfrmt-initf+2] = 0;
562	switch (*strfrmt++) {	701	switch (*strfrmt++) {
563	case 'c': case 'd': case 'i':	702	case 'c': case 'd': case 'i': {
564	sprintf(buff, form, luaL_check_int(L, arg));	703	sprintf(buff, form, luaL_checkint(L, arg));
565	break;	704	break;
566	case 'o': case 'u': case 'x': case 'X':	705	}
567	sprintf(buff, form, (unsigned int)luaL_check_number(L, arg));	706	case 'o': case 'u': case 'x': case 'X': {
		707	sprintf(buff, form, (unsigned int)(luaL_checknumber(L, arg)));
568	break;	708	break;
569	case 'e': case 'E': case 'f': case 'g': case 'G':	709	}
570	sprintf(buff, form, luaL_check_number(L, arg));	710	case 'e': case 'E': case 'f':
		711	case 'g': case 'G': {
		712	sprintf(buff, form, luaL_checknumber(L, arg));
571	break;	713	break;
572	case 'q':	714	}
		715	case 'q': {
573	luaI_addquoted(L, &b, arg);	716	luaI_addquoted(L, &b, arg);
574	continue; /* skip the "addsize" at the end */	717	continue; /* skip the `addsize' at the end */
		718	}
575	case 's': {	719	case 's': {
576	size_t l;	720	size_t l;
577	const char *s = luaL_check_lstr(L, arg, &l);	721	const char *s = luaL_checklstring(L, arg, &l);
578	if (cap.capture[1].len == 0 && l >= 100) {	722	if (!hasprecision && l >= 100) {
579	/* no precision and string is too long to be formatted;	723	/* no precision and string is too long to be formatted;
580	keep original string */	724	keep original string */
581	lua_pushvalue(L, arg);	725	lua_pushvalue(L, arg);
582	luaL_addvalue(&b);	726	luaL_addvalue(&b);
583	continue; /* skip the "addsize" at the end */	727	continue; /* skip the `addsize' at the end */
584	}	728	}
585	else {	729	else {
586	sprintf(buff, form, s);	730	sprintf(buff, form, s);
587	break;	731	break;
588	}	732	}
589	}	733	}
590	default: /* also treat cases 'pnLlh' */	734	default: { /* also treat cases `pnLlh' */
591	lua_error(L, "invalid option in `format'");	735	return luaL_error(L, "invalid option to `format'");
		736	}
592	}	737	}
593	luaL_addlstring(&b, buff, strlen(buff));	738	luaL_addlstring(&b, buff, strlen(buff));
594	}	739	}
@@ -598,24 +743,28 @@ static int str_format (lua_State *L) { · 3 unmodified lines
598	}	743	}
599		744
600		745
601	static const struct luaL_reg strlib[] = {	746	static const luaL_reg strlib[] = {
602	{"strlen", str_len},	747	{"len", str_len},
603	{"strsub", str_sub},	748	{"sub", str_sub},
604	{"strlower", str_lower},	749	{"lower", str_lower},
605	{"strupper", str_upper},	750	{"upper", str_upper},
606	{"strchar", str_char},	751	{"char", str_char},
607	{"strrep", str_rep},	752	{"rep", str_rep},
608	{"ascii", str_byte}, /* for compatibility with 3.0 and earlier */	753	{"byte", str_byte},
609	{"strbyte", str_byte},	754	{"format", str_format},
610	{"format", str_format},	755	{"dump", str_dump},
611	{"strfind", str_find},	756	{"find", str_find},
612	{"gsub", str_gsub}	757	{"gfind", gfind},
		758	{"gsub", str_gsub},
		759	{NULL, NULL}
613	};	760	};
614		761
615		762
616	/*	763	/*
617	** Open string library	764	** Open string library
618	*/	765	*/
619	LUALIB_API void lua_strlibopen (lua_State *L) {	766	LUALIB_API int luaopen_string (lua_State *L) {
620	luaL_openl(L, strlib);	767	luaL_openlib(L, LUA_STRLIBNAME, strlib, 0);
		768	return 1;
621	}	769	}
		770

src/lib/ltablib.c+250−0

@@ -0,0 +1,250 @@
	1	/*
	2	** $Id: ltablib.c,v 1.21 2003/04/03 13:35:34 roberto Exp $
	3	** Library for Table Manipulation
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7
	8	#include <stddef.h>
	9
	10	#define ltablib_c
	11
	12	#include "lua.h"
	13
	14	#include "lauxlib.h"
	15	#include "lualib.h"
	16
	17
	18	#define aux_getn(L,n) (luaL_checktype(L, n, LUA_TTABLE), luaL_getn(L, n))
	19
	20
	21	static int luaB_foreachi (lua_State *L) {
	22	int i;
	23	int n = aux_getn(L, 1);
	24	luaL_checktype(L, 2, LUA_TFUNCTION);
	25	for (i=1; i<=n; i++) {
	26	lua_pushvalue(L, 2); /* function */
	27	lua_pushnumber(L, (lua_Number)i); /* 1st argument */
	28	lua_rawgeti(L, 1, i); /* 2nd argument */
	29	lua_call(L, 2, 1);
	30	if (!lua_isnil(L, -1))
	31	return 1;
	32	lua_pop(L, 1); /* remove nil result */
	33	}
	34	return 0;
	35	}
	36
	37
	38	static int luaB_foreach (lua_State *L) {
	39	luaL_checktype(L, 1, LUA_TTABLE);
	40	luaL_checktype(L, 2, LUA_TFUNCTION);
	41	lua_pushnil(L); /* first key */
	42	for (;;) {
	43	if (lua_next(L, 1) == 0)
	44	return 0;
	45	lua_pushvalue(L, 2); /* function */
	46	lua_pushvalue(L, -3); /* key */
	47	lua_pushvalue(L, -3); /* value */
	48	lua_call(L, 2, 1);
	49	if (!lua_isnil(L, -1))
	50	return 1;
	51	lua_pop(L, 2); /* remove value and result */
	52	}
	53	}
	54
	55
	56	static int luaB_getn (lua_State *L) {
	57	lua_pushnumber(L, (lua_Number)aux_getn(L, 1));
	58	return 1;
	59	}
	60
	61
	62	static int luaB_setn (lua_State *L) {
	63	luaL_checktype(L, 1, LUA_TTABLE);
	64	luaL_setn(L, 1, luaL_checkint(L, 2));
	65	return 0;
	66	}
	67
	68
	69	static int luaB_tinsert (lua_State *L) {
	70	int v = lua_gettop(L); /* number of arguments */
	71	int n = aux_getn(L, 1) + 1;
	72	int pos; /* where to insert new element */
	73	if (v == 2) /* called with only 2 arguments */
	74	pos = n; /* insert new element at the end */
	75	else {
	76	pos = luaL_checkint(L, 2); /* 2nd argument is the position */
	77	if (pos > n) n = pos; /* `grow' array if necessary */
	78	v = 3; /* function may be called with more than 3 args */
	79	}
	80	luaL_setn(L, 1, n); /* new size */
	81	while (--n >= pos) { /* move up elements */
	82	lua_rawgeti(L, 1, n);
	83	lua_rawseti(L, 1, n+1); /* t[n+1] = t[n] */
	84	}
	85	lua_pushvalue(L, v);
	86	lua_rawseti(L, 1, pos); /* t[pos] = v */
	87	return 0;
	88	}
	89
	90
	91	static int luaB_tremove (lua_State *L) {
	92	int n = aux_getn(L, 1);
	93	int pos = luaL_optint(L, 2, n);
	94	if (n <= 0) return 0; /* table is `empty' */
	95	luaL_setn(L, 1, n-1); /* t.n = n-1 */
	96	lua_rawgeti(L, 1, pos); /* result = t[pos] */
	97	for ( ;pos<n; pos++) {
	98	lua_rawgeti(L, 1, pos+1);
	99	lua_rawseti(L, 1, pos); /* t[pos] = t[pos+1] */
	100	}
	101	lua_pushnil(L);
	102	lua_rawseti(L, 1, n); /* t[n] = nil */
	103	return 1;
	104	}
	105
	106
	107	static int str_concat (lua_State *L) {
	108	luaL_Buffer b;
	109	size_t lsep;
	110	const char *sep = luaL_optlstring(L, 2, "", &lsep);
	111	int i = luaL_optint(L, 3, 1);
	112	int n = luaL_optint(L, 4, 0);
	113	luaL_checktype(L, 1, LUA_TTABLE);
	114	if (n == 0) n = luaL_getn(L, 1);
	115	luaL_buffinit(L, &b);
	116	for (; i <= n; i++) {
	117	lua_rawgeti(L, 1, i);
	118	luaL_argcheck(L, lua_isstring(L, -1), 1, "table contains non-strings");
	119	luaL_addvalue(&b);
	120	if (i != n)
	121	luaL_addlstring(&b, sep, lsep);
	122	}
	123	luaL_pushresult(&b);
	124	return 1;
	125	}
	126
	127
	128
	129	/*
	130	** {======================================================
	131	** Quicksort
	132	** (based on `Algorithms in MODULA-3', Robert Sedgewick;
	133	** Addison-Wesley, 1993.)
	134	*/
	135
	136
	137	static void set2 (lua_State *L, int i, int j) {
	138	lua_rawseti(L, 1, i);
	139	lua_rawseti(L, 1, j);
	140	}
	141
	142	static int sort_comp (lua_State *L, int a, int b) {
	143	if (!lua_isnil(L, 2)) { /* function? */
	144	int res;
	145	lua_pushvalue(L, 2);
	146	lua_pushvalue(L, a-1); /* -1 to compensate function */
	147	lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */
	148	lua_call(L, 2, 1);
	149	res = lua_toboolean(L, -1);
	150	lua_pop(L, 1);
	151	return res;
	152	}
	153	else /* a < b? */
	154	return lua_lessthan(L, a, b);
	155	}
	156
	157	static void auxsort (lua_State *L, int l, int u) {
	158	while (l < u) { /* for tail recursion */
	159	int i, j;
	160	/* sort elements a[l], a[(l+u)/2] and a[u] */
	161	lua_rawgeti(L, 1, l);
	162	lua_rawgeti(L, 1, u);
	163	if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */
	164	set2(L, l, u); /* swap a[l] - a[u] */
	165	else
	166	lua_pop(L, 2);
	167	if (u-l == 1) break; /* only 2 elements */
	168	i = (l+u)/2;
	169	lua_rawgeti(L, 1, i);
	170	lua_rawgeti(L, 1, l);
	171	if (sort_comp(L, -2, -1)) /* a[i]<a[l]? */
	172	set2(L, i, l);
	173	else {
	174	lua_pop(L, 1); /* remove a[l] */
	175	lua_rawgeti(L, 1, u);
	176	if (sort_comp(L, -1, -2)) /* a[u]<a[i]? */
	177	set2(L, i, u);
	178	else
	179	lua_pop(L, 2);
	180	}
	181	if (u-l == 2) break; /* only 3 elements */
	182	lua_rawgeti(L, 1, i); /* Pivot */
	183	lua_pushvalue(L, -1);
	184	lua_rawgeti(L, 1, u-1);
	185	set2(L, i, u-1);
	186	/* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */
	187	i = l; j = u-1;
	188	for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */
	189	/* repeat ++i until a[i] >= P */
	190	while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) {
	191	if (i>u) luaL_error(L, "invalid order function for sorting");
	192	lua_pop(L, 1); /* remove a[i] */
	193	}
	194	/* repeat --j until a[j] <= P */
	195	while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) {
	196	if (j<l) luaL_error(L, "invalid order function for sorting");
	197	lua_pop(L, 1); /* remove a[j] */
	198	}
	199	if (j<i) {
	200	lua_pop(L, 3); /* pop pivot, a[i], a[j] */
	201	break;
	202	}
	203	set2(L, i, j);
	204	}
	205	lua_rawgeti(L, 1, u-1);
	206	lua_rawgeti(L, 1, i);
	207	set2(L, u-1, i); /* swap pivot (a[u-1]) with a[i] */
	208	/* a[l..i-1] <= a[i] == P <= a[i+1..u] */
	209	/* adjust so that smaller half is in [j..i] and larger one in [l..u] */
	210	if (i-l < u-i) {
	211	j=l; i=i-1; l=i+2;
	212	}
	213	else {
	214	j=i+1; i=u; u=j-2;
	215	}
	216	auxsort(L, j, i); /* call recursively the smaller one */
	217	} /* repeat the routine for the larger one */
	218	}
	219
	220	static int luaB_sort (lua_State *L) {
	221	int n = aux_getn(L, 1);
	222	luaL_checkstack(L, 40, ""); /* assume array is smaller than 2^40 */
	223	if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */
	224	luaL_checktype(L, 2, LUA_TFUNCTION);
	225	lua_settop(L, 2); /* make sure there is two arguments */
	226	auxsort(L, 1, n);
	227	return 0;
	228	}
	229
	230	/* }====================================================== */
	231
	232
	233	static const luaL_reg tab_funcs[] = {
	234	{"concat", str_concat},
	235	{"foreach", luaB_foreach},
	236	{"foreachi", luaB_foreachi},
	237	{"getn", luaB_getn},
	238	{"setn", luaB_setn},
	239	{"sort", luaB_sort},
	240	{"insert", luaB_tinsert},
	241	{"remove", luaB_tremove},
	242	{NULL, NULL}
	243	};
	244
	245
	246	LUALIB_API int luaopen_table (lua_State *L) {
	247	luaL_openlib(L, LUA_TABLIBNAME, tab_funcs, 0);
	248	return 1;
	249	}
	250

src/llex.c+201−164

@@ -1,24 +1,23 @@
1	/*	1	/*
2	** $Id: llex.c,v 1.72 2000/10/20 16:39:03 roberto Exp $	2	** $Id: llex.c,v 1.119 2003/03/24 12:39:34 roberto Exp $
3	** Lexical Analyzer	3	** Lexical Analyzer
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <ctype.h>	8	#include <ctype.h>
9	#include <stdio.h>
10	#include <string.h>	9	#include <string.h>
11		10
		11	#define llex_c
		12
12	#include "lua.h"	13	#include "lua.h"
13		14
		15	#include "ldo.h"
14	#include "llex.h"	16	#include "llex.h"
15	#include "lmem.h"
16	#include "lobject.h"	17	#include "lobject.h"
17	#include "lparser.h"	18	#include "lparser.h"
18	#include "lstate.h"	19	#include "lstate.h"
19	#include "lstring.h"	20	#include "lstring.h"
20	#include "ltable.h"
21	#include "luadebug.h"
22	#include "lzio.h"	21	#include "lzio.h"
23		22
24		23
@@ -29,16 +28,22 @@ · 4 unmodified lines
29		28
30	/* ORDER RESERVED */	29	/* ORDER RESERVED */
31	static const char *const token2string [] = {	30	static const char *const token2string [] = {
32	"and", "break", "do", "else", "elseif", "end", "for",	31	"and", "break", "do", "else", "elseif",
33	"function", "if", "local", "nil", "not", "or", "repeat", "return", "then",	32	"end", "false", "for", "function", "if",
34	"until", "while", "", "..", "...", "==", ">=", "<=", "~=", "", "", "<eof>"};	33	"in", "local", "nil", "not", "or", "repeat",
		34	"return", "then", "true", "until", "while", "*name",
		35	"..", "...", "==", ">=", "<=", "~=",
		36	"number", "string", "<eof>"
		37	};
35		38
36		39
37	void luaX_init (lua_State *L) {	40	void luaX_init (lua_State *L) {
38	int i;	41	int i;
39	for (i=0; i<NUM_RESERVED; i++) {	42	for (i=0; i<NUM_RESERVED; i++) {
40	TString *ts = luaS_new(L, token2string[i]);	43	TString *ts = luaS_new(L, token2string[i]);
41	ts->marked = (unsigned char)(RESERVEDMARK+i); /* reserved word */	44	luaS_fix(ts); /* reserved words are never collected */
		45	lua_assert(strlen(token2string[i])+1 <= TOKEN_LEN);
		46	ts->tsv.reserved = cast(lu_byte, i+1); /* reserved word */
42	}	47	}
43	}	48	}
44		49
@@ -48,50 +53,64 @@ void luaX_init (lua_State *L) { · 3 unmodified lines
48		53
49	void luaX_checklimit (LexState ls, int val, int limit, const char msg) {	54	void luaX_checklimit (LexState ls, int val, int limit, const char msg) {
50	if (val > limit) {	55	if (val > limit) {
51	char buff[100];	56	msg = luaO_pushfstring(ls->L, "too many %s (limit=%d)", msg, limit);
52	sprintf(buff, "too many %.50s (limit=%d)", msg, limit);	57	luaX_syntaxerror(ls, msg);
53	luaX_error(ls, buff, ls->t.token);
54	}	58	}
55	}	59	}
56		60
57		61
58	void luaX_syntaxerror (LexState ls, const char s, const char *token) {	62	void luaX_errorline (LexState ls, const char s, const char *token, int line) {
		63	lua_State *L = ls->L;
59	char buff[MAXSRC];	64	char buff[MAXSRC];
60	luaO_chunkid(buff, ls->source->str, sizeof(buff));	65	luaO_chunkid(buff, getstr(ls->source), MAXSRC);
61	luaO_verror(ls->L, "%.99s;\n last token read: `%.30s' at line %d in %.80s",	66	luaO_pushfstring(L, "%s:%d: %s near `%s'", buff, line, s, token);
62	s, token, ls->linenumber, buff);	67	luaD_throw(L, LUA_ERRSYNTAX);
63	}	68	}
64		69
65		70
66	void luaX_error (LexState ls, const char s, int token) {	71	static void luaX_error (LexState ls, const char s, const char *token) {
67	char buff[TOKEN_LEN];	72	luaX_errorline(ls, s, token, ls->linenumber);
68	luaX_token2str(token, buff);	73	}
69	if (buff[0] == '\0')	74
70	luaX_syntaxerror(ls, s, ls->L->Mbuffer);	75
71	else	76	void luaX_syntaxerror (LexState ls, const char msg) {
72	luaX_syntaxerror(ls, s, buff);	77	const char *lasttoken;
		78	switch (ls->t.token) {
		79	case TK_NAME:
		80	lasttoken = getstr(ls->t.seminfo.ts);
		81	break;
		82	case TK_STRING:
		83	case TK_NUMBER:
		84	lasttoken = luaZ_buffer(ls->buff);
		85	break;
		86	default:
		87	lasttoken = luaX_token2str(ls, ls->t.token);
		88	break;
		89	}
		90	luaX_error(ls, msg, lasttoken);
73	}	91	}
74		92
75		93
76	void luaX_token2str (int token, char *s) {	94	const char luaX_token2str (LexState ls, int token) {
77	if (token < 256) {	95	if (token < FIRST_RESERVED) {
78	s[0] = (char)token;	96	lua_assert(token == (unsigned char)token);
79	s[1] = '\0';	97	return luaO_pushfstring(ls->L, "%c", token);
80	}	98	}
81	else	99	else
82	strcpy(s, token2string[token-FIRST_RESERVED]);	100	return token2string[token-FIRST_RESERVED];
83	}	101	}
84		102
85		103
86	static void luaX_invalidchar (LexState *ls, int c) {	104	static void luaX_lexerror (LexState ls, const char s, int token) {
87	char buff[8];	105	if (token == TK_EOS)
88	sprintf(buff, "0x%02X", c);	106	luaX_error(ls, s, luaX_token2str(ls, token));
89	luaX_syntaxerror(ls, "invalid control char", buff);	107	else
		108	luaX_error(ls, s, luaZ_buffer(ls->buff));
90	}	109	}
91		110
92		111
93	static void inclinenumber (LexState *LS) {	112	static void inclinenumber (LexState *LS) {
94	next(LS); /* skip '\n' */	113	next(LS); /* skip `\n' */
95	++LS->linenumber;	114	++LS->linenumber;
96	luaX_checklimit(LS, LS->linenumber, MAX_INT, "lines in a chunk");	115	luaX_checklimit(LS, LS->linenumber, MAX_INT, "lines in a chunk");
97	}	116	}
@@ -122,159 +141,173 @@ void luaX_setinput (lua_State L, LexState LS, ZIO z, TString source) { · 24 unmodified lines
122	*/	141	*/
123		142
124		143
125	/* use Mbuffer to store names, literal strings and numbers */	144	/* use buffer to store names, literal strings and numbers */
		145
		146	/* extra space to allocate when growing buffer */
		147	#define EXTRABUFF 32
		148
		149	/* maximum number of chars that can be read without checking buffer size */
		150	#define MAXNOCHECK 5
126		151
127	#define EXTRABUFF 128	152	#define checkbuffer(LS, len) \
128	#define checkbuffer(L, n, len) if ((len)+(n) > L->Mbuffsize) \	153	if (((len)+MAXNOCHECK)*sizeof(char) > luaZ_sizebuffer((LS)->buff)) \
129	luaO_openspace(L, (len)+(n)+EXTRABUFF)	154	luaZ_openspace((LS)->L, (LS)->buff, (len)+EXTRABUFF)
130		155
131	#define save(L, c, l) (L->Mbuffer[l++] = (char)c)	156	#define save(LS, c, l) \
132	#define save_and_next(L, LS, l) (save(L, LS->current, l), next(LS))	157	(luaZ_buffer((LS)->buff)[l++] = cast(char, c))
		158	#define save_and_next(LS, l) (save(LS, LS->current, l), next(LS))
133		159
134		160
135	static const char readname (LexState LS) {	161	static size_t readname (LexState *LS) {
136	lua_State *L = LS->L;
137	size_t l = 0;	162	size_t l = 0;
138	checkbuffer(L, 10, l);	163	checkbuffer(LS, l);
139	do {	164	do {
140	checkbuffer(L, 10, l);	165	checkbuffer(LS, l);
141	save_and_next(L, LS, l);	166	save_and_next(LS, l);
142	} while (isalnum(LS->current) \|\| LS->current == '_');	167	} while (isalnum(LS->current) \|\| LS->current == '_');
143	save(L, '\0', l);	168	save(LS, '\0', l);
144	return L->Mbuffer;	169	return l-1;
145	}	170	}
146		171
147		172
148	/* LUA_NUMBER */	173	/* LUA_NUMBER */
149	static void read_number (LexState LS, int comma, SemInfo seminfo) {	174	static void read_numeral (LexState LS, int comma, SemInfo seminfo) {
150	lua_State *L = LS->L;
151	size_t l = 0;	175	size_t l = 0;
152	checkbuffer(L, 10, l);	176	checkbuffer(LS, l);
153	if (comma) save(L, '.', l);	177	if (comma) save(LS, '.', l);
154	while (isdigit(LS->current)) {	178	while (isdigit(LS->current)) {
155	checkbuffer(L, 10, l);	179	checkbuffer(LS, l);
156	save_and_next(L, LS, l);	180	save_and_next(LS, l);
157	}	181	}
158	if (LS->current == '.') {	182	if (LS->current == '.') {
159	save_and_next(L, LS, l);	183	save_and_next(LS, l);
160	if (LS->current == '.') {	184	if (LS->current == '.') {
161	save_and_next(L, LS, l);	185	save_and_next(LS, l);
162	save(L, '\0', l);	186	save(LS, '\0', l);
163	luaX_error(LS, "ambiguous syntax"	187	luaX_lexerror(LS,
164	" (decimal point x string concatenation)", TK_NUMBER);	188	"ambiguous syntax (decimal point x string concatenation)",
		189	TK_NUMBER);
165	}	190	}
166	}	191	}
167	while (isdigit(LS->current)) {	192	while (isdigit(LS->current)) {
168	checkbuffer(L, 10, l);	193	checkbuffer(LS, l);
169	save_and_next(L, LS, l);	194	save_and_next(LS, l);
170	}	195	}
171	if (LS->current == 'e' \|\| LS->current == 'E') {	196	if (LS->current == 'e' \|\| LS->current == 'E') {
172	save_and_next(L, LS, l); /* read 'E' */	197	save_and_next(LS, l); /* read `E' */
173	if (LS->current == '+' \|\| LS->current == '-')	198	if (LS->current == '+' \|\| LS->current == '-')
174	save_and_next(L, LS, l); /* optional exponent sign */	199	save_and_next(LS, l); /* optional exponent sign */
175	while (isdigit(LS->current)) {	200	while (isdigit(LS->current)) {
176	checkbuffer(L, 10, l);	201	checkbuffer(LS, l);
177	save_and_next(L, LS, l);	202	save_and_next(LS, l);
178	}	203	}
179	}	204	}
180	save(L, '\0', l);	205	save(LS, '\0', l);
181	if (!luaO_str2d(L->Mbuffer, &seminfo->r))	206	if (!luaO_str2d(luaZ_buffer(LS->buff), &seminfo->r))
182	luaX_error(LS, "malformed number", TK_NUMBER);	207	luaX_lexerror(LS, "malformed number", TK_NUMBER);
183	}	208	}
184		209
185		210
186	static void read_long_string (LexState LS, SemInfo seminfo) {	211	static void read_long_string (LexState LS, SemInfo seminfo) {
187	lua_State *L = LS->L;
188	int cont = 0;	212	int cont = 0;
189	size_t l = 0;	213	size_t l = 0;
190	checkbuffer(L, 10, l);	214	checkbuffer(LS, l);
191	save(L, '[', l); /* save first '[' */	215	save(LS, '[', l); /* save first `[' */
192	save_and_next(L, LS, l); /* pass the second '[' */	216	save_and_next(LS, l); /* pass the second `[' */
		217	if (LS->current == '\n') /* string starts with a newline? */
		218	inclinenumber(LS); /* skip it */
193	for (;;) {	219	for (;;) {
194	checkbuffer(L, 10, l);	220	checkbuffer(LS, l);
195	switch (LS->current) {	221	switch (LS->current) {
196	case EOZ:	222	case EOZ:
197	save(L, '\0', l);	223	save(LS, '\0', l);
198	luaX_error(LS, "unfinished long string", TK_STRING);	224	luaX_lexerror(LS, (seminfo) ? "unfinished long string" :
		225	"unfinished long comment", TK_EOS);
199	break; /* to avoid warnings */	226	break; /* to avoid warnings */
200	case '[':	227	case '[':
201	save_and_next(L, LS, l);	228	save_and_next(LS, l);
202	if (LS->current == '[') {	229	if (LS->current == '[') {
203	cont++;	230	cont++;
204	save_and_next(L, LS, l);	231	save_and_next(LS, l);
205	}	232	}
206	continue;	233	continue;
207	case ']':	234	case ']':
208	save_and_next(L, LS, l);	235	save_and_next(LS, l);
209	if (LS->current == ']') {	236	if (LS->current == ']') {
210	if (cont == 0) goto endloop;	237	if (cont == 0) goto endloop;
211	cont--;	238	cont--;
212	save_and_next(L, LS, l);	239	save_and_next(LS, l);
213	}	240	}
214	continue;	241	continue;
215	case '\n':	242	case '\n':
216	save(L, '\n', l);	243	save(LS, '\n', l);
217	inclinenumber(LS);	244	inclinenumber(LS);
		245	if (!seminfo) l = 0; /* reset buffer to avoid wasting space */
218	continue;	246	continue;
219	default:	247	default:
220	save_and_next(L, LS, l);	248	save_and_next(LS, l);
221	}	249	}
222	} endloop:	250	} endloop:
223	save_and_next(L, LS, l); /* skip the second ']' */	251	save_and_next(LS, l); /* skip the second `]' */
224	save(L, '\0', l);	252	save(LS, '\0', l);
225	seminfo->ts = luaS_newlstr(L, L->Mbuffer+2, l-5);	253	if (seminfo)
		254	seminfo->ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff) + 2, l - 5);
226	}	255	}
227		256
228		257
229	static void read_string (LexState LS, int del, SemInfo seminfo) {	258	static void read_string (LexState LS, int del, SemInfo seminfo) {
230	lua_State *L = LS->L;
231	size_t l = 0;	259	size_t l = 0;
232	checkbuffer(L, 10, l);	260	checkbuffer(LS, l);
233	save_and_next(L, LS, l);	261	save_and_next(LS, l);
234	while (LS->current != del) {	262	while (LS->current != del) {
235	checkbuffer(L, 10, l);	263	checkbuffer(LS, l);
236	switch (LS->current) {	264	switch (LS->current) {
237	case EOZ: case '\n':	265	case EOZ:
238	save(L, '\0', l);	266	save(LS, '\0', l);
239	luaX_error(LS, "unfinished string", TK_STRING);	267	luaX_lexerror(LS, "unfinished string", TK_EOS);
		268	break; /* to avoid warnings */
		269	case '\n':
		270	save(LS, '\0', l);
		271	luaX_lexerror(LS, "unfinished string", TK_STRING);
240	break; /* to avoid warnings */	272	break; /* to avoid warnings */
241	case '\\':	273	case '\\':
242	next(LS); /* do not save the '\' */	274	next(LS); /* do not save the `\' */
243	switch (LS->current) {	275	switch (LS->current) {
244	case 'a': save(L, '\a', l); next(LS); break;	276	case 'a': save(LS, '\a', l); next(LS); break;
245	case 'b': save(L, '\b', l); next(LS); break;	277	case 'b': save(LS, '\b', l); next(LS); break;
246	case 'f': save(L, '\f', l); next(LS); break;	278	case 'f': save(LS, '\f', l); next(LS); break;
247	case 'n': save(L, '\n', l); next(LS); break;	279	case 'n': save(LS, '\n', l); next(LS); break;
248	case 'r': save(L, '\r', l); next(LS); break;	280	case 'r': save(LS, '\r', l); next(LS); break;
249	case 't': save(L, '\t', l); next(LS); break;	281	case 't': save(LS, '\t', l); next(LS); break;
250	case 'v': save(L, '\v', l); next(LS); break;	282	case 'v': save(LS, '\v', l); next(LS); break;
251	case '\n': save(L, '\n', l); inclinenumber(LS); break;	283	case '\n': save(LS, '\n', l); inclinenumber(LS); break;
252	case '0': case '1': case '2': case '3': case '4':	284	case EOZ: break; /* will raise an error next loop */
253	case '5': case '6': case '7': case '8': case '9': {	285	default: {
254	int c = 0;	286	if (!isdigit(LS->current))
255	int i = 0;	287	save_and_next(LS, l); /* handles \\, \", \', and \? */
256	do {	288	else { /* \xxx */
257	c = 10*c + (LS->current-'0');	289	int c = 0;
258	next(LS);	290	int i = 0;
259	} while (++i<3 && isdigit(LS->current));	291	do {
260	if (c != (unsigned char)c) {	292	c = 10*c + (LS->current-'0');
261	save(L, '\0', l);	293	next(LS);
262	luaX_error(LS, "escape sequence too large", TK_STRING);	294	} while (++i<3 && isdigit(LS->current));
		295	if (c > UCHAR_MAX) {
		296	save(LS, '\0', l);
		297	luaX_lexerror(LS, "escape sequence too large", TK_STRING);
		298	}
		299	save(LS, c, l);
263	}	300	}
264	save(L, c, l);
265	break;
266	}	301	}
267	default: /* handles \\, \", \', and \? */
268	save_and_next(L, LS, l);
269	}	302	}
270	break;	303	break;
271	default:	304	default:
272	save_and_next(L, LS, l);	305	save_and_next(LS, l);
273	}	306	}
274	}	307	}
275	save_and_next(L, LS, l); /* skip delimiter */	308	save_and_next(LS, l); /* skip delimiter */
276	save(L, '\0', l);	309	save(LS, '\0', l);
277	seminfo->ts = luaS_newlstr(L, L->Mbuffer+1, l-3);	310	seminfo->ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff) + 1, l - 3);
278	}	311	}
279		312
280		313
@@ -282,58 +315,56 @@ int luaX_lex (LexState LS, SemInfo seminfo) { · 1 unmodified line
282	for (;;) {	315	for (;;) {
283	switch (LS->current) {	316	switch (LS->current) {
284		317
285	case ' ': case '\t': case '\r': /* `\r' to avoid problems with DOS */	318	case '\n': {
286	next(LS);
287	continue;
288
289	case '\n':
290	inclinenumber(LS);	319	inclinenumber(LS);
291	continue;	320	continue;
292		321	}
293	case '$':	322	case '-': {
294	luaX_error(LS, "unexpected `$' (pragmas are no longer supported)", '$');
295	break;
296
297	case '-':
298	next(LS);	323	next(LS);
299	if (LS->current != '-') return '-';	324	if (LS->current != '-') return '-';
300	do { next(LS); } while (LS->current != '\n' && LS->current != EOZ);	325	/* else is a comment */
		326	next(LS);
		327	if (LS->current == '[' && (next(LS), LS->current == '['))
		328	read_long_string(LS, NULL); /* long comment */
		329	else /* short comment */
		330	while (LS->current != '\n' && LS->current != EOZ)
		331	next(LS);
301	continue;	332	continue;
302		333	}
303	case '[':	334	case '[': {
304	next(LS);	335	next(LS);
305	if (LS->current != '[') return '[';	336	if (LS->current != '[') return '[';
306	else {	337	else {
307	read_long_string(LS, seminfo);	338	read_long_string(LS, seminfo);
308	return TK_STRING;	339	return TK_STRING;
309	}	340	}
310		341	}
311	case '=':	342	case '=': {
312	next(LS);	343	next(LS);
313	if (LS->current != '=') return '=';	344	if (LS->current != '=') return '=';
314	else { next(LS); return TK_EQ; }	345	else { next(LS); return TK_EQ; }
315		346	}
316	case '<':	347	case '<': {
317	next(LS);	348	next(LS);
318	if (LS->current != '=') return '<';	349	if (LS->current != '=') return '<';
319	else { next(LS); return TK_LE; }	350	else { next(LS); return TK_LE; }
320		351	}
321	case '>':	352	case '>': {
322	next(LS);	353	next(LS);
323	if (LS->current != '=') return '>';	354	if (LS->current != '=') return '>';
324	else { next(LS); return TK_GE; }	355	else { next(LS); return TK_GE; }
325		356	}
326	case '~':	357	case '~': {
327	next(LS);	358	next(LS);
328	if (LS->current != '=') return '~';	359	if (LS->current != '=') return '~';
329	else { next(LS); return TK_NE; }	360	else { next(LS); return TK_NE; }
330		361	}
331	case '"':	362	case '"':
332	case '\'':	363	case '\'': {
333	read_string(LS, LS->current, seminfo);	364	read_string(LS, LS->current, seminfo);
334	return TK_STRING;	365	return TK_STRING;
335		366	}
336	case '.':	367	case '.': {
337	next(LS);	368	next(LS);
338	if (LS->current == '.') {	369	if (LS->current == '.') {
339	next(LS);	370	next(LS);
@@ -345,36 +376,42 @@ int luaX_lex (LexState LS, SemInfo seminfo) { · 5 unmodified lines
345	}	376	}
346	else if (!isdigit(LS->current)) return '.';	377	else if (!isdigit(LS->current)) return '.';
347	else {	378	else {
348	read_number(LS, 1, seminfo);	379	read_numeral(LS, 1, seminfo);
349	return TK_NUMBER;	380	return TK_NUMBER;
350	}	381	}
351		382	}
352	case '0': case '1': case '2': case '3': case '4':	383	case EOZ: {
353	case '5': case '6': case '7': case '8': case '9':
354	read_number(LS, 0, seminfo);
355	return TK_NUMBER;
356
357	case EOZ:
358	return TK_EOS;	384	return TK_EOS;
359		385	}
360	case '_': goto tname;	386	default: {
361		387	if (isspace(LS->current)) {
362	default:
363	if (!isalpha(LS->current)) {
364	int c = LS->current;
365	if (iscntrl(c))
366	luaX_invalidchar(LS, c);
367	next(LS);	388	next(LS);
368	return c;	389	continue;
		390	}
		391	else if (isdigit(LS->current)) {
		392	read_numeral(LS, 0, seminfo);
		393	return TK_NUMBER;
369	}	394	}
370	tname: { /* identifier or reserved word */	395	else if (isalpha(LS->current) \|\| LS->current == '_') {
371	TString *ts = luaS_new(LS->L, readname(LS));	396	/* identifier or reserved word */
372	if (ts->marked >= RESERVEDMARK) /* reserved word? */	397	size_t l = readname(LS);
373	return ts->marked-RESERVEDMARK+FIRST_RESERVED;	398	TString *ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff), l);
		399	if (ts->tsv.reserved > 0) /* reserved word? */
		400	return ts->tsv.reserved - 1 + FIRST_RESERVED;
374	seminfo->ts = ts;	401	seminfo->ts = ts;
375	return TK_NAME;	402	return TK_NAME;
376	}	403	}
		404	else {
		405	int c = LS->current;
		406	if (iscntrl(c))
		407	luaX_error(LS, "invalid control char",
		408	luaO_pushfstring(LS->L, "char(%d)", c));
		409	next(LS);
		410	return c; /* single-char tokens (+ - / ...) */
		411	}
		412	}
377	}	413	}
378	}	414	}
379	}	415	}
380		416
		417	#undef next

src/llex.h+17−14

 /*
-** $Id: llex.h,v 1.31 2000/09/27 17:41:58 roberto Exp $
+** $Id: llex.h,v 1.47 2003/02/28 17:19:47 roberto Exp $
 ** Lexical Analyzer
 ** See Copyright Notice in lua.h
 */
 #define FIRST_RESERVED	257
-/* maximum length of a reserved word (+1 for final 0) */
+/* maximum length of a reserved word */
-#define TOKEN_LEN	15
+#define TOKEN_LEN	(sizeof("function")/sizeof(char))
 /*
 enum RESERVED {
   /* terminal symbols denoted by reserved words */
   TK_AND = FIRST_RESERVED, TK_BREAK,
-  TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FOR, TK_FUNCTION, TK_IF, TK_LOCAL,
+  TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION,
-  TK_NIL, TK_NOT, TK_OR, TK_REPEAT, TK_RETURN, TK_THEN, TK_UNTIL, TK_WHILE,
+  TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT,
+  TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,
   /* other terminal symbols */
   TK_NAME, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_NUMBER,
   TK_STRING, TK_EOS
 };
 /* number of reserved words */
-#define NUM_RESERVED	((int)(TK_WHILE-FIRST_RESERVED+1))
+#define NUM_RESERVED	(cast(int, TK_WHILE-FIRST_RESERVED+1))
 typedef union {
-  Number r;
+  lua_Number r;
   TString *ts;
 } SemInfo;  /* semantics information */
 typedef struct LexState {
-  int current;  /* current character */
+  int current;  /* current character (charint) */
+  int linenumber;  /* input line counter */
+  int lastline;  /* line of last token `consumed' */
   Token t;  /* current token */
   Token lookahead;  /* look ahead token */
   struct FuncState *fs;  /* `FuncState' is private to the parser */
   struct lua_State *L;
-  struct zio *z;  /* input stream */
+  ZIO *z;  /* input stream */
-  int linenumber;  /* input line counter */
+  Mbuffer *buff;  /* buffer for tokens */
-  int lastline;  /* line of last token `consumed' */
   TString *source;  /* current source name */
+  int nestlevel;  /* level of nested non-terminals */
 } LexState;
 void luaX_setinput (lua_State *L, LexState *LS, ZIO *z, TString *source);
 int luaX_lex (LexState *LS, SemInfo *seminfo);
 void luaX_checklimit (LexState *ls, int val, int limit, const char *msg);
-void luaX_syntaxerror (LexState *ls, const char *s, const char *token);
+void luaX_syntaxerror (LexState *ls, const char *s);
-void luaX_error (LexState *ls, const char *s, int token);
+void luaX_errorline (LexState *ls, const char *s, const char *token, int line);
-void luaX_token2str (int token, char *s);
+const char *luaX_token2str (LexState *ls, int token);
 #endif

src/llimits.h+83−102

@@ -1,6 +1,6 @@
1	/*	1	/*
2	** $Id: llimits.h,v 1.19 2000/10/26 12:47:05 roberto Exp $	2	** $Id: llimits.h,v 1.52 2003/02/20 19:33:23 roberto Exp $
3	** Limits, basic types, and some other "installation-dependent" definitions	3	** Limits, basic types, and some other `installation-dependent' definitions
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
@@ -12,6 +12,8 @@ · 5 unmodified lines
12	#include <stddef.h>	12	#include <stddef.h>
13		13
14		14
		15	#include "lua.h"
		16
15		17
16	/*	18	/*
17	** try to find number of bits in an integer	19	** try to find number of bits in an integer
@@ -32,25 +34,29 @@ · 14 unmodified lines
32		34
33		35
34	/*	36	/*
35	** Define the type `number' of Lua	37	** the following types define integer types for values that may not
36	** GREP LUA_NUMBER to change that	38	** fit in a `small int' (16 bits), but may waste space in a
		39	** `large long' (64 bits). The current definitions should work in
		40	** any machine, but may not be optimal.
37	*/	41	*/
38	#ifndef LUA_NUM_TYPE
39	#define LUA_NUM_TYPE double
40	#endif
41		42
42	typedef LUA_NUM_TYPE Number;	43	/* an unsigned integer to hold hash values */
		44	typedef unsigned int lu_hash;
		45	/* its signed equivalent */
		46	typedef int ls_hash;
43		47
44	/* function to convert a Number to a string */	48	/* an unsigned integer big enough to count the total memory used by Lua; */
45	#define NUMBER_FMT "%.16g" /* LUA_NUMBER */	49	/* it should be at least as large as size_t */
46	#define lua_number2str(s,n) sprintf((s), NUMBER_FMT, (n))	50	typedef unsigned long lu_mem;
47		51
48	/* function to convert a string to a Number */	52	#define MAX_LUMEM ULONG_MAX
49	#define lua_str2number(s,p) strtod((s), (p))
50		53
51		54
		55	/* an integer big enough to count the number of strings in use */
		56	typedef long ls_nstr;
52		57
53	typedef unsigned long lint32; /* unsigned int with at least 32 bits */	58	/* chars used as small naturals (so that `char' is reserved for characters) */
		59	typedef unsigned char lu_byte;
54		60
55		61
56	#define MAX_SIZET ((size_t)(~(size_t)0)-2)	62	#define MAX_SIZET ((size_t)(~(size_t)0)-2)
@@ -59,117 +65,93 @@ typedef unsigned long lint32; /* unsigned int with at least 32 bits */ · 2 unmodified lines
59	#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */	65	#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
60		66
61	/*	67	/*
62	** conversion of pointer to int (for hashing only)	68	** conversion of pointer to integer
63	** (the shift removes bits that are usually 0 because of alignment)	69	** this is for hashing only; there is no problem if the integer
		70	** cannot hold the whole pointer value
64	*/	71	*/
65	#define IntPoint(p) (((unsigned long)(p)) >> 3)	72	#define IntPoint(p) ((lu_hash)(p))
		73
66		74
67		75
		76	/* type to ensure maximum alignment */
		77	#ifndef LUSER_ALIGNMENT_T
		78	typedef union { double u; void *s; long l; } L_Umaxalign;
		79	#else
		80	typedef LUSER_ALIGNMENT_T L_Umaxalign;
		81	#endif
68		82
69	#define MINPOWER2 4 /* minimum size for "growing" vectors */
70		83
		84	/* result of `usual argument conversion' over lua_Number */
		85	#ifndef LUA_UACNUMBER
		86	typedef double l_uacNumber;
		87	#else
		88	typedef LUA_UACNUMBER l_uacNumber;
		89	#endif
71		90
72		91
73	#ifndef DEFAULT_STACK_SIZE	92	#ifndef lua_assert
74	#define DEFAULT_STACK_SIZE 1024	93	#define lua_assert(c) /* empty */
75	#endif	94	#endif
76		95
77		96
		97	#ifndef check_exp
		98	#define check_exp(c,e) (e)
		99	#endif
78		100
79	/* type to ensure maximum alignment */	101
80	union L_Umaxalign { double d; char *s; long l; };	102	#ifndef UNUSED
		103	#define UNUSED(x) ((void)(x)) /* to avoid warnings */
		104	#endif
		105
		106
		107	#ifndef cast
		108	#define cast(t, exp) ((t)(exp))
		109	#endif
81		110
82		111
83		112
84	/*	113	/*
85	** type for virtual-machine instructions	114	** type for virtual-machine instructions
86	** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)	115	** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
87	** For a very small machine, you may change that to 2 bytes (and adjust
88	** the following limits accordingly)
89	*/	116	*/
90	typedef unsigned long Instruction;	117	typedef unsigned long Instruction;
91		118
92		119
93	/*	120	/* maximum depth for calls (unsigned short) */
94	** size and position of opcode arguments.	121	#ifndef LUA_MAXCALLS
95	** For an instruction with 2 bytes, size is 16, and size_b can be 5	122	#define LUA_MAXCALLS 4096
96	** (accordingly, size_u will be 10, and size_a will be 5)	123	#endif
97	*/
98	#define SIZE_INSTRUCTION 32
99	#define SIZE_B 9
100
101	#define SIZE_OP 6
102	#define SIZE_U (SIZE_INSTRUCTION-SIZE_OP)
103	#define POS_U SIZE_OP
104	#define POS_B SIZE_OP
105	#define SIZE_A (SIZE_INSTRUCTION-(SIZE_OP+SIZE_B))
106	#define POS_A (SIZE_OP+SIZE_B)
107		124
108		125
109	/*	126	/*
110	** limits for opcode arguments.	127	** maximum depth for C calls (unsigned short): Not too big, or may
111	** we use (signed) int to manipulate most arguments,	128	** overflow the C stack...
112	** so they must fit in BITS_INT-1 bits (-1 for sign)
113	*/	129	*/
114	#if SIZE_U < BITS_INT-1
115	#define MAXARG_U ((1<<SIZE_U)-1)
116	#define MAXARG_S (MAXARG_U>>1) /* `S' is signed */
117	#else
118	#define MAXARG_U MAX_INT
119	#define MAXARG_S MAX_INT
120	#endif
121		130
122	#if SIZE_A < BITS_INT-1	131	#ifndef LUA_MAXCCALLS
123	#define MAXARG_A ((1<<SIZE_A)-1)	132	#define LUA_MAXCCALLS 200
124	#else
125	#define MAXARG_A MAX_INT
126	#endif	133	#endif
127		134
128	#if SIZE_B < BITS_INT-1	135
129	#define MAXARG_B ((1<<SIZE_B)-1)	136	/* maximum size for the C stack */
130	#else	137	#ifndef LUA_MAXCSTACK
131	#define MAXARG_B MAX_INT	138	#define LUA_MAXCSTACK 2048
132	#endif	139	#endif
133		140
134		141
135	/* maximum stack size in a function */	142	/* maximum stack for a Lua function */
136	#ifndef MAXSTACK
137	#define MAXSTACK 250	143	#define MAXSTACK 250
138	#endif
139
140	#if MAXSTACK > MAXARG_B
141	#undef MAXSTACK
142	#define MAXSTACK MAXARG_B
143	#endif
144		144
145		145
146	/* maximum number of local variables */	146	/* maximum number of variables declared in a function */
147	#ifndef MAXLOCALS	147	#ifndef MAXVARS
148	#define MAXLOCALS 200 /* arbitrary limit (<MAXSTACK) */	148	#define MAXVARS 200 /* arbitrary limit (<MAXSTACK) */
149	#endif
150	#if MAXLOCALS>=MAXSTACK
151	#undef MAXLOCALS
152	#define MAXLOCALS (MAXSTACK-1)
153	#endif	149	#endif
154		150
155		151
156	/* maximum number of upvalues */	152	/* maximum number of upvalues per function */
157	#ifndef MAXUPVALUES	153	#ifndef MAXUPVALUES
158	#define MAXUPVALUES 32 /* arbitrary limit (<=MAXARG_B) */	154	#define MAXUPVALUES 32
159	#endif
160	#if MAXUPVALUES>MAXARG_B
161	#undef MAXUPVALUES
162	#define MAXUPVALUES MAXARG_B
163	#endif
164
165
166	/* maximum number of variables in the left side of an assignment */
167	#ifndef MAXVARSLH
168	#define MAXVARSLH 100 /* arbitrary limit (<MULT_RET) */
169	#endif
170	#if MAXVARSLH>=MULT_RET
171	#undef MAXVARSLH
172	#define MAXVARSLH (MULT_RET-1)
173	#endif	155	#endif
174		156
175		157
@@ -177,27 +159,26 @@ typedef unsigned long Instruction; · 1 unmodified line
177	#ifndef MAXPARAMS	159	#ifndef MAXPARAMS
178	#define MAXPARAMS 100 /* arbitrary limit (<MAXLOCALS) */	160	#define MAXPARAMS 100 /* arbitrary limit (<MAXLOCALS) */
179	#endif	161	#endif
180	#if MAXPARAMS>=MAXLOCALS
181	#undef MAXPARAMS
182	#define MAXPARAMS (MAXLOCALS-1)
183	#endif
184		162
185		163
186	/* number of list items to accumulate before a SETLIST instruction */	164	/* minimum size for the string table (must be power of 2) */
187	#define LFIELDS_PER_FLUSH 64	165	#ifndef MINSTRTABSIZE
188	#if LFIELDS_PER_FLUSH>(MAXSTACK/4)	166	#define MINSTRTABSIZE 32
189	#undef LFIELDS_PER_FLUSH
190	#define LFIELDS_PER_FLUSH (MAXSTACK/4)
191	#endif	167	#endif
192		168
193	/* number of record items to accumulate before a SETMAP instruction */	169
194	/* (each item counts 2 elements on the stack: an index and a value) */	170	/* minimum size for string buffer */
195	#define RFIELDS_PER_FLUSH (LFIELDS_PER_FLUSH/2)	171	#ifndef LUA_MINBUFFER
		172	#define LUA_MINBUFFER 32
		173	#endif
196		174
197		175
198	/* maximum lookback to find a real constant (for code generation) */	176	/*
199	#ifndef LOOKBACKNUMS	177	** maximum number of syntactical nested non-terminals: Not too big,
200	#define LOOKBACKNUMS 20 /* arbitrary constant */	178	** or may overflow the C stack...
		179	*/
		180	#ifndef LUA_MAXPARSERLEVEL
		181	#define LUA_MAXPARSERLEVEL 200
201	#endif	182	#endif
202		183
203		184

src/lmem.c+52−111

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lmem.c,v 1.39 2000/10/30 16:29:59 roberto Exp $	2	** $Id: lmem.c,v 1.61 2002/12/04 17:38:31 roberto Exp $
3	** Interface to Memory Manager	3	** Interface to Memory Manager
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -7,8 +7,11 @@ · 1 unmodified line
7		7
8	#include <stdlib.h>	8	#include <stdlib.h>
9		9
		10	#define lmem_c
		11
10	#include "lua.h"	12	#include "lua.h"
11		13
		14	#include "ldebug.h"
12	#include "ldo.h"	15	#include "ldo.h"
13	#include "lmem.h"	16	#include "lmem.h"
14	#include "lobject.h"	17	#include "lobject.h"
@@ -16,135 +19,73 @@ · 1 unmodified line
16		19
17		20
18		21
19
20	#ifdef LUA_DEBUG
21	/*	22	/*
22	** {======================================================================	23	** definition for realloc function. It must assure that l_realloc(NULL,
23	** Controlled version for realloc.	24	** 0, x) allocates a new block (ANSI C assures that). (`os' is the old
24	** =======================================================================	25	** block size; some allocators may use that.)
25	*/	26	*/
26		27	#ifndef l_realloc
27		28	#define l_realloc(b,os,s) realloc(b,s)
28	#include <assert.h>
29	#include <limits.h>
30	#include <string.h>
31
32	#define realloc(b, s) debug_realloc(b, s)
33	#define malloc(b) debug_realloc(NULL, b)
34	#define free(b) debug_realloc(b, 0)
35
36
37	/* ensures maximum alignment for HEADER */
38	#define HEADER (sizeof(union L_Umaxalign))
39
40	#define MARKSIZE 16
41	#define MARK 0x55 /* 01010101 (a nice pattern) */
42
43
44	#define blocksize(b) ((unsigned long )((char )(b) - HEADER))
45
46	unsigned long memdebug_numblocks = 0;
47	unsigned long memdebug_total = 0;
48	unsigned long memdebug_maxmem = 0;
49	unsigned long memdebug_memlimit = LONG_MAX;
50
51
52	static void checkblock (void block) {
53	unsigned long *b = blocksize(block);
54	unsigned long size = *b;
55	int i;
56	for (i=0;i<MARKSIZE;i++)
57	assert((((char )b)+HEADER+size+i) == MARK+i); /* corrupted block? */
58	memdebug_numblocks--;
59	memdebug_total -= size;
60	return b;
61	}
62
63
64	static void freeblock (void *block) {
65	if (block) {
66	size_t size = *blocksize(block);
67	block = checkblock(block);
68	memset(block, -1, size+HEADER+MARKSIZE); /* erase block */
69	(free)(block); /* free original block */
70	}
71	}
72
73
74	static void debug_realloc (void block, size_t size) {
75	if (size == 0) {
76	freeblock(block);
77	return NULL;
78	}
79	else if (memdebug_total+size > memdebug_memlimit)
80	return NULL; /* to test memory allocation errors */
81	else {
82	size_t realsize = HEADER+size+MARKSIZE;
83	char newblock = (char )(malloc)(realsize); /* alloc a new block */
84	int i;
85	if (realsize < size) return NULL; /* overflow! */
86	if (newblock == NULL) return NULL;
87	if (block) {
88	size_t oldsize = *blocksize(block);
89	if (oldsize > size) oldsize = size;
90	memcpy(newblock+HEADER, block, oldsize);
91	freeblock(block); /* erase (and check) old copy */
92	}
93	memdebug_total += size;
94	if (memdebug_total > memdebug_maxmem) memdebug_maxmem = memdebug_total;
95	memdebug_numblocks++;
96	(unsigned long )newblock = size;
97	for (i=0;i<MARKSIZE;i++)
98	*(newblock+HEADER+size+i) = (char)(MARK+i);
99	return newblock+HEADER;
100	}
101	}
102
103
104	/* }====================================================================== */
105	#endif	29	#endif
106		30
107
108
109	/*	31	/*
110	** Real ISO (ANSI) systems do not need these tests;	32	** definition for free function. (`os' is the old block size; some
111	** but some systems (Sun OS) are not that ISO...	33	** allocators may use that.)
112	*/	34	*/
113	#ifdef OLD_ANSI	35	#ifndef l_free
114	#define realloc(b,s) ((b) == NULL ? malloc(s) : (realloc)(b, s))	36	#define l_free(b,os) free(b)
115	#define free(b) if (b) (free)(b)
116	#endif	37	#endif
117		38
118		39
119	void luaM_growaux (lua_State L, void *block, size_t nelems,	40	#define MINSIZEARRAY 4
120	int inc, size_t size, const char *errormsg, size_t limit) {	41
121	size_t newn = nelems+inc;	42
122	if (nelems >= limit-inc) lua_error(L, errormsg);	43	void luaM_growaux (lua_State L, void block, int size, int size_elems,
123	if ((newn ^ nelems) <= nelems \|\| /* still the same power-of-2 limit? */	44	int limit, const char *errormsg) {
124	(nelems > 0 && newn < MINPOWER2)) /* or block already is MINPOWER2? */	45	void *newblock;
125	return block; /* do not need to reallocate */	46	int newsize = (size)2;
126	else /* it crossed a power-of-2 boundary; grow to next power */	47	if (newsize < MINSIZEARRAY)
127	return luaM_realloc(L, block, luaO_power2(newn)*size);	48	newsize = MINSIZEARRAY; /* minimum size */
		49	else if (size >= limit/2) { / cannot double it? */
		50	if (size < limit - MINSIZEARRAY) / try something smaller... */
		51	newsize = limit; /* still have at least MINSIZEARRAY free places */
		52	else luaG_runerror(L, errormsg);
		53	}
		54	newblock = luaM_realloc(L, block,
		55	cast(lu_mem, size)cast(lu_mem, size_elems),
		56	cast(lu_mem, newsize)*cast(lu_mem, size_elems));
		57	size = newsize; / update only when everything else is OK */
		58	return newblock;
128	}	59	}
129		60
130		61
131	/*	62	/*
132	** generic allocation routine.	63	** generic allocation routine.
133	*/	64	*/
134	void luaM_realloc (lua_State L, void *block, lint32 size) {	65	void luaM_realloc (lua_State L, void *block, lu_mem oldsize, lu_mem size) {
		66	lua_assert((oldsize == 0) == (block == NULL));
135	if (size == 0) {	67	if (size == 0) {
136	free(block); /* block may be NULL; that is OK for free */	68	if (block != NULL) {
137	return NULL;	69	l_free(block, oldsize);
		70	block = NULL;
		71	}
		72	else return NULL; /* avoid `nblocks' computations when oldsize==size==0 */
138	}	73	}
139	else if (size >= MAX_SIZET)	74	else if (size >= MAX_SIZET)
140	lua_error(L, "memory allocation error: block too big");	75	luaG_runerror(L, "memory allocation error: block too big");
141	block = realloc(block, size);	76	else {
142	if (block == NULL) {	77	block = l_realloc(block, oldsize, size);
143	if (L)	78	if (block == NULL) {
144	luaD_breakrun(L, LUA_ERRMEM); /* break run without error message */	79	if (L)
145	else return NULL; /* error before creating state! */	80	luaD_throw(L, LUA_ERRMEM);
		81	else return NULL; /* error before creating state! */
		82	}
		83	}
		84	if (L) {
		85	lua_assert(G(L) != NULL && G(L)->nblocks > 0);
		86	G(L)->nblocks -= oldsize;
		87	G(L)->nblocks += size;
146	}	88	}
147	return block;	89	return block;
148	}	90	}
149		91
150

src/lmem.h+21−19

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lmem.h,v 1.16 2000/10/30 16:29:59 roberto Exp $	2	** $Id: lmem.h,v 1.26 2002/05/01 20:40:42 roberto Exp $
3	** Interface to Memory Manager	3	** Interface to Memory Manager
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -13,29 +13,31 @@ · 7 unmodified lines
13	#include "llimits.h"	13	#include "llimits.h"
14	#include "lua.h"	14	#include "lua.h"
15		15
16	void luaM_realloc (lua_State L, void *oldblock, lint32 size);	16	#define MEMERRMSG "not enough memory"
17	void luaM_growaux (lua_State L, void *block, size_t nelems,
18	int inc, size_t size, const char *errormsg,
19	size_t limit);
20		17
21	#define luaM_free(L, b) luaM_realloc(L, (b), 0)
22	#define luaM_malloc(L, t) luaM_realloc(L, NULL, (t))
23	#define luaM_new(L, t) ((t *)luaM_malloc(L, sizeof(t)))
24	#define luaM_newvector(L, n,t) ((t )luaM_malloc(L, (n)(lint32)sizeof(t)))
25		18
26	#define luaM_growvector(L, v,nelems,inc,t,e,l) \	19	void luaM_realloc (lua_State L, void *oldblock, lu_mem oldsize, lu_mem size);
27	((v)=(t *)luaM_growaux(L, v,nelems,inc,sizeof(t),e,l))
28		20
29	#define luaM_reallocvector(L, v,n,t) \	21	void luaM_growaux (lua_State L, void block, int size, int size_elem,
30	((v)=(t )luaM_realloc(L, v,(n)(lint32)sizeof(t)))	22	int limit, const char *errormsg);
31		23
		24	#define luaM_free(L, b, s) luaM_realloc(L, (b), (s), 0)
		25	#define luaM_freelem(L, b) luaM_realloc(L, (b), sizeof(*(b)), 0)
		26	#define luaM_freearray(L, b, n, t) luaM_realloc(L, (b), \
		27	cast(lu_mem, n)*cast(lu_mem, sizeof(t)), 0)
32		28
33	#ifdef LUA_DEBUG	29	#define luaM_malloc(L, t) luaM_realloc(L, NULL, 0, (t))
34	extern unsigned long memdebug_numblocks;	30	#define luaM_new(L, t) cast(t *, luaM_malloc(L, sizeof(t)))
35	extern unsigned long memdebug_total;	31	#define luaM_newvector(L, n,t) cast(t *, luaM_malloc(L, \
36	extern unsigned long memdebug_maxmem;	32	cast(lu_mem, n)*cast(lu_mem, sizeof(t))))
37	extern unsigned long memdebug_memlimit;	33
38	#endif	34	#define luaM_growvector(L,v,nelems,size,t,limit,e) \
		35	if (((nelems)+1) > (size)) \
		36	((v)=cast(t *, luaM_growaux(L,v,&(size),sizeof(t),limit,e)))
		37
		38	#define luaM_reallocvector(L, v,oldn,n,t) \
		39	((v)=cast(t , luaM_realloc(L, v,cast(lu_mem, oldn)cast(lu_mem, sizeof(t)), \
		40	cast(lu_mem, n)*cast(lu_mem, sizeof(t)))))
39		41
40		42
41	#endif	43	#endif

src/lobject.c+125−55

 /*
-** $Id: lobject.c,v 1.55 2000/10/20 16:36:32 roberto Exp $
+** $Id: lobject.c,v 1.97 2003/04/03 13:35:34 roberto Exp $
 ** Some generic functions over Lua objects
 ** See Copyright Notice in lua.h
 */
 #include <ctype.h>
 #include <stdarg.h>
-#include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
+#define lobject_c
 #include "lua.h"
+#include "ldo.h"
 #include "lmem.h"
 #include "lobject.h"
 #include "lstate.h"
+#include "lstring.h"
+#include "lvm.h"
+/* function to convert a string to a lua_Number */
+#ifndef lua_str2number
+#define lua_str2number(s,p)     strtod((s), (p))
+#endif
-const TObject luaO_nilobject = {LUA_TNIL, {NULL}};
-const char *const luaO_typenames[] = {
-  "userdata", "nil", "number", "string", "table", "function"
-};
+const TObject luaO_nilobject = {LUA_TNIL, {NULL}};
 /*
-** returns smaller power of 2 larger than `n' (minimum is MINPOWER2)
+** converts an integer to a "floating point byte", represented as
+** (mmmmmxxx), where the real value is (xxx) * 2^(mmmmm)
 */
-lint32 luaO_power2 (lint32 n) {
+int luaO_int2fb (unsigned int x) {
-  lint32 p = MINPOWER2;
+  int m = 0;  /* mantissa */
-  while (p<=n) p<<=1;
+  while (x >= (1<<3)) {
-  return p;
+    x = (x+1) >> 1;
+    m++;
+  }
+  return (m << 3) | cast(int, x);
 }
-int luaO_equalObj (const TObject *t1, const TObject *t2) {
+int luaO_log2 (unsigned int x) {
-  if (ttype(t1) != ttype(t2)) return 0;
+  static const lu_byte log_8[255] = {
-  switch (ttype(t1)) {
+    0,
-    case LUA_TNUMBER:
+    1,1,
-      return nvalue(t1) == nvalue(t2);
+    2,2,2,2,
-    case LUA_TSTRING: case LUA_TUSERDATA:
+    3,3,3,3,3,3,3,3,
-      return tsvalue(t1) == tsvalue(t2);
+    4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,
-    case LUA_TTABLE:
+    5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
-      return hvalue(t1) == hvalue(t2);
+    6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
-    case LUA_TFUNCTION:
+    6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
-      return clvalue(t1) == clvalue(t2);
+    7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
-    default:
+    7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
-      LUA_ASSERT(ttype(t1) == LUA_TNIL, "invalid type");
+    7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
-      return 1; /* LUA_TNIL */
+    7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
+  };
+  if (x >= 0x00010000) {
+    if (x >= 0x01000000) return log_8[((x>>24) & 0xff) - 1]+24;
+    else return log_8[((x>>16) & 0xff) - 1]+16;
+  }
+  else {
+    if (x >= 0x00000100) return log_8[((x>>8) & 0xff) - 1]+8;
+    else if (x) return log_8[(x & 0xff) - 1];
+    return -1;  /* special `log' for 0 */
   }
 }
-char *luaO_openspace (lua_State *L, size_t n) {
+int luaO_rawequalObj (const TObject *t1, const TObject *t2) {
-  if (n > L->Mbuffsize) {
+  if (ttype(t1) != ttype(t2)) return 0;
-    luaM_reallocvector(L, L->Mbuffer, n, char);
+  else switch (ttype(t1)) {
-    L->nblocks += (n - L->Mbuffsize)*sizeof(char);
+    case LUA_TNIL:
-    L->Mbuffsize = n;
+      return 1;
+    case LUA_TNUMBER:
+      return nvalue(t1) == nvalue(t2);
+    case LUA_TBOOLEAN:
+      return bvalue(t1) == bvalue(t2);  /* boolean true must be 1 !! */
+    case LUA_TLIGHTUSERDATA:
+      return pvalue(t1) == pvalue(t2);
+    default:
+      lua_assert(iscollectable(t1));
+      return gcvalue(t1) == gcvalue(t2);
   }
-  return L->Mbuffer;
 }
-int luaO_str2d (const char *s, Number *result) {  /* LUA_NUMBER */
+int luaO_str2d (const char *s, lua_Number *result) {
   char *endptr;
-  Number res = lua_str2number(s, &endptr);
+  lua_Number res = lua_str2number(s, &endptr);
   if (endptr == s) return 0;  /* no conversion */
-  while (isspace((unsigned char)*endptr)) endptr++;
+  while (isspace((unsigned char)(*endptr))) endptr++;
   if (*endptr != '\0') return 0;  /* invalid trailing characters? */
   *result = res;
   return 1;
 }
-/* maximum length of a string format for `luaO_verror' */
-#define MAX_VERROR	280
-/* this function needs to handle only '%d' and '%.XXs' formats */
+static void pushstr (lua_State *L, const char *str) {
-void luaO_verror (lua_State *L, const char *fmt, ...) {
+  setsvalue2s(L->top, luaS_new(L, str));
+  incr_top(L);
+}
+/* this function handles only `%d', `%c', %f, and `%s' formats */
+const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {
+  int n = 1;
+  pushstr(L, "");
+  for (;;) {
+    const char *e = strchr(fmt, '%');
+    if (e == NULL) break;
+    setsvalue2s(L->top, luaS_newlstr(L, fmt, e-fmt));
+    incr_top(L);
+    switch (*(e+1)) {
+      case 's':
+        pushstr(L, va_arg(argp, char *));
+        break;
+      case 'c': {
+        char buff[2];
+        buff[0] = cast(char, va_arg(argp, int));
+        buff[1] = '\0';
+        pushstr(L, buff);
+        break;
+      }
+      case 'd':
+        setnvalue(L->top, cast(lua_Number, va_arg(argp, int)));
+        incr_top(L);
+        break;
+      case 'f':
+        setnvalue(L->top, cast(lua_Number, va_arg(argp, l_uacNumber)));
+        incr_top(L);
+        break;
+      case '%':
+        pushstr(L, "%");
+        break;
+      default: lua_assert(0);
+    }
+    n += 2;
+    fmt = e+2;
+  }
+  pushstr(L, fmt);
+  luaV_concat(L, n+1, L->top - L->base - 1);
+  L->top -= n;
+  return svalue(L->top - 1);
+}
+const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) {
+  const char *msg;
   va_list argp;
-  char buff[MAX_VERROR];  /* to hold formatted message */
   va_start(argp, fmt);
-  vsprintf(buff, fmt, argp);
+  msg = luaO_pushvfstring(L, fmt, argp);
   va_end(argp);
-  lua_error(L, buff);
+  return msg;
 }
     strncpy(out, source+1, bufflen);  /* remove first char */
     out[bufflen-1] = '\0';  /* ensures null termination */
   }
-  else {
+  else {  /* out = "source", or "...source" */
     if (*source == '@') {
       int l;
       source++;  /* skip the `@' */
-      bufflen -= sizeof("file `...%s'");
+      bufflen -= sizeof(" `...' ");
       l = strlen(source);
+      strcpy(out, "");
       if (l>bufflen) {
         source += (l-bufflen);  /* get last part of file name */
-        sprintf(out, "file `...%.99s'", source);
+        strcat(out, "...");
       }
-      else
+      strcat(out, source);
-        sprintf(out, "file `%.99s'", source);
     }
-    else {
+    else {  /* out = [string "string"] */
       int len = strcspn(source, "\n");  /* stop at first newline */
-      bufflen -= sizeof("string \"%.*s...\"");
+      bufflen -= sizeof(" [string \"...\"] ");
       if (len > bufflen) len = bufflen;
+      strcpy(out, "[string \"");
       if (source[len] != '\0') {  /* must truncate? */
-        strcpy(out, "string \"");
+        strncat(out, source, len);
-        out += strlen(out);
+        strcat(out, "...");
-        strncpy(out, source, len);
-        strcpy(out+len, "...\"");
       }
       else
-        sprintf(out, "string \"%.99s\"", source);
+        strcat(out, source);
+      strcat(out, "\"]");
     }
   }
 }

src/lobject.h+246−114

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lobject.h,v 1.82 2000/10/30 17:49:19 roberto Exp $	2	** $Id: lobject.h,v 1.159 2003/03/18 12:50:04 roberto Exp $
3	** Type definitions for Lua objects	3	** Type definitions for Lua objects
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -12,115 +12,222 @@ · 6 unmodified lines
12	#include "lua.h"	12	#include "lua.h"
13		13
14		14
15	#ifdef LUA_DEBUG	15	/* tags for values visible from Lua */
16	#undef NDEBUG	16	#define NUM_TAGS LUA_TTHREAD
17	#include <assert.h>
18	#define LUA_INTERNALERROR(s) assert(((void)s,0))
19	#define LUA_ASSERT(c,s) assert(((void)s,(c)))
20	#else
21	#define LUA_INTERNALERROR(s) /* empty */
22	#define LUA_ASSERT(c,s) /* empty */
23	#endif
24		17
25		18
26	#ifdef LUA_DEBUG	19	/*
27	/* to avoid warnings, and make sure value is really unused */	20	** Extra tags for non-values
28	#define UNUSED(x) (x=0, (void)(x))	21	*/
29	#else	22	#define LUA_TPROTO (NUM_TAGS+1)
30	#define UNUSED(x) ((void)(x)) /* to avoid warnings */	23	#define LUA_TUPVAL (NUM_TAGS+2)
31	#endif	24
		25
		26	/*
		27	** Union of all collectable objects
		28	*/
		29	typedef union GCObject GCObject;
32		30
33		31
34	/* mark for closures active in the stack */	32	/*
35	#define LUA_TMARK 6	33	** Common Header for all collectable objects (in macro form, to be
		34	** included in other objects)
		35	*/
		36	#define CommonHeader GCObject *next; lu_byte tt; lu_byte marked
36		37
37		38
38	/* tags for values visible from Lua == first user-created tag */	39	/*
39	#define NUM_TAGS 6	40	** Common header in struct form
		41	*/
		42	typedef struct GCheader {
		43	CommonHeader;
		44	} GCheader;
40		45
41		46
42	/* check whether `t' is a mark */
43	#define is_T_MARK(t) ((t) == LUA_TMARK)
44		47
45		48
		49	/*
		50	** Union of all Lua values
		51	*/
46	typedef union {	52	typedef union {
47	struct TString ts; / LUA_TSTRING, LUA_TUSERDATA */	53	GCObject *gc;
48	struct Closure cl; / LUA_TFUNCTION */	54	void *p;
49	struct Hash a; / LUA_TTABLE */	55	lua_Number n;
50	struct CallInfo i; / LUA_TLMARK */	56	int b;
51	Number n; /* LUA_TNUMBER */
52	} Value;	57	} Value;
53		58
54		59
55	/* Macros to access values */	60	/*
56	#define ttype(o) ((o)->ttype)	61	** Lua values (or `tagged objects')
57	#define nvalue(o) ((o)->value.n)	62	*/
58	#define tsvalue(o) ((o)->value.ts)
59	#define clvalue(o) ((o)->value.cl)
60	#define hvalue(o) ((o)->value.a)
61	#define infovalue(o) ((o)->value.i)
62	#define svalue(o) (tsvalue(o)->str)
63
64
65	typedef struct lua_TObject {	63	typedef struct lua_TObject {
66	int ttype;	64	int tt;
67	Value value;	65	Value value;
68	} TObject;	66	} TObject;
69		67
70		68
		69	/* Macros to test type */
		70	#define ttisnil(o) (ttype(o) == LUA_TNIL)
		71	#define ttisnumber(o) (ttype(o) == LUA_TNUMBER)
		72	#define ttisstring(o) (ttype(o) == LUA_TSTRING)
		73	#define ttistable(o) (ttype(o) == LUA_TTABLE)
		74	#define ttisfunction(o) (ttype(o) == LUA_TFUNCTION)
		75	#define ttisboolean(o) (ttype(o) == LUA_TBOOLEAN)
		76	#define ttisuserdata(o) (ttype(o) == LUA_TUSERDATA)
		77	#define ttisthread(o) (ttype(o) == LUA_TTHREAD)
		78	#define ttislightuserdata(o) (ttype(o) == LUA_TLIGHTUSERDATA)
		79
		80	/* Macros to access values */
		81	#define ttype(o) ((o)->tt)
		82	#define gcvalue(o) check_exp(iscollectable(o), (o)->value.gc)
		83	#define pvalue(o) check_exp(ttislightuserdata(o), (o)->value.p)
		84	#define nvalue(o) check_exp(ttisnumber(o), (o)->value.n)
		85	#define tsvalue(o) check_exp(ttisstring(o), &(o)->value.gc->ts)
		86	#define uvalue(o) check_exp(ttisuserdata(o), &(o)->value.gc->u)
		87	#define clvalue(o) check_exp(ttisfunction(o), &(o)->value.gc->cl)
		88	#define hvalue(o) check_exp(ttistable(o), &(o)->value.gc->h)
		89	#define bvalue(o) check_exp(ttisboolean(o), (o)->value.b)
		90	#define thvalue(o) check_exp(ttisthread(o), &(o)->value.gc->th)
		91
		92	#define l_isfalse(o) (ttisnil(o) \|\| (ttisboolean(o) && bvalue(o) == 0))
		93
		94	/* Macros to set values */
		95	#define setnvalue(obj,x) \
		96	{ TObject *i_o=(obj); i_o->tt=LUA_TNUMBER; i_o->value.n=(x); }
		97
		98	#define chgnvalue(obj,x) \
		99	check_exp(ttype(obj)==LUA_TNUMBER, (obj)->value.n=(x))
		100
		101	#define setpvalue(obj,x) \
		102	{ TObject *i_o=(obj); i_o->tt=LUA_TLIGHTUSERDATA; i_o->value.p=(x); }
		103
		104	#define setbvalue(obj,x) \
		105	{ TObject *i_o=(obj); i_o->tt=LUA_TBOOLEAN; i_o->value.b=(x); }
		106
		107	#define setsvalue(obj,x) \
		108	{ TObject *i_o=(obj); i_o->tt=LUA_TSTRING; \
		109	i_o->value.gc=cast(GCObject *, (x)); \
		110	lua_assert(i_o->value.gc->gch.tt == LUA_TSTRING); }
		111
		112	#define setuvalue(obj,x) \
		113	{ TObject *i_o=(obj); i_o->tt=LUA_TUSERDATA; \
		114	i_o->value.gc=cast(GCObject *, (x)); \
		115	lua_assert(i_o->value.gc->gch.tt == LUA_TUSERDATA); }
		116
		117	#define setthvalue(obj,x) \
		118	{ TObject *i_o=(obj); i_o->tt=LUA_TTHREAD; \
		119	i_o->value.gc=cast(GCObject *, (x)); \
		120	lua_assert(i_o->value.gc->gch.tt == LUA_TTHREAD); }
		121
		122	#define setclvalue(obj,x) \
		123	{ TObject *i_o=(obj); i_o->tt=LUA_TFUNCTION; \
		124	i_o->value.gc=cast(GCObject *, (x)); \
		125	lua_assert(i_o->value.gc->gch.tt == LUA_TFUNCTION); }
		126
		127	#define sethvalue(obj,x) \
		128	{ TObject *i_o=(obj); i_o->tt=LUA_TTABLE; \
		129	i_o->value.gc=cast(GCObject *, (x)); \
		130	lua_assert(i_o->value.gc->gch.tt == LUA_TTABLE); }
		131
		132	#define setnilvalue(obj) ((obj)->tt=LUA_TNIL)
		133
		134
		135
71	/*	136	/*
72	** String headers for string table	137	** for internal debug only
		138	*/
		139	#define checkconsistency(obj) \
		140	lua_assert(!iscollectable(obj) \|\| (ttype(obj) == (obj)->value.gc->gch.tt))
		141
		142
		143	#define setobj(obj1,obj2) \
		144	{ const TObject o2=(obj2); TObject o1=(obj1); \
		145	checkconsistency(o2); \
		146	o1->tt=o2->tt; o1->value = o2->value; }
		147
		148
		149	/*
		150	** different types of sets, according to destination
73	*/	151	*/
74		152
		153	/* from stack to (same) stack */
		154	#define setobjs2s setobj
		155	/* to stack (not from same stack) */
		156	#define setobj2s setobj
		157	#define setsvalue2s setsvalue
		158	/* from table to same table */
		159	#define setobjt2t setobj
		160	/* to table */
		161	#define setobj2t setobj
		162	/* to new object */
		163	#define setobj2n setobj
		164	#define setsvalue2n setsvalue
		165
		166	#define setttype(obj, tt) (ttype(obj) = (tt))
		167
		168
		169	#define iscollectable(o) (ttype(o) >= LUA_TSTRING)
		170
		171
		172
		173	typedef TObject StkId; / index to stack elements */
		174
		175
75	/*	176	/*
76	** most `malloc' libraries allocate memory in blocks of 8 bytes. TSPACK	177	** String headers for string table
77	** tries to make sizeof(TString) a multiple of this granularity, to reduce
78	** waste of space.
79	*/	178	*/
80	#define TSPACK ((int)sizeof(int))	179	typedef union TString {
81		180	L_Umaxalign dummy; /* ensures maximum alignment for strings */
82	typedef struct TString {	181	struct {
83	union {	182	CommonHeader;
84	struct { /* for strings */	183	lu_byte reserved;
85	unsigned long hash;	184	lu_hash hash;
86	int constindex; /* hint to reuse constants */	185	size_t len;
87	} s;	186	} tsv;
88	struct { /* for userdata */
89	int tag;
90	void *value;
91	} d;
92	} u;
93	size_t len;
94	struct TString nexthash; / chain for hash table */
95	int marked;
96	char str[TSPACK]; /* variable length string!! must be the last field! */
97	} TString;	187	} TString;
98		188
99		189
		190	#define getstr(ts) cast(const char *, (ts) + 1)
		191	#define svalue(o) getstr(tsvalue(o))
		192
		193
		194
		195	typedef union Udata {
		196	L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */
		197	struct {
		198	CommonHeader;
		199	struct Table *metatable;
		200	size_t len;
		201	} uv;
		202	} Udata;
		203
		204
		205
		206
100	/*	207	/*
101	** Function Prototypes	208	** Function Prototypes
102	*/	209	*/
103	typedef struct Proto {	210	typedef struct Proto {
104	Number knum; / Number numbers used by the function */	211	CommonHeader;
105	int nknum; /* size of `knum' */	212	TObject k; / constants used by the function */
106	struct TString *kstr; / strings used by the function */
107	int nkstr; /* size of `kstr' */
108	struct Proto *kproto; / functions defined inside the function */
109	int nkproto; /* size of `kproto' */
110	Instruction *code;	213	Instruction *code;
111	int ncode; /* size of `code'; when 0 means an incomplete `Proto' */	214	struct Proto *p; / functions defined inside the function */
112	short numparams;
113	short is_vararg;
114	short maxstacksize;
115	short marked;
116	struct Proto *next;
117	/* debug information */
118	int lineinfo; / map from opcodes to source lines */	215	int lineinfo; / map from opcodes to source lines */
119	int nlineinfo; /* size of `lineinfo' */
120	int nlocvars;
121	struct LocVar locvars; / information about local variables */	216	struct LocVar locvars; / information about local variables */
122	int lineDefined;	217	TString *upvalues; / upvalue names */
123	TString *source;	218	TString *source;
		219	int sizeupvalues;
		220	int sizek; /* size of `k' */
		221	int sizecode;
		222	int sizelineinfo;
		223	int sizep; /* size of `p' */
		224	int sizelocvars;
		225	int lineDefined;
		226	GCObject *gclist;
		227	lu_byte nups; /* number of upvalues */
		228	lu_byte numparams;
		229	lu_byte is_vararg;
		230	lu_byte maxstacksize;
124	} Proto;	231	} Proto;
125		232
126		233
@@ -131,73 +238,98 @@ typedef struct LocVar { · 4 unmodified lines
131	} LocVar;	238	} LocVar;
132		239
133		240
		241
		242	/*
		243	** Upvalues
		244	*/
		245
		246	typedef struct UpVal {
		247	CommonHeader;
		248	TObject v; / points to stack or to its own value */
		249	TObject value; /* the value (when closed) */
		250	} UpVal;
		251
		252
134	/*	253	/*
135	** Closures	254	** Closures
136	*/	255	*/
137	typedef struct Closure {	256
138	union {	257	#define ClosureHeader \
139	lua_CFunction c; /* C functions */	258	CommonHeader; lu_byte isC; lu_byte nupvalues; GCObject *gclist
140	struct Proto l; / Lua functions */	259
141	} f;	260	typedef struct CClosure {
142	struct Closure *next;	261	ClosureHeader;
143	struct Closure mark; / marked closures (point to itself when not marked) */	262	lua_CFunction f;
144	short isC; /* 0 for Lua functions, 1 for C functions */
145	short nupvalues;
146	TObject upvalue[1];	263	TObject upvalue[1];
		264	} CClosure;
		265
		266
		267	typedef struct LClosure {
		268	ClosureHeader;
		269	struct Proto *p;
		270	TObject g; /* global table for this closure */
		271	UpVal *upvals[1];
		272	} LClosure;
		273
		274
		275	typedef union Closure {
		276	CClosure c;
		277	LClosure l;
147	} Closure;	278	} Closure;
148		279
149		280
150	#define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->isC)	281	#define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->c.isC)
		282	#define isLfunction(o) (ttype(o) == LUA_TFUNCTION && !clvalue(o)->c.isC)
		283
151		284
		285	/*
		286	** Tables
		287	*/
152		288
153	typedef struct Node {	289	typedef struct Node {
154	TObject key;	290	TObject i_key;
155	TObject val;	291	TObject i_val;
156	struct Node next; / for chaining */	292	struct Node next; / for chaining */
157	} Node;	293	} Node;
158		294
159	typedef struct Hash {	295
		296	typedef struct Table {
		297	CommonHeader;
		298	lu_byte flags; /* 1<<p means tagmethod(p) is not present */
		299	lu_byte lsizenode; /* log2 of size of `node' array */
		300	struct Table *metatable;
		301	TObject array; / array part */
160	Node *node;	302	Node *node;
161	int htag;
162	int size;
163	Node firstfree; / this position is free; all positions after it are full */	303	Node firstfree; / this position is free; all positions after it are full */
164	struct Hash *next;	304	GCObject *gclist;
165	struct Hash mark; / marked tables (point to itself when not marked) */	305	int sizearray; /* size of `array' array */
166	} Hash;	306	} Table;
167
168		307
169	/* unmarked tables and closures are represented by pointing `mark' to
170	** themselves
171	*/
172	#define ismarked(x) ((x)->mark != (x))
173		308
174		309
175	/*	310	/*
176	** informations about a call (for debugging)	311	** `module' operation for hashing (size is always a power of 2)
177	*/	312	*/
178	typedef struct CallInfo {	313	#define lmod(s,size) \
179	struct Closure func; / function being called */	314	check_exp((size&(size-1))==0, (cast(int, (s) & ((size)-1))))
180	const Instruction *pc; / current pc of called function */
181	int lastpc; /* last pc traced */
182	int line; /* current line */
183	int refi; /* current index in `lineinfo' */
184	} CallInfo;
185		315
186		316
187	extern const TObject luaO_nilobject;	317	#define twoto(x) (1<<(x))
188	extern const char *const luaO_typenames[];	318	#define sizenode(t) (twoto((t)->lsizenode))
189		319
190		320
191	#define luaO_typename(o) (luaO_typenames[ttype(o)])
192		321
		322	extern const TObject luaO_nilobject;
193		323
194	lint32 luaO_power2 (lint32 n);	324	int luaO_log2 (unsigned int x);
195	char luaO_openspace (lua_State L, size_t n);	325	int luaO_int2fb (unsigned int x);
		326	#define fb2int(x) (((x) & 7) << ((x) >> 3))
196		327
197	int luaO_equalObj (const TObject t1, const TObject t2);	328	int luaO_rawequalObj (const TObject t1, const TObject t2);
198	int luaO_str2d (const char s, Number result);	329	int luaO_str2d (const char s, lua_Number result);
199		330
200	void luaO_verror (lua_State L, const char fmt, ...);	331	const char luaO_pushvfstring (lua_State L, const char *fmt, va_list argp);
		332	const char luaO_pushfstring (lua_State L, const char *fmt, ...);
201	void luaO_chunkid (char out, const char source, int len);	333	void luaO_chunkid (char out, const char source, int len);
202		334
203		335

src/lopcodes.c+102−0

@@ -0,0 +1,102 @@
	1	/*
	2	** $Id: lopcodes.c,v 1.22 2002/12/04 17:38:31 roberto Exp $
	3	** extracted automatically from lopcodes.h by mkprint.lua
	4	** DO NOT EDIT
	5	** See Copyright Notice in lua.h
	6	*/
	7
	8
	9	#define lopcodes_c
	10
	11	#include "lua.h"
	12
	13	#include "lobject.h"
	14	#include "lopcodes.h"
	15
	16
	17	#ifdef LUA_OPNAMES
	18
	19	const char *const luaP_opnames[] = {
	20	"MOVE",
	21	"LOADK",
	22	"LOADBOOL",
	23	"LOADNIL",
	24	"GETUPVAL",
	25	"GETGLOBAL",
	26	"GETTABLE",
	27	"SETGLOBAL",
	28	"SETUPVAL",
	29	"SETTABLE",
	30	"NEWTABLE",
	31	"SELF",
	32	"ADD",
	33	"SUB",
	34	"MUL",
	35	"DIV",
	36	"POW",
	37	"UNM",
	38	"NOT",
	39	"CONCAT",
	40	"JMP",
	41	"EQ",
	42	"LT",
	43	"LE",
	44	"TEST",
	45	"CALL",
	46	"TAILCALL",
	47	"RETURN",
	48	"FORLOOP",
	49	"TFORLOOP",
	50	"TFORPREP",
	51	"SETLIST",
	52	"SETLISTO",
	53	"CLOSE",
	54	"CLOSURE"
	55	};
	56
	57	#endif
	58
	59	#define opmode(t,b,bk,ck,sa,k,m) (((t)<<OpModeT) \| \
	60	((b)<<OpModeBreg) \| ((bk)<<OpModeBrk) \| ((ck)<<OpModeCrk) \| \
	61	((sa)<<OpModesetA) \| ((k)<<OpModeK) \| (m))
	62
	63
	64	const lu_byte luaP_opmodes[NUM_OPCODES] = {
	65	/* T B Bk Ck sA K mode opcode */
	66	opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_MOVE */
	67	,opmode(0, 0, 0, 0, 1, 1, iABx) /* OP_LOADK */
	68	,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_LOADBOOL */
	69	,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_LOADNIL */
	70	,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_GETUPVAL */
	71	,opmode(0, 0, 0, 0, 1, 1, iABx) /* OP_GETGLOBAL */
	72	,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_GETTABLE */
	73	,opmode(0, 0, 0, 0, 0, 1, iABx) /* OP_SETGLOBAL */
	74	,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_SETUPVAL */
	75	,opmode(0, 0, 1, 1, 0, 0, iABC) /* OP_SETTABLE */
	76	,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_NEWTABLE */
	77	,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_SELF */
	78	,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_ADD */
	79	,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_SUB */
	80	,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_MUL */
	81	,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_DIV */
	82	,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_POW */
	83	,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_UNM */
	84	,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_NOT */
	85	,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_CONCAT */
	86	,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_JMP */
	87	,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_EQ */
	88	,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_LT */
	89	,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_LE */
	90	,opmode(1, 1, 0, 0, 1, 0, iABC) /* OP_TEST */
	91	,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_CALL */
	92	,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_TAILCALL */
	93	,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_RETURN */
	94	,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_FORLOOP */
	95	,opmode(1, 0, 0, 0, 0, 0, iABC) /* OP_TFORLOOP */
	96	,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_TFORPREP */
	97	,opmode(0, 0, 0, 0, 0, 0, iABx) /* OP_SETLIST */
	98	,opmode(0, 0, 0, 0, 0, 0, iABx) /* OP_SETLISTO */
	99	,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_CLOSE */
	100	,opmode(0, 0, 0, 0, 1, 0, iABx) /* OP_CLOSURE */
	101	};
	102

src/lopcodes.h+165−95

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lopcodes.h,v 1.68 2000/10/24 16:05:59 roberto Exp $	2	** $Id: lopcodes.h,v 1.102 2002/08/21 18:56:09 roberto Exp $
3	** Opcodes for Lua virtual machine	3	** Opcodes for Lua virtual machine
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -12,29 +12,58 @@ · 6 unmodified lines
12		12
13	/*===========================================================================	13	/*===========================================================================
14	We assume that instructions are unsigned numbers.	14	We assume that instructions are unsigned numbers.
15	All instructions have an opcode in the first 6 bits. Moreover,	15	All instructions have an opcode in the first 6 bits.
16	an instruction can have 0, 1, or 2 arguments. Instructions can	16	Instructions can have the following fields:
17	have the following types:	17	`A' : 8 bits
18	type 0: no arguments	18	`B' : 9 bits
19	type 1: 1 unsigned argument in the higher bits (called `U')	19	`C' : 9 bits
20	type 2: 1 signed argument in the higher bits (`S')	20	`Bx' : 18 bits (`B' and `C' together)
21	type 3: 1st unsigned argument in the higher bits (`A')	21	`sBx' : signed Bx
22	2nd unsigned argument in the middle bits (`B')
23		22
24	A signed argument is represented in excess K; that is, the number	23	A signed argument is represented in excess K; that is, the number
25	value is the unsigned value minus K. K is exactly the maximum value	24	value is the unsigned value minus K. K is exactly the maximum value
26	for that argument (so that -max is represented by 0, and +max is	25	for that argument (so that -max is represented by 0, and +max is
27	represented by 2*max), which is half the maximum for the corresponding	26	represented by 2*max), which is half the maximum for the corresponding
28	unsigned argument.	27	unsigned argument.
29
30	The size of each argument is defined in `llimits.h'. The usual is an
31	instruction with 32 bits, U arguments with 26 bits (32-6), B arguments
32	with 9 bits, and A arguments with 17 bits (32-6-9). For small
33	installations, the instruction size can be 16, so U has 10 bits,
34	and A and B have 5 bits each.
35	===========================================================================*/	28	===========================================================================*/
36		29
37		30
		31	enum OpMode {iABC, iABx, iAsBx}; /* basic instruction format */
		32
		33
		34	/*
		35	** size and position of opcode arguments.
		36	*/
		37	#define SIZE_C 9
		38	#define SIZE_B 9
		39	#define SIZE_Bx (SIZE_C + SIZE_B)
		40	#define SIZE_A 8
		41
		42	#define SIZE_OP 6
		43
		44	#define POS_C SIZE_OP
		45	#define POS_B (POS_C + SIZE_C)
		46	#define POS_Bx POS_C
		47	#define POS_A (POS_B + SIZE_B)
		48
		49
		50	/*
		51	** limits for opcode arguments.
		52	** we use (signed) int to manipulate most arguments,
		53	** so they must fit in BITS_INT-1 bits (-1 for sign)
		54	*/
		55	#if SIZE_Bx < BITS_INT-1
		56	#define MAXARG_Bx ((1<<SIZE_Bx)-1)
		57	#define MAXARG_sBx (MAXARG_Bx>>1) /* `sBx' is signed */
		58	#else
		59	#define MAXARG_Bx MAX_INT
		60	#define MAXARG_sBx MAX_INT
		61	#endif
		62
		63
		64	#define MAXARG_A ((1<<SIZE_A)-1)
		65	#define MAXARG_B ((1<<SIZE_B)-1)
		66	#define MAXARG_C ((1<<SIZE_C)-1)
38		67
39		68
40	/* creates a mask with `n' 1 bits at position `p' */	69	/* creates a mask with `n' 1 bits at position `p' */
@@ -47,122 +76,163 @@ · 6 unmodified lines
47	** the following macros help to manipulate instructions	76	** the following macros help to manipulate instructions
48	*/	77	*/
49		78
50	#define CREATE_0(o) ((Instruction)(o))	79	#define GET_OPCODE(i) (cast(OpCode, (i)&MASK1(SIZE_OP,0)))
51	#define GET_OPCODE(i) ((OpCode)((i)&MASK1(SIZE_OP,0)))	80	#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) \| cast(Instruction, o)))
52	#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) \| (Instruction)(o)))
53		81
54	#define CREATE_U(o,u) ((Instruction)(o) \| ((Instruction)(u)<<POS_U))	82	#define GETARG_A(i) (cast(int, (i)>>POS_A))
55	#define GETARG_U(i) ((int)((i)>>POS_U))	83	#define SETARG_A(i,u) ((i) = (((i)&MASK0(SIZE_A,POS_A)) \| \
56	#define SETARG_U(i,u) ((i) = (((i)&MASK0(SIZE_U,POS_U)) \| \	84	((cast(Instruction, u)<<POS_A)&MASK1(SIZE_A,POS_A))))
57	((Instruction)(u)<<POS_U)))
58		85
59	#define CREATE_S(o,s) CREATE_U((o),(s)+MAXARG_S)	86	#define GETARG_B(i) (cast(int, ((i)>>POS_B) & MASK1(SIZE_B,0)))
60	#define GETARG_S(i) (GETARG_U(i)-MAXARG_S)	87	#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) \| \
61	#define SETARG_S(i,s) SETARG_U((i),(s)+MAXARG_S)	88	((cast(Instruction, b)<<POS_B)&MASK1(SIZE_B,POS_B))))
		89
		90	#define GETARG_C(i) (cast(int, ((i)>>POS_C) & MASK1(SIZE_C,0)))
		91	#define SETARG_C(i,b) ((i) = (((i)&MASK0(SIZE_C,POS_C)) \| \
		92	((cast(Instruction, b)<<POS_C)&MASK1(SIZE_C,POS_C))))
		93
		94	#define GETARG_Bx(i) (cast(int, ((i)>>POS_Bx) & MASK1(SIZE_Bx,0)))
		95	#define SETARG_Bx(i,b) ((i) = (((i)&MASK0(SIZE_Bx,POS_Bx)) \| \
		96	((cast(Instruction, b)<<POS_Bx)&MASK1(SIZE_Bx,POS_Bx))))
		97
		98	#define GETARG_sBx(i) (GETARG_Bx(i)-MAXARG_sBx)
		99	#define SETARG_sBx(i,b) SETARG_Bx((i),cast(unsigned int, (b)+MAXARG_sBx))
		100
		101
		102	#define CREATE_ABC(o,a,b,c) (cast(Instruction, o) \
		103	\| (cast(Instruction, a)<<POS_A) \
		104	\| (cast(Instruction, b)<<POS_B) \
		105	\| (cast(Instruction, c)<<POS_C))
		106
		107	#define CREATE_ABx(o,a,bc) (cast(Instruction, o) \
		108	\| (cast(Instruction, a)<<POS_A) \
		109	\| (cast(Instruction, bc)<<POS_Bx))
62		110
63		111
64	#define CREATE_AB(o,a,b) ((Instruction)(o) \| ((Instruction)(a)<<POS_A) \
65	\| ((Instruction)(b)<<POS_B))
66	#define GETARG_A(i) ((int)((i)>>POS_A))
67	#define SETARG_A(i,a) ((i) = (((i)&MASK0(SIZE_A,POS_A)) \| \
68	((Instruction)(a)<<POS_A)))
69	#define GETARG_B(i) ((int)(((i)>>POS_B) & MASK1(SIZE_B,0)))
70	#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) \| \
71	((Instruction)(b)<<POS_B)))
72		112
73		113
74	/*	114	/*
75	** K = U argument used as index to `kstr'	115	** invalid register that fits in 8 bits
76	** J = S argument used as jump offset (relative to pc of next instruction)	116	*/
77	** L = unsigned argument used as index of local variable	117	#define NO_REG MAXARG_A
78	** N = U argument used as index to `knum'	118
		119
		120	/*
		121	** R(x) - register
		122	** Kst(x) - constant (in constant table)
		123	** RK(x) == if x < MAXSTACK then R(x) else Kst(x-MAXSTACK)
		124	*/
		125
		126
		127	/*
		128	** grep "ORDER OP" if you change these enums
79	*/	129	*/
80		130
81	typedef enum {	131	typedef enum {
82	/*----------------------------------------------------------------------	132	/*----------------------------------------------------------------------
83	name args stack before stack after side effects	133	name args description
84	------------------------------------------------------------------------*/	134	------------------------------------------------------------------------*/
85	OP_END,/* - - (return) no results */	135	OP_MOVE,/* A B R(A) := R(B) */
86	OP_RETURN,/* U v_n-v_x(at u) (return) returns v_x-v_n */	136	OP_LOADK,/* A Bx R(A) := Kst(Bx) */
		137	OP_LOADBOOL,/* A B C R(A) := (Bool)B; if (C) PC++ */
		138	OP_LOADNIL,/* A B R(A) := ... := R(B) := nil */
		139	OP_GETUPVAL,/* A B R(A) := UpValue[B] */
87		140
88	OP_CALL,/* A B v_n-v_1 f(at a) r_b-r_1 f(v1,...,v_n) */	141	OP_GETGLOBAL,/* A Bx R(A) := Gbl[Kst(Bx)] */
89	OP_TAILCALL,/* A B v_n-v_1 f(at a) (return) f(v1,...,v_n) */	142	OP_GETTABLE,/* A B C R(A) := R(B)[RK(C)] */
90		143
91	OP_PUSHNIL,/* U - nil_1-nil_u */	144	OP_SETGLOBAL,/* A Bx Gbl[Kst(Bx)] := R(A) */
92	OP_POP,/* U a_u-a_1 - */	145	OP_SETUPVAL,/* A B UpValue[B] := R(A) */
		146	OP_SETTABLE,/* A B C R(A)[RK(B)] := RK(C) */
93		147
94	OP_PUSHINT,/* S - (Number)s */	148	OP_NEWTABLE,/* A B C R(A) := {} (size = B,C) */
95	OP_PUSHSTRING,/* K - KSTR[k] */
96	OP_PUSHNUM,/* N - KNUM[n] */
97	OP_PUSHNEGNUM,/* N - -KNUM[n] */
98		149
99	OP_PUSHUPVALUE,/* U - Closure[u] */	150	OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] */
100		151
101	OP_GETLOCAL,/* L - LOC[l] */	152	OP_ADD,/* A B C R(A) := RK(B) + RK(C) */
102	OP_GETGLOBAL,/* K - VAR[KSTR[k]] */	153	OP_SUB,/* A B C R(A) := RK(B) - RK(C) */
		154	OP_MUL,/* A B C R(A) := RK(B) * RK(C) */
		155	OP_DIV,/* A B C R(A) := RK(B) / RK(C) */
		156	OP_POW,/* A B C R(A) := RK(B) ^ RK(C) */
		157	OP_UNM,/* A B R(A) := -R(B) */
		158	OP_NOT,/* A B R(A) := not R(B) */
103		159
104	OP_GETTABLE,/* - i t t[i] */	160	OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */
105	OP_GETDOTTED,/* K t t[KSTR[k]] */
106	OP_GETINDEXED,/* L t t[LOC[l]] */
107	OP_PUSHSELF,/* K t t t[KSTR[k]] */
108		161
109	OP_CREATETABLE,/* U - newarray(size = u) */	162	OP_JMP,/* sBx PC += sBx */
110		163
111	OP_SETLOCAL,/* L x - LOC[l]=x */	164	OP_EQ,/* A B C if ((RK(B) == RK(C)) ~= A) then pc++ */
112	OP_SETGLOBAL,/* K x - VAR[KSTR[k]]=x */	165	OP_LT,/* A B C if ((RK(B) < RK(C)) ~= A) then pc++ */
113	OP_SETTABLE,/* A B v a_a-a_1 i t (pops b values) t[i]=v */	166	OP_LE,/* A B C if ((RK(B) <= RK(C)) ~= A) then pc++ */
114		167
115	OP_SETLIST,/* A B v_b-v_1 t t t[i+aFPF]=v_i /	168	OP_TEST,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */
116	OP_SETMAP,/* U v_u k_u - v_1 k_1 t t t[k_i]=v_i */
117		169
118	OP_ADD,/* - y x x+y */	170	OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */
119	OP_ADDI,/* S x x+s */	171	OP_TAILCALL,/* A B C return R(A)(R(A+1), ... ,R(A+B-1)) */
120	OP_SUB,/* - y x x-y */	172	OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */
121	OP_MULT,/* - y x xy /
122	OP_DIV,/* - y x x/y */
123	OP_POW,/* - y x x^y */
124	OP_CONCAT,/* U v_u-v_1 v1..-..v_u */
125	OP_MINUS,/* - x -x */
126	OP_NOT,/* - x (x==nil)? 1 : nil */
127		173
128	OP_JMPNE,/* J y x - (x~=y)? PC+=s */	174	OP_FORLOOP,/* A sBx R(A)+=R(A+2); if R(A) <?= R(A+1) then PC+= sBx */
129	OP_JMPEQ,/* J y x - (x==y)? PC+=s */
130	OP_JMPLT,/* J y x - (x<y)? PC+=s */
131	OP_JMPLE,/* J y x - (x<y)? PC+=s */
132	OP_JMPGT,/* J y x - (x>y)? PC+=s */
133	OP_JMPGE,/* J y x - (x>=y)? PC+=s */
134		175
135	OP_JMPT,/* J x - (x~=nil)? PC+=s */	176	OP_TFORLOOP,/* A C R(A+2), ... ,R(A+2+C) := R(A)(R(A+1), R(A+2));
136	OP_JMPF,/* J x - (x==nil)? PC+=s */	177	if R(A+2) ~= nil then pc++ */
137	OP_JMPONT,/* J x (x~=nil)? x : - (x~=nil)? PC+=s */	178	OP_TFORPREP,/* A sBx if type(R(A)) == table then R(A+1):=R(A), R(A):=next;
138	OP_JMPONF,/* J x (x==nil)? x : - (x==nil)? PC+=s */	179	PC += sBx */
139	OP_JMP,/* J - - PC+=s */
140		180
141	OP_PUSHNILJMP,/* - - nil PC++; */	181	OP_SETLIST,/* A Bx R(A)[Bx-Bx%FPF+i] := R(A+i), 1 <= i <= Bx%FPF+1 */
		182	OP_SETLISTO,/* A Bx */
142		183
143	OP_FORPREP,/* J */	184	OP_CLOSE,/* A close all variables in the stack up to (>=) R(A)*/
144	OP_FORLOOP,/* J */	185	OP_CLOSURE/* A Bx R(A) := closure(KPROTO[Bx], R(A), ... ,R(A+n)) */
		186	} OpCode;
145		187
146	OP_LFORPREP,/* J */
147	OP_LFORLOOP,/* J */
148		188
149	OP_CLOSURE/* A B v_b-v_1 closure(KPROTO[a], v_1-v_b) */	189	#define NUM_OPCODES (cast(int, OP_CLOSURE+1))
		190
150		191
151	} OpCode;
152		192
153	#define NUM_OPCODES ((int)OP_CLOSURE+1)	193	/*===========================================================================
		194	Notes:
		195	(1) In OP_CALL, if (B == 0) then B = top. C is the number of returns - 1,
		196	and can be 0: OP_CALL then sets `top' to last_result+1, so
		197	next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use `top'.
		198
		199	(2) In OP_RETURN, if (B == 0) then return up to `top'
		200
		201	(3) For comparisons, B specifies what conditions the test should accept.
		202
		203	(4) All `skips' (pc++) assume that next instruction is a jump
		204	===========================================================================*/
154		205
155		206
156	#define ISJUMP(o) (OP_JMPNE <= (o) && (o) <= OP_JMP)	207	/*
		208	** masks for instruction properties
		209	*/
		210	enum OpModeMask {
		211	OpModeBreg = 2, /* B is a register */
		212	OpModeBrk, /* B is a register/constant */
		213	OpModeCrk, /* C is a register/constant */
		214	OpModesetA, /* instruction set register A */
		215	OpModeK, /* Bx is a constant */
		216	OpModeT /* operator is a test */
		217
		218	};
157		219
158		220
		221	extern const lu_byte luaP_opmodes[NUM_OPCODES];
159		222
160	/* special code to fit a LUA_MULTRET inside an argB */	223	#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 3))
161	#define MULT_RET 255 /* (<=MAXARG_B) */	224	#define testOpMode(m, b) (luaP_opmodes[m] & (1 << (b)))
162	#if MULT_RET>MAXARG_B	225
163	#undef MULT_RET	226
164	#define MULT_RET MAXARG_B	227	#ifdef LUA_OPNAMES
		228	extern const char const luaP_opnames[]; / opcode names */
165	#endif	229	#endif
166		230
167		231
		232
		233	/* number of list items to accumulate before a SETLIST instruction */
		234	/* (must be a power of 2) */
		235	#define LFIELDS_PER_FLUSH 32
		236
		237
168	#endif	238	#endif

src/lparser.c+787−582

@@ -1,16 +1,18 @@
1	/*	1	/*
2	** $Id: lparser.c,v 1.117 2000/11/29 11:57:42 roberto Exp $	2	** $Id: lparser.c,v 1.208 2003/04/03 13:35:34 roberto Exp $
3	** LL(1) Parser and code generator for Lua	3	** Lua Parser
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <stdio.h>
9	#include <string.h>	8	#include <string.h>
10		9
		10	#define lparser_c
		11
11	#include "lua.h"	12	#include "lua.h"
12		13
13	#include "lcode.h"	14	#include "lcode.h"
		15	#include "ldebug.h"
14	#include "lfunc.h"	16	#include "lfunc.h"
15	#include "llex.h"	17	#include "llex.h"
16	#include "lmem.h"	18	#include "lmem.h"
@@ -21,35 +23,34 @@ · 4 unmodified lines
21	#include "lstring.h"	23	#include "lstring.h"
22		24
23		25
24	/*
25	** Constructors descriptor:
26	** `n' indicates number of elements, and `k' signals whether
27	** it is a list constructor (k = 0) or a record constructor (k = 1)
28	** or empty (k = ';' or '}')
29	*/
30	typedef struct Constdesc {
31	int n;
32	int k;
33	} Constdesc;
34		26
35		27
36	typedef struct Breaklabel {	28	#define getlocvar(fs, i) ((fs)->f->locvars[(fs)->actvar[i]])
37	struct Breaklabel previous; / chain */	29
38	int breaklist;	30
39	int stacklevel;	31	#define enterlevel(ls) if (++(ls)->nestlevel > LUA_MAXPARSERLEVEL) \
40	} Breaklabel;	32	luaX_syntaxerror(ls, "too many syntax levels");
		33	#define leavelevel(ls) ((ls)->nestlevel--)
41		34
42		35
		36	/*
		37	** nodes for block list (list of active blocks)
		38	*/
		39	typedef struct BlockCnt {
		40	struct BlockCnt previous; / chain */
		41	int breaklist; /* list of jumps out of this loop */
		42	int nactvar; /* # active local variables outside the breakable structure */
		43	int upval; /* true if some variable in the block is an upvalue */
		44	int isbreakable; /* true if `block' is a loop */
		45	} BlockCnt;
		46
43		47
44		48
45	/*	49	/*
46	** prototypes for recursive non-terminal functions	50	** prototypes for recursive non-terminal functions
47	*/	51	*/
48	static void body (LexState *ls, int needself, int line);
49	static void chunk (LexState *ls);	52	static void chunk (LexState *ls);
50	static void constructor (LexState *ls);
51	static void expr (LexState ls, expdesc v);	53	static void expr (LexState ls, expdesc v);
52	static void exp1 (LexState *ls);
53		54
54		55
55		56
@@ -65,32 +66,18 @@ static void next (LexState *ls) { · 9 unmodified lines
65		66
66		67
67	static void lookahead (LexState *ls) {	68	static void lookahead (LexState *ls) {
68	LUA_ASSERT(ls->lookahead.token == TK_EOS, "two look-aheads");	69	lua_assert(ls->lookahead.token == TK_EOS);
69	ls->lookahead.token = luaX_lex(ls, &ls->lookahead.seminfo);	70	ls->lookahead.token = luaX_lex(ls, &ls->lookahead.seminfo);
70	}	71	}
71		72
72		73
73	static void error_expected (LexState *ls, int token) {	74	static void error_expected (LexState *ls, int token) {
74	char buff[100], t[TOKEN_LEN];	75	luaX_syntaxerror(ls,
75	luaX_token2str(token, t);	76	luaO_pushfstring(ls->L, "`%s' expected", luaX_token2str(ls, token)));
76	sprintf(buff, "`%.20s' expected", t);
77	luaK_error(ls, buff);
78	}	77	}
79		78
80		79
81	static void check (LexState *ls, int c) {	80	static int testnext (LexState *ls, int c) {
82	if (ls->t.token != c)
83	error_expected(ls, c);
84	next(ls);
85	}
86
87
88	static void check_condition (LexState ls, int c, const char msg) {
89	if (!c) luaK_error(ls, msg);
90	}
91
92
93	static int optional (LexState *ls, int c) {
94	if (ls->t.token == c) {	81	if (ls->t.token == c) {
95	next(ls);	82	next(ls);
96	return 1;	83	return 1;
@@ -99,40 +86,26 @@ static int optional (LexState *ls, int c) { · 2 unmodified lines
99	}	86	}
100		87
101		88
		89	static void check (LexState *ls, int c) {
		90	if (!testnext(ls, c))
		91	error_expected(ls, c);
		92	}
		93
		94
		95	#define check_condition(ls,c,msg) { if (!(c)) luaX_syntaxerror(ls, msg); }
		96
		97
		98
102	static void check_match (LexState *ls, int what, int who, int where) {	99	static void check_match (LexState *ls, int what, int who, int where) {
103	if (ls->t.token != what) {	100	if (!testnext(ls, what)) {
104	if (where == ls->linenumber)	101	if (where == ls->linenumber)
105	error_expected(ls, what);	102	error_expected(ls, what);
106	else {	103	else {
107	char buff[100];	104	luaX_syntaxerror(ls, luaO_pushfstring(ls->L,
108	char t_what[TOKEN_LEN], t_who[TOKEN_LEN];	105	"`%s' expected (to close `%s' at line %d)",
109	luaX_token2str(what, t_what);	106	luaX_token2str(ls, what), luaX_token2str(ls, who), where));
110	luaX_token2str(who, t_who);
111	sprintf(buff, "`%.20s' expected (to close `%.20s' at line %d)",
112	t_what, t_who, where);
113	luaK_error(ls, buff);
114	}	107	}
115	}	108	}
116	next(ls);
117	}
118
119
120	static int string_constant (FuncState fs, TString s) {
121	Proto *f = fs->f;
122	int c = s->u.s.constindex;
123	if (c >= f->nkstr \|\| f->kstr[c] != s) {
124	luaM_growvector(fs->L, f->kstr, f->nkstr, 1, TString *,
125	"constant table overflow", MAXARG_U);
126	c = f->nkstr++;
127	f->kstr[c] = s;
128	s->u.s.constindex = c; /* hint for next time */
129	}
130	return c;
131	}
132
133
134	static void code_string (LexState ls, TString s) {
135	luaK_kstr(ls, string_constant(ls->fs, s));
136	}	109	}
137		110
138		111
@@ -145,182 +118,224 @@ static TString str_checkname (LexState ls) { · 6 unmodified lines
145	}	118	}
146		119
147		120
148	static int checkname (LexState *ls) {	121	static void init_exp (expdesc *e, expkind k, int i) {
149	return string_constant(ls->fs, str_checkname(ls));	122	e->f = e->t = NO_JUMP;
		123	e->k = k;
		124	e->info = i;
		125	}
		126
		127
		128	static void codestring (LexState ls, expdesc e, TString *s) {
		129	init_exp(e, VK, luaK_stringK(ls->fs, s));
		130	}
		131
		132
		133	static void checkname(LexState ls, expdesc e) {
		134	codestring(ls, e, str_checkname(ls));
150	}	135	}
151		136
152		137
153	static int luaI_registerlocalvar (LexState ls, TString varname) {	138	static int luaI_registerlocalvar (LexState ls, TString varname) {
154	Proto *f = ls->fs->f;	139	FuncState *fs = ls->fs;
155	luaM_growvector(ls->L, f->locvars, f->nlocvars, 1, LocVar, "", MAX_INT);	140	Proto *f = fs->f;
156	f->locvars[f->nlocvars].varname = varname;	141	luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars,
157	return f->nlocvars++;	142	LocVar, MAX_INT, "");
		143	f->locvars[fs->nlocvars].varname = varname;
		144	return fs->nlocvars++;
158	}	145	}
159		146
160		147
161	static void new_localvar (LexState ls, TString name, int n) {	148	static void new_localvar (LexState ls, TString name, int n) {
162	FuncState *fs = ls->fs;	149	FuncState *fs = ls->fs;
163	luaX_checklimit(ls, fs->nactloc+n+1, MAXLOCALS, "local variables");	150	luaX_checklimit(ls, fs->nactvar+n+1, MAXVARS, "local variables");
164	fs->actloc[fs->nactloc+n] = luaI_registerlocalvar(ls, name);	151	fs->actvar[fs->nactvar+n] = luaI_registerlocalvar(ls, name);
165	}	152	}
166		153
167		154
168	static void adjustlocalvars (LexState *ls, int nvars) {	155	static void adjustlocalvars (LexState *ls, int nvars) {
169	FuncState *fs = ls->fs;	156	FuncState *fs = ls->fs;
170	while (nvars--)	157	fs->nactvar += nvars;
171	fs->f->locvars[fs->actloc[fs->nactloc++]].startpc = fs->pc;	158	for (; nvars; nvars--) {
		159	getlocvar(fs, fs->nactvar - nvars).startpc = fs->pc;
		160	}
172	}	161	}
173		162
174		163
175	static void removelocalvars (LexState *ls, int nvars) {	164	static void removevars (LexState *ls, int tolevel) {
176	FuncState *fs = ls->fs;	165	FuncState *fs = ls->fs;
177	while (nvars--)	166	while (fs->nactvar > tolevel)
178	fs->f->locvars[fs->actloc[--fs->nactloc]].endpc = fs->pc;	167	getlocvar(fs, --fs->nactvar).endpc = fs->pc;
179	}	168	}
180		169
181		170
182	static void new_localvarstr (LexState ls, const char name, int n) {	171	static void new_localvarstr (LexState ls, const char name, int n) {
183	new_localvar(ls, luaS_newfixed(ls->L, name), n);	172	new_localvar(ls, luaS_new(ls->L, name), n);
184	}	173	}
185		174
186		175
187	static int search_local (LexState ls, TString n, expdesc *var) {	176	static void create_local (LexState ls, const char name) {
188	FuncState *fs;	177	new_localvarstr(ls, name, 0);
189	int level = 0;	178	adjustlocalvars(ls, 1);
190	for (fs=ls->fs; fs; fs=fs->prev) {
191	int i;
192	for (i=fs->nactloc-1; i >= 0; i--) {
193	if (n == fs->f->locvars[fs->actloc[i]].varname) {
194	var->k = VLOCAL;
195	var->u.index = i;
196	return level;
197	}
198	}
199	level++; /* `var' not found; check outer level */
200	}
201	var->k = VGLOBAL; /* not found in any level; must be global */
202	return -1;
203	}	179	}
204		180
205		181
206	static void singlevar (LexState ls, TString n, expdesc *var) {	182	static int indexupvalue (FuncState fs, TString name, expdesc *v) {
207	int level = search_local(ls, n, var);	183	int i;
208	if (level >= 1) /* neither local (0) nor global (-1)? */	184	Proto *f = fs->f;
209	luaX_syntaxerror(ls, "cannot access a variable in outer scope", n->str);	185	for (i=0; i<f->nups; i++) {
210	else if (level == -1) /* global? */	186	if (fs->upvalues[i].k == v->k && fs->upvalues[i].info == v->info) {
211	var->u.index = string_constant(ls->fs, n);	187	lua_assert(fs->f->upvalues[i] == name);
		188	return i;
		189	}
		190	}
		191	/* new one */
		192	luaX_checklimit(fs->ls, f->nups + 1, MAXUPVALUES, "upvalues");
		193	luaM_growvector(fs->L, fs->f->upvalues, f->nups, fs->f->sizeupvalues,
		194	TString *, MAX_INT, "");
		195	fs->f->upvalues[f->nups] = name;
		196	fs->upvalues[f->nups] = *v;
		197	return f->nups++;
212	}	198	}
213		199
214		200
215	static int indexupvalue (LexState ls, expdesc v) {	201	static int searchvar (FuncState fs, TString n) {
216	FuncState *fs = ls->fs;
217	int i;	202	int i;
218	for (i=0; i<fs->nupvalues; i++) {	203	for (i=fs->nactvar-1; i >= 0; i--) {
219	if (fs->upvalues[i].k == v->k && fs->upvalues[i].u.index == v->u.index)	204	if (n == getlocvar(fs, i).varname)
220	return i;	205	return i;
221	}	206	}
222	/* new one */	207	return -1; /* not found */
223	luaX_checklimit(ls, fs->nupvalues+1, MAXUPVALUES, "upvalues");
224	fs->upvalues[fs->nupvalues] = *v;
225	return fs->nupvalues++;
226	}	208	}
227		209
228		210
229	static void pushupvalue (LexState ls, TString n) {	211	static void markupval (FuncState *fs, int level) {
230	FuncState *fs = ls->fs;	212	BlockCnt *bl = fs->bl;
231	expdesc v;	213	while (bl && bl->nactvar > level) bl = bl->previous;
232	int level = search_local(ls, n, &v);	214	if (bl) bl->upval = 1;
233	if (level == -1) { /* global? */	215	}
234	if (fs->prev == NULL)	216
235	luaX_syntaxerror(ls, "cannot access upvalue in main", n->str);	217
236	v.u.index = string_constant(fs->prev, n);	218	static void singlevaraux (FuncState fs, TString n, expdesc *var, int base) {
		219	if (fs == NULL) /* no more levels? */
		220	init_exp(var, VGLOBAL, NO_REG); /* default is global variable */
		221	else {
		222	int v = searchvar(fs, n); /* look up at current level */
		223	if (v >= 0) {
		224	init_exp(var, VLOCAL, v);
		225	if (!base)
		226	markupval(fs, v); /* local will be used as an upval */
		227	}
		228	else { /* not found at current level; try upper one */
		229	singlevaraux(fs->prev, n, var, 0);
		230	if (var->k == VGLOBAL) {
		231	if (base)
		232	var->info = luaK_stringK(fs, n); /* info points to global name */
		233	}
		234	else { /* LOCAL or UPVAL */
		235	var->info = indexupvalue(fs, n, var);
		236	var->k = VUPVAL; /* upvalue in this level */
		237	}
		238	}
237	}	239	}
238	else if (level != 1)
239	luaX_syntaxerror(ls,
240	"upvalue must be global or local to immediately outer scope", n->str);
241	luaK_code1(fs, OP_PUSHUPVALUE, indexupvalue(ls, &v));
242	}	240	}
243		241
244		242
245	static void adjust_mult_assign (LexState *ls, int nvars, int nexps) {	243	static TString singlevar (LexState ls, expdesc *var, int base) {
		244	TString *varname = str_checkname(ls);
		245	singlevaraux(ls->fs, varname, var, base);
		246	return varname;
		247	}
		248
		249
		250	static void adjust_assign (LexState ls, int nvars, int nexps, expdesc e) {
246	FuncState *fs = ls->fs;	251	FuncState *fs = ls->fs;
247	int diff = nexps - nvars;	252	int extra = nvars - nexps;
248	if (nexps > 0 && luaK_lastisopen(fs)) { /* list ends in a function call */	253	if (e->k == VCALL) {
249	diff--; /* do not count function call itself */	254	extra++; /* includes call itself */
250	if (diff <= 0) { /* more variables than values? */	255	if (extra <= 0) extra = 0;
251	luaK_setcallreturns(fs, -diff); /* function call provide extra values */	256	else luaK_reserveregs(fs, extra-1);
252	diff = 0; /* no more difference */	257	luaK_setcallreturns(fs, e, extra); /* call provides the difference */
		258	}
		259	else {
		260	if (e->k != VVOID) luaK_exp2nextreg(fs, e); /* close last expression */
		261	if (extra > 0) {
		262	int reg = fs->freereg;
		263	luaK_reserveregs(fs, extra);
		264	luaK_nil(fs, reg, extra);
253	}	265	}
254	else /* more values than variables */
255	luaK_setcallreturns(fs, 0); /* call should provide no value */
256	}	266	}
257	/* push or pop eventual difference between list lengths */
258	luaK_adjuststack(fs, diff);
259	}	267	}
260		268
261		269
262	static void code_params (LexState *ls, int nparams, int dots) {	270	static void code_params (LexState *ls, int nparams, int dots) {
263	FuncState *fs = ls->fs;	271	FuncState *fs = ls->fs;
264	adjustlocalvars(ls, nparams);	272	adjustlocalvars(ls, nparams);
265	luaX_checklimit(ls, fs->nactloc, MAXPARAMS, "parameters");	273	luaX_checklimit(ls, fs->nactvar, MAXPARAMS, "parameters");
266	fs->f->numparams = fs->nactloc; /* `self' could be there already */	274	fs->f->numparams = cast(lu_byte, fs->nactvar);
267	fs->f->is_vararg = dots;	275	fs->f->is_vararg = cast(lu_byte, dots);
268	if (dots) {	276	if (dots)
269	new_localvarstr(ls, "arg", 0);	277	create_local(ls, "arg");
270	adjustlocalvars(ls, 1);	278	luaK_reserveregs(fs, fs->nactvar); /* reserve register for parameters */
271	}
272	luaK_deltastack(fs, fs->nactloc); /* count parameters in the stack */
273	}	279	}
274		280
275		281
276	static void enterbreak (FuncState fs, Breaklabel bl) {	282	static void enterblock (FuncState fs, BlockCnt bl, int isbreakable) {
277	bl->stacklevel = fs->stacklevel;
278	bl->breaklist = NO_JUMP;	283	bl->breaklist = NO_JUMP;
		284	bl->isbreakable = isbreakable;
		285	bl->nactvar = fs->nactvar;
		286	bl->upval = 0;
279	bl->previous = fs->bl;	287	bl->previous = fs->bl;
280	fs->bl = bl;	288	fs->bl = bl;
		289	lua_assert(fs->freereg == fs->nactvar);
281	}	290	}
282		291
283		292
284	static void leavebreak (FuncState fs, Breaklabel bl) {	293	static void leaveblock (FuncState *fs) {
		294	BlockCnt *bl = fs->bl;
285	fs->bl = bl->previous;	295	fs->bl = bl->previous;
286	LUA_ASSERT(bl->stacklevel == fs->stacklevel, "wrong levels");	296	removevars(fs->ls, bl->nactvar);
287	luaK_patchlist(fs, bl->breaklist, luaK_getlabel(fs));	297	if (bl->upval)
		298	luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0);
		299	lua_assert(bl->nactvar == fs->nactvar);
		300	fs->freereg = fs->nactvar; /* free registers */
		301	luaK_patchtohere(fs, bl->breaklist);
288	}	302	}
289		303
290		304
291	static void pushclosure (LexState ls, FuncState func) {	305	static void pushclosure (LexState ls, FuncState func, expdesc *v) {
292	FuncState *fs = ls->fs;	306	FuncState *fs = ls->fs;
293	Proto *f = fs->f;	307	Proto *f = fs->f;
294	int i;	308	int i;
295	for (i=0; i<func->nupvalues; i++)	309	luaM_growvector(ls->L, f->p, fs->np, f->sizep, Proto *,
296	luaK_tostack(ls, &func->upvalues[i], 1);	310	MAXARG_Bx, "constant table overflow");
297	luaM_growvector(ls->L, f->kproto, f->nkproto, 1, Proto *,	311	f->p[fs->np++] = func->f;
298	"constant table overflow", MAXARG_A);	312	init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np-1));
299	f->kproto[f->nkproto++] = func->f;	313	for (i=0; i<func->f->nups; i++) {
300	luaK_code2(fs, OP_CLOSURE, f->nkproto-1, func->nupvalues);	314	OpCode o = (func->upvalues[i].k == VLOCAL) ? OP_MOVE : OP_GETUPVAL;
		315	luaK_codeABC(fs, o, 0, func->upvalues[i].info, 0);
		316	}
301	}	317	}
302		318
303		319
304	static void open_func (LexState ls, FuncState fs) {	320	static void open_func (LexState ls, FuncState fs) {
305	Proto *f = luaF_newproto(ls->L);	321	Proto *f = luaF_newproto(ls->L);
		322	fs->f = f;
306	fs->prev = ls->fs; /* linked list of funcstates */	323	fs->prev = ls->fs; /* linked list of funcstates */
307	fs->ls = ls;	324	fs->ls = ls;
308	fs->L = ls->L;	325	fs->L = ls->L;
309	ls->fs = fs;	326	ls->fs = fs;
310	fs->stacklevel = 0;
311	fs->nactloc = 0;
312	fs->nupvalues = 0;
313	fs->bl = NULL;
314	fs->f = f;
315	f->source = ls->source;
316	fs->pc = 0;	327	fs->pc = 0;
317	fs->lasttarget = 0;	328	fs->lasttarget = 0;
318	fs->lastline = 0;	329	fs->jpc = NO_JUMP;
319	fs->jlt = NO_JUMP;	330	fs->freereg = 0;
320	f->code = NULL;	331	fs->nk = 0;
321	f->maxstacksize = 0;	332	fs->h = luaH_new(ls->L, 0, 0);
322	f->numparams = 0; /* default for main chunk */	333	fs->np = 0;
323	f->is_vararg = 0; /* default for main chunk */	334	fs->nlocvars = 0;
		335	fs->nactvar = 0;
		336	fs->bl = NULL;
		337	f->source = ls->source;
		338	f->maxstacksize = 2; /* registers 0/1 are always valid */
324	}	339	}
325		340
326		341
@@ -328,33 +343,40 @@ static void close_func (LexState *ls) { · 1 unmodified line
328	lua_State *L = ls->L;	343	lua_State *L = ls->L;
329	FuncState *fs = ls->fs;	344	FuncState *fs = ls->fs;
330	Proto *f = fs->f;	345	Proto *f = fs->f;
331	luaK_code0(fs, OP_END);	346	removevars(ls, 0);
332	luaK_getlabel(fs); /* close eventual list of pending jumps */	347	luaK_codeABC(fs, OP_RETURN, 0, 1, 0); /* final return */
333	luaM_reallocvector(L, f->code, fs->pc, Instruction);	348	luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction);
334	luaM_reallocvector(L, f->kstr, f->nkstr, TString *);	349	f->sizecode = fs->pc;
335	luaM_reallocvector(L, f->knum, f->nknum, Number);	350	luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int);
336	luaM_reallocvector(L, f->kproto, f->nkproto, Proto *);	351	f->sizelineinfo = fs->pc;
337	removelocalvars(ls, fs->nactloc);	352	luaM_reallocvector(L, f->k, f->sizek, fs->nk, TObject);
338	luaM_reallocvector(L, f->locvars, f->nlocvars, LocVar);	353	f->sizek = fs->nk;
339	luaM_reallocvector(L, f->lineinfo, f->nlineinfo+1, int);	354	luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *);
340	f->lineinfo[f->nlineinfo++] = MAX_INT; /* end flag */	355	f->sizep = fs->np;
341	luaF_protook(L, f, fs->pc); /* proto is ok now */	356	luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar);
		357	f->sizelocvars = fs->nlocvars;
		358	luaM_reallocvector(L, f->upvalues, f->sizeupvalues, f->nups, TString *);
		359	f->sizeupvalues = f->nups;
		360	lua_assert(luaG_checkcode(f));
		361	lua_assert(fs->bl == NULL);
342	ls->fs = fs->prev;	362	ls->fs = fs->prev;
343	LUA_ASSERT(fs->bl == NULL, "wrong list end");
344	}	363	}
345		364
346		365
347	Proto luaY_parser (lua_State L, ZIO *z) {	366	Proto luaY_parser (lua_State L, ZIO z, Mbuffer buff) {
348	struct LexState lexstate;	367	struct LexState lexstate;
349	struct FuncState funcstate;	368	struct FuncState funcstate;
		369	lexstate.buff = buff;
		370	lexstate.nestlevel = 0;
350	luaX_setinput(L, &lexstate, z, luaS_new(L, zname(z)));	371	luaX_setinput(L, &lexstate, z, luaS_new(L, zname(z)));
351	open_func(&lexstate, &funcstate);	372	open_func(&lexstate, &funcstate);
352	next(&lexstate); /* read first token */	373	next(&lexstate); /* read first token */
353	chunk(&lexstate);	374	chunk(&lexstate);
354	check_condition(&lexstate, (lexstate.t.token == TK_EOS), "<eof> expected");	375	check_condition(&lexstate, (lexstate.t.token == TK_EOS), "<eof> expected");
355	close_func(&lexstate);	376	close_func(&lexstate);
356	LUA_ASSERT(funcstate.prev == NULL, "wrong list end");	377	lua_assert(funcstate.prev == NULL);
357	LUA_ASSERT(funcstate.nupvalues == 0, "no upvalues in main");	378	lua_assert(funcstate.f->nups == 0);
		379	lua_assert(lexstate.nestlevel == 0);
358	return funcstate.f;	380	return funcstate.f;
359	}	381	}
360		382
@@ -365,235 +387,239 @@ Proto luaY_parser (lua_State L, ZIO *z) { · 4 unmodified lines
365	/============================================================/	387	/============================================================/
366		388
367		389
368	static int explist1 (LexState *ls) {	390	static void luaY_field (LexState ls, expdesc v) {
369	/* explist1 -> expr { ',' expr } */	391	/* field -> ['.' \| ':'] NAME */
370	int n = 1; /* at least one expression */	392	FuncState *fs = ls->fs;
371	expdesc v;	393	expdesc key;
372	expr(ls, &v);	394	luaK_exp2anyreg(fs, v);
373	while (ls->t.token == ',') {	395	next(ls); /* skip the dot or colon */
374	luaK_tostack(ls, &v, 1); /* gets only 1 value from previous expression */	396	checkname(ls, &key);
375	next(ls); /* skip comma */	397	luaK_indexed(fs, v, &key);
376	expr(ls, &v);
377	n++;
378	}
379	luaK_tostack(ls, &v, 0); /* keep open number of values of last expression */
380	return n;
381	}	398	}
382		399
383		400
384	static void funcargs (LexState *ls, int slf) {	401	static void luaY_index (LexState ls, expdesc v) {
		402	/* index -> '[' expr ']' */
		403	next(ls); /* skip the '[' */
		404	expr(ls, v);
		405	luaK_exp2val(ls->fs, v);
		406	check(ls, ']');
		407	}
		408
		409
		410	/*
		411	** {======================================================================
		412	** Rules for Constructors
		413	** =======================================================================
		414	*/
		415
		416
		417	struct ConsControl {
		418	expdesc v; /* last list item read */
		419	expdesc t; / table descriptor */
		420	int nh; /* total number of `record' elements */
		421	int na; /* total number of array elements */
		422	int tostore; /* number of array elements pending to be stored */
		423	};
		424
		425
		426	static void recfield (LexState ls, struct ConsControl cc) {
		427	/* recfield -> (NAME \| `['exp1`]') = exp1 */
385	FuncState *fs = ls->fs;	428	FuncState *fs = ls->fs;
386	int slevel = fs->stacklevel - slf - 1; /* where is func in the stack */	429	int reg = ls->fs->freereg;
387	switch (ls->t.token) {	430	expdesc key, val;
388	case '(': { /* funcargs -> '(' [ explist1 ] ')' */	431	if (ls->t.token == TK_NAME) {
389	int line = ls->linenumber;	432	luaX_checklimit(ls, cc->nh, MAX_INT, "items in a constructor");
390	int nargs = 0;	433	cc->nh++;
391	next(ls);	434	checkname(ls, &key);
392	if (ls->t.token != ')') /* arg list not empty? */	435	}
393	nargs = explist1(ls);	436	else /* ls->t.token == '[' */
394	check_match(ls, ')', '(', line);	437	luaY_index(ls, &key);
395	#ifdef LUA_COMPAT_ARGRET	438	check(ls, '=');
396	if (nargs > 0) /* arg list is not empty? */	439	luaK_exp2RK(fs, &key);
397	luaK_setcallreturns(fs, 1); /* last call returns only 1 value */	440	expr(ls, &val);
398	#else	441	luaK_codeABC(fs, OP_SETTABLE, cc->t->info, luaK_exp2RK(fs, &key),
399	UNUSED(nargs); /* to avoid warnings */	442	luaK_exp2RK(fs, &val));
400	#endif	443	fs->freereg = reg; /* free registers */
401	break;	444	}
402	}	445
403	case '{': { /* funcargs -> constructor */	446
404	constructor(ls);	447	static void closelistfield (FuncState fs, struct ConsControl cc) {
405	break;	448	if (cc->v.k == VVOID) return; /* there is no list item */
406	}	449	luaK_exp2nextreg(fs, &cc->v);
407	case TK_STRING: { /* funcargs -> STRING */	450	cc->v.k = VVOID;
408	code_string(ls, ls->t.seminfo.ts); /* must use `seminfo' before `next' */	451	if (cc->tostore == LFIELDS_PER_FLUSH) {
409	next(ls);	452	luaK_codeABx(fs, OP_SETLIST, cc->t->info, cc->na-1); /* flush */
410	break;	453	cc->tostore = 0; /* no more items pending */
411	}	454	fs->freereg = cc->t->info + 1; /* free registers */
412	default: {
413	luaK_error(ls, "function arguments expected");
414	break;
415	}
416	}	455	}
417	fs->stacklevel = slevel; /* call will remove function and arguments */
418	luaK_code2(fs, OP_CALL, slevel, MULT_RET);
419	}	456	}
420		457
421		458
422	static void var_or_func_tail (LexState ls, expdesc v) {	459	static void lastlistfield (FuncState fs, struct ConsControl cc) {
423	for (;;) {	460	if (cc->tostore == 0) return;
424	switch (ls->t.token) {	461	if (cc->v.k == VCALL) {
425	case '.': { /* var_or_func_tail -> '.' NAME */	462	luaK_setcallreturns(fs, &cc->v, LUA_MULTRET);
426	next(ls);	463	luaK_codeABx(fs, OP_SETLISTO, cc->t->info, cc->na-1);
427	luaK_tostack(ls, v, 1); /* `v' must be on stack */	464	}
428	luaK_kstr(ls, checkname(ls));	465	else {
429	v->k = VINDEXED;	466	if (cc->v.k != VVOID)
430	break;	467	luaK_exp2nextreg(fs, &cc->v);
431	}	468	luaK_codeABx(fs, OP_SETLIST, cc->t->info, cc->na-1);
432	case '[': { /* var_or_func_tail -> '[' exp1 ']' */	469	}
433	next(ls);	470	fs->freereg = cc->t->info + 1; /* free registers */
434	luaK_tostack(ls, v, 1); /* `v' must be on stack */	471	}
435	v->k = VINDEXED;	472
436	exp1(ls);	473
437	check(ls, ']');	474	static void listfield (LexState ls, struct ConsControl cc) {
		475	expr(ls, &cc->v);
		476	luaX_checklimit(ls, cc->na, MAXARG_Bx, "items in a constructor");
		477	cc->na++;
		478	cc->tostore++;
		479	}
		480
		481
		482	static void constructor (LexState ls, expdesc t) {
		483	/* constructor -> ?? */
		484	FuncState *fs = ls->fs;
		485	int line = ls->linenumber;
		486	int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0);
		487	struct ConsControl cc;
		488	cc.na = cc.nh = cc.tostore = 0;
		489	cc.t = t;
		490	init_exp(t, VRELOCABLE, pc);
		491	init_exp(&cc.v, VVOID, 0); /* no value (yet) */
		492	luaK_exp2nextreg(ls->fs, t); /* fix it at stack top (for gc) */
		493	check(ls, '{');
		494	do {
		495	lua_assert(cc.v.k == VVOID \|\| cc.tostore > 0);
		496	testnext(ls, ';'); /* compatibility only */
		497	if (ls->t.token == '}') break;
		498	closelistfield(fs, &cc);
		499	switch(ls->t.token) {
		500	case TK_NAME: { /* may be listfields or recfields */
		501	lookahead(ls);
		502	if (ls->lookahead.token != '=') /* expression? */
		503	listfield(ls, &cc);
		504	else
		505	recfield(ls, &cc);
438	break;	506	break;
439	}	507	}
440	case ':': { /* var_or_func_tail -> ':' NAME funcargs */	508	case '[': { /* constructor_item -> recfield */
441	int name;	509	recfield(ls, &cc);
442	next(ls);
443	name = checkname(ls);
444	luaK_tostack(ls, v, 1); /* `v' must be on stack */
445	luaK_code1(ls->fs, OP_PUSHSELF, name);
446	funcargs(ls, 1);
447	v->k = VEXP;
448	v->u.l.t = v->u.l.f = NO_JUMP;
449	break;	510	break;
450	}	511	}
451	case '(': case TK_STRING: case '{': { /* var_or_func_tail -> funcargs */	512	default: { /* constructor_part -> listfield */
452	luaK_tostack(ls, v, 1); /* `v' must be on stack */	513	listfield(ls, &cc);
453	funcargs(ls, 0);
454	v->k = VEXP;
455	v->u.l.t = v->u.l.f = NO_JUMP;
456	break;	514	break;
457	}	515	}
458	default: return; /* should be follow... */
459	}	516	}
460	}	517	} while (testnext(ls, ',') \|\| testnext(ls, ';'));
461	}	518	check_match(ls, '}', '{', line);
462		519	lastlistfield(fs, &cc);
463		520	SETARG_B(fs->f->code[pc], luaO_int2fb(cc.na)); /* set initial array size */
464	static void var_or_func (LexState ls, expdesc v) {	521	SETARG_C(fs->f->code[pc], luaO_log2(cc.nh)+1); /* set initial table size */
465	/* var_or_func -> ['%'] NAME var_or_func_tail */
466	if (optional(ls, '%')) { /* upvalue? */
467	pushupvalue(ls, str_checkname(ls));
468	v->k = VEXP;
469	v->u.l.t = v->u.l.f = NO_JUMP;
470	}
471	else /* variable name */
472	singlevar(ls, str_checkname(ls), v);
473	var_or_func_tail(ls, v);
474	}	522	}
475		523
		524	/* }====================================================================== */
476		525
477		526
478	/*
479	** {======================================================================
480	** Rules for Constructors
481	** =======================================================================
482	*/
483
484		527
485	static void recfield (LexState *ls) {	528	static void parlist (LexState *ls) {
486	/* recfield -> (NAME \| '['exp1']') = exp1 */	529	/* parlist -> [ param { `,' param } ] */
487	switch (ls->t.token) {	530	int nparams = 0;
488	case TK_NAME: {	531	int dots = 0;
489	luaK_kstr(ls, checkname(ls));	532	if (ls->t.token != ')') { /* is `parlist' not empty? */
490	break;	533	do {
491	}	534	switch (ls->t.token) {
492	case '[': {	535	case TK_DOTS: dots = 1; next(ls); break;
493	next(ls);	536	case TK_NAME: new_localvar(ls, str_checkname(ls), nparams++); break;
494	exp1(ls);	537	default: luaX_syntaxerror(ls, "<name> or `...' expected");
495	check(ls, ']');	538	}
496	break;	539	} while (!dots && testnext(ls, ','));
497	}
498	default: luaK_error(ls, "<name> or `[' expected");
499	}	540	}
500	check(ls, '=');	541	code_params(ls, nparams, dots);
501	exp1(ls);
502	}	542	}
503		543
504		544
505	static int recfields (LexState *ls) {	545	static void body (LexState ls, expdesc e, int needself, int line) {
506	/* recfields -> recfield { ',' recfield } [','] */	546	/* body -> `(' parlist `)' chunk END */
507	FuncState *fs = ls->fs;	547	FuncState new_fs;
508	int n = 1; /* at least one element */	548	open_func(ls, &new_fs);
509	recfield(ls);	549	new_fs.f->lineDefined = line;
510	while (ls->t.token == ',') {	550	check(ls, '(');
511	next(ls);	551	if (needself)
512	if (ls->t.token == ';' \|\| ls->t.token == '}')	552	create_local(ls, "self");
513	break;	553	parlist(ls);
514	recfield(ls);	554	check(ls, ')');
515	n++;	555	chunk(ls);
516	if (n%RFIELDS_PER_FLUSH == 0)	556	check_match(ls, TK_END, TK_FUNCTION, line);
517	luaK_code1(fs, OP_SETMAP, RFIELDS_PER_FLUSH);	557	close_func(ls);
518	}	558	pushclosure(ls, &new_fs, e);
519	luaK_code1(fs, OP_SETMAP, n%RFIELDS_PER_FLUSH);
520	return n;
521	}	559	}
522		560
523		561
524	static int listfields (LexState *ls) {	562	static int explist1 (LexState ls, expdesc v) {
525	/* listfields -> exp1 { ',' exp1 } [','] */	563	/* explist1 -> expr { `,' expr } */
526	FuncState *fs = ls->fs;	564	int n = 1; /* at least one expression */
527	int n = 1; /* at least one element */	565	expr(ls, v);
528	exp1(ls);	566	while (testnext(ls, ',')) {
529	while (ls->t.token == ',') {	567	luaK_exp2nextreg(ls->fs, v);
530	next(ls);	568	expr(ls, v);
531	if (ls->t.token == ';' \|\| ls->t.token == '}')
532	break;
533	exp1(ls);
534	n++;	569	n++;
535	luaX_checklimit(ls, n/LFIELDS_PER_FLUSH, MAXARG_A,
536	"`item groups' in a list initializer");
537	if (n%LFIELDS_PER_FLUSH == 0)
538	luaK_code2(fs, OP_SETLIST, n/LFIELDS_PER_FLUSH - 1, LFIELDS_PER_FLUSH);
539	}	570	}
540	luaK_code2(fs, OP_SETLIST, n/LFIELDS_PER_FLUSH, n%LFIELDS_PER_FLUSH);
541	return n;	571	return n;
542	}	572	}
543		573
544		574
545		575	static void funcargs (LexState ls, expdesc f) {
546	static void constructor_part (LexState ls, Constdesc cd) {	576	FuncState *fs = ls->fs;
		577	expdesc args;
		578	int base, nparams;
		579	int line = ls->linenumber;
547	switch (ls->t.token) {	580	switch (ls->t.token) {
548	case ';': case '}': { /* constructor_part -> empty */	581	case '(': { /* funcargs -> `(' [ explist1 ] `)' */
549	cd->n = 0;	582	if (line != ls->lastline)
550	cd->k = ls->t.token;	583	luaX_syntaxerror(ls,"ambiguous syntax (function call x new statement)");
		584	next(ls);
		585	if (ls->t.token == ')') /* arg list is empty? */
		586	args.k = VVOID;
		587	else {
		588	explist1(ls, &args);
		589	luaK_setcallreturns(fs, &args, LUA_MULTRET);
		590	}
		591	check_match(ls, ')', '(', line);
551	break;	592	break;
552	}	593	}
553	case TK_NAME: { /* may be listfields or recfields */	594	case '{': { /* funcargs -> constructor */
554	lookahead(ls);	595	constructor(ls, &args);
555	if (ls->lookahead.token != '=') /* expression? */
556	goto case_default;
557	/* else go through to recfields */
558	}
559	case '[': { /* constructor_part -> recfields */
560	cd->n = recfields(ls);
561	cd->k = 1; /* record */
562	break;	596	break;
563	}	597	}
564	default: { /* constructor_part -> listfields */	598	case TK_STRING: { /* funcargs -> STRING */
565	case_default:	599	codestring(ls, &args, ls->t.seminfo.ts);
566	cd->n = listfields(ls);	600	next(ls); /* must use `seminfo' before `next' */
567	cd->k = 0; /* list */
568	break;	601	break;
569	}	602	}
		603	default: {
		604	luaX_syntaxerror(ls, "function arguments expected");
		605	return;
		606	}
570	}	607	}
571	}	608	lua_assert(f->k == VNONRELOC);
572		609	base = f->info; /* base register for call */
573		610	if (args.k == VCALL)
574	static void constructor (LexState *ls) {	611	nparams = LUA_MULTRET; /* open call */
575	/* constructor -> '{' constructor_part [';' constructor_part] '}' */	612	else {
576	FuncState *fs = ls->fs;	613	if (args.k != VVOID)
577	int line = ls->linenumber;	614	luaK_exp2nextreg(fs, &args); /* close last argument */
578	int pc = luaK_code1(fs, OP_CREATETABLE, 0);	615	nparams = fs->freereg - (base+1);
579	int nelems;
580	Constdesc cd;
581	check(ls, '{');
582	constructor_part(ls, &cd);
583	nelems = cd.n;
584	if (optional(ls, ';')) {
585	Constdesc other_cd;
586	constructor_part(ls, &other_cd);
587	check_condition(ls, (cd.k != other_cd.k), "invalid constructor syntax");
588	nelems += other_cd.n;
589	}	616	}
590	check_match(ls, '}', '{', line);	617	init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2));
591	luaX_checklimit(ls, nelems, MAXARG_U, "elements in a table constructor");	618	luaK_fixline(fs, line);
592	SETARG_U(fs->f->code[pc], nelems); /* set initial table size */	619	fs->freereg = base+1; /* call remove function and arguments and leaves
		620	(unless changed) one result */
593	}	621	}
594		622
595	/* }====================================================================== */
596
597		623
598		624
599		625
@@ -604,58 +630,121 @@ static void constructor (LexState *ls) { · 4 unmodified lines
604	*/	630	*/
605		631
606		632
607	static void simpleexp (LexState ls, expdesc v) {	633	static void prefixexp (LexState ls, expdesc v) {
608	FuncState *fs = ls->fs;	634	/* prefixexp -> NAME \| '(' expr ')' */
609	switch (ls->t.token) {	635	switch (ls->t.token) {
610	case TK_NUMBER: { /* simpleexp -> NUMBER */	636	case '(': {
611	Number r = ls->t.seminfo.r;	637	int line = ls->linenumber;
612	next(ls);	638	next(ls);
613	luaK_number(fs, r);	639	expr(ls, v);
		640	check_match(ls, ')', '(', line);
		641	luaK_dischargevars(ls->fs, v);
		642	return;
		643	}
		644	case TK_NAME: {
		645	singlevar(ls, v, 1);
		646	return;
		647	}
		648	#ifdef LUA_COMPATUPSYNTAX
		649	case '%': { /* for compatibility only */
		650	TString *varname;
		651	int line = ls->linenumber;
		652	next(ls); /* skip `%' */
		653	varname = singlevar(ls, v, 1);
		654	if (v->k != VUPVAL)
		655	luaX_errorline(ls, "global upvalues are obsolete",
		656	getstr(varname), line);
		657	return;
		658	}
		659	#endif
		660	default: {
		661	luaX_syntaxerror(ls, "unexpected symbol");
		662	return;
		663	}
		664	}
		665	}
		666
		667
		668	static void primaryexp (LexState ls, expdesc v) {
		669	/* primaryexp ->
		670	prefixexp { `.' NAME \| `[' exp `]' \| `:' NAME funcargs \| funcargs } */
		671	FuncState *fs = ls->fs;
		672	prefixexp(ls, v);
		673	for (;;) {
		674	switch (ls->t.token) {
		675	case '.': { /* field */
		676	luaY_field(ls, v);
		677	break;
		678	}
		679	case '[': { /* `[' exp1 `]' */
		680	expdesc key;
		681	luaK_exp2anyreg(fs, v);
		682	luaY_index(ls, &key);
		683	luaK_indexed(fs, v, &key);
		684	break;
		685	}
		686	case ':': { /* `:' NAME funcargs */
		687	expdesc key;
		688	next(ls);
		689	checkname(ls, &key);
		690	luaK_self(fs, v, &key);
		691	funcargs(ls, v);
		692	break;
		693	}
		694	case '(': case TK_STRING: case '{': { /* funcargs */
		695	luaK_exp2nextreg(fs, v);
		696	funcargs(ls, v);
		697	break;
		698	}
		699	default: return;
		700	}
		701	}
		702	}
		703
		704
		705	static void simpleexp (LexState ls, expdesc v) {
		706	/* simpleexp -> NUMBER \| STRING \| NIL \| constructor \| FUNCTION body
		707	\| primaryexp */
		708	switch (ls->t.token) {
		709	case TK_NUMBER: {
		710	init_exp(v, VK, luaK_numberK(ls->fs, ls->t.seminfo.r));
		711	next(ls); /* must use `seminfo' before `next' */
614	break;	712	break;
615	}	713	}
616	case TK_STRING: { /* simpleexp -> STRING */	714	case TK_STRING: {
617	code_string(ls, ls->t.seminfo.ts); /* must use `seminfo' before `next' */	715	codestring(ls, v, ls->t.seminfo.ts);
618	next(ls);	716	next(ls); /* must use `seminfo' before `next' */
619	break;	717	break;
620	}	718	}
621	case TK_NIL: { /* simpleexp -> NIL */	719	case TK_NIL: {
622	luaK_adjuststack(fs, -1);	720	init_exp(v, VNIL, 0);
623	next(ls);	721	next(ls);
624	break;	722	break;
625	}	723	}
626	case '{': { /* simpleexp -> constructor */	724	case TK_TRUE: {
627	constructor(ls);	725	init_exp(v, VTRUE, 0);
		726	next(ls);
628	break;	727	break;
629	}	728	}
630	case TK_FUNCTION: { /* simpleexp -> FUNCTION body */	729	case TK_FALSE: {
		730	init_exp(v, VFALSE, 0);
631	next(ls);	731	next(ls);
632	body(ls, 0, ls->linenumber);
633	break;	732	break;
634	}	733	}
635	case '(': { /* simpleexp -> '(' expr ')' */	734	case '{': { /* constructor */
636	next(ls);	735	constructor(ls, v);
637	expr(ls, v);	736	break;
638	check(ls, ')');
639	return;
640	}	737	}
641	case TK_NAME: case '%': {	738	case TK_FUNCTION: {
642	var_or_func(ls, v);	739	next(ls);
643	return;	740	body(ls, v, 0, ls->linenumber);
		741	break;
644	}	742	}
645	default: {	743	default: {
646	luaK_error(ls, "<expression> expected");	744	primaryexp(ls, v);
647	return;	745	break;
648	}	746	}
649	}	747	}
650	v->k = VEXP;
651	v->u.l.t = v->u.l.f = NO_JUMP;
652	}
653
654
655	static void exp1 (LexState *ls) {
656	expdesc v;
657	expr(ls, &v);
658	luaK_tostack(ls, &v, 1);
659	}	748	}
660		749
661		750
@@ -690,17 +779,17 @@ static BinOpr getbinopr (int op) { · 28 unmodified lines
690		779
691		780
692	static const struct {	781	static const struct {
693	char left; /* left priority for each binary operator */	782	lu_byte left; /* left priority for each binary operator */
694	char right; /* right priority */	783	lu_byte right; /* right priority */
695	} priority[] = { /* ORDER OPR */	784	} priority[] = { /* ORDER OPR */
696	{5, 5}, {5, 5}, {6, 6}, {6, 6}, /* arithmetic */	785	{6, 6}, {6, 6}, {7, 7}, {7, 7}, /* arithmetic */
697	{9, 8}, {4, 3}, /* power and concat (right associative) */	786	{10, 9}, {5, 4}, /* power and concat (right associative) */
698	{2, 2}, {2, 2}, /* equality */	787	{3, 3}, {3, 3}, /* equality */
699	{2, 2}, {2, 2}, {2, 2}, {2, 2}, /* order */	788	{3, 3}, {3, 3}, {3, 3}, {3, 3}, /* order */
700	{1, 1}, {1, 1} /* logical */	789	{2, 2}, {1, 1} /* logical (and/or) */
701	};	790	};
702		791
703	#define UNARY_PRIORITY 7 /* priority for unary operators */	792	#define UNARY_PRIORITY 8 /* priority for unary operators */
704		793
705		794
706	/*	795	/*
@@ -709,25 +798,28 @@ static const struct { · 2 unmodified lines
709	*/	798	*/
710	static BinOpr subexpr (LexState ls, expdesc v, int limit) {	799	static BinOpr subexpr (LexState ls, expdesc v, int limit) {
711	BinOpr op;	800	BinOpr op;
712	UnOpr uop = getunopr(ls->t.token);	801	UnOpr uop;
		802	enterlevel(ls);
		803	uop = getunopr(ls->t.token);
713	if (uop != OPR_NOUNOPR) {	804	if (uop != OPR_NOUNOPR) {
714	next(ls);	805	next(ls);
715	subexpr(ls, v, UNARY_PRIORITY);	806	subexpr(ls, v, UNARY_PRIORITY);
716	luaK_prefix(ls, uop, v);	807	luaK_prefix(ls->fs, uop, v);
717	}	808	}
718	else simpleexp(ls, v);	809	else simpleexp(ls, v);
719	/* expand while operators have priorities higher than `limit' */	810	/* expand while operators have priorities higher than `limit' */
720	op = getbinopr(ls->t.token);	811	op = getbinopr(ls->t.token);
721	while (op != OPR_NOBINOPR && priority[op].left > limit) {	812	while (op != OPR_NOBINOPR && cast(int, priority[op].left) > limit) {
722	expdesc v2;	813	expdesc v2;
723	BinOpr nextop;	814	BinOpr nextop;
724	next(ls);	815	next(ls);
725	luaK_infix(ls, op, v);	816	luaK_infix(ls->fs, op, v);
726	/* read sub-expression with higher priority */	817	/* read sub-expression with higher priority */
727	nextop = subexpr(ls, &v2, priority[op].right);	818	nextop = subexpr(ls, &v2, cast(int, priority[op].right));
728	luaK_posfix(ls, op, v, &v2);	819	luaK_posfix(ls->fs, op, v, &v2);
729	op = nextop;	820	op = nextop;
730	}	821	}
		822	leavelevel(ls);
731	return op; /* return first untreated operator */	823	return op; /* return first untreated operator */
732	}	824	}
733		825
@@ -739,6 +831,7 @@ static void expr (LexState ls, expdesc v) { · 5 unmodified lines
739	/* }==================================================================== */	831	/* }==================================================================== */
740		832
741		833
		834
742	/*	835	/*
743	** {======================================================================	836	** {======================================================================
744	** Rules for Statements	837	** Rules for Statements
@@ -759,61 +852,151 @@ static int block_follow (int token) { · 14 unmodified lines
759	static void block (LexState *ls) {	852	static void block (LexState *ls) {
760	/* block -> chunk */	853	/* block -> chunk */
761	FuncState *fs = ls->fs;	854	FuncState *fs = ls->fs;
762	int nactloc = fs->nactloc;	855	BlockCnt bl;
		856	enterblock(fs, &bl, 0);
763	chunk(ls);	857	chunk(ls);
764	luaK_adjuststack(fs, fs->nactloc - nactloc); /* remove local variables */	858	lua_assert(bl.breaklist == NO_JUMP);
765	removelocalvars(ls, fs->nactloc - nactloc);	859	leaveblock(fs);
766	}	860	}
767		861
768		862
769	static int assignment (LexState ls, expdesc v, int nvars) {	863	/*
770	int left = 0; /* number of values left in the stack after assignment */	864	** structure to chain all variables in the left-hand side of an
771	luaX_checklimit(ls, nvars, MAXVARSLH, "variables in a multiple assignment");	865	** assignment
772	if (ls->t.token == ',') { /* assignment -> ',' NAME assignment */	866	*/
773	expdesc nv;	867	struct LHS_assign {
774	next(ls);	868	struct LHS_assign *prev;
775	var_or_func(ls, &nv);	869	expdesc v; /* variable (global, local, upvalue, or indexed) */
776	check_condition(ls, (nv.k != VEXP), "syntax error");	870	};
777	left = assignment(ls, &nv, nvars+1);	871
		872
		873	/*
		874	** check whether, in an assignment to a local variable, the local variable
		875	** is needed in a previous assignment (to a table). If so, save original
		876	** local value in a safe place and use this safe copy in the previous
		877	** assignment.
		878	*/
		879	static void check_conflict (LexState ls, struct LHS_assign lh, expdesc *v) {
		880	FuncState *fs = ls->fs;
		881	int extra = fs->freereg; /* eventual position to save local variable */
		882	int conflict = 0;
		883	for (; lh; lh = lh->prev) {
		884	if (lh->v.k == VINDEXED) {
		885	if (lh->v.info == v->info) { /* conflict? */
		886	conflict = 1;
		887	lh->v.info = extra; /* previous assignment will use safe copy */
		888	}
		889	if (lh->v.aux == v->info) { /* conflict? */
		890	conflict = 1;
		891	lh->v.aux = extra; /* previous assignment will use safe copy */
		892	}
		893	}
		894	}
		895	if (conflict) {
		896	luaK_codeABC(fs, OP_MOVE, fs->freereg, v->info, 0); /* make copy */
		897	luaK_reserveregs(fs, 1);
778	}	898	}
779	else { /* assignment -> '=' explist1 */	899	}
		900
		901
		902	static void assignment (LexState ls, struct LHS_assign lh, int nvars) {
		903	expdesc e;
		904	check_condition(ls, VLOCAL <= lh->v.k && lh->v.k <= VINDEXED,
		905	"syntax error");
		906	if (testnext(ls, ',')) { /* assignment -> `,' primaryexp assignment */
		907	struct LHS_assign nv;
		908	nv.prev = lh;
		909	primaryexp(ls, &nv.v);
		910	if (nv.v.k == VLOCAL)
		911	check_conflict(ls, lh, &nv.v);
		912	assignment(ls, &nv, nvars+1);
		913	}
		914	else { /* assignment -> `=' explist1 */
780	int nexps;	915	int nexps;
781	check(ls, '=');	916	check(ls, '=');
782	nexps = explist1(ls);	917	nexps = explist1(ls, &e);
783	adjust_mult_assign(ls, nvars, nexps);	918	if (nexps != nvars) {
784	}	919	adjust_assign(ls, nvars, nexps, &e);
785	if (v->k != VINDEXED)	920	if (nexps > nvars)
786	luaK_storevar(ls, v);	921	ls->fs->freereg -= nexps - nvars; /* remove extra values */
787	else { /* there may be garbage between table-index and value */	922	}
788	luaK_code2(ls->fs, OP_SETTABLE, left+nvars+2, 1);	923	else {
789	left += 2;	924	luaK_setcallreturns(ls->fs, &e, 1); /* close last expression */
		925	luaK_storevar(ls->fs, &lh->v, &e);
		926	return; /* avoid default */
		927	}
790	}	928	}
791	return left;	929	init_exp(&e, VNONRELOC, ls->fs->freereg-1); /* default assignment */
		930	luaK_storevar(ls->fs, &lh->v, &e);
792	}	931	}
793		932
794		933
795	static void cond (LexState ls, expdesc v) {	934	static void cond (LexState ls, expdesc v) {
796	/* cond -> exp */	935	/* cond -> exp */
797	expr(ls, v); /* read condition */	936	expr(ls, v); /* read condition */
798	luaK_goiftrue(ls->fs, v, 0);	937	if (v->k == VNIL) v->k = VFALSE; /* `falses' are all equal here */
		938	luaK_goiftrue(ls->fs, v);
		939	luaK_patchtohere(ls->fs, v->t);
799	}	940	}
800		941
801		942
		943	/*
		944	** The while statement optimizes its code by coding the condition
		945	** after its body (and thus avoiding one jump in the loop).
		946	*/
		947
		948	/*
		949	** maximum size of expressions for optimizing `while' code
		950	*/
		951	#ifndef MAXEXPWHILE
		952	#define MAXEXPWHILE 100
		953	#endif
		954
		955	/*
		956	** the call `luaK_goiffalse' may grow the size of an expression by
		957	** at most this:
		958	*/
		959	#define EXTRAEXP 5
		960
802	static void whilestat (LexState *ls, int line) {	961	static void whilestat (LexState *ls, int line) {
803	/* whilestat -> WHILE cond DO block END */	962	/* whilestat -> WHILE cond DO block END */
		963	Instruction codeexp[MAXEXPWHILE + EXTRAEXP];
		964	int lineexp;
		965	int i;
		966	int sizeexp;
804	FuncState *fs = ls->fs;	967	FuncState *fs = ls->fs;
805	int while_init = luaK_getlabel(fs);	968	int whileinit, blockinit, expinit;
806	expdesc v;	969	expdesc v;
807	Breaklabel bl;	970	BlockCnt bl;
808	enterbreak(fs, &bl);	971	next(ls); /* skip WHILE */
809	next(ls);	972	whileinit = luaK_jump(fs); /* jump to condition (which will be moved) */
810	cond(ls, &v);	973	expinit = luaK_getlabel(fs);
		974	expr(ls, &v); /* parse condition */
		975	if (v.k == VK) v.k = VTRUE; /* `trues' are all equal here */
		976	lineexp = ls->linenumber;
		977	luaK_goiffalse(fs, &v);
		978	luaK_concat(fs, &v.f, fs->jpc);
		979	fs->jpc = NO_JUMP;
		980	sizeexp = fs->pc - expinit; /* size of expression code */
		981	if (sizeexp > MAXEXPWHILE)
		982	luaX_syntaxerror(ls, "`while' condition too complex");
		983	for (i = 0; i < sizeexp; i++) /* save `exp' code */
		984	codeexp[i] = fs->f->code[expinit + i];
		985	fs->pc = expinit; /* remove `exp' code */
		986	enterblock(fs, &bl, 1);
811	check(ls, TK_DO);	987	check(ls, TK_DO);
		988	blockinit = luaK_getlabel(fs);
812	block(ls);	989	block(ls);
813	luaK_patchlist(fs, luaK_jump(fs), while_init);	990	luaK_patchtohere(fs, whileinit); /* initial jump jumps to here */
814	luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs));	991	/* move `exp' back to code */
		992	if (v.t != NO_JUMP) v.t += fs->pc - expinit;
		993	if (v.f != NO_JUMP) v.f += fs->pc - expinit;
		994	for (i=0; i<sizeexp; i++)
		995	luaK_code(fs, codeexp[i], lineexp);
815	check_match(ls, TK_END, TK_WHILE, line);	996	check_match(ls, TK_END, TK_WHILE, line);
816	leavebreak(fs, &bl);	997	leaveblock(fs);
		998	luaK_patchlist(fs, v.t, blockinit); /* true conditions go back to loop */
		999	luaK_patchtohere(fs, v.f); /* false conditions finish the loop */
817	}	1000	}
818		1001
819		1002
@@ -822,64 +1005,86 @@ static void repeatstat (LexState *ls, int line) { · 2 unmodified lines
822	FuncState *fs = ls->fs;	1005	FuncState *fs = ls->fs;
823	int repeat_init = luaK_getlabel(fs);	1006	int repeat_init = luaK_getlabel(fs);
824	expdesc v;	1007	expdesc v;
825	Breaklabel bl;	1008	BlockCnt bl;
826	enterbreak(fs, &bl);	1009	enterblock(fs, &bl, 1);
827	next(ls);	1010	next(ls);
828	block(ls);	1011	block(ls);
829	check_match(ls, TK_UNTIL, TK_REPEAT, line);	1012	check_match(ls, TK_UNTIL, TK_REPEAT, line);
830	cond(ls, &v);	1013	cond(ls, &v);
831	luaK_patchlist(fs, v.u.l.f, repeat_init);	1014	luaK_patchlist(fs, v.f, repeat_init);
832	leavebreak(fs, &bl);	1015	leaveblock(fs);
833	}	1016	}
834		1017
835		1018
836	static void forbody (LexState *ls, int nvar, OpCode prepfor, OpCode loopfor) {	1019	static int exp1 (LexState *ls) {
837	/* forbody -> DO block END */	1020	expdesc e;
		1021	int k;
		1022	expr(ls, &e);
		1023	k = e.k;
		1024	luaK_exp2nextreg(ls->fs, &e);
		1025	return k;
		1026	}
		1027
		1028
		1029	static void forbody (LexState *ls, int base, int line, int nvars, int isnum) {
		1030	BlockCnt bl;
838	FuncState *fs = ls->fs;	1031	FuncState *fs = ls->fs;
839	int prep = luaK_code1(fs, prepfor, NO_JUMP);	1032	int prep, endfor;
840	int blockinit = luaK_getlabel(fs);	1033	adjustlocalvars(ls, nvars); /* scope for all variables */
841	check(ls, TK_DO);	1034	check(ls, TK_DO);
842	adjustlocalvars(ls, nvar); /* scope for control variables */	1035	enterblock(fs, &bl, 1); /* loop block */
		1036	prep = luaK_getlabel(fs);
843	block(ls);	1037	block(ls);
844	luaK_patchlist(fs, luaK_code1(fs, loopfor, NO_JUMP), blockinit);	1038	luaK_patchtohere(fs, prep-1);
845	luaK_patchlist(fs, prep, luaK_getlabel(fs));	1039	endfor = (isnum) ? luaK_codeAsBx(fs, OP_FORLOOP, base, NO_JUMP) :
846	removelocalvars(ls, nvar);	1040	luaK_codeABC(fs, OP_TFORLOOP, base, 0, nvars - 3);
		1041	luaK_fixline(fs, line); /* pretend that `OP_FOR' starts the loop */
		1042	luaK_patchlist(fs, (isnum) ? endfor : luaK_jump(fs), prep);
		1043	leaveblock(fs);
847	}	1044	}
848		1045
849		1046
850	static void fornum (LexState ls, TString varname) {	1047	static void fornum (LexState ls, TString varname, int line) {
851	/* fornum -> NAME = exp1,exp1[,exp1] forbody */	1048	/* fornum -> NAME = exp1,exp1[,exp1] DO body */
852	FuncState *fs = ls->fs;	1049	FuncState *fs = ls->fs;
		1050	int base = fs->freereg;
		1051	new_localvar(ls, varname, 0);
		1052	new_localvarstr(ls, "(for limit)", 1);
		1053	new_localvarstr(ls, "(for step)", 2);
853	check(ls, '=');	1054	check(ls, '=');
854	exp1(ls); /* initial value */	1055	exp1(ls); /* initial value */
855	check(ls, ',');	1056	check(ls, ',');
856	exp1(ls); /* limit */	1057	exp1(ls); /* limit */
857	if (optional(ls, ','))	1058	if (testnext(ls, ','))
858	exp1(ls); /* optional step */	1059	exp1(ls); /* optional step */
859	else	1060	else { /* default step = 1 */
860	luaK_code1(fs, OP_PUSHINT, 1); /* default step */	1061	luaK_codeABx(fs, OP_LOADK, fs->freereg, luaK_numberK(fs, 1));
861	new_localvar(ls, varname, 0);	1062	luaK_reserveregs(fs, 1);
862	new_localvarstr(ls, "(limit)", 1);	1063	}
863	new_localvarstr(ls, "(step)", 2);	1064	luaK_codeABC(fs, OP_SUB, fs->freereg - 3, fs->freereg - 3, fs->freereg - 1);
864	forbody(ls, 3, OP_FORPREP, OP_FORLOOP);	1065	luaK_jump(fs);
		1066	forbody(ls, base, line, 3, 1);
865	}	1067	}
866		1068
867		1069
868	static void forlist (LexState ls, TString indexname) {	1070	static void forlist (LexState ls, TString indexname) {
869	/* forlist -> NAME,NAME IN exp1 forbody */	1071	/* forlist -> NAME {,NAME} IN explist1 DO body */
870	TString *valname;	1072	FuncState *fs = ls->fs;
871	check(ls, ',');	1073	expdesc e;
872	valname = str_checkname(ls);	1074	int nvars = 0;
873	/* next test is dirty, but avoids `in' being a reserved word */	1075	int line;
874	check_condition(ls,	1076	int base = fs->freereg;
875	(ls->t.token == TK_NAME && ls->t.seminfo.ts == luaS_new(ls->L, "in")),	1077	new_localvarstr(ls, "(for generator)", nvars++);
876	"`in' expected");	1078	new_localvarstr(ls, "(for state)", nvars++);
877	next(ls); /* skip `in' */	1079	new_localvar(ls, indexname, nvars++);
878	exp1(ls); /* table */	1080	while (testnext(ls, ','))
879	new_localvarstr(ls, "(table)", 0);	1081	new_localvar(ls, str_checkname(ls), nvars++);
880	new_localvar(ls, indexname, 1);	1082	check(ls, TK_IN);
881	new_localvar(ls, valname, 2);	1083	line = ls->linenumber;
882	forbody(ls, 3, OP_LFORPREP, OP_LFORLOOP);	1084	adjust_assign(ls, nvars, explist1(ls, &e), &e);
		1085	luaK_checkstack(fs, 3); /* extra space to call generator */
		1086	luaK_codeAsBx(fs, OP_TFORPREP, base, NO_JUMP);
		1087	forbody(ls, base, line, nvars, 0);
883	}	1088	}
884		1089
885		1090
@@ -887,17 +1092,17 @@ static void forstat (LexState *ls, int line) { · 1 unmodified line
887	/* forstat -> fornum \| forlist */	1092	/* forstat -> fornum \| forlist */
888	FuncState *fs = ls->fs;	1093	FuncState *fs = ls->fs;
889	TString *varname;	1094	TString *varname;
890	Breaklabel bl;	1095	BlockCnt bl;
891	enterbreak(fs, &bl);	1096	enterblock(fs, &bl, 0); /* block to control variable scope */
892	next(ls); /* skip `for' */	1097	next(ls); /* skip `for' */
893	varname = str_checkname(ls); /* first variable name */	1098	varname = str_checkname(ls); /* first variable name */
894	switch (ls->t.token) {	1099	switch (ls->t.token) {
895	case '=': fornum(ls, varname); break;	1100	case '=': fornum(ls, varname, line); break;
896	case ',': forlist(ls, varname); break;	1101	case ',': case TK_IN: forlist(ls, varname); break;
897	default: luaK_error(ls, "`=' or `,' expected");	1102	default: luaX_syntaxerror(ls, "`=' or `in' expected");
898	}	1103	}
899	check_match(ls, TK_END, TK_FOR, line);	1104	check_match(ls, TK_END, TK_FOR, line);
900	leavebreak(fs, &bl);	1105	leaveblock(fs);
901	}	1106	}
902		1107
903		1108
@@ -918,49 +1123,60 @@ static void ifstat (LexState *ls, int line) { · 14 unmodified lines
918	test_then_block(ls, &v); /* IF cond THEN block */	1123	test_then_block(ls, &v); /* IF cond THEN block */
919	while (ls->t.token == TK_ELSEIF) {	1124	while (ls->t.token == TK_ELSEIF) {
920	luaK_concat(fs, &escapelist, luaK_jump(fs));	1125	luaK_concat(fs, &escapelist, luaK_jump(fs));
921	luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs));	1126	luaK_patchtohere(fs, v.f);
922	test_then_block(ls, &v); /* ELSEIF cond THEN block */	1127	test_then_block(ls, &v); /* ELSEIF cond THEN block */
923	}	1128	}
924	if (ls->t.token == TK_ELSE) {	1129	if (ls->t.token == TK_ELSE) {
925	luaK_concat(fs, &escapelist, luaK_jump(fs));	1130	luaK_concat(fs, &escapelist, luaK_jump(fs));
926	luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs));	1131	luaK_patchtohere(fs, v.f);
927	next(ls); /* skip ELSE */	1132	next(ls); /* skip ELSE (after patch, for correct line info) */
928	block(ls); /* `else' part */	1133	block(ls); /* `else' part */
929	}	1134	}
930	else	1135	else
931	luaK_concat(fs, &escapelist, v.u.l.f);	1136	luaK_concat(fs, &escapelist, v.f);
932	luaK_patchlist(fs, escapelist, luaK_getlabel(fs));	1137	luaK_patchtohere(fs, escapelist);
933	check_match(ls, TK_END, TK_IF, line);	1138	check_match(ls, TK_END, TK_IF, line);
934	}	1139	}
935		1140
936		1141
		1142	static void localfunc (LexState *ls) {
		1143	expdesc v, b;
		1144	new_localvar(ls, str_checkname(ls), 0);
		1145	init_exp(&v, VLOCAL, ls->fs->freereg++);
		1146	adjustlocalvars(ls, 1);
		1147	body(ls, &b, 0, ls->linenumber);
		1148	luaK_storevar(ls->fs, &v, &b);
		1149	}
		1150
		1151
937	static void localstat (LexState *ls) {	1152	static void localstat (LexState *ls) {
938	/* stat -> LOCAL NAME {',' NAME} ['=' explist1] */	1153	/* stat -> LOCAL NAME {`,' NAME} [`=' explist1] */
939	int nvars = 0;	1154	int nvars = 0;
940	int nexps;	1155	int nexps;
		1156	expdesc e;
941	do {	1157	do {
942	next(ls); /* skip LOCAL or ',' */
943	new_localvar(ls, str_checkname(ls), nvars++);	1158	new_localvar(ls, str_checkname(ls), nvars++);
944	} while (ls->t.token == ',');	1159	} while (testnext(ls, ','));
945	if (optional(ls, '='))	1160	if (testnext(ls, '='))
946	nexps = explist1(ls);	1161	nexps = explist1(ls, &e);
947	else	1162	else {
		1163	e.k = VVOID;
948	nexps = 0;	1164	nexps = 0;
949	adjust_mult_assign(ls, nvars, nexps);	1165	}
		1166	adjust_assign(ls, nvars, nexps, &e);
950	adjustlocalvars(ls, nvars);	1167	adjustlocalvars(ls, nvars);
951	}	1168	}
952		1169
953		1170
954	static int funcname (LexState ls, expdesc v) {	1171	static int funcname (LexState ls, expdesc v) {
955	/* funcname -> NAME [':' NAME \| '.' NAME] */	1172	/* funcname -> NAME {field} [`:' NAME] */
956	int needself = 0;	1173	int needself = 0;
957	singlevar(ls, str_checkname(ls), v);	1174	singlevar(ls, v, 1);
958	if (ls->t.token == ':' \|\| ls->t.token == '.') {	1175	while (ls->t.token == '.')
959	needself = (ls->t.token == ':');	1176	luaY_field(ls, v);
960	next(ls);	1177	if (ls->t.token == ':') {
961	luaK_tostack(ls, v, 1);	1178	needself = 1;
962	luaK_kstr(ls, checkname(ls));	1179	luaY_field(ls, v);
963	v->k = VINDEXED;
964	}	1180	}
965	return needself;	1181	return needself;
966	}	1182	}
@@ -969,26 +1185,26 @@ static int funcname (LexState ls, expdesc v) { · 2 unmodified lines
969	static void funcstat (LexState *ls, int line) {	1185	static void funcstat (LexState *ls, int line) {
970	/* funcstat -> FUNCTION funcname body */	1186	/* funcstat -> FUNCTION funcname body */
971	int needself;	1187	int needself;
972	expdesc v;	1188	expdesc v, b;
973	next(ls); /* skip FUNCTION */	1189	next(ls); /* skip FUNCTION */
974	needself = funcname(ls, &v);	1190	needself = funcname(ls, &v);
975	body(ls, needself, line);	1191	body(ls, &b, needself, line);
976	luaK_storevar(ls, &v);	1192	luaK_storevar(ls->fs, &v, &b);
		1193	luaK_fixline(ls->fs, line); /* definition `happens' in the first line */
977	}	1194	}
978		1195
979		1196
980	static void namestat (LexState *ls) {	1197	static void exprstat (LexState *ls) {
981	/* stat -> func \| ['%'] NAME assignment */	1198	/* stat -> func \| assignment */
982	FuncState *fs = ls->fs;	1199	FuncState *fs = ls->fs;
983	expdesc v;	1200	struct LHS_assign v;
984	var_or_func(ls, &v);	1201	primaryexp(ls, &v.v);
985	if (v.k == VEXP) { /* stat -> func */	1202	if (v.v.k == VCALL) { /* stat -> func */
986	check_condition(ls, luaK_lastisopen(fs), "syntax error"); /* an upvalue? */	1203	luaK_setcallreturns(fs, &v.v, 0); /* call statement uses no results */
987	luaK_setcallreturns(fs, 0); /* call statement uses no results */
988	}	1204	}
989	else { /* stat -> ['%'] NAME assignment */	1205	else { /* stat -> assignment */
990	int left = assignment(ls, &v, 1);	1206	v.prev = NULL;
991	luaK_adjuststack(fs, left); /* remove eventual garbage left on stack */	1207	assignment(ls, &v, 1);
992	}	1208	}
993	}	1209	}
994		1210
@@ -996,30 +1212,55 @@ static void namestat (LexState *ls) { · 1 unmodified line
996	static void retstat (LexState *ls) {	1212	static void retstat (LexState *ls) {
997	/* stat -> RETURN explist */	1213	/* stat -> RETURN explist */
998	FuncState *fs = ls->fs;	1214	FuncState *fs = ls->fs;
		1215	expdesc e;
		1216	int first, nret; /* registers with returned values */
999	next(ls); /* skip RETURN */	1217	next(ls); /* skip RETURN */
1000	if (!block_follow(ls->t.token) && ls->t.token != ';')	1218	if (block_follow(ls->t.token) \|\| ls->t.token == ';')
1001	explist1(ls); /* optional return values */	1219	first = nret = 0; /* return no values */
1002	luaK_code1(fs, OP_RETURN, ls->fs->nactloc);	1220	else {
1003	fs->stacklevel = fs->nactloc; /* removes all temp values */	1221	nret = explist1(ls, &e); /* optional return values */
		1222	if (e.k == VCALL) {
		1223	luaK_setcallreturns(fs, &e, LUA_MULTRET);
		1224	if (nret == 1) { /* tail call? */
		1225	SET_OPCODE(getcode(fs,&e), OP_TAILCALL);
		1226	lua_assert(GETARG_A(getcode(fs,&e)) == fs->nactvar);
		1227	}
		1228	first = fs->nactvar;
		1229	nret = LUA_MULTRET; /* return all values */
		1230	}
		1231	else {
		1232	if (nret == 1) /* only one single value? */
		1233	first = luaK_exp2anyreg(fs, &e);
		1234	else {
		1235	luaK_exp2nextreg(fs, &e); /* values must go to the `stack' */
		1236	first = fs->nactvar; /* return all `active' values */
		1237	lua_assert(nret == fs->freereg - first);
		1238	}
		1239	}
		1240	}
		1241	luaK_codeABC(fs, OP_RETURN, first, nret+1, 0);
1004	}	1242	}
1005		1243
1006		1244
1007	static void breakstat (LexState *ls) {	1245	static void breakstat (LexState *ls) {
1008	/* stat -> BREAK [NAME] */	1246	/* stat -> BREAK [NAME] */
1009	FuncState *fs = ls->fs;	1247	FuncState *fs = ls->fs;
1010	int currentlevel = fs->stacklevel;	1248	BlockCnt *bl = fs->bl;
1011	Breaklabel *bl = fs->bl;	1249	int upval = 0;
1012	if (!bl)
1013	luaK_error(ls, "no loop to break");
1014	next(ls); /* skip BREAK */	1250	next(ls); /* skip BREAK */
1015	luaK_adjuststack(fs, currentlevel - bl->stacklevel);	1251	while (bl && !bl->isbreakable) {
		1252	upval \|= bl->upval;
		1253	bl = bl->previous;
		1254	}
		1255	if (!bl)
		1256	luaX_syntaxerror(ls, "no loop to break");
		1257	if (upval)
		1258	luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0);
1016	luaK_concat(fs, &bl->breaklist, luaK_jump(fs));	1259	luaK_concat(fs, &bl->breaklist, luaK_jump(fs));
1017	/* correct stack for compiler and symbolic execution */
1018	luaK_adjuststack(fs, bl->stacklevel - currentlevel);
1019	}	1260	}
1020		1261
1021		1262
1022	static int stat (LexState *ls) {	1263	static int statement (LexState *ls) {
1023	int line = ls->linenumber; /* may be needed for error messages */	1264	int line = ls->linenumber; /* may be needed for error messages */
1024	switch (ls->t.token) {	1265	switch (ls->t.token) {
1025	case TK_IF: { /* stat -> ifstat */	1266	case TK_IF: { /* stat -> ifstat */
@@ -1044,16 +1285,16 @@ static int stat (LexState *ls) { · 18 unmodified lines
1044	repeatstat(ls, line);	1285	repeatstat(ls, line);
1045	return 0;	1286	return 0;
1046	}	1287	}
1047	case TK_FUNCTION: { /* stat -> funcstat */	1288	case TK_FUNCTION: {
1048	funcstat(ls, line);	1289	funcstat(ls, line); /* stat -> funcstat */
1049	return 0;	1290	return 0;
1050	}	1291	}
1051	case TK_LOCAL: { /* stat -> localstat */	1292	case TK_LOCAL: { /* stat -> localstat */
1052	localstat(ls);	1293	next(ls); /* skip LOCAL */
1053	return 0;	1294	if (testnext(ls, TK_FUNCTION)) /* local function? */
1054	}	1295	localfunc(ls);
1055	case TK_NAME: case '%': { /* stat -> namestat */	1296	else
1056	namestat(ls);	1297	localstat(ls);
1057	return 0;	1298	return 0;
1058	}	1299	}
1059	case TK_RETURN: { /* stat -> retstat */	1300	case TK_RETURN: { /* stat -> retstat */
@@ -1065,60 +1306,24 @@ static int stat (LexState *ls) { · 5 unmodified lines
1065	return 1; /* must be last statement */	1306	return 1; /* must be last statement */
1066	}	1307	}
1067	default: {	1308	default: {
1068	luaK_error(ls, "<statement> expected");	1309	exprstat(ls);
1069	return 0; /* to avoid warnings */	1310	return 0; /* to avoid warnings */
1070	}	1311	}
1071	}	1312	}
1072	}	1313	}
1073		1314
1074		1315
1075	static void parlist (LexState *ls) {
1076	/* parlist -> [ param { ',' param } ] */
1077	int nparams = 0;
1078	int dots = 0;
1079	if (ls->t.token != ')') { /* is `parlist' not empty? */
1080	do {
1081	switch (ls->t.token) {
1082	case TK_DOTS: next(ls); dots = 1; break;
1083	case TK_NAME: new_localvar(ls, str_checkname(ls), nparams++); break;
1084	default: luaK_error(ls, "<name> or `...' expected");
1085	}
1086	} while (!dots && optional(ls, ','));
1087	}
1088	code_params(ls, nparams, dots);
1089	}
1090
1091
1092	static void body (LexState *ls, int needself, int line) {
1093	/* body -> '(' parlist ')' chunk END */
1094	FuncState new_fs;
1095	open_func(ls, &new_fs);
1096	new_fs.f->lineDefined = line;
1097	check(ls, '(');
1098	if (needself) {
1099	new_localvarstr(ls, "self", 0);
1100	adjustlocalvars(ls, 1);
1101	}
1102	parlist(ls);
1103	check(ls, ')');
1104	chunk(ls);
1105	check_match(ls, TK_END, TK_FUNCTION, line);
1106	close_func(ls);
1107	pushclosure(ls, &new_fs);
1108	}
1109
1110
1111	/* }====================================================================== */
1112
1113
1114	static void chunk (LexState *ls) {	1316	static void chunk (LexState *ls) {
1115	/* chunk -> { stat [';'] } */	1317	/* chunk -> { stat [`;'] } */
1116	int islast = 0;	1318	int islast = 0;
		1319	enterlevel(ls);
1117	while (!islast && !block_follow(ls->t.token)) {	1320	while (!islast && !block_follow(ls->t.token)) {
1118	islast = stat(ls);	1321	islast = statement(ls);
1119	optional(ls, ';');	1322	testnext(ls, ';');
1120	LUA_ASSERT(ls->fs->stacklevel == ls->fs->nactloc,	1323	lua_assert(ls->fs->freereg >= ls->fs->nactvar);
1121	"stack size != # local vars");	1324	ls->fs->freereg = ls->fs->nactvar; /* free registers */
1122	}	1325	}
		1326	leavelevel(ls);
1123	}	1327	}
1124		1328
		1329	/* }====================================================================== */

src/lparser.h+33−22

 /*
-** $Id: lparser.h,v 1.26 2000/10/09 13:47:46 roberto Exp $
+** $Id: lparser.h,v 1.47 2003/02/11 10:46:24 roberto Exp $
-** LL(1) Parser and code generator for Lua
+** Lua Parser
 ** See Copyright Notice in lua.h
 */
 #ifndef lparser_h
 #define lparser_h
+#include "llimits.h"
 #include "lobject.h"
+#include "ltable.h"
 #include "lzio.h"
 */
 typedef enum {
-  VGLOBAL,
+  VVOID,	/* no value */
-  VLOCAL,
+  VNIL,
-  VINDEXED,
+  VTRUE,
-  VEXP
+  VFALSE,
+  VK,		/* info = index of constant in `k' */
+  VLOCAL,	/* info = local register */
+  VUPVAL,       /* info = index of upvalue in `upvalues' */
+  VGLOBAL,	/* info = index of table; aux = index of global name in `k' */
+  VINDEXED,	/* info = table register; aux = index register (or `k') */
+  VJMP,		/* info = instruction pc */
+  VRELOCABLE,	/* info = instruction pc */
+  VNONRELOC,	/* info = result register */
+  VCALL		/* info = result register */
 } expkind;
 typedef struct expdesc {
   expkind k;
-  union {
+  int info, aux;
-    int index;  /* VGLOBAL: `kstr' index of global name; VLOCAL: stack index */
+  int t;  /* patch list of `exit when true' */
-    struct {
+  int f;  /* patch list of `exit when false' */
-      int t;  /* patch list of `exit when true' */
-      int f;  /* patch list of `exit when false' */
-    } l;
-  } u;
 } expdesc;
+struct BlockCnt;  /* defined in lparser.c */
 /* state needed to generate code for a given function */
 typedef struct FuncState {
   Proto *f;  /* current function header */
+  Table *h;  /* table to find (and reuse) elements in `k' */
   struct FuncState *prev;  /* enclosing function */
   struct LexState *ls;  /* lexical state */
   struct lua_State *L;  /* copy of the Lua state */
-  int pc;  /* next position to code */
+  struct BlockCnt *bl;  /* chain of current blocks */
+  int pc;  /* next position to code (equivalent to `ncode') */
   int lasttarget;   /* `pc' of last `jump target' */
-  int jlt;  /* list of jumps to `lasttarget' */
+  int jpc;  /* list of pending jumps to `pc' */
-  short stacklevel;  /* number of values on activation register */
+  int freereg;  /* first free register */
-  short nactloc;  /* number of active local variables */
+  int nk;  /* number of elements in `k' */
-  short nupvalues;  /* number of upvalues */
+  int np;  /* number of elements in `p' */
-  int lastline;  /* line where last `lineinfo' was generated */
+  int nlocvars;  /* number of elements in `locvars' */
-  struct Breaklabel *bl;  /* chain of breakable blocks */
+  int nactvar;  /* number of active local variables */
   expdesc upvalues[MAXUPVALUES];  /* upvalues */
-  int actloc[MAXLOCALS];  /* local-variable stack (indices to locvars) */
+  int actvar[MAXVARS];  /* declared-variable stack */
 } FuncState;
-Proto *luaY_parser (lua_State *L, ZIO *z);
+Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff);
 #endif

src/lstate.c+174−75

@@ -1,15 +1,19 @@
1	/*	1	/*
2	** $Id: lstate.c,v 1.48 2000/10/30 16:29:59 roberto Exp $	2	** $Id: lstate.c,v 1.123 2003/04/03 13:35:34 roberto Exp $
3	** Global State	3	** Global State
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <stdio.h>	8	#include <stdlib.h>
		9
		10	#define lstate_c
9		11
10	#include "lua.h"	12	#include "lua.h"
11		13
		14	#include "ldebug.h"
12	#include "ldo.h"	15	#include "ldo.h"
		16	#include "lfunc.h"
13	#include "lgc.h"	17	#include "lgc.h"
14	#include "llex.h"	18	#include "llex.h"
15	#include "lmem.h"	19	#include "lmem.h"
@@ -19,103 +23,198 @@ · 3 unmodified lines
19	#include "ltm.h"	23	#include "ltm.h"
20		24
21		25
22	#ifdef LUA_DEBUG	26	/*
23	static lua_State *lua_state = NULL;	27	** macro to allow the inclusion of user information in Lua state
24	void luaB_opentests (lua_State *L);	28	*/
		29	#ifndef LUA_USERSTATE
		30	#define EXTRASPACE 0
		31	#else
		32	union UEXTRASPACE {L_Umaxalign a; LUA_USERSTATE b;};
		33	#define EXTRASPACE (sizeof(union UEXTRASPACE))
25	#endif	34	#endif
26		35
27		36
		37
28	/*	38	/*
29	** built-in implementation for ERRORMESSAGE. In a "correct" environment	39	** you can change this function through the official API:
30	** ERRORMESSAGE should have an external definition, and so this function	40	** call `lua_setpanicf'
31	** would not be used.
32	*/	41	*/
33	static int errormessage (lua_State *L) {	42	static int default_panic (lua_State *L) {
34	const char *s = lua_tostring(L, 1);	43	UNUSED(L);
35	if (s == NULL) s = "(no message)";
36	fprintf(stderr, "error: %s\n", s);
37	return 0;	44	return 0;
38	}	45	}
39		46
40		47
		48	static lua_State mallocstate (lua_State L) {
		49	lu_byte block = (lu_byte )luaM_malloc(L, sizeof(lua_State) + EXTRASPACE);
		50	if (block == NULL) return NULL;
		51	else {
		52	block += EXTRASPACE;
		53	return cast(lua_State *, block);
		54	}
		55	}
		56
		57
		58	static void freestate (lua_State L, lua_State L1) {
		59	luaM_free(L, cast(lu_byte *, L1) - EXTRASPACE,
		60	sizeof(lua_State) + EXTRASPACE);
		61	}
		62
		63
		64	static void stack_init (lua_State L1, lua_State L) {
		65	L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, TObject);
		66	L1->stacksize = BASIC_STACK_SIZE + EXTRA_STACK;
		67	L1->top = L1->stack;
		68	L1->stack_last = L1->stack+(L1->stacksize - EXTRA_STACK)-1;
		69	L1->base_ci = luaM_newvector(L, BASIC_CI_SIZE, CallInfo);
		70	L1->ci = L1->base_ci;
		71	L1->ci->state = CI_C; /* not a Lua function */
		72	setnilvalue(L1->top++); /* `function' entry for this `ci' */
		73	L1->base = L1->ci->base = L1->top;
		74	L1->ci->top = L1->top + LUA_MINSTACK;
		75	L1->size_ci = BASIC_CI_SIZE;
		76	L1->end_ci = L1->base_ci + L1->size_ci;
		77	}
		78
		79
		80	static void freestack (lua_State L, lua_State L1) {
		81	luaM_freearray(L, L1->base_ci, L1->size_ci, CallInfo);
		82	luaM_freearray(L, L1->stack, L1->stacksize, TObject);
		83	}
		84
		85
41	/*	86	/*
42	** open parts that may cause memory-allocation errors	87	** open parts that may cause memory-allocation errors
43	*/	88	*/
44	static void f_luaopen (lua_State L, void ud) {	89	static void f_luaopen (lua_State L, void ud) {
45	int stacksize = (int )ud;	90	/* create a new global state */
46	if (stacksize == 0)	91	global_State *g = luaM_new(NULL, global_State);
47	stacksize = DEFAULT_STACK_SIZE;	92	UNUSED(ud);
48	else	93	if (g == NULL) luaD_throw(L, LUA_ERRMEM);
49	stacksize += LUA_MINSTACK;	94	L->l_G = g;
50	L->gt = luaH_new(L, 10); /* table of globals */	95	g->mainthread = L;
51	luaD_init(L, stacksize);	96	g->GCthreshold = 0; /* mark it as unfinished state */
52	luaS_init(L);	97	g->strt.size = 0;
53	luaX_init(L);	98	g->strt.nuse = 0;
		99	g->strt.hash = NULL;
		100	setnilvalue(defaultmeta(L));
		101	setnilvalue(registry(L));
		102	luaZ_initbuffer(L, &g->buff);
		103	g->panic = default_panic;
		104	g->rootgc = NULL;
		105	g->rootudata = NULL;
		106	g->tmudata = NULL;
		107	setnilvalue(gkey(g->dummynode));
		108	setnilvalue(gval(g->dummynode));
		109	g->dummynode->next = NULL;
		110	g->nblocks = sizeof(lua_State) + sizeof(global_State);
		111	stack_init(L, L); /* init stack */
		112	/* create default meta table with a dummy table, and then close the loop */
		113	defaultmeta(L)->tt = LUA_TTABLE;
		114	sethvalue(defaultmeta(L), luaH_new(L, 0, 0));
		115	hvalue(defaultmeta(L))->metatable = hvalue(defaultmeta(L));
		116	sethvalue(gt(L), luaH_new(L, 0, 4)); /* table of globals */
		117	sethvalue(registry(L), luaH_new(L, 4, 4)); /* registry */
		118	luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */
54	luaT_init(L);	119	luaT_init(L);
55	lua_newtable(L);	120	luaX_init(L);
56	lua_ref(L, 1); /* create registry */	121	luaS_fix(luaS_newliteral(L, MEMERRMSG));
57	lua_register(L, LUA_ERRORMESSAGE, errormessage);	122	g->GCthreshold = 4*G(L)->nblocks;
58	#ifdef LUA_DEBUG
59	luaB_opentests(L);
60	if (lua_state == NULL) lua_state = L; /* keep first state to be opened */
61	#endif
62	LUA_ASSERT(lua_gettop(L) == 0, "wrong API stack");
63	}	123	}
64		124
65		125
66	LUA_API lua_State *lua_open (int stacksize) {	126	static void preinit_state (lua_State *L) {
67	lua_State *L = luaM_new(NULL, lua_State);
68	if (L == NULL) return NULL; /* memory allocation error */
69	L->stack = NULL;	127	L->stack = NULL;
70	L->strt.size = L->udt.size = 0;	128	L->stacksize = 0;
71	L->strt.nuse = L->udt.nuse = 0;
72	L->strt.hash = NULL;
73	L->udt.hash = NULL;
74	L->Mbuffer = NULL;
75	L->Mbuffsize = 0;
76	L->rootproto = NULL;
77	L->rootcl = NULL;
78	L->roottable = NULL;
79	L->TMtable = NULL;
80	L->last_tag = -1;
81	L->refArray = NULL;
82	L->refSize = 0;
83	L->refFree = NONEXT;
84	L->nblocks = sizeof(lua_State);
85	L->GCthreshold = MAX_INT; /* to avoid GC during pre-definitions */
86	L->callhook = NULL;
87	L->linehook = NULL;
88	L->allowhooks = 1;
89	L->errorJmp = NULL;	129	L->errorJmp = NULL;
90	if (luaD_runprotected(L, f_luaopen, &stacksize) != 0) {	130	L->hook = NULL;
91	/* memory allocation error: free partial state */	131	L->hookmask = L->hookinit = 0;
92	lua_close(L);	132	L->basehookcount = 0;
93	return NULL;	133	L->allowhook = 1;
		134	resethookcount(L);
		135	L->openupval = NULL;
		136	L->size_ci = 0;
		137	L->nCcalls = 0;
		138	L->base_ci = L->ci = NULL;
		139	L->errfunc = 0;
		140	setnilvalue(gt(L));
		141	}
		142
		143
		144	static void close_state (lua_State *L) {
		145	luaF_close(L, L->stack); /* close all upvalues for this thread */
		146	if (G(L)) { /* close global state */
		147	luaC_sweep(L, 1); /* collect all elements */
		148	lua_assert(G(L)->rootgc == NULL);
		149	lua_assert(G(L)->rootudata == NULL);
		150	luaS_freeall(L);
		151	luaZ_freebuffer(L, &G(L)->buff);
		152	}
		153	freestack(L, L);
		154	if (G(L)) {
		155	lua_assert(G(L)->nblocks == sizeof(lua_State) + sizeof(global_State));
		156	luaM_freelem(NULL, G(L));
		157	}
		158	freestate(NULL, L);
		159	}
		160
		161
		162	lua_State luaE_newthread (lua_State L) {
		163	lua_State *L1 = mallocstate(L);
		164	luaC_link(L, valtogco(L1), LUA_TTHREAD);
		165	preinit_state(L1);
		166	L1->l_G = L->l_G;
		167	stack_init(L1, L); /* init stack */
		168	setobj2n(gt(L1), gt(L)); /* share table of globals */
		169	return L1;
		170	}
		171
		172
		173	void luaE_freethread (lua_State L, lua_State L1) {
		174	luaF_close(L1, L1->stack); /* close all upvalues for this thread */
		175	lua_assert(L1->openupval == NULL);
		176	freestack(L, L1);
		177	freestate(L, L1);
		178	}
		179
		180
		181	LUA_API lua_State *lua_open (void) {
		182	lua_State *L = mallocstate(NULL);
		183	if (L) { /* allocation OK? */
		184	L->tt = LUA_TTHREAD;
		185	L->marked = 0;
		186	L->next = L->gclist = NULL;
		187	preinit_state(L);
		188	L->l_G = NULL;
		189	if (luaD_rawrunprotected(L, f_luaopen, NULL) != 0) {
		190	/* memory allocation error: free partial state */
		191	close_state(L);
		192	L = NULL;
		193	}
94	}	194	}
95	L->GCthreshold = 2*L->nblocks;	195	lua_userstateopen(L);
96	return L;	196	return L;
97	}	197	}
98		198
99		199
		200	static void callallgcTM (lua_State L, void ud) {
		201	UNUSED(ud);
		202	luaC_callGCTM(L); /* call GC metamethods for all udata */
		203	}
		204
		205
100	LUA_API void lua_close (lua_State *L) {	206	LUA_API void lua_close (lua_State *L) {
101	LUA_ASSERT(L != lua_state \|\| lua_gettop(L) == 0, "garbage in C stack");	207	lua_lock(L);
102	luaC_collect(L, 1); /* collect all elements */	208	L = G(L)->mainthread; /* only the main thread can be closed */
103	LUA_ASSERT(L->rootproto == NULL, "list should be empty");	209	luaF_close(L, L->stack); /* close all upvalues for this thread */
104	LUA_ASSERT(L->rootcl == NULL, "list should be empty");	210	luaC_separateudata(L); /* separate udata that have GC metamethods */
105	LUA_ASSERT(L->roottable == NULL, "list should be empty");	211	L->errfunc = 0; /* no error function during GC metamethods */
106	luaS_freeall(L);	212	do { /* repeat until no more errors */
107	if (L->stack)	213	L->ci = L->base_ci;
108	L->nblocks -= (L->stack_last - L->stack + 1)*sizeof(TObject);	214	L->base = L->top = L->ci->base;
109	luaM_free(L, L->stack);	215	L->nCcalls = 0;
110	L->nblocks -= (L->last_tag+1)*sizeof(struct TM);	216	} while (luaD_rawrunprotected(L, callallgcTM, NULL) != 0);
111	luaM_free(L, L->TMtable);	217	lua_assert(G(L)->tmudata == NULL);
112	L->nblocks -= (L->refSize)*sizeof(struct Ref);	218	close_state(L);
113	luaM_free(L, L->refArray);
114	L->nblocks -= (L->Mbuffsize)*sizeof(char);
115	luaM_free(L, L->Mbuffer);
116	LUA_ASSERT(L->nblocks == sizeof(lua_State), "wrong count for nblocks");
117	luaM_free(L, L);
118	LUA_ASSERT(L != lua_state \|\| memdebug_numblocks == 0, "memory leak!");
119	LUA_ASSERT(L != lua_state \|\| memdebug_total == 0,"memory leak!");
120	}	219	}
121		220

src/lstate.h+158−40

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lstate.h,v 1.41 2000/10/05 13:00:17 roberto Exp $	2	** $Id: lstate.h,v 1.109 2003/02/27 11:52:30 roberto Exp $
3	** Global State	3	** Global State
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -7,71 +7,189 @@ · 1 unmodified line
7	#ifndef lstate_h	7	#ifndef lstate_h
8	#define lstate_h	8	#define lstate_h
9		9
10	#include "lobject.h"
11	#include "lua.h"	10	#include "lua.h"
12	#include "luadebug.h"
13
14		11
15		12	#include "lobject.h"
16	typedef TObject StkId; / index to stack elements */	13	#include "ltm.h"
		14	#include "lzio.h"
17		15
18		16
19	/*	17	/*
20	** marks for Reference array	18	** macros for thread synchronization inside Lua core machine:
		19	** all accesses to the global state and to global objects are synchronized.
		20	** Because threads can read the stack of other threads
		21	** (when running garbage collection),
		22	** a thread must also synchronize any write-access to its own stack.
		23	** Unsynchronized accesses are allowed only when reading its own stack,
		24	** or when reading immutable fields from global objects
		25	** (such as string values and udata values).
21	*/	26	*/
22	#define NONEXT -1 /* to end the free list */	27	#ifndef lua_lock
23	#define HOLD -2	28	#define lua_lock(L) ((void) 0)
24	#define COLLECTED -3	29	#endif
25	#define LOCK -4
26		30
		31	#ifndef lua_unlock
		32	#define lua_unlock(L) ((void) 0)
		33	#endif
		34
		35
		36	#ifndef lua_userstateopen
		37	#define lua_userstateopen(l)
		38	#endif
27		39
28	struct Ref {
29	TObject o;
30	int st; /* can be LOCK, HOLD, COLLECTED, or next (for free list) */
31	};
32		40
33		41
34	struct lua_longjmp; /* defined in ldo.c */	42	struct lua_longjmp; /* defined in ldo.c */
35	struct TM; /* defined in ltm.h */	43
		44
		45	/* default meta table (both for tables and udata) */
		46	#define defaultmeta(L) (&G(L)->_defaultmeta)
		47
		48	/* table of globals */
		49	#define gt(L) (&L->_gt)
		50
		51	/* registry */
		52	#define registry(L) (&G(L)->_registry)
		53
		54
		55	/* extra stack space to handle TM calls and some other extras */
		56	#define EXTRA_STACK 5
		57
		58
		59	#define BASIC_CI_SIZE 8
		60
		61	#define BASIC_STACK_SIZE (2*LUA_MINSTACK)
		62
36		63
37		64
38	typedef struct stringtable {	65	typedef struct stringtable {
		66	GCObject **hash;
		67	ls_nstr nuse; /* number of elements */
39	int size;	68	int size;
40	lint32 nuse; /* number of elements */
41	TString **hash;
42	} stringtable;	69	} stringtable;
43		70
44		71
		72	/*
		73	** informations about a call
		74	*/
		75	typedef struct CallInfo {
		76	StkId base; /* base for called function */
		77	StkId top; /* top for this function */
		78	int state; /* bit fields; see below */
		79	union {
		80	struct { /* for Lua functions */
		81	const Instruction *savedpc;
		82	const Instruction *pc; / points to `pc' variable in `luaV_execute' */
		83	int tailcalls; /* number of tail calls lost under this entry */
		84	} l;
		85	struct { /* for C functions */
		86	int dummy; /* just to avoid an empty struct */
		87	} c;
		88	} u;
		89	} CallInfo;
		90
		91
		92	/*
		93	** bit fields for `CallInfo.state'
		94	*/
		95	#define CI_C (1<<0) /* 1 if function is a C function */
		96	/* 1 if (Lua) function has an active `luaV_execute' running it */
		97	#define CI_HASFRAME (1<<1)
		98	/* 1 if Lua function is calling another Lua function (and therefore its
		99	`pc' is being used by the other, and therefore CI_SAVEDPC is 1 too) */
		100	#define CI_CALLING (1<<2)
		101	#define CI_SAVEDPC (1<<3) /* 1 if `savedpc' is updated */
		102	#define CI_YIELD (1<<4) /* 1 if thread is suspended */
		103
		104
		105	#define ci_func(ci) (clvalue((ci)->base - 1))
		106
45		107
		108	/*
		109	** `global state', shared by all threads of this state
		110	*/
		111	typedef struct global_State {
		112	stringtable strt; /* hash table for strings */
		113	GCObject rootgc; / list of (almost) all collectable objects */
		114	GCObject rootudata; / (separated) list of all userdata */
		115	GCObject tmudata; / list of userdata to be GC */
		116	Mbuffer buff; /* temporary buffer for string concatentation */
		117	lu_mem GCthreshold;
		118	lu_mem nblocks; /* number of `bytes' currently allocated */
		119	lua_CFunction panic; /* to be called in unprotected errors */
		120	TObject _registry;
		121	TObject _defaultmeta;
		122	struct lua_State *mainthread;
		123	Node dummynode[1]; /* common node array for all empty tables */
		124	TString tmname[TM_N]; / array with tag-method names */
		125	} global_State;
		126
		127
		128	/*
		129	** `per thread' state
		130	*/
46	struct lua_State {	131	struct lua_State {
47	/* thread-specific state */	132	CommonHeader;
48	StkId top; /* first free slot in the stack */	133	StkId top; /* first free slot in the stack */
49	StkId stack; /* stack base */	134	StkId base; /* base of current function */
		135	global_State *l_G;
		136	CallInfo ci; / call info for current function */
50	StkId stack_last; /* last free slot in the stack */	137	StkId stack_last; /* last free slot in the stack */
		138	StkId stack; /* stack base */
51	int stacksize;	139	int stacksize;
52	StkId Cbase; /* base for current C function */	140	CallInfo end_ci; / points after end of ci array*/
		141	CallInfo base_ci; / array of CallInfo's */
		142	unsigned short size_ci; /* size of array `base_ci' */
		143	unsigned short nCcalls; /* number of nested C calls */
		144	lu_byte hookmask;
		145	lu_byte allowhook;
		146	lu_byte hookinit;
		147	int basehookcount;
		148	int hookcount;
		149	lua_Hook hook;
		150	TObject _gt; /* table of globals */
		151	GCObject openupval; / list of open upvalues in this stack */
		152	GCObject *gclist;
53	struct lua_longjmp errorJmp; / current error recover point */	153	struct lua_longjmp errorJmp; / current error recover point */
54	char Mbuffer; / global buffer */	154	ptrdiff_t errfunc; /* current error handling function (stack index) */
55	size_t Mbuffsize; /* size of Mbuffer */	155	};
56	/* global state */	156
57	Proto rootproto; / list of all prototypes */	157
58	Closure rootcl; / list of all closures */	158	#define G(L) (L->l_G)
59	Hash roottable; / list of all tables */	159
60	stringtable strt; /* hash table for strings */	160
61	stringtable udt; /* hash table for udata */	161	/*
62	Hash gt; / table for globals */	162	** Union of all collectable objects
63	struct TM TMtable; / table for tag methods */	163	*/
64	int last_tag; /* last used tag in TMtable */	164	union GCObject {
65	struct Ref refArray; / locked objects */	165	GCheader gch;
66	int refSize; /* size of refArray */	166	union TString ts;
67	int refFree; /* list of free positions in refArray */	167	union Udata u;
68	unsigned long GCthreshold;	168	union Closure cl;
69	unsigned long nblocks; /* number of `bytes' currently allocated */	169	struct Table h;
70	lua_Hook callhook;	170	struct Proto p;
71	lua_Hook linehook;	171	struct UpVal uv;
72	int allowhooks;	172	struct lua_State th; /* thread */
73	};	173	};
74		174
75		175
		176	/* macros to convert a GCObject into a specific value */
		177	#define gcotots(o) check_exp((o)->gch.tt == LUA_TSTRING, &((o)->ts))
		178	#define gcotou(o) check_exp((o)->gch.tt == LUA_TUSERDATA, &((o)->u))
		179	#define gcotocl(o) check_exp((o)->gch.tt == LUA_TFUNCTION, &((o)->cl))
		180	#define gcotoh(o) check_exp((o)->gch.tt == LUA_TTABLE, &((o)->h))
		181	#define gcotop(o) check_exp((o)->gch.tt == LUA_TPROTO, &((o)->p))
		182	#define gcotouv(o) check_exp((o)->gch.tt == LUA_TUPVAL, &((o)->uv))
		183	#define ngcotouv(o) \
		184	check_exp((o) == NULL \|\| (o)->gch.tt == LUA_TUPVAL, &((o)->uv))
		185	#define gcototh(o) check_exp((o)->gch.tt == LUA_TTHREAD, &((o)->th))
		186
		187	/* macro to convert any value into a GCObject */
		188	#define valtogco(v) (cast(GCObject *, (v)))
		189
		190
		191	lua_State luaE_newthread (lua_State L);
		192	void luaE_freethread (lua_State L, lua_State L1);
		193
76	#endif	194	#endif
77		195

src/lstring.c+55−108

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lstring.c,v 1.45a 2000/10/30 17:49:19 roberto Exp $	2	** $Id: lstring.c,v 1.78 2002/12/04 17:38:31 roberto Exp $
3	** String table (keeps all strings handled by Lua)	3	** String table (keeps all strings handled by Lua)
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -7,6 +7,8 @@ · 1 unmodified line
7		7
8	#include <string.h>	8	#include <string.h>
9		9
		10	#define lstring_c
		11
10	#include "lua.h"	12	#include "lua.h"
11		13
12	#include "lmem.h"	14	#include "lmem.h"
@@ -15,141 +17,86 @@ · 2 unmodified lines
15	#include "lstring.h"	17	#include "lstring.h"
16		18
17		19
18	/*
19	** type equivalent to TString, but with maximum alignment requirements
20	*/
21	union L_UTString {
22	TString ts;
23	union L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */
24	};
25
26
27
28	void luaS_init (lua_State *L) {
29	L->strt.hash = luaM_newvector(L, 1, TString *);
30	L->udt.hash = luaM_newvector(L, 1, TString *);
31	L->nblocks += 2sizeof(TString );
32	L->strt.size = L->udt.size = 1;
33	L->strt.nuse = L->udt.nuse = 0;
34	L->strt.hash[0] = L->udt.hash[0] = NULL;
35	}
36
37		20
38	void luaS_freeall (lua_State *L) {	21	void luaS_freeall (lua_State *L) {
39	LUA_ASSERT(L->strt.nuse==0, "non-empty string table");	22	lua_assert(G(L)->strt.nuse==0);
40	L->nblocks -= (L->strt.size + L->udt.size)sizeof(TString );	23	luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size, TString *);
41	luaM_free(L, L->strt.hash);
42	LUA_ASSERT(L->udt.nuse==0, "non-empty udata table");
43	luaM_free(L, L->udt.hash);
44	}
45
46
47	static unsigned long hash_s (const char *s, size_t l) {
48	unsigned long h = l; /* seed */
49	size_t step = (l>>5)\|1; /* if string is too long, don't hash all its chars */
50	for (; l>=step; l-=step)
51	h = h ^ ((h<<5)+(h>>2)+(unsigned char)*(s++));
52	return h;
53	}	24	}
54		25
55		26
56	void luaS_resize (lua_State L, stringtable tb, int newsize) {	27	void luaS_resize (lua_State *L, int newsize) {
57	TString *newhash = luaM_newvector(L, newsize, TString );	28	GCObject *newhash = luaM_newvector(L, newsize, GCObject );
		29	stringtable *tb = &G(L)->strt;
58	int i;	30	int i;
59	for (i=0; i<newsize; i++) newhash[i] = NULL;	31	for (i=0; i<newsize; i++) newhash[i] = NULL;
60	/* rehash */	32	/* rehash */
61	for (i=0; i<tb->size; i++) {	33	for (i=0; i<tb->size; i++) {
62	TString *p = tb->hash[i];	34	GCObject *p = tb->hash[i];
63	while (p) { /* for each node in the list */	35	while (p) { /* for each node in the list */
64	TString next = p->nexthash; / save next */	36	GCObject next = p->gch.next; / save next */
65	unsigned long h = (tb == &L->strt) ? p->u.s.hash : IntPoint(p->u.d.value);	37	lu_hash h = gcotots(p)->tsv.hash;
66	int h1 = h&(newsize-1); /* new position */	38	int h1 = lmod(h, newsize); /* new position */
67	LUA_ASSERT(h%newsize == (h&(newsize-1)),	39	lua_assert(cast(int, h%newsize) == lmod(h, newsize));
68	"a&(x-1) == a%x, for x power of 2");	40	p->gch.next = newhash[h1]; /* chain it */
69	p->nexthash = newhash[h1]; /* chain it in new position */
70	newhash[h1] = p;	41	newhash[h1] = p;
71	p = next;	42	p = next;
72	}	43	}
73	}	44	}
74	luaM_free(L, tb->hash);	45	luaM_freearray(L, tb->hash, tb->size, TString *);
75	L->nblocks += (newsize - tb->size)sizeof(TString );
76	tb->size = newsize;	46	tb->size = newsize;
77	tb->hash = newhash;	47	tb->hash = newhash;
78	}	48	}
79		49
80		50
81	static void newentry (lua_State L, stringtable tb, TString *ts, int h) {	51	static TString newlstr (lua_State L, const char *str, size_t l, lu_hash h) {
82	ts->nexthash = tb->hash[h]; /* chain new entry */	52	TString ts = cast(TString , luaM_malloc(L, sizestring(l)));
83	tb->hash[h] = ts;	53	stringtable *tb;
		54	ts->tsv.len = l;
		55	ts->tsv.hash = h;
		56	ts->tsv.marked = 0;
		57	ts->tsv.tt = LUA_TSTRING;
		58	ts->tsv.reserved = 0;
		59	memcpy(ts+1, str, l*sizeof(char));
		60	((char )(ts+1))[l] = '\0'; / ending 0 */
		61	tb = &G(L)->strt;
		62	h = lmod(h, tb->size);
		63	ts->tsv.next = tb->hash[h]; /* chain new entry */
		64	tb->hash[h] = valtogco(ts);
84	tb->nuse++;	65	tb->nuse++;
85	if (tb->nuse > (lint32)tb->size && tb->size < MAX_INT/2) /* too crowded? */	66	if (tb->nuse > cast(ls_nstr, tb->size) && tb->size <= MAX_INT/2)
86	luaS_resize(L, tb, tb->size*2);	67	luaS_resize(L, tb->size2); / too crowded */
87	}
88
89
90
91	TString luaS_newlstr (lua_State L, const char *str, size_t l) {
92	unsigned long h = hash_s(str, l);
93	int h1 = h & (L->strt.size-1);
94	TString *ts;
95	for (ts = L->strt.hash[h1]; ts; ts = ts->nexthash) {
96	if (ts->len == l && (memcmp(str, ts->str, l) == 0))
97	return ts;
98	}
99	/* not found */
100	ts = (TString *)luaM_malloc(L, sizestring(l));
101	ts->marked = 0;
102	ts->nexthash = NULL;
103	ts->len = l;
104	ts->u.s.hash = h;
105	ts->u.s.constindex = 0;
106	memcpy(ts->str, str, l);
107	ts->str[l] = 0; /* ending 0 */
108	L->nblocks += sizestring(l);
109	newentry(L, &L->strt, ts, h1); /* insert it on table */
110	return ts;
111	}
112
113
114	TString luaS_newudata (lua_State L, size_t s, void *udata) {
115	union L_UTString uts = (union L_UTString )luaM_malloc(L,
116	(lint32)sizeof(union L_UTString)+s);
117	TString *ts = &uts->ts;
118	ts->marked = 0;
119	ts->nexthash = NULL;
120	ts->len = s;
121	ts->u.d.tag = 0;
122	ts->u.d.value = (s > 0) ? uts+1 : udata;
123	L->nblocks += sizestring(s);
124	/* insert it on table */
125	newentry(L, &L->udt, ts, IntPoint(ts->u.d.value) & (L->udt.size-1));
126	return ts;	68	return ts;
127	}	69	}
128		70
129		71
130	TString luaS_createudata (lua_State L, void *udata, int tag) {	72	TString luaS_newlstr (lua_State L, const char *str, size_t l) {
131	int h1 = IntPoint(udata) & (L->udt.size-1);	73	GCObject *o;
132	TString *ts;	74	lu_hash h = (lu_hash)l; /* seed */
133	for (ts = L->udt.hash[h1]; ts; ts = ts->nexthash) {	75	size_t step = (l>>5)+1; /* if string is too long, don't hash all its chars */
134	if (udata == ts->u.d.value && (tag == ts->u.d.tag \|\| tag == LUA_ANYTAG))	76	size_t l1;
		77	for (l1=l; l1>=step; l1-=step) /* compute hash */
		78	h = h ^ ((h<<5)+(h>>2)+(unsigned char)(str[l1-1]));
		79	for (o = G(L)->strt.hash[lmod(h, G(L)->strt.size)];
		80	o != NULL;
		81	o = o->gch.next) {
		82	TString *ts = gcotots(o);
		83	if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0))
135	return ts;	84	return ts;
136	}	85	}
137	/* not found */	86	return newlstr(L, str, l, h); /* not found */
138	ts = luaS_newudata(L, 0, udata);
139	if (tag != LUA_ANYTAG)
140	ts->u.d.tag = tag;
141	return ts;
142	}	87	}
143		88
144		89
145	TString luaS_new (lua_State L, const char *str) {	90	Udata luaS_newudata (lua_State L, size_t s) {
146	return luaS_newlstr(L, str, strlen(str));	91	Udata *u;
147	}	92	u = cast(Udata *, luaM_malloc(L, sizeudata(s)));
148		93	u->uv.marked = (1<<1); /* is not finalized */
149		94	u->uv.tt = LUA_TUSERDATA;
150	TString luaS_newfixed (lua_State L, const char *str) {	95	u->uv.len = s;
151	TString *ts = luaS_new(L, str);	96	u->uv.metatable = hvalue(defaultmeta(L));
152	if (ts->marked == 0) ts->marked = FIXMARK; /* avoid GC */	97	/* chain it on udata list */
153	return ts;	98	u->uv.next = G(L)->rootudata;
		99	G(L)->rootudata = valtogco(u);
		100	return u;
154	}	101	}
155		102

src/lstring.h+11−15

 /*
-** $Id: lstring.h,v 1.24 2000/10/30 17:49:19 roberto Exp $
+** $Id: lstring.h,v 1.37 2002/08/16 14:45:55 roberto Exp $
 ** String table (keep all strings handled by Lua)
 ** See Copyright Notice in lua.h
 */
 #include "lstate.h"
-/*
-** any TString with mark>=FIXMARK is never collected.
-** Marks>=RESERVEDMARK are used to identify reserved words.
-*/
-#define FIXMARK		2
-#define RESERVEDMARK	3
+#define sizestring(l)	(cast(lu_mem, sizeof(union TString))+ \
+                         (cast(lu_mem, l)+1)*sizeof(char))
+#define sizeudata(l)	(cast(lu_mem, sizeof(union Udata))+(l))
-#define sizestring(l)	((long)sizeof(TString) + \
+#define luaS_new(L, s)	(luaS_newlstr(L, s, strlen(s)))
-                         ((long)(l+1)-TSPACK)*(long)sizeof(char))
+#define luaS_newliteral(L, s)	(luaS_newlstr(L, "" s, \
+                                 (sizeof(s)/sizeof(char))-1))
+#define luaS_fix(s)	((s)->tsv.marked |= (1<<4))
-void luaS_init (lua_State *L);
+void luaS_resize (lua_State *L, int newsize);
-void luaS_resize (lua_State *L, stringtable *tb, int newsize);
+Udata *luaS_newudata (lua_State *L, size_t s);
-TString *luaS_newudata (lua_State *L, size_t s, void *udata);
-TString *luaS_createudata (lua_State *L, void *udata, int tag);
 void luaS_freeall (lua_State *L);
 TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
-TString *luaS_new (lua_State *L, const char *str);
-TString *luaS_newfixed (lua_State *L, const char *str);
 #endif

src/ltable.c+393−187

@@ -1,13 +1,17 @@
1	/*	1	/*
2	** $Id: ltable.c,v 1.58 2000/10/26 12:47:05 roberto Exp $	2	** $Id: ltable.c,v 1.132 2003/04/03 13:35:34 roberto Exp $
3	** Lua tables (hash)	3	** Lua tables (hash)
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	/*	8	/*
9	** Implementation of tables (aka arrays, objects, or hash tables);	9	** Implementation of tables (aka arrays, objects, or hash tables).
10	** uses a mix of chained scatter table with Brent's variation.	10	** Tables keep its elements in two parts: an array part and a hash part.
		11	** Non-negative integer keys are all candidates to be kept in the array
		12	** part. The actual size of the array is the largest `n' such that at
		13	** least half the slots between 0 and n are in use.
		14	** Hash uses a mix of chained scatter table with Brent's variation.
11	** A main invariant of these tables is that, if an element is not	15	** A main invariant of these tables is that, if an element is not
12	** in its main position (i.e. the `original' position that its hash gives	16	** in its main position (i.e. the `original' position that its hash gives
13	** to it), then the colliding element is in its own main position.	17	** to it), then the colliding element is in its own main position.
@@ -17,21 +21,74 @@ · 3 unmodified lines
17	** performance penalties.	21	** performance penalties.
18	*/	22	*/
19		23
		24	#include <string.h>
		25
		26	#define ltable_c
20		27
21	#include "lua.h"	28	#include "lua.h"
22		29
		30	#include "ldebug.h"
		31	#include "ldo.h"
		32	#include "lgc.h"
23	#include "lmem.h"	33	#include "lmem.h"
24	#include "lobject.h"	34	#include "lobject.h"
25	#include "lstate.h"	35	#include "lstate.h"
26	#include "lstring.h"
27	#include "ltable.h"	36	#include "ltable.h"
28		37
29		38
30	#define gcsize(L, n) (sizeof(Hash)+(n)*sizeof(Node))	39	/*
		40	** max size of array part is 2^MAXBITS
		41	*/
		42	#if BITS_INT > 26
		43	#define MAXBITS 24
		44	#else
		45	#define MAXBITS (BITS_INT-2)
		46	#endif
		47
		48	/* check whether `x' < 2^MAXBITS */
		49	#define toobig(x) ((((x)-1) >> MAXBITS) != 0)
31		50
32		51
		52	/* function to convert a lua_Number to int (with any rounding method) */
		53	#ifndef lua_number2int
		54	#define lua_number2int(i,n) ((i)=(int)(n))
		55	#endif
33		56
34	#define TagDefault LUA_TTABLE	57
		58	#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t))))
		59
		60	#define hashstr(t,str) hashpow2(t, (str)->tsv.hash)
		61	#define hashboolean(t,p) hashpow2(t, p)
		62
		63
		64	/*
		65	** for some types, it is better to avoid modulus by power of 2, as
		66	** they tend to have many 2 factors.
		67	*/
		68	#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)\|1))))
		69
		70
		71	#define hashpointer(t,p) hashmod(t, IntPoint(p))
		72
		73
		74	/*
		75	** number of ints inside a lua_Number
		76	*/
		77	#define numints cast(int, sizeof(lua_Number)/sizeof(int))
		78
		79
		80	/*
		81	** hash for lua_Numbers
		82	*/
		83	static Node hashnum (const Table t, lua_Number n) {
		84	unsigned int a[numints];
		85	int i;
		86	n += 1; /* normalize number (avoid -0) */
		87	lua_assert(sizeof(a) <= sizeof(n));
		88	memcpy(a, &n, sizeof(a));
		89	for (i = 1; i < numints; i++) a[0] += a[i];
		90	return hashmod(t, cast(lu_hash, a[0]));
		91	}
35		92
36		93
37		94
@@ -39,226 +96,299 @@ · 1 unmodified line
39	** returns the `main' position of an element in a table (that is, the index	96	** returns the `main' position of an element in a table (that is, the index
40	** of its hash value)	97	** of its hash value)
41	*/	98	*/
42	Node luaH_mainposition (const Hash t, const TObject *key) {	99	Node luaH_mainposition (const Table t, const TObject *key) {
43	unsigned long h;
44	switch (ttype(key)) {	100	switch (ttype(key)) {
45	case LUA_TNUMBER:	101	case LUA_TNUMBER:
46	h = (unsigned long)(long)nvalue(key);	102	return hashnum(t, nvalue(key));
47	break;
48	case LUA_TSTRING:	103	case LUA_TSTRING:
49	h = tsvalue(key)->u.s.hash;	104	return hashstr(t, tsvalue(key));
50	break;	105	case LUA_TBOOLEAN:
51	case LUA_TUSERDATA:	106	return hashboolean(t, bvalue(key));
52	h = IntPoint(tsvalue(key));	107	case LUA_TLIGHTUSERDATA:
53	break;	108	return hashpointer(t, pvalue(key));
54	case LUA_TTABLE:
55	h = IntPoint(hvalue(key));
56	break;
57	case LUA_TFUNCTION:
58	h = IntPoint(clvalue(key));
59	break;
60	default:	109	default:
61	return NULL; /* invalid key */	110	return hashpointer(t, gcvalue(key));
62	}	111	}
63	LUA_ASSERT(h%(unsigned int)t->size == (h&((unsigned int)t->size-1)),
64	"a&(x-1) == a%x, for x power of 2");
65	return &t->node[h&(t->size-1)];
66	}	112	}
67		113
68		114
69	static const TObject luaH_getany (lua_State L, const Hash *t,	115	/*
70	const TObject *key) {	116	** returns the index for `key' if `key' is an appropriate key to live in
71	Node *n = luaH_mainposition(t, key);	117	** the array part of the table, -1 otherwise.
72	if (!n)	118	*/
73	lua_error(L, "table index is nil");	119	static int arrayindex (const TObject *key) {
74	else do {	120	if (ttisnumber(key)) {
75	if (luaO_equalObj(key, &n->key))	121	int k;
76	return &n->val;	122	lua_number2int(k, (nvalue(key)));
77	n = n->next;	123	if (cast(lua_Number, k) == nvalue(key) && k >= 1 && !toobig(k))
78	} while (n);	124	return k;
79	return &luaO_nilobject; /* key not found */	125	}
		126	return -1; /* `key' did not match some condition */
80	}	127	}
81		128
82		129
83	/* specialized version for numbers */	130	/*
84	const TObject luaH_getnum (const Hash t, Number key) {	131	** returns the index of a `key' for table traversals. First goes all
85	Node *n = &t->node[(unsigned long)(long)key&(t->size-1)];	132	** elements in the array part, then elements in the hash part. The
86	do {	133	** beginning and end of a traversal are signalled by -1.
87	if (ttype(&n->key) == LUA_TNUMBER && nvalue(&n->key) == key)	134	*/
88	return &n->val;	135	static int luaH_index (lua_State L, Table t, StkId key) {
89	n = n->next;	136	int i;
90	} while (n);	137	if (ttisnil(key)) return -1; /* first iteration */
91	return &luaO_nilobject; /* key not found */	138	i = arrayindex(key);
		139	if (0 <= i && i <= t->sizearray) { /* is `key' inside array part? */
		140	return i-1; /* yes; that's the index (corrected to C) */
		141	}
		142	else {
		143	const TObject *v = luaH_get(t, key);
		144	if (v == &luaO_nilobject)
		145	luaG_runerror(L, "invalid key for `next'");
		146	i = cast(int, (cast(const lu_byte *, v) -
		147	cast(const lu_byte *, gval(gnode(t, 0)))) / sizeof(Node));
		148	return i + t->sizearray; /* hash elements are numbered after array ones */
		149	}
92	}	150	}
93		151
94		152
95	/* specialized version for strings */	153	int luaH_next (lua_State L, Table t, StkId key) {
96	const TObject luaH_getstr (const Hash t, TString *key) {	154	int i = luaH_index(L, t, key); /* find original element */
97	Node *n = &t->node[key->u.s.hash&(t->size-1)];	155	for (i++; i < t->sizearray; i++) { /* try first array part */
98	do {	156	if (!ttisnil(&t->array[i])) { /* a non-nil value? */
99	if (ttype(&n->key) == LUA_TSTRING && tsvalue(&n->key) == key)	157	setnvalue(key, cast(lua_Number, i+1));
100	return &n->val;	158	setobj2s(key+1, &t->array[i]);
101	n = n->next;	159	return 1;
102	} while (n);	160	}
103	return &luaO_nilobject; /* key not found */	161	}
		162	for (i -= t->sizearray; i < sizenode(t); i++) { /* then hash part */
		163	if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */
		164	setobj2s(key, gkey(gnode(t, i)));
		165	setobj2s(key+1, gval(gnode(t, i)));
		166	return 1;
		167	}
		168	}
		169	return 0; /* no more elements */
104	}	170	}
105		171
106		172
107	const TObject luaH_get (lua_State L, const Hash t, const TObject key) {	173	/*
108	switch (ttype(key)) {	174	** {=============================================================
109	case LUA_TNUMBER: return luaH_getnum(t, nvalue(key));	175	** Rehash
110	case LUA_TSTRING: return luaH_getstr(t, tsvalue(key));	176	** ==============================================================
111	default: return luaH_getany(L, t, key);	177	*/
		178
		179
		180	static void computesizes (int nums[], int ntotal, int narray, int nhash) {
		181	int i;
		182	int a = nums[0]; /* number of elements smaller than 2^i */
		183	int na = a; /* number of elements to go to array part */
		184	int n = (na == 0) ? -1 : 0; /* (log of) optimal size for array part */
		185	for (i = 1; a < narray && narray >= twoto(i-1); i++) {
		186	if (nums[i] > 0) {
		187	a += nums[i];
		188	if (a >= twoto(i-1)) { /* more than half elements in use? */
		189	n = i;
		190	na = a;
		191	}
		192	}
112	}	193	}
		194	lua_assert(na <= narray && narray <= ntotal);
		195	*nhash = ntotal - na;
		196	*narray = (n == -1) ? 0 : twoto(n);
		197	lua_assert(na <= narray && na >= narray/2);
113	}	198	}
114		199
115		200
116	Node luaH_next (lua_State L, const Hash t, const TObject key) {	201	static void numuse (const Table t, int narray, int *nhash) {
117	int i;	202	int nums[MAXBITS+1];
118	if (ttype(key) == LUA_TNIL)	203	int i, lg;
119	i = 0; /* first iteration */	204	int totaluse = 0;
120	else {	205	/* count elements in array part */
121	const TObject *v = luaH_get(L, t, key);	206	for (i=0, lg=0; lg<=MAXBITS; lg++) { /* for each slice [2^(lg-1) to 2^lg) */
122	if (v == &luaO_nilobject)	207	int ttlg = twoto(lg); /* 2^lg */
123	lua_error(L, "invalid key for `next'");	208	if (ttlg > t->sizearray) {
124	i = (int)(((const char *)v -	209	ttlg = t->sizearray;
125	(const char *)(&t->node[0].val)) / sizeof(Node)) + 1;	210	if (i >= ttlg) break;
		211	}
		212	nums[lg] = 0;
		213	for (; i<ttlg; i++) {
		214	if (!ttisnil(&t->array[i])) {
		215	nums[lg]++;
		216	totaluse++;
		217	}
		218	}
126	}	219	}
127	for (; i<t->size; i++) {	220	for (; lg<=MAXBITS; lg++) nums[lg] = 0; /* reset other counts */
128	Node *n = node(t, i);	221	narray = totaluse; / all previous uses were in array part */
129	if (ttype(val(n)) != LUA_TNIL)	222	/* count elements in hash part */
130	return n;	223	i = sizenode(t);
		224	while (i--) {
		225	Node *n = &t->node[i];
		226	if (!ttisnil(gval(n))) {
		227	int k = arrayindex(gkey(n));
		228	if (k >= 0) { /* is `key' an appropriate array index? */
		229	nums[luaO_log2(k-1)+1]++; /* count as such */
		230	(*narray)++;
		231	}
		232	totaluse++;
		233	}
131	}	234	}
132	return NULL; /* no more elements */	235	computesizes(nums, totaluse, narray, nhash);
133	}	236	}
134		237
135		238
136	/*	239	static void setarrayvector (lua_State L, Table t, int size) {
137	** try to remove a key without value from a table. To avoid problems with	240	int i;
138	** hash, change `key' for a number with the same hash.	241	luaM_reallocvector(L, t->array, t->sizearray, size, TObject);
139	*/	242	for (i=t->sizearray; i<size; i++)
140	void luaH_remove (Hash t, TObject key) {	243	setnilvalue(&t->array[i]);
141	if (ttype(key) == LUA_TNUMBER \|\|	244	t->sizearray = size;
142	(ttype(key) == LUA_TSTRING && tsvalue(key)->len <= 30))	245	}
143	return; /* do not remove numbers nor small strings */	246
		247
		248	static void setnodevector (lua_State L, Table t, int lsize) {
		249	int i;
		250	int size = twoto(lsize);
		251	if (lsize > MAXBITS)
		252	luaG_runerror(L, "table overflow");
		253	if (lsize == 0) { /* no elements to hash part? */
		254	t->node = G(L)->dummynode; /* use common `dummynode' */
		255	lua_assert(ttisnil(gkey(t->node))); /* assert invariants: */
		256	lua_assert(ttisnil(gval(t->node)));
		257	lua_assert(t->node->next == NULL); /* (`dummynode' must be empty) */
		258	}
144	else {	259	else {
145	/* try to find a number `n' with the same hash as `key' */	260	t->node = luaM_newvector(L, size, Node);
146	Node *mp = luaH_mainposition(t, key);	261	for (i=0; i<size; i++) {
147	int n = mp - &t->node[0];	262	t->node[i].next = NULL;
148	/* make sure `n' is not in `t' */	263	setnilvalue(gkey(gnode(t, i)));
149	while (luaH_getnum(t, n) != &luaO_nilobject) {	264	setnilvalue(gval(gnode(t, i)));
150	if (n >= MAX_INT - t->size)
151	return; /* give up; (to avoid overflow) */
152	n += t->size;
153	}	265	}
154	ttype(key) = LUA_TNUMBER;
155	nvalue(key) = n;
156	LUA_ASSERT(luaH_mainposition(t, key) == mp, "cannot change hash");
157	}	266	}
		267	t->lsizenode = cast(lu_byte, lsize);
		268	t->firstfree = gnode(t, size-1); /* first free position to be used */
158	}	269	}
159		270
160		271
161	static void setnodevector (lua_State L, Hash t, lint32 size) {	272	static void resize (lua_State L, Table t, int nasize, int nhsize) {
162	int i;	273	int i;
163	if (size > MAX_INT)	274	int oldasize = t->sizearray;
164	lua_error(L, "table overflow");	275	int oldhsize = t->lsizenode;
165	t->node = luaM_newvector(L, size, Node);	276	Node *nold;
166	for (i=0; i<(int)size; i++) {	277	Node temp[1];
167	ttype(&t->node[i].key) = ttype(&t->node[i].val) = LUA_TNIL;	278	if (oldhsize)
168	t->node[i].next = NULL;	279	nold = t->node; /* save old hash ... */
		280	else { /* old hash is `dummynode' */
		281	lua_assert(t->node == G(L)->dummynode);
		282	temp[0] = t->node[0]; /* copy it to `temp' */
		283	nold = temp;
		284	setnilvalue(gkey(G(L)->dummynode)); /* restate invariant */
		285	setnilvalue(gval(G(L)->dummynode));
		286	lua_assert(G(L)->dummynode->next == NULL);
		287	}
		288	if (nasize > oldasize) /* array part must grow? */
		289	setarrayvector(L, t, nasize);
		290	/* create new hash part with appropriate size */
		291	setnodevector(L, t, nhsize);
		292	/* re-insert elements */
		293	if (nasize < oldasize) { /* array part must shrink? */
		294	t->sizearray = nasize;
		295	/* re-insert elements from vanishing slice */
		296	for (i=nasize; i<oldasize; i++) {
		297	if (!ttisnil(&t->array[i]))
		298	setobjt2t(luaH_setnum(L, t, i+1), &t->array[i]);
		299	}
		300	/* shrink array */
		301	luaM_reallocvector(L, t->array, oldasize, nasize, TObject);
169	}	302	}
170	L->nblocks += gcsize(L, size) - gcsize(L, t->size);	303	/* re-insert elements in hash part */
171	t->size = size;	304	for (i = twoto(oldhsize) - 1; i >= 0; i--) {
172	t->firstfree = &t->node[size-1]; /* first free position to be used */	305	Node *old = nold+i;
		306	if (!ttisnil(gval(old)))
		307	setobjt2t(luaH_set(L, t, gkey(old)), gval(old));
		308	}
		309	if (oldhsize)
		310	luaM_freearray(L, nold, twoto(oldhsize), Node); /* free old array */
173	}	311	}
174		312
175		313
176	Hash luaH_new (lua_State L, int size) {	314	static void rehash (lua_State L, Table t) {
177	Hash *t = luaM_new(L, Hash);	315	int nasize, nhsize;
178	t->htag = TagDefault;	316	numuse(t, &nasize, &nhsize); /* compute new sizes for array and hash parts */
179	t->next = L->roottable;	317	resize(L, t, nasize, luaO_log2(nhsize)+1);
180	L->roottable = t;
181	t->mark = t;
182	t->size = 0;
183	L->nblocks += gcsize(L, 0);
184	t->node = NULL;
185	setnodevector(L, t, luaO_power2(size));
186	return t;
187	}	318	}
188		319
189		320
190	void luaH_free (lua_State L, Hash t) {	321
191	L->nblocks -= gcsize(L, t->size);	322	/*
192	luaM_free(L, t->node);	323	** }=============================================================
193	luaM_free(L, t);	324	*/
		325
		326
		327	Table luaH_new (lua_State L, int narray, int lnhash) {
		328	Table *t = luaM_new(L, Table);
		329	luaC_link(L, valtogco(t), LUA_TTABLE);
		330	t->metatable = hvalue(defaultmeta(L));
		331	t->flags = cast(lu_byte, ~0);
		332	/* temporary values (kept only if some malloc fails) */
		333	t->array = NULL;
		334	t->sizearray = 0;
		335	t->lsizenode = 0;
		336	t->node = NULL;
		337	setarrayvector(L, t, narray);
		338	setnodevector(L, t, lnhash);
		339	return t;
194	}	340	}
195		341
196		342
197	static int numuse (const Hash *t) {	343	void luaH_free (lua_State L, Table t) {
198	Node *v = t->node;	344	if (t->lsizenode)
199	int size = t->size;	345	luaM_freearray(L, t->node, sizenode(t), Node);
200	int realuse = 0;	346	luaM_freearray(L, t->array, t->sizearray, TObject);
201	int i;	347	luaM_freelem(L, t);
202	for (i=0; i<size; i++) {
203	if (ttype(&v[i].val) != LUA_TNIL)
204	realuse++;
205	}
206	return realuse;
207	}	348	}
208		349
209		350
210	static void rehash (lua_State L, Hash t) {	351	#if 0
211	int oldsize = t->size;	352	/*
212	Node *nold = t->node;	353	** try to remove an element from a hash table; cannot move any element
213	int nelems = numuse(t);	354	** (because gc can call `remove' during a table traversal)
214	int i;	355	*/
215	LUA_ASSERT(nelems<=oldsize, "wrong count");	356	void luaH_remove (Table t, Node e) {
216	if (nelems >= oldsize-oldsize/4) /* using more than 3/4? */	357	Node *mp = luaH_mainposition(t, gkey(e));
217	setnodevector(L, t, (lint32)oldsize*2);	358	if (e != mp) { /* element not in its main position? */
218	else if (nelems <= oldsize/4 && /* less than 1/4? */	359	while (mp->next != e) mp = mp->next; /* find previous */
219	oldsize > MINPOWER2)	360	mp->next = e->next; /* remove `e' from its list */
220	setnodevector(L, t, oldsize/2);	361	}
221	else	362	else {
222	setnodevector(L, t, oldsize);	363	if (e->next != NULL) ??
223	for (i=0; i<oldsize; i++) {
224	Node *old = nold+i;
225	if (ttype(&old->val) != LUA_TNIL)
226	*luaH_set(L, t, &old->key) = old->val;
227	}	364	}
228	luaM_free(L, nold); /* free old array */	365	lua_assert(ttisnil(gval(node)));
		366	setnilvalue(gkey(e)); /* clear node `e' */
		367	e->next = NULL;
229	}	368	}
		369	#endif
230		370
231		371
232	/*	372	/*
233	** inserts a key into a hash table; first, check whether key is	373	** inserts a new key into a hash table; first, check whether key's main
234	** already present; if not, check whether key's main position is free;	374	** position is free. If not, check whether colliding node is in its main
235	** if not, check whether colliding node is in its main position or not;	375	** position or not: if it is not, move colliding node to an empty place and
236	** if it is not, move colliding node to an empty place and put new key	376	** put new key in its main position; otherwise (colliding node is in its main
237	** in its main position; otherwise (colliding node is in its main position),	377	** position), new key goes to an empty position.
238	** new key goes to an empty position.
239	*/	378	*/
240	TObject luaH_set (lua_State L, Hash t, const TObject key) {	379	static TObject newkey (lua_State L, Table t, const TObject key) {
		380	TObject *val;
241	Node *mp = luaH_mainposition(t, key);	381	Node *mp = luaH_mainposition(t, key);
242	Node *n = mp;	382	if (!ttisnil(gval(mp))) { /* main position is not free? */
243	if (!mp)	383	Node othern = luaH_mainposition(t, gkey(mp)); / `mp' of colliding node */
244	lua_error(L, "table index is nil");	384	Node n = t->firstfree; / get a free place */
245	do { /* check whether `key' is somewhere in the chain */	385	if (othern != mp) { /* is colliding node out of its main position? */
246	if (luaO_equalObj(key, &n->key))
247	return &n->val; /* that's all */
248	else n = n->next;
249	} while (n);
250	/* `key' not found; must insert it */
251	if (ttype(&mp->key) != LUA_TNIL) { /* main position is not free? */
252	Node othern; / main position of colliding node */
253	n = t->firstfree; /* get a free place */
254	/* is colliding node out of its main position? (can only happens if
255	its position is after "firstfree") */
256	if (mp > n && (othern=luaH_mainposition(t, &mp->key)) != mp) {
257	/* yes; move colliding node into free position */	386	/* yes; move colliding node into free position */
258	while (othern->next != mp) othern = othern->next; /* find previous */	387	while (othern->next != mp) othern = othern->next; /* find previous */
259	othern->next = n; /* redo the chain with `n' in place of `mp' */	388	othern->next = n; /* redo the chain with `n' in place of `mp' */
260	n = mp; /* copy colliding node into free pos. (mp->next also goes) */	389	n = mp; /* copy colliding node into free pos. (mp->next also goes) */
261	mp->next = NULL; /* now `mp' is free */	390	mp->next = NULL; /* now `mp' is free */
		391	setnilvalue(gval(mp));
262	}	392	}
263	else { /* colliding node is in its own main position */	393	else { /* colliding node is in its own main position */
264	/* new node will go into free position */	394	/* new node will go into free position */
@@ -267,37 +397,113 @@ TObject luaH_set (lua_State L, Hash t, const TObject key) { · 2 unmodified lines
267	mp = n;	397	mp = n;
268	}	398	}
269	}	399	}
270	mp->key = *key;	400	setobj2t(gkey(mp), key); /* write barrier */
		401	lua_assert(ttisnil(gval(mp)));
271	for (;;) { /* correct `firstfree' */	402	for (;;) { /* correct `firstfree' */
272	if (ttype(&t->firstfree->key) == LUA_TNIL)	403	if (ttisnil(gkey(t->firstfree)))
273	return &mp->val; /* OK; table still has a free place */	404	return gval(mp); /* OK; table still has a free place */
274	else if (t->firstfree == t->node) break; /* cannot decrement from here */	405	else if (t->firstfree == t->node) break; /* cannot decrement from here */
275	else (t->firstfree)--;	406	else (t->firstfree)--;
276	}	407	}
277	rehash(L, t); /* no more free places */	408	/* no more free places; must create one */
278	return luaH_set(L, t, key); /* `rehash' invalidates this insertion */	409	setbvalue(gval(mp), 0); /* avoid new key being removed */
		410	rehash(L, t); /* grow table */
		411	val = cast(TObject , luaH_get(t, key)); / get new position */
		412	lua_assert(ttisboolean(val));
		413	setnilvalue(val);
		414	return val;
		415	}
		416
		417
		418	/*
		419	** generic search function
		420	*/
		421	static const TObject luaH_getany (Table t, const TObject *key) {
		422	if (ttisnil(key)) return &luaO_nilobject;
		423	else {
		424	Node *n = luaH_mainposition(t, key);
		425	do { /* check whether `key' is somewhere in the chain */
		426	if (luaO_rawequalObj(gkey(n), key)) return gval(n); /* that's it */
		427	else n = n->next;
		428	} while (n);
		429	return &luaO_nilobject;
		430	}
279	}	431	}
280		432
281		433
282	TObject luaH_setint (lua_State L, Hash *t, int key) {	434	/*
283	TObject index;	435	** search function for integers
284	ttype(&index) = LUA_TNUMBER;	436	*/
285	nvalue(&index) = key;	437	const TObject luaH_getnum (Table t, int key) {
286	return luaH_set(L, t, &index);	438	if (1 <= key && key <= t->sizearray)
		439	return &t->array[key-1];
		440	else {
		441	lua_Number nk = cast(lua_Number, key);
		442	Node *n = hashnum(t, nk);
		443	do { /* check whether `key' is somewhere in the chain */
		444	if (ttisnumber(gkey(n)) && nvalue(gkey(n)) == nk)
		445	return gval(n); /* that's it */
		446	else n = n->next;
		447	} while (n);
		448	return &luaO_nilobject;
		449	}
287	}	450	}
288		451
289		452
290	void luaH_setstrnum (lua_State L, Hash t, TString *key, Number val) {	453	/*
291	TObject *value, index;	454	** search function for strings
292	ttype(&index) = LUA_TSTRING;	455	*/
293	tsvalue(&index) = key;	456	const TObject luaH_getstr (Table t, TString *key) {
294	value = luaH_set(L, t, &index);	457	Node *n = hashstr(t, key);
295	ttype(value) = LUA_TNUMBER;	458	do { /* check whether `key' is somewhere in the chain */
296	nvalue(value) = val;	459	if (ttisstring(gkey(n)) && tsvalue(gkey(n)) == key)
		460	return gval(n); /* that's it */
		461	else n = n->next;
		462	} while (n);
		463	return &luaO_nilobject;
297	}	464	}
298		465
299		466
300	const TObject luaH_getglobal (lua_State L, const char *name) {	467	/*
301	return luaH_getstr(L->gt, luaS_new(L, name));	468	** main search function
		469	*/
		470	const TObject luaH_get (Table t, const TObject *key) {
		471	switch (ttype(key)) {
		472	case LUA_TSTRING: return luaH_getstr(t, tsvalue(key));
		473	case LUA_TNUMBER: {
		474	int k;
		475	lua_number2int(k, (nvalue(key)));
		476	if (cast(lua_Number, k) == nvalue(key)) /* is an integer index? */
		477	return luaH_getnum(t, k); /* use specialized version */
		478	/* else go through */
		479	}
		480	default: return luaH_getany(t, key);
		481	}
		482	}
		483
		484
		485	TObject luaH_set (lua_State L, Table t, const TObject key) {
		486	const TObject *p = luaH_get(t, key);
		487	t->flags = 0;
		488	if (p != &luaO_nilobject)
		489	return cast(TObject *, p);
		490	else {
		491	if (ttisnil(key)) luaG_runerror(L, "table index is nil");
		492	else if (ttisnumber(key) && nvalue(key) != nvalue(key))
		493	luaG_runerror(L, "table index is NaN");
		494	return newkey(L, t, key);
		495	}
		496	}
		497
		498
		499	TObject luaH_setnum (lua_State L, Table *t, int key) {
		500	const TObject *p = luaH_getnum(t, key);
		501	if (p != &luaO_nilobject)
		502	return cast(TObject *, p);
		503	else {
		504	TObject k;
		505	setnvalue(&k, cast(lua_Number, key));
		506	return newkey(L, t, &k);
		507	}
302	}	508	}
303		509

src/ltable.h+14−17

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: ltable.h,v 1.24 2000/08/31 14:08:27 roberto Exp $	2	** $Id: ltable.h,v 1.44 2003/03/18 12:50:04 roberto Exp $
3	** Lua tables (hash)	3	** Lua tables (hash)
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -10,25 +10,22 @@ · 4 unmodified lines
10	#include "lobject.h"	10	#include "lobject.h"
11		11
12		12
13	#define node(t,i) (&(t)->node[i])	13	#define gnode(t,i) (&(t)->node[i])
14	#define key(n) (&(n)->key)	14	#define gkey(n) (&(n)->i_key)
15	#define val(n) (&(n)->val)	15	#define gval(n) (&(n)->i_val)
16		16
17	Hash luaH_new (lua_State L, int nhash);	17
18	void luaH_free (lua_State L, Hash t);	18	const TObject luaH_getnum (Table t, int key);
19	const TObject luaH_get (lua_State L, const Hash t, const TObject key);	19	TObject luaH_setnum (lua_State L, Table *t, int key);
20	const TObject luaH_getnum (const Hash t, Number key);	20	const TObject luaH_getstr (Table t, TString *key);
21	const TObject luaH_getstr (const Hash t, TString *key);	21	const TObject luaH_get (Table t, const TObject *key);
22	void luaH_remove (Hash t, TObject key);	22	TObject luaH_set (lua_State L, Table t, const TObject key);
23	TObject luaH_set (lua_State L, Hash t, const TObject key);	23	Table luaH_new (lua_State L, int narray, int lnhash);
24	Node * luaH_next (lua_State L, const Hash t, const TObject *r);	24	void luaH_free (lua_State L, Table t);
25	TObject luaH_setint (lua_State L, Hash *t, int key);	25	int luaH_next (lua_State L, Table t, StkId key);
26	void luaH_setstrnum (lua_State L, Hash t, TString *key, Number val);
27	unsigned long luaH_hash (lua_State L, const TObject key);
28	const TObject luaH_getglobal (lua_State L, const char *name);
29		26
30	/* exported only for debugging */	27	/* exported only for debugging */
31	Node luaH_mainposition (const Hash t, const TObject *key);	28	Node luaH_mainposition (const Table t, const TObject *key);
32		29
33		30
34	#endif	31	#endif

src/ltests.c+500−191

@@ -1,15 +1,17 @@
1	/*	1	/*
2	** $Id: ltests.c,v 1.54 2000/10/31 13:10:24 roberto Exp $	2	** $Id: ltests.c,v 1.158 2003/04/07 14:35:00 roberto Exp $
3	** Internal Module for Debugging of the Lua Implementation	3	** Internal Module for Debugging of the Lua Implementation
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <ctype.h>	8	#include <ctype.h>
		9	#include <limits.h>
9	#include <stdio.h>	10	#include <stdio.h>
10	#include <stdlib.h>	11	#include <stdlib.h>
11	#include <string.h>	12	#include <string.h>
12		13
		14	#define ltests_c
13		15
14	#include "lua.h"	16	#include "lua.h"
15		17
@@ -24,12 +26,9 @@ · 8 unmodified lines
24	#include "lstate.h"	26	#include "lstate.h"
25	#include "lstring.h"	27	#include "lstring.h"
26	#include "ltable.h"	28	#include "ltable.h"
27	#include "luadebug.h"
28	#include "lualib.h"	29	#include "lualib.h"
29		30
30		31
31	void luaB_opentests (lua_State *L);
32
33		32
34	/*	33	/*
35	** The whole module only makes sense with LUA_DEBUG on	34	** The whole module only makes sense with LUA_DEBUG on
@@ -37,14 +36,117 @@ void luaB_opentests (lua_State *L); · 1 unmodified line
37	#ifdef LUA_DEBUG	36	#ifdef LUA_DEBUG
38		37
39		38
		39	#define lua_pushintegral(L,i) lua_pushnumber(L, cast(lua_Number, (i)))
		40
		41
		42	static lua_State *lua_state = NULL;
		43
		44	int islocked = 0;
		45
		46
		47	#define func_at(L,k) (L->ci->base+(k) - 1)
		48
40		49
41	static void setnameval (lua_State L, const char name, int val) {	50	static void setnameval (lua_State L, const char name, int val) {
42	lua_pushstring(L, name);	51	lua_pushstring(L, name);
43	lua_pushnumber(L, val);	52	lua_pushintegral(L, val);
44	lua_settable(L, -3);	53	lua_settable(L, -3);
45	}	54	}
46		55
47		56
		57	/*
		58	** {======================================================================
		59	** Controlled version for realloc.
		60	** =======================================================================
		61	*/
		62
		63	#define MARK 0x55 /* 01010101 (a nice pattern) */
		64
		65	#ifndef EXTERNMEMCHECK
		66	/* full memory check */
		67	#define HEADER (sizeof(L_Umaxalign)) /* ensures maximum alignment for HEADER */
		68	#define MARKSIZE 16 /* size of marks after each block */
		69	#define blockhead(b) (cast(char *, b) - HEADER)
		70	#define setsize(newblock, size) (cast(size_t , newblock) = size)
		71	#define checkblocksize(b, size) (size == (cast(size_t , blockhead(b))))
		72	#define fillmem(mem,size) memset(mem, -MARK, size)
		73	#else
		74	/* external memory check: don't do it twice */
		75	#define HEADER 0
		76	#define MARKSIZE 0
		77	#define blockhead(b) (b)
		78	#define setsize(newblock, size) /* empty */
		79	#define checkblocksize(b,size) (1)
		80	#define fillmem(mem,size) /* empty */
		81	#endif
		82
		83	unsigned long memdebug_numblocks = 0;
		84	unsigned long memdebug_total = 0;
		85	unsigned long memdebug_maxmem = 0;
		86	unsigned long memdebug_memlimit = ULONG_MAX;
		87
		88
		89	static void checkblock (void block, size_t size) {
		90	void *b = blockhead(block);
		91	int i;
		92	for (i=0;i<MARKSIZE;i++)
		93	lua_assert((cast(char , b)+HEADER+size+i) == MARK+i); /* corrupted block? */
		94	return b;
		95	}
		96
		97
		98	static void freeblock (void *block, size_t size) {
		99	if (block) {
		100	lua_assert(checkblocksize(block, size));
		101	block = checkblock(block, size);
		102	fillmem(block, size+HEADER+MARKSIZE); /* erase block */
		103	free(block); /* free original block */
		104	memdebug_numblocks--;
		105	memdebug_total -= size;
		106	}
		107	}
		108
		109
		110	void debug_realloc (void block, size_t oldsize, size_t size) {
		111	lua_assert(oldsize == 0 \|\| checkblocksize(block, oldsize));
		112	/* ISO does not specify what realloc(NULL, 0) does */
		113	lua_assert(block != NULL \|\| size > 0);
		114	if (size == 0) {
		115	freeblock(block, oldsize);
		116	return NULL;
		117	}
		118	else if (size > oldsize && memdebug_total+size-oldsize > memdebug_memlimit)
		119	return NULL; /* to test memory allocation errors */
		120	else {
		121	void *newblock;
		122	int i;
		123	size_t realsize = HEADER+size+MARKSIZE;
		124	size_t commonsize = (oldsize < size) ? oldsize : size;
		125	if (realsize < size) return NULL; /* overflow! */
		126	newblock = malloc(realsize); /* alloc a new block */
		127	if (newblock == NULL) return NULL;
		128	if (block) {
		129	memcpy(cast(char *, newblock)+HEADER, block, commonsize);
		130	freeblock(block, oldsize); /* erase (and check) old copy */
		131	}
		132	/* initialize new part of the block with something `weird' */
		133	fillmem(cast(char *, newblock)+HEADER+commonsize, size-commonsize);
		134	memdebug_total += size;
		135	if (memdebug_total > memdebug_maxmem)
		136	memdebug_maxmem = memdebug_total;
		137	memdebug_numblocks++;
		138	setsize(newblock, size);
		139	for (i=0;i<MARKSIZE;i++)
		140	(cast(char , newblock)+HEADER+size+i) = cast(char, MARK+i);
		141	return cast(char *, newblock)+HEADER;
		142	}
		143	}
		144
		145
		146	/* }====================================================================== */
		147
		148
		149
48	/*	150	/*
49	** {======================================================	151	** {======================================================
50	** Disassembler	152	** Disassembler
@@ -52,73 +154,69 @@ static void setnameval (lua_State L, const char name, int val) { · 1 unmodified line
52	*/	154	*/
53		155
54		156
55	static const char *const instrname[NUM_OPCODES] = {	157	static char buildop (Proto p, int pc, char *buff) {
56	"END", "RETURN", "CALL", "TAILCALL", "PUSHNIL", "POP", "PUSHINT",
57	"PUSHSTRING", "PUSHNUM", "PUSHNEGNUM", "PUSHUPVALUE", "GETLOCAL",
58	"GETGLOBAL", "GETTABLE", "GETDOTTED", "GETINDEXED", "PUSHSELF",
59	"CREATETABLE", "SETLOCAL", "SETGLOBAL", "SETTABLE", "SETLIST", "SETMAP",
60	"ADD", "ADDI", "SUB", "MULT", "DIV", "POW", "CONCAT", "MINUS", "NOT",
61	"JMPNE", "JMPEQ", "JMPLT", "JMPLE", "JMPGT", "JMPGE", "JMPT", "JMPF",
62	"JMPONT", "JMPONF", "JMP", "PUSHNILJMP", "FORPREP", "FORLOOP", "LFORPREP",
63	"LFORLOOP", "CLOSURE"
64	};
65
66
67	static int pushop (lua_State L, Proto p, int pc) {
68	char buff[100];
69	Instruction i = p->code[pc];	158	Instruction i = p->code[pc];
70	OpCode o = GET_OPCODE(i);	159	OpCode o = GET_OPCODE(i);
71	const char *name = instrname[o];	160	const char *name = luaP_opnames[o];
72	sprintf(buff, "%5d - ", luaG_getline(p->lineinfo, pc, 1, NULL));	161	int line = getline(p, pc);
73	switch ((enum Mode)luaK_opproperties[o].mode) {	162	sprintf(buff, "(%4d) %4d - ", line, pc);
74	case iO:	163	switch (getOpMode(o)) {
75	sprintf(buff+8, "%-12s", name);	164	case iABC:
76	break;	165	sprintf(buff+strlen(buff), "%-12s%4d %4d %4d", name,
77	case iU:	166	GETARG_A(i), GETARG_B(i), GETARG_C(i));
78	sprintf(buff+8, "%-12s%4u", name, GETARG_U(i));
79	break;	167	break;
80	case iS:	168	case iABx:
81	sprintf(buff+8, "%-12s%4d", name, GETARG_S(i));	169	sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i), GETARG_Bx(i));
82	break;	170	break;
83	case iAB:	171	case iAsBx:
84	sprintf(buff+8, "%-12s%4d %4d", name, GETARG_A(i), GETARG_B(i));	172	sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i), GETARG_sBx(i));
85	break;	173	break;
86	}	174	}
87	lua_pushstring(L, buff);	175	return buff;
88	return (o != OP_END);
89	}	176	}
90		177
91		178
		179	#if 0
		180	void luaI_printcode (Proto *pt, int size) {
		181	int pc;
		182	for (pc=0; pc<size; pc++) {
		183	char buff[100];
		184	printf("%s\n", buildop(pt, pc, buff));
		185	}
		186	printf("-------\n");
		187	}
		188	#endif
		189
		190
92	static int listcode (lua_State *L) {	191	static int listcode (lua_State *L) {
93	int pc;	192	int pc;
94	Proto *p;	193	Proto *p;
95	int res;	194	luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
96	luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
97	1, "Lua function expected");	195	1, "Lua function expected");
98	p = clvalue(luaA_index(L, 1))->f.l;	196	p = clvalue(func_at(L, 1))->l.p;
99	lua_newtable(L);	197	lua_newtable(L);
100	setnameval(L, "maxstack", p->maxstacksize);	198	setnameval(L, "maxstack", p->maxstacksize);
101	setnameval(L, "numparams", p->numparams);	199	setnameval(L, "numparams", p->numparams);
102	pc = 0;	200	for (pc=0; pc<p->sizecode; pc++) {
103	do {	201	char buff[100];
104	lua_pushnumber(L, pc+1);	202	lua_pushintegral(L, pc+1);
105	res = pushop(L, p, pc++);	203	lua_pushstring(L, buildop(p, pc, buff));
106	lua_settable(L, -3);	204	lua_settable(L, -3);
107	} while (res);	205	}
108	return 1;	206	return 1;
109	}	207	}
110		208
111		209
112	static int liststrings (lua_State *L) {	210	static int listk (lua_State *L) {
113	Proto *p;	211	Proto *p;
114	int i;	212	int i;
115	luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),	213	luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
116	1, "Lua function expected");	214	1, "Lua function expected");
117	p = clvalue(luaA_index(L, 1))->f.l;	215	p = clvalue(func_at(L, 1))->l.p;
118	lua_newtable(L);	216	lua_newtable(L);
119	for (i=0; i<p->nkstr; i++) {	217	for (i=0; i<p->sizek; i++) {
120	lua_pushnumber(L, i+1);	218	lua_pushintegral(L, i+1);
121	lua_pushstring(L, p->kstr[i]->str);	219	luaA_pushobject(L, p->k+i);
122	lua_settable(L, -3);	220	lua_settable(L, -3);
123	}	221	}
124	return 1;	222	return 1;
@@ -127,12 +225,12 @@ static int liststrings (lua_State *L) { · 2 unmodified lines
127		225
128	static int listlocals (lua_State *L) {	226	static int listlocals (lua_State *L) {
129	Proto *p;	227	Proto *p;
130	int pc = luaL_check_int(L, 2) - 1;	228	int pc = luaL_checkint(L, 2) - 1;
131	int i = 0;	229	int i = 0;
132	const char *name;	230	const char *name;
133	luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),	231	luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
134	1, "Lua function expected");	232	1, "Lua function expected");
135	p = clvalue(luaA_index(L, 1))->f.l;	233	p = clvalue(func_at(L, 1))->l.p;
136	while ((name = luaF_getlocalname(p, ++i, pc)) != NULL)	234	while ((name = luaF_getlocalname(p, ++i, pc)) != NULL)
137	lua_pushstring(L, name);	235	lua_pushstring(L, name);
138	return i-1;	236	return i-1;
@@ -142,96 +240,107 @@ static int listlocals (lua_State *L) { · 3 unmodified lines
142		240
143		241
144		242
		243
145	static int get_limits (lua_State *L) {	244	static int get_limits (lua_State *L) {
146	lua_newtable(L);	245	lua_newtable(L);
147	setnameval(L, "BITS_INT", BITS_INT);	246	setnameval(L, "BITS_INT", BITS_INT);
148	setnameval(L, "LFPF", LFIELDS_PER_FLUSH);	247	setnameval(L, "LFPF", LFIELDS_PER_FLUSH);
149	setnameval(L, "MAXARG_A", MAXARG_A);	248	setnameval(L, "MAXVARS", MAXVARS);
150	setnameval(L, "MAXARG_B", MAXARG_B);
151	setnameval(L, "MAXARG_S", MAXARG_S);
152	setnameval(L, "MAXARG_U", MAXARG_U);
153	setnameval(L, "MAXLOCALS", MAXLOCALS);
154	setnameval(L, "MAXPARAMS", MAXPARAMS);	249	setnameval(L, "MAXPARAMS", MAXPARAMS);
155	setnameval(L, "MAXSTACK", MAXSTACK);	250	setnameval(L, "MAXSTACK", MAXSTACK);
156	setnameval(L, "MAXUPVALUES", MAXUPVALUES);	251	setnameval(L, "MAXUPVALUES", MAXUPVALUES);
157	setnameval(L, "MAXVARSLH", MAXVARSLH);
158	setnameval(L, "RFPF", RFIELDS_PER_FLUSH);
159	setnameval(L, "SIZE_A", SIZE_A);
160	setnameval(L, "SIZE_B", SIZE_B);
161	setnameval(L, "SIZE_OP", SIZE_OP);
162	setnameval(L, "SIZE_U", SIZE_U);
163	return 1;	252	return 1;
164	}	253	}
165		254
166		255
167	static int mem_query (lua_State *L) {	256	static int mem_query (lua_State *L) {
168	if (lua_isnull(L, 1)) {	257	if (lua_isnone(L, 1)) {
169	lua_pushnumber(L, memdebug_total);	258	lua_pushintegral(L, memdebug_total);
170	lua_pushnumber(L, memdebug_numblocks);	259	lua_pushintegral(L, memdebug_numblocks);
171	lua_pushnumber(L, memdebug_maxmem);	260	lua_pushintegral(L, memdebug_maxmem);
172	return 3;	261	return 3;
173	}	262	}
174	else {	263	else {
175	memdebug_memlimit = luaL_check_int(L, 1);	264	memdebug_memlimit = luaL_checkint(L, 1);
176	return 0;	265	return 0;
177	}	266	}
178	}	267	}
179		268
180		269
181	static int hash_query (lua_State *L) {	270	static int hash_query (lua_State *L) {
182	if (lua_isnull(L, 2)) {	271	if (lua_isnone(L, 2)) {
183	luaL_arg_check(L, lua_tag(L, 1) == LUA_TSTRING, 1, "string expected");	272	luaL_argcheck(L, lua_type(L, 1) == LUA_TSTRING, 1, "string expected");
184	lua_pushnumber(L, tsvalue(luaA_index(L, 1))->u.s.hash);	273	lua_pushintegral(L, tsvalue(func_at(L, 1))->tsv.hash);
185	}	274	}
186	else {	275	else {
187	Hash *t;	276	TObject *o = func_at(L, 1);
		277	Table *t;
188	luaL_checktype(L, 2, LUA_TTABLE);	278	luaL_checktype(L, 2, LUA_TTABLE);
189	t = hvalue(luaA_index(L, 2));	279	t = hvalue(func_at(L, 2));
190	lua_pushnumber(L, luaH_mainposition(t, luaA_index(L, 1)) - t->node);	280	lua_pushintegral(L, luaH_mainposition(t, o) - t->node);
191	}	281	}
192	return 1;	282	return 1;
193	}	283	}
194		284
195		285
		286	static int stacklevel (lua_State *L) {
		287	unsigned long a = 0;
		288	lua_pushintegral(L, (int)(L->top - L->stack));
		289	lua_pushintegral(L, (int)(L->stack_last - L->stack));
		290	lua_pushintegral(L, (int)(L->ci - L->base_ci));
		291	lua_pushintegral(L, (int)(L->end_ci - L->base_ci));
		292	lua_pushintegral(L, (unsigned long)&a);
		293	return 5;
		294	}
		295
		296
196	static int table_query (lua_State *L) {	297	static int table_query (lua_State *L) {
197	const Hash *t;	298	const Table *t;
198	int i = luaL_opt_int(L, 2, -1);	299	int i = luaL_optint(L, 2, -1);
199	luaL_checktype(L, 1, LUA_TTABLE);	300	luaL_checktype(L, 1, LUA_TTABLE);
200	t = hvalue(luaA_index(L, 1));	301	t = hvalue(func_at(L, 1));
201	if (i == -1) {	302	if (i == -1) {
202	lua_pushnumber(L, t->size);	303	lua_pushintegral(L, t->sizearray);
203	lua_pushnumber(L, t->firstfree - t->node);	304	lua_pushintegral(L, sizenode(t));
204	return 2;	305	lua_pushintegral(L, t->firstfree - t->node);
205	}	306	}
206	else if (i < t->size) {	307	else if (i < t->sizearray) {
207	luaA_pushobject(L, &t->node[i].key);	308	lua_pushintegral(L, i);
208	luaA_pushobject(L, &t->node[i].val);	309	luaA_pushobject(L, &t->array[i]);
209	if (t->node[i].next) {	310	lua_pushnil(L);
210	lua_pushnumber(L, t->node[i].next - t->node);	311	}
211	return 3;	312	else if ((i -= t->sizearray) < sizenode(t)) {
		313	if (!ttisnil(gval(gnode(t, i))) \|\|
		314	ttisnil(gkey(gnode(t, i))) \|\|
		315	ttisnumber(gkey(gnode(t, i)))) {
		316	luaA_pushobject(L, gkey(gnode(t, i)));
212	}	317	}
213	else	318	else
214	return 2;	319	lua_pushstring(L, "<undef>");
		320	luaA_pushobject(L, gval(gnode(t, i)));
		321	if (t->node[i].next)
		322	lua_pushintegral(L, t->node[i].next - t->node);
		323	else
		324	lua_pushnil(L);
215	}	325	}
216	return 0;	326	return 3;
217	}	327	}
218		328
219		329
220	static int string_query (lua_State *L) {	330	static int string_query (lua_State *L) {
221	stringtable tb = (luaL_check_string(L, 1) == 's') ? &L->strt : &L->udt;	331	stringtable *tb = &G(L)->strt;
222	int s = luaL_opt_int(L, 2, 0) - 1;	332	int s = luaL_optint(L, 2, 0) - 1;
223	if (s==-1) {	333	if (s==-1) {
224	lua_pushnumber(L ,tb->nuse);	334	lua_pushintegral(L ,tb->nuse);
225	lua_pushnumber(L ,tb->size);	335	lua_pushintegral(L ,tb->size);
226	return 2;	336	return 2;
227	}	337	}
228	else if (s < tb->size) {	338	else if (s < tb->size) {
229	TString *ts;	339	GCObject *ts;
230	int n = 0;	340	int n = 0;
231	for (ts = tb->hash[s]; ts; ts = ts->nexthash) {	341	for (ts = tb->hash[s]; ts; ts = ts->gch.next) {
232	ttype(L->top) = LUA_TSTRING;	342	setsvalue2s(L->top, gcotots(ts));
233	tsvalue(L->top) = ts;	343	incr_top(L);
234	incr_top;
235	n++;	344	n++;
236	}	345	}
237	return n;	346	return n;
@@ -241,111 +350,193 @@ static int string_query (lua_State *L) { · 3 unmodified lines
241		350
242		351
243	static int tref (lua_State *L) {	352	static int tref (lua_State *L) {
		353	int level = lua_gettop(L);
		354	int lock = luaL_optint(L, 2, 1);
244	luaL_checkany(L, 1);	355	luaL_checkany(L, 1);
245	lua_pushvalue(L, 1);	356	lua_pushvalue(L, 1);
246	lua_pushnumber(L, lua_ref(L, luaL_opt_int(L, 2, 1)));	357	lua_pushintegral(L, lua_ref(L, lock));
		358	assert(lua_gettop(L) == level+1); /* +1 for result */
247	return 1;	359	return 1;
248	}	360	}
249		361
250	static int getref (lua_State *L) {	362	static int getref (lua_State *L) {
251	if (lua_getref(L, luaL_check_int(L, 1)))	363	int level = lua_gettop(L);
252	return 1;	364	lua_getref(L, luaL_checkint(L, 1));
253	else	365	assert(lua_gettop(L) == level+1);
254	return 0;	366	return 1;
255	}	367	}
256		368
257	static int unref (lua_State *L) {	369	static int unref (lua_State *L) {
258	lua_unref(L, luaL_check_int(L, 1));	370	int level = lua_gettop(L);
		371	lua_unref(L, luaL_checkint(L, 1));
		372	assert(lua_gettop(L) == level);
259	return 0;	373	return 0;
260	}	374	}
261		375
		376	static int metatable (lua_State *L) {
		377	luaL_checkany(L, 1);
		378	if (lua_isnone(L, 2)) {
		379	if (lua_getmetatable(L, 1) == 0)
		380	lua_pushnil(L);
		381	}
		382	else {
		383	lua_settop(L, 2);
		384	luaL_checktype(L, 2, LUA_TTABLE);
		385	lua_setmetatable(L, 1);
		386	}
		387	return 1;
		388	}
		389
		390
		391	static int upvalue (lua_State *L) {
		392	int n = luaL_checkint(L, 2);
		393	luaL_checktype(L, 1, LUA_TFUNCTION);
		394	if (lua_isnone(L, 3)) {
		395	const char *name = lua_getupvalue(L, 1, n);
		396	if (name == NULL) return 0;
		397	lua_pushstring(L, name);
		398	return 2;
		399	}
		400	else {
		401	const char *name = lua_setupvalue(L, 1, n);
		402	lua_pushstring(L, name);
		403	return 1;
		404	}
		405	}
		406
		407
262	static int newuserdata (lua_State *L) {	408	static int newuserdata (lua_State *L) {
263	if (lua_isnumber(L, 2))	409	size_t size = luaL_checkint(L, 1);
264	lua_pushusertag(L, (void *)luaL_check_int(L, 1), luaL_check_int(L, 2));	410	char p = cast(char , lua_newuserdata(L, size));
265	else	411	while (size--) *p++ = '\0';
266	lua_newuserdata(L, luaL_check_int(L, 1));	412	return 1;
		413	}
		414
		415
		416	static int pushuserdata (lua_State *L) {
		417	lua_pushlightuserdata(L, cast(void *, luaL_checkint(L, 1)));
267	return 1;	418	return 1;
268	}	419	}
269		420
		421
270	static int udataval (lua_State *L) {	422	static int udataval (lua_State *L) {
271	luaL_checktype(L, 1, LUA_TUSERDATA);	423	lua_pushintegral(L, cast(int, lua_touserdata(L, 1)));
272	lua_pushnumber(L, (int)lua_touserdata(L, 1));	424	return 1;
		425	}
		426
		427
		428	static int doonnewstack (lua_State *L) {
		429	lua_State *L1 = lua_newthread(L);
		430	size_t l;
		431	const char *s = luaL_checklstring(L, 1, &l);
		432	int status = luaL_loadbuffer(L1, s, l, s);
		433	if (status == 0)
		434	status = lua_pcall(L1, 0, 0, 0);
		435	lua_pushintegral(L, status);
		436	return 1;
		437	}
		438
		439
		440	static int s2d (lua_State *L) {
		441	lua_pushnumber(L, cast(const double , luaL_checkstring(L, 1)));
		442	return 1;
		443	}
		444
		445	static int d2s (lua_State *L) {
		446	double d = luaL_checknumber(L, 1);
		447	lua_pushlstring(L, cast(char *, &d), sizeof(d));
273	return 1;	448	return 1;
274	}	449	}
275		450
		451
276	static int newstate (lua_State *L) {	452	static int newstate (lua_State *L) {
277	lua_State *L1 = lua_open(luaL_check_int(L, 1));	453	lua_State *L1 = lua_open();
278	if (L1)	454	if (L1) {
279	lua_pushuserdata(L, L1);	455	lua_userstateopen(L1); /* init lock */
		456	lua_pushintegral(L, (unsigned long)L1);
		457	}
280	else	458	else
281	lua_pushnil(L);	459	lua_pushnil(L);
282	return 1;	460	return 1;
283	}	461	}
284		462
		463
285	static int loadlib (lua_State *L) {	464	static int loadlib (lua_State *L) {
286	lua_State L1 = (lua_State )lua_touserdata(L, 1);	465	static const luaL_reg libs[] = {
287	switch (*luaL_check_string(L, 2)) {	466	{"mathlibopen", luaopen_math},
288	case 'm': lua_mathlibopen(L1); break;	467	{"strlibopen", luaopen_string},
289	case 's': lua_strlibopen(L1); break;	468	{"iolibopen", luaopen_io},
290	case 'i': lua_iolibopen(L1); break;	469	{"tablibopen", luaopen_table},
291	case 'd': lua_dblibopen(L1); break;	470	{"dblibopen", luaopen_debug},
292	case 'b': lua_baselibopen(L1); break;	471	{"baselibopen", luaopen_base},
293	default: luaL_argerror(L, 2, "invalid option");	472	{NULL, NULL}
294	}	473	};
		474	lua_State L1 = cast(lua_State ,
		475	cast(unsigned long, luaL_checknumber(L, 1)));
		476	lua_pushvalue(L1, LUA_GLOBALSINDEX);
		477	luaL_openlib(L1, NULL, libs, 0);
295	return 0;	478	return 0;
296	}	479	}
297		480
298	static int closestate (lua_State *L) {	481	static int closestate (lua_State *L) {
299	luaL_checktype(L, 1, LUA_TUSERDATA);	482	lua_State L1 = cast(lua_State , cast(unsigned long, luaL_checknumber(L, 1)));
300	lua_close((lua_State *)lua_touserdata(L, 1));	483	lua_close(L1);
		484	lua_unlock(L); /* close cannot unlock that */
301	return 0;	485	return 0;
302	}	486	}
303		487
304	static int doremote (lua_State *L) {	488	static int doremote (lua_State *L) {
305	lua_State *L1;	489	lua_State L1 = cast(lua_State ,cast(unsigned long,luaL_checknumber(L, 1)));
306	const char *code = luaL_check_string(L, 2);	490	size_t lcode;
		491	const char *code = luaL_checklstring(L, 2, &lcode);
307	int status;	492	int status;
308	luaL_checktype(L, 1, LUA_TUSERDATA);	493	lua_settop(L1, 0);
309	L1 = (lua_State *)lua_touserdata(L, 1);	494	status = luaL_loadbuffer(L1, code, lcode, code);
310	status = lua_dostring(L1, code);	495	if (status == 0)
		496	status = lua_pcall(L1, 0, LUA_MULTRET, 0);
311	if (status != 0) {	497	if (status != 0) {
312	lua_pushnil(L);	498	lua_pushnil(L);
313	lua_pushnumber(L, status);	499	lua_pushintegral(L, status);
314	return 2;	500	lua_pushstring(L, lua_tostring(L1, -1));
		501	return 3;
315	}	502	}
316	else {	503	else {
317	int i = 0;	504	int i = 0;
318	while (!lua_isnull(L1, ++i))	505	while (!lua_isnone(L1, ++i))
319	lua_pushstring(L, lua_tostring(L1, i));	506	lua_pushstring(L, lua_tostring(L1, i));
		507	lua_pop(L1, i-1);
320	return i-1;	508	return i-1;
321	}	509	}
322	}	510	}
323		511
324	static int settagmethod (lua_State *L) {	512
325	int tag = luaL_check_int(L, 1);	513	static int log2_aux (lua_State *L) {
326	const char *event = luaL_check_string(L, 2);	514	lua_pushintegral(L, luaO_log2(luaL_checkint(L, 1)));
327	luaL_checkany(L, 3);
328	lua_gettagmethod(L, tag, event);
329	lua_pushvalue(L, 3);
330	lua_settagmethod(L, tag, event);
331	return 1;	515	return 1;
332	}	516	}
333		517
334	static int pushbool (lua_State *L, int b) {	518	static int int2fb_aux (lua_State *L) {
335	if (b) lua_pushnumber(L, 1);	519	int b = luaO_int2fb(luaL_checkint(L, 1));
336	else lua_pushnil(L);	520	lua_pushintegral(L, b);
337	return 1;	521	lua_pushintegral(L, fb2int(b));
		522	return 2;
338	}	523	}
339		524
340	static int equal (lua_State *L) {	525
341	return pushbool(L, lua_equal(L, 1, 2));	526	static int test_do (lua_State *L) {
		527	const char *p = luaL_checkstring(L, 1);
		528	if (*p == '@')
		529	lua_dofile(L, p+1);
		530	else
		531	lua_dostring(L, p);
		532	return lua_gettop(L);
342	}	533	}
343		534
344		535
345		536
346	/*	537	/*
347	** {======================================================	538	** {======================================================
348	** function to test the API with C. It interprets a kind of "assembler"	539	** function to test the API with C. It interprets a kind of assembler
349	** language with calls to the API, so the test can be driven by Lua code	540	** language with calls to the API, so the test can be driven by Lua code
350	** =======================================================	541	** =======================================================
351	*/	542	*/
@@ -356,12 +547,12 @@ static void skip (const char **pc) { · 4 unmodified lines
356	while (pc != '\0' && strchr(delimits, pc)) (*pc)++;	547	while (pc != '\0' && strchr(delimits, pc)) (*pc)++;
357	}	548	}
358		549
359	static int getnum (lua_State L, const char *pc) {	550	static int getnum_aux (lua_State L, const char *pc) {
360	int res = 0;	551	int res = 0;
361	int sig = 1;	552	int sig = 1;
362	skip(pc);	553	skip(pc);
363	if (**pc == '.') {	554	if (**pc == '.') {
364	res = (int)lua_tonumber(L, -1);	555	res = cast(int, lua_tonumber(L, -1));
365	lua_pop(L, 1);	556	lua_pop(L, 1);
366	(*pc)++;	557	(*pc)++;
367	return res;	558	return res;
@@ -370,11 +561,11 @@ static int getnum (lua_State L, const char *pc) { · 2 unmodified lines
370	sig = -1;	561	sig = -1;
371	(*pc)++;	562	(*pc)++;
372	}	563	}
373	while (isdigit(*pc)) res = res10 + ((pc)++) - '0';	564	while (isdigit(cast(int, *pc))) res = res10 + ((pc)++) - '0';
374	return sig*res;	565	return sig*res;
375	}	566	}
376		567
377	static const char getname (char buff, const char **pc) {	568	static const char getname_aux (char buff, const char **pc) {
378	int i = 0;	569	int i = 0;
379	skip(pc);	570	skip(pc);
380	while (pc != '\0' && !strchr(delimits, pc))	571	while (pc != '\0' && !strchr(delimits, pc))
@@ -386,51 +577,52 @@ static const char getname (char buff, const char **pc) { · 5 unmodified lines
386		577
387	#define EQ(s1) (strcmp(s1, inst) == 0)	578	#define EQ(s1) (strcmp(s1, inst) == 0)
388		579
389	#define getnum ((getnum)(L, &pc))	580	#define getnum (getnum_aux(L, &pc))
390	#define getname ((getname)(buff, &pc))	581	#define getname (getname_aux(buff, &pc))
391		582
392		583
393	static int testC (lua_State *L) {	584	static int testC (lua_State *L) {
394	char buff[30];	585	char buff[30];
395	const char *pc = luaL_check_string(L, 1);	586	const char *pc = luaL_checkstring(L, 1);
396	for (;;) {	587	for (;;) {
397	const char *inst = getname;	588	const char *inst = getname;
398	if EQ("") return 0;	589	if EQ("") return 0;
399	else if EQ("isnumber") {	590	else if EQ("isnumber") {
400	lua_pushnumber(L, lua_isnumber(L, getnum));	591	lua_pushintegral(L, lua_isnumber(L, getnum));
401	}	592	}
402	else if EQ("isstring") {	593	else if EQ("isstring") {
403	lua_pushnumber(L, lua_isstring(L, getnum));	594	lua_pushintegral(L, lua_isstring(L, getnum));
404	}	595	}
405	else if EQ("istable") {	596	else if EQ("istable") {
406	lua_pushnumber(L, lua_istable(L, getnum));	597	lua_pushintegral(L, lua_istable(L, getnum));
407	}	598	}
408	else if EQ("iscfunction") {	599	else if EQ("iscfunction") {
409	lua_pushnumber(L, lua_iscfunction(L, getnum));	600	lua_pushintegral(L, lua_iscfunction(L, getnum));
410	}	601	}
411	else if EQ("isfunction") {	602	else if EQ("isfunction") {
412	lua_pushnumber(L, lua_isfunction(L, getnum));	603	lua_pushintegral(L, lua_isfunction(L, getnum));
413	}	604	}
414	else if EQ("isuserdata") {	605	else if EQ("isuserdata") {
415	lua_pushnumber(L, lua_isuserdata(L, getnum));	606	lua_pushintegral(L, lua_isuserdata(L, getnum));
		607	}
		608	else if EQ("isudataval") {
		609	lua_pushintegral(L, lua_islightuserdata(L, getnum));
416	}	610	}
417	else if EQ("isnil") {	611	else if EQ("isnil") {
418	lua_pushnumber(L, lua_isnil(L, getnum));	612	lua_pushintegral(L, lua_isnil(L, getnum));
419	}	613	}
420	else if EQ("isnull") {	614	else if EQ("isnull") {
421	lua_pushnumber(L, lua_isnull(L, getnum));	615	lua_pushintegral(L, lua_isnone(L, getnum));
422	}	616	}
423	else if EQ("tonumber") {	617	else if EQ("tonumber") {
424	lua_pushnumber(L, lua_tonumber(L, getnum));	618	lua_pushnumber(L, lua_tonumber(L, getnum));
425	}	619	}
426	else if EQ("tostring") {	620	else if EQ("tostring") {
427	lua_pushstring(L, lua_tostring(L, getnum));	621	const char *s = lua_tostring(L, getnum);
428	}	622	lua_pushstring(L, s);
429	else if EQ("tonumber") {
430	lua_pushnumber(L, lua_tonumber(L, getnum));
431	}	623	}
432	else if EQ("strlen") {	624	else if EQ("strlen") {
433	lua_pushnumber(L, lua_strlen(L, getnum));	625	lua_pushintegral(L, lua_strlen(L, getnum));
434	}	626	}
435	else if EQ("tocfunction") {	627	else if EQ("tocfunction") {
436	lua_pushcfunction(L, lua_tocfunction(L, getnum));	628	lua_pushcfunction(L, lua_tocfunction(L, getnum));
@@ -439,7 +631,7 @@ static int testC (lua_State *L) { · 2 unmodified lines
439	return getnum;	631	return getnum;
440	}	632	}
441	else if EQ("gettop") {	633	else if EQ("gettop") {
442	lua_pushnumber(L, lua_gettop(L));	634	lua_pushintegral(L, lua_gettop(L));
443	}	635	}
444	else if EQ("settop") {	636	else if EQ("settop") {
445	lua_settop(L, getnum);	637	lua_settop(L, getnum);
@@ -448,17 +640,35 @@ static int testC (lua_State *L) { · 2 unmodified lines
448	lua_pop(L, getnum);	640	lua_pop(L, getnum);
449	}	641	}
450	else if EQ("pushnum") {	642	else if EQ("pushnum") {
451	lua_pushnumber(L, getnum);	643	lua_pushintegral(L, getnum);
		644	}
		645	else if EQ("pushnil") {
		646	lua_pushnil(L);
		647	}
		648	else if EQ("pushbool") {
		649	lua_pushboolean(L, getnum);
		650	}
		651	else if EQ("tobool") {
		652	lua_pushintegral(L, lua_toboolean(L, getnum));
452	}	653	}
453	else if EQ("pushvalue") {	654	else if EQ("pushvalue") {
454	lua_pushvalue(L, getnum);	655	lua_pushvalue(L, getnum);
455	}	656	}
		657	else if EQ("pushcclosure") {
		658	lua_pushcclosure(L, testC, getnum);
		659	}
		660	else if EQ("pushupvalues") {
		661	lua_pushupvalues(L);
		662	}
456	else if EQ("remove") {	663	else if EQ("remove") {
457	lua_remove(L, getnum);	664	lua_remove(L, getnum);
458	}	665	}
459	else if EQ("insert") {	666	else if EQ("insert") {
460	lua_insert(L, getnum);	667	lua_insert(L, getnum);
461	}	668	}
		669	else if EQ("replace") {
		670	lua_replace(L, getnum);
		671	}
462	else if EQ("gettable") {	672	else if EQ("gettable") {
463	lua_gettable(L, getnum);	673	lua_gettable(L, getnum);
464	}	674	}
@@ -471,33 +681,53 @@ static int testC (lua_State *L) { · 6 unmodified lines
471	else if EQ("concat") {	681	else if EQ("concat") {
472	lua_concat(L, getnum);	682	lua_concat(L, getnum);
473	}	683	}
		684	else if EQ("lessthan") {
		685	int a = getnum;
		686	lua_pushboolean(L, lua_lessthan(L, a, getnum));
		687	}
		688	else if EQ("equal") {
		689	int a = getnum;
		690	lua_pushboolean(L, lua_equal(L, a, getnum));
		691	}
474	else if EQ("rawcall") {	692	else if EQ("rawcall") {
475	int narg = getnum;	693	int narg = getnum;
476	int nres = getnum;	694	int nres = getnum;
477	lua_rawcall(L, narg, nres);	695	lua_call(L, narg, nres);
478	}	696	}
479	else if EQ("call") {	697	else if EQ("call") {
480	int narg = getnum;	698	int narg = getnum;
481	int nres = getnum;	699	int nres = getnum;
482	lua_call(L, narg, nres);	700	lua_pcall(L, narg, nres, 0);
		701	}
		702	else if EQ("loadstring") {
		703	size_t sl;
		704	const char *s = luaL_checklstring(L, getnum, &sl);
		705	luaL_loadbuffer(L, s, sl, s);
483	}	706	}
484	else if EQ("dostring") {	707	else if EQ("loadfile") {
485	lua_dostring(L, luaL_check_string(L, getnum));	708	luaL_loadfile(L, luaL_checkstring(L, getnum));
486	}	709	}
487	else if EQ("settagmethod") {	710	else if EQ("setmetatable") {
488	int tag = getnum;	711	lua_setmetatable(L, getnum);
489	const char *event = getname;
490	lua_settagmethod(L, tag, event);
491	}	712	}
492	else if EQ("gettagmethod") {	713	else if EQ("getmetatable") {
493	int tag = getnum;	714	if (lua_getmetatable(L, getnum) == 0)
494	const char *event = getname;	715	lua_pushnil(L);
495	lua_gettagmethod(L, tag, event);
496	}	716	}
497	else if EQ("type") {	717	else if EQ("type") {
498	lua_pushstring(L, lua_typename(L, lua_type(L, getnum)));	718	lua_pushstring(L, lua_typename(L, lua_type(L, getnum)));
499	}	719	}
500	else luaL_verror(L, "unknown instruction %.30s", buff);	720	else if EQ("getn") {
		721	int i = getnum;
		722	lua_pushintegral(L, luaL_getn(L, i));
		723	}
		724	else if EQ("setn") {
		725	int i = getnum;
		726	int n = cast(int, lua_tonumber(L, -1));
		727	luaL_setn(L, i, n);
		728	lua_pop(L, 1);
		729	}
		730	else luaL_error(L, "unknown instruction %s", buff);
501	}	731	}
502	return 0;	732	return 0;
503	}	733	}
@@ -505,39 +735,118 @@ static int testC (lua_State *L) { · 1 unmodified line
505	/* }====================================================== */	735	/* }====================================================== */
506		736
507		737
		738	/*
		739	** {======================================================
		740	** tests for yield inside hooks
		741	** =======================================================
		742	*/
		743
		744	static void yieldf (lua_State L, lua_Debug ar) {
		745	lua_yield(L, 0);
		746	}
		747
		748	static int setyhook (lua_State *L) {
		749	if (lua_isnoneornil(L, 1))
		750	lua_sethook(L, NULL, 0, 0); /* turn off hooks */
		751	else {
		752	const char *smask = luaL_checkstring(L, 1);
		753	int count = luaL_optint(L, 2, 0);
		754	int mask = 0;
		755	if (strchr(smask, 'l')) mask \|= LUA_MASKLINE;
		756	if (count > 0) mask \|= LUA_MASKCOUNT;
		757	lua_sethook(L, yieldf, mask, count);
		758	}
		759	return 0;
		760	}
		761
		762
		763	static int coresume (lua_State *L) {
		764	int status;
		765	lua_State *co = lua_tothread(L, 1);
		766	luaL_argcheck(L, co, 1, "coroutine expected");
		767	status = lua_resume(co, 0);
		768	if (status != 0) {
		769	lua_pushboolean(L, 0);
		770	lua_insert(L, -2);
		771	return 2; /* return false + error message */
		772	}
		773	else {
		774	lua_pushboolean(L, 1);
		775	return 1;
		776	}
		777	}
		778
		779	/* }====================================================== */
		780
		781
508		782
509	static const struct luaL_reg tests_funcs[] = {	783	static const struct luaL_reg tests_funcs[] = {
510	{"hash", hash_query},	784	{"hash", hash_query},
511	{"limits", get_limits},	785	{"limits", get_limits},
512	{"listcode", listcode},	786	{"listcode", listcode},
513	{"liststrings", liststrings},	787	{"listk", listk},
514	{"listlocals", listlocals},	788	{"listlocals", listlocals},
515	{"loadlib", loadlib},	789	{"loadlib", loadlib},
		790	{"stacklevel", stacklevel},
516	{"querystr", string_query},	791	{"querystr", string_query},
517	{"querytab", table_query},	792	{"querytab", table_query},
		793	{"doit", test_do},
518	{"testC", testC},	794	{"testC", testC},
519	{"ref", tref},	795	{"ref", tref},
520	{"getref", getref},	796	{"getref", getref},
521	{"unref", unref},	797	{"unref", unref},
		798	{"d2s", d2s},
		799	{"s2d", s2d},
		800	{"metatable", metatable},
		801	{"upvalue", upvalue},
522	{"newuserdata", newuserdata},	802	{"newuserdata", newuserdata},
		803	{"pushuserdata", pushuserdata},
523	{"udataval", udataval},	804	{"udataval", udataval},
		805	{"doonnewstack", doonnewstack},
524	{"newstate", newstate},	806	{"newstate", newstate},
525	{"closestate", closestate},	807	{"closestate", closestate},
526	{"doremote", doremote},	808	{"doremote", doremote},
527	{"settagmethod", settagmethod},	809	{"log2", log2_aux},
528	{"equal", equal},	810	{"int2fb", int2fb_aux},
529	{"totalmem", mem_query}	811	{"totalmem", mem_query},
		812	{"resume", coresume},
		813	{"setyhook", setyhook},
		814	{NULL, NULL}
530	};	815	};
531		816
532		817
533	void luaB_opentests (lua_State *L) {	818	static void fim (void) {
534	lua_newtable(L);	819	if (!islocked)
535	lua_getglobals(L);	820	lua_close(lua_state);
536	lua_pushvalue(L, -2);	821	lua_assert(memdebug_numblocks == 0);
537	lua_setglobals(L);	822	lua_assert(memdebug_total == 0);
538	luaL_openl(L, tests_funcs); /* open functions inside new table */	823	}
539	lua_setglobals(L); /* restore old table of globals */	824
540	lua_setglobal(L, "T"); /* set new table as global T */	825
		826	static int l_panic (lua_State *L) {
		827	UNUSED(L);
		828	fprintf(stderr, "unable to recover; exiting\n");
		829	return 0;
		830	}
		831
		832
		833	int luaB_opentests (lua_State *L) {
		834	lua_atpanic(L, l_panic);
		835	lua_userstateopen(L); /* init lock */
		836	lua_state = L; /* keep first state to be opened */
		837	luaL_openlib(L, "T", tests_funcs, 0);
		838	atexit(fim);
		839	return 0;
		840	}
		841
		842
		843	#undef main
		844	int main (int argc, char *argv[]) {
		845	char *limit = getenv("MEMLIMIT");
		846	if (limit)
		847	memdebug_memlimit = strtoul(limit, NULL, 10);
		848	l_main(argc, argv);
		849	return 0;
541	}	850	}
542		851
543	#endif	852	#endif

src/ltm.c+38−131

@@ -1,163 +1,70 @@
1	/*	1	/*
2	** $Id: ltm.c,v 1.56 2000/10/31 13:10:24 roberto Exp $	2	** $Id: ltm.c,v 1.106 2003/04/03 13:35:34 roberto Exp $
3	** Tag methods	3	** Tag methods
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <stdio.h>
9	#include <string.h>	8	#include <string.h>
10		9
		10	#define ltm_c
		11
11	#include "lua.h"	12	#include "lua.h"
12		13
13	#include "ldo.h"
14	#include "lmem.h"
15	#include "lobject.h"	14	#include "lobject.h"
16	#include "lstate.h"	15	#include "lstate.h"
		16	#include "lstring.h"
		17	#include "ltable.h"
17	#include "ltm.h"	18	#include "ltm.h"
18		19
19		20
20	const char const luaT_eventname[] = { / ORDER TM */
21	"gettable", "settable", "index", "getglobal", "setglobal", "add", "sub",
22	"mul", "div", "pow", "unm", "lt", "concat", "gc", "function",
23	"le", "gt", "ge", /* deprecated options!! */
24	NULL
25	};
26
27
28	static int findevent (const char *name) {
29	int i;
30	for (i=0; luaT_eventname[i]; i++)
31	if (strcmp(luaT_eventname[i], name) == 0)
32	return i;
33	return -1; /* name not found */
34	}
35
36
37	static int luaI_checkevent (lua_State L, const char name, int t) {
38	int e = findevent(name);
39	if (e >= TM_N)
40	luaO_verror(L, "event `%.50s' is deprecated", name);
41	if (e == TM_GC && t == LUA_TTABLE)
42	luaO_verror(L, "event `gc' for tables is deprecated");
43	if (e < 0)
44	luaO_verror(L, "`%.50s' is not a valid event name", name);
45	return e;
46	}
47
48
49		21
50	/* events in LUA_TNIL are all allowed, since this is used as a	22	const char *const luaT_typenames[] = {
51	* 'placeholder' for "default" fallbacks	23	"nil", "boolean", "userdata", "number",
52	*/	24	"string", "table", "function", "userdata", "thread"
53	/* ORDER LUA_T, ORDER TM */
54	static const char luaT_validevents[NUM_TAGS][TM_N] = {
55	{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_TUSERDATA */
56	{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_TNIL */
57	{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1}, /* LUA_TNUMBER */
58	{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_TSTRING */
59	{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_TTABLE */
60	{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0} /* LUA_TFUNCTION */
61	};	25	};
62		26
63	int luaT_validevent (int t, int e) { /* ORDER LUA_T */
64	return (t >= NUM_TAGS) ? 1 : luaT_validevents[t][e];
65	}
66
67
68	static void init_entry (lua_State *L, int tag) {
69	int i;
70	for (i=0; i<TM_N; i++)
71	luaT_gettm(L, tag, i) = NULL;
72	L->TMtable[tag].collected = NULL;
73	}
74
75		27
76	void luaT_init (lua_State *L) {	28	void luaT_init (lua_State *L) {
77	int t;	29	static const char const luaT_eventname[] = { / ORDER TM */
78	luaM_growvector(L, L->TMtable, 0, NUM_TAGS, struct TM, "", MAX_INT);	30	"__index", "__newindex",
79	L->nblocks += NUM_TAGS*sizeof(struct TM);	31	"__gc", "__mode", "__eq",
80	L->last_tag = NUM_TAGS-1;	32	"__add", "__sub", "__mul", "__div",
81	for (t=0; t<=L->last_tag; t++)	33	"__pow", "__unm", "__lt", "__le",
82	init_entry(L, t);	34	"__concat", "__call"
83	}	35	};
84		36	int i;
85		37	for (i=0; i<TM_N; i++) {
86	LUA_API int lua_newtag (lua_State *L) {	38	G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]);
87	luaM_growvector(L, L->TMtable, L->last_tag, 1, struct TM,	39	luaS_fix(G(L)->tmname[i]); /* never collect these names */
88	"tag table overflow", MAX_INT);
89	L->nblocks += sizeof(struct TM);
90	L->last_tag++;
91	init_entry(L, L->last_tag);
92	return L->last_tag;
93	}
94
95
96	static void checktag (lua_State *L, int tag) {
97	if (!(0 <= tag && tag <= L->last_tag))
98	luaO_verror(L, "%d is not a valid tag", tag);
99	}
100
101	void luaT_realtag (lua_State *L, int tag) {
102	if (!validtag(tag))
103	luaO_verror(L, "tag %d was not created by `newtag'", tag);
104	}
105
106
107	LUA_API int lua_copytagmethods (lua_State *L, int tagto, int tagfrom) {
108	int e;
109	checktag(L, tagto);
110	checktag(L, tagfrom);
111	for (e=0; e<TM_N; e++) {
112	if (luaT_validevent(tagto, e))
113	luaT_gettm(L, tagto, e) = luaT_gettm(L, tagfrom, e);
114	}
115	return tagto;
116	}
117
118
119	int luaT_tag (const TObject *o) {
120	int t = ttype(o);
121	switch (t) {
122	case LUA_TUSERDATA: return tsvalue(o)->u.d.tag;
123	case LUA_TTABLE: return hvalue(o)->htag;
124	default: return t;
125	}	40	}
126	}	41	}
127		42
128		43
129	LUA_API void lua_gettagmethod (lua_State L, int t, const char event) {	44	/*
130	int e;	45	** function to be used with macro "fasttm": optimized for absence of
131	e = luaI_checkevent(L, event, t);	46	** tag methods
132	checktag(L, t);	47	*/
133	if (luaT_validevent(t, e) && luaT_gettm(L, t, e)) {	48	const TObject luaT_gettm (Table events, TMS event, TString *ename) {
134	clvalue(L->top) = luaT_gettm(L, t, e);	49	const TObject *tm = luaH_getstr(events, ename);
135	ttype(L->top) = LUA_TFUNCTION;	50	lua_assert(event <= TM_EQ);
		51	if (ttisnil(tm)) { /* no tag method? */
		52	events->flags \|= cast(lu_byte, 1u<<event); /* cache this fact */
		53	return NULL;
136	}	54	}
137	else	55	else return tm;
138	ttype(L->top) = LUA_TNIL;
139	incr_top;
140	}	56	}
141		57
142		58
143	LUA_API void lua_settagmethod (lua_State L, int t, const char event) {	59	const TObject luaT_gettmbyobj (lua_State L, const TObject *o, TMS event) {
144	int e = luaI_checkevent(L, event, t);	60	TString *ename = G(L)->tmname[event];
145	checktag(L, t);	61	switch (ttype(o)) {
146	if (!luaT_validevent(t, e))	62	case LUA_TTABLE:
147	luaO_verror(L, "cannot change `%.20s' tag method for type `%.20s'%.20s",	63	return luaH_getstr(hvalue(o)->metatable, ename);
148	luaT_eventname[e], luaO_typenames[t],	64	case LUA_TUSERDATA:
149	(t == LUA_TTABLE \|\| t == LUA_TUSERDATA) ?	65	return luaH_getstr(uvalue(o)->uv.metatable, ename);
150	" with default tag" : "");
151	switch (ttype(L->top - 1)) {
152	case LUA_TNIL:
153	luaT_gettm(L, t, e) = NULL;
154	break;
155	case LUA_TFUNCTION:
156	luaT_gettm(L, t, e) = clvalue(L->top - 1);
157	break;
158	default:	66	default:
159	lua_error(L, "tag method must be a function (or nil)");	67	return &luaO_nilobject;
160	}	68	}
161	L->top--;
162	}	69	}
163		70

src/ltm.h+14−22

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: ltm.h,v 1.18 2000/10/05 13:00:17 roberto Exp $	2	** $Id: ltm.h,v 1.41 2002/11/14 11:51:50 roberto Exp $
3	** Tag methods	3	** Tag methods
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -9,18 +9,18 @@ · 3 unmodified lines
9		9
10		10
11	#include "lobject.h"	11	#include "lobject.h"
12	#include "lstate.h"	12
13		13
14	/*	14	/*
15	* WARNING: if you change the order of this enumeration,	15	* WARNING: if you change the order of this enumeration,
16	* grep "ORDER TM"	16	* grep "ORDER TM"
17	*/	17	*/
18	typedef enum {	18	typedef enum {
19	TM_GETTABLE = 0,
20	TM_SETTABLE,
21	TM_INDEX,	19	TM_INDEX,
22	TM_GETGLOBAL,	20	TM_NEWINDEX,
23	TM_SETGLOBAL,	21	TM_GC,
		22	TM_MODE,
		23	TM_EQ, /* last tag method with `fast' access */
24	TM_ADD,	24	TM_ADD,
25	TM_SUB,	25	TM_SUB,
26	TM_MUL,	26	TM_MUL,
@@ -28,32 +28,24 @@ typedef enum { · 1 unmodified line
28	TM_POW,	28	TM_POW,
29	TM_UNM,	29	TM_UNM,
30	TM_LT,	30	TM_LT,
		31	TM_LE,
31	TM_CONCAT,	32	TM_CONCAT,
32	TM_GC,	33	TM_CALL,
33	TM_FUNCTION,
34	TM_N /* number of elements in the enum */	34	TM_N /* number of elements in the enum */
35	} TMS;	35	} TMS;
36		36
37		37
38	struct TM {
39	Closure *method[TM_N];
40	TString collected; / list of garbage-collected udata with this tag */
41	};
42
43
44	#define luaT_gettm(L,tag,event) (L->TMtable[tag].method[event])
45	#define luaT_gettmbyObj(L,o,e) (luaT_gettm((L),luaT_tag(o),(e)))
46
47		38
48	#define validtag(t) (NUM_TAGS <= (t) && (t) <= L->last_tag)	39	#define gfasttm(g,et,e) \
		40	(((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e]))
49		41
50	extern const char *const luaT_eventname[];	42	#define fasttm(l,et,e) gfasttm(G(l), et, e)
51		43
52		44
		45	const TObject luaT_gettm (Table events, TMS event, TString *ename);
		46	const TObject luaT_gettmbyobj (lua_State L, const TObject *o, TMS event);
53	void luaT_init (lua_State *L);	47	void luaT_init (lua_State *L);
54	void luaT_realtag (lua_State *L, int tag);
55	int luaT_tag (const TObject *o);
56	int luaT_validevent (int t, int e); /* used by compatibility module */
57		48
		49	extern const char *const luaT_typenames[];
58		50
59	#endif	51	#endif

src/lua/Makefile+4−5

@@ -4,17 +4,16 @@ LUA= ../.. · 3 unmodified lines
4		4
5	include $(LUA)/config	5	include $(LUA)/config
6		6
7	EXTRA_DEFS= $(POSIX)	7	EXTRA_DEFS= $(USERCONF)
8
9	OBJS= lua.o	8	OBJS= lua.o
10	SRCS= lua.c	9	SRCS= lua.c
11		10
12	T= $(BIN)/lua	11	T= $(BIN)/lua
13		12
14	all: $T	13	all: $T
15		14
16	$T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a	15	$T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a
17	$(CC) -o $@ $(OBJS) -L$(LIB) -llua -llualib $(EXTRA_LIBS)	16	$(CC) -o $@ $(MYLDFLAGS) $(OBJS) -L$(LIB) -llua -llualib $(EXTRA_LIBS) $(DLLIB)
18		17
19	$(LIB)/liblua.a:	18	$(LIB)/liblua.a:
20	cd ..; $(MAKE)	19	cd ..; $(MAKE)

src/lua/README+21−29

@@ -2,39 +2,31 @@ This is lua, a sample Lua interpreter. · 1 unmodified line
2	It can be used as a batch interpreter and also interactively.	2	It can be used as a batch interpreter and also interactively.
3	There are man pages for it in both nroff and html in ../../doc.	3	There are man pages for it in both nroff and html in ../../doc.
4		4
5	Here are the options that it understands:	5	Usage: ./lua [options] [script [args]]. Available options are:
6	- execute stdin as a file	6	- execute stdin as a file
7	-c close Lua when exiting
8	-e stat execute string `stat'	7	-e stat execute string `stat'
9	-f name execute file `name' with remaining arguments in table `arg'	8	-i enter interactive mode after executing `script'
10	-i enter interactive mode with prompt	9	-l name load and run library `name'
11	-q enter interactive mode without prompt	10	-v show version information
12	-sNUM set stack size to NUM (must be the first option)	11	-- stop handling options
13	-v print version information
14	a=b set global `a' to string `b'
15	name execute file `name'
16		12
17	If no options are given, then it reads lines from stdin and executes them	13	This interpreter is suitable for using Lua as a standalone language; it loads
18	as they are read -- so, each line must contain a complete statement.	14	all standard libraries. For a minimal interpreter, see ../../etc/min.c.
19	To span a statement across several lines, end each line with a backslash '\'.
20		15
21	To change the prompt, set the global variable _PROMPT to whatever you want.	16	If your application simply exports new functions to Lua (which is common),
22	You can do this after calling the interpreter or on the command line with	17	then you can use this interpreter (almost) unmodified, as follows:
23	lua _PROMPT="lua: " -i
24	for example. Note that you need "-i" in this case.
25		18
26	You must be careful when using quotes on the command line because they are	19	* First, define a function
27	usually handled by the shell.	20	void myinit (lua_State *L)
		21	in your own code. In this function, you should do whatever initializations
		22	are needed by your application, typically exporting your functions to Lua.
		23	(Of course, you can use any name instead of "myinit".)
28		24
29	This interpreter is good for using Lua as a standalone language.	25	* Then, #define lua_userinit(L) to be "openstdlibs(L)+myinit(L)".
30	For a minimal interpreter, see ../../etc/min.c.	26	Here, openstdlibs is a function in lua.c that opens all standard libraries.
		27	If you don't need them, just don't call openstdlibs and open any standard
		28	libraries that you do need in myinit.
31		29
32	If your application simply exports new functions to Lua (which is common),	30	* Finally, remember to link your C code when building lua.
33	then you can use this interpreter (almost) unmodified, as follows:	31
34	First, define a function	32	For other customizations, see ../../etc/config.c.
35	void myinit (lua_State *L)
36	in your own code. In this function, you should do whatever initializations
37	are needed by your application, typically exporting your functions to Lua.
38	Then, add a call "myinit(L)" in lua.c after the place marked
39	"add your libraries here"
40	Of course, you can use any name instead of "myinit".

src/lua/lua.c+332−216

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lua.c,v 1.55 2000/10/20 16:36:32 roberto Exp $	2	** $Id: lua.c,v 1.122 2003/04/03 13:34:42 roberto Exp $
3	** Lua stand-alone interpreter	3	** Lua stand-alone interpreter
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -10,313 +10,429 @@ · 4 unmodified lines
10	#include <stdlib.h>	10	#include <stdlib.h>
11	#include <string.h>	11	#include <string.h>
12		12
		13	#define lua_c
		14
13	#include "lua.h"	15	#include "lua.h"
14		16
15	#include "luadebug.h"	17	#include "lauxlib.h"
16	#include "lualib.h"	18	#include "lualib.h"
17		19
18		20
19	static lua_State *L = NULL;	21	/*
		22	** generic extra include file
		23	*/
		24	#ifdef LUA_USERCONFIG
		25	#include LUA_USERCONFIG
		26	#endif
		27
		28
		29	/*
		30	** definition of `isatty'
		31	*/
		32	#ifdef _POSIX_C_SOURCE
		33	#include <unistd.h>
		34	#define stdin_is_tty() isatty(0)
		35	#else
		36	#define stdin_is_tty() 1 /* assume stdin is a tty */
		37	#endif
		38
20		39
21		40
22	#ifndef PROMPT	41	#ifndef PROMPT
23	#define PROMPT "> "	42	#define PROMPT "> "
24	#endif	43	#endif
25		44
26	#ifdef _POSIX_SOURCE	45
27	#include <unistd.h>	46	#ifndef PROMPT2
28	#else	47	#define PROMPT2 ">> "
29	static int isatty (int x) { return x==0; } /* assume stdin is a tty */
30	#endif	48	#endif
31		49
		50	#ifndef PROGNAME
		51	#define PROGNAME "lua"
		52	#endif
32		53
33	/*	54	#ifndef lua_userinit
34	** global options	55	#define lua_userinit(L) openstdlibs(L)
35	*/	56	#endif
36	struct Options {
37	int toclose;
38	int stacksize;
39	};
40		57
41		58
42	typedef void (handler)(int); / type for signal actions */	59	#ifndef LUA_EXTRALIBS
		60	#define LUA_EXTRALIBS /* empty */
		61	#endif
43		62
44	static void laction (int i);
45		63
		64	static lua_State *L = NULL;
46		65
47	static lua_Hook old_linehook = NULL;	66	static const char *progname = PROGNAME;
48	static lua_Hook old_callhook = NULL;
49		67
50		68
51	static void userinit (void) {	69
52	lua_baselibopen(L);	70	static const luaL_reg lualibs[] = {
53	lua_iolibopen(L);	71	{"base", luaopen_base},
54	lua_strlibopen(L);	72	{"table", luaopen_table},
55	lua_mathlibopen(L);	73	{"io", luaopen_io},
56	lua_dblibopen(L);	74	{"string", luaopen_string},
		75	{"math", luaopen_math},
		76	{"debug", luaopen_debug},
		77	{"loadlib", luaopen_loadlib},
57	/* add your libraries here */	78	/* add your libraries here */
58	}	79	LUA_EXTRALIBS
		80	{NULL, NULL}
		81	};
59		82
60		83
61	static handler lreset (void) {
62	return signal(SIGINT, laction);
63	}
64		84
65		85	static void lstop (lua_State l, lua_Debug ar) {
66	static void lstop (void) {	86	(void)ar; /* unused arg. */
67	lua_setlinehook(L, old_linehook);	87	lua_sethook(l, NULL, 0, 0);
68	lua_setcallhook(L, old_callhook);	88	luaL_error(l, "interrupted!");
69	lreset();
70	lua_error(L, "interrupted!");
71	}	89	}
72		90
73		91
74	static void laction (int i) {	92	static void laction (int i) {
75	(void)i; /* to avoid warnings */	93	signal(i, SIG_DFL); /* if another SIGINT happens before lstop,
76	signal(SIGINT, SIG_DFL); /* if another SIGINT happens before lstop,
77	terminate process (default action) */	94	terminate process (default action) */
78	old_linehook = lua_setlinehook(L, (lua_Hook)lstop);	95	lua_sethook(L, lstop, LUA_MASKCALL \| LUA_MASKRET \| LUA_MASKCOUNT, 1);
79	old_callhook = lua_setcallhook(L, (lua_Hook)lstop);
80	}
81
82
83	static int ldo (int (f)(lua_State l, const char ), const char name) {
84	int res;
85	handler h = lreset();
86	int top = lua_gettop(L);
87	res = f(L, name); /* dostring \| dofile */
88	lua_settop(L, top); /* remove eventual results */
89	signal(SIGINT, h); /* restore old action */
90	/* Lua gives no message in such cases, so lua.c provides one */
91	if (res == LUA_ERRMEM) {
92	fprintf(stderr, "lua: memory allocation error\n");
93	}
94	else if (res == LUA_ERRERR)
95	fprintf(stderr, "lua: error in error message\n");
96	return res;
97	}	96	}
98		97
99		98
100	static void print_message (void) {	99	static void print_usage (void) {
101	fprintf(stderr,	100	fprintf(stderr,
102	"usage: lua [options]. Available options are:\n"	101	"usage: %s [options] [script [args]].\n"
		102	"Available options are:\n"
103	" - execute stdin as a file\n"	103	" - execute stdin as a file\n"
104	" -c close Lua when exiting\n"
105	" -e stat execute string `stat'\n"	104	" -e stat execute string `stat'\n"
106	" -f name execute file `name' with remaining arguments in table `arg'\n"	105	" -i enter interactive mode after executing `script'\n"
107	" -i enter interactive mode with prompt\n"	106	" -l name load and run library `name'\n"
108	" -q enter interactive mode without prompt\n"	107	" -v show version information\n"
109	" -sNUM set stack size to NUM (must be the first option)\n"	108	" -- stop handling options\n" ,
110	" -v print version information\n"	109	progname);
111	" a=b set global `a' to string `b'\n"
112	" name execute file `name'\n"
113	);
114	}	110	}
115		111
116		112
117	static void print_version (void) {	113	static void l_message (const char pname, const char msg) {
118	printf("%.80s %.80s\n", LUA_VERSION, LUA_COPYRIGHT);	114	if (pname) fprintf(stderr, "%s: ", pname);
		115	fprintf(stderr, "%s\n", msg);
119	}	116	}
120		117
121		118
122	static void assign (char *arg) {	119	static int report (int status) {
123	char *eq = strchr(arg, '=');	120	const char *msg;
124	eq = '\0'; / spilt `arg' in two strings (name & value) */	121	if (status) {
125	lua_pushstring(L, eq+1);	122	msg = lua_tostring(L, -1);
126	lua_setglobal(L, arg);	123	if (msg == NULL) msg = "(error with no message)";
		124	l_message(progname, msg);
		125	lua_pop(L, 1);
		126	}
		127	return status;
127	}	128	}
128		129
129		130
130	static void getargs (char *argv[]) {	131	static int lcall (int narg, int clear) {
		132	int status;
		133	int base = lua_gettop(L) - narg; /* function index */
		134	lua_pushliteral(L, "_TRACEBACK");
		135	lua_rawget(L, LUA_GLOBALSINDEX); /* get traceback function */
		136	lua_insert(L, base); /* put it under chunk and args */
		137	signal(SIGINT, laction);
		138	status = lua_pcall(L, narg, (clear ? 0 : LUA_MULTRET), base);
		139	signal(SIGINT, SIG_DFL);
		140	lua_remove(L, base); /* remove traceback function */
		141	return status;
		142	}
		143
		144
		145	static void print_version (void) {
		146	l_message(NULL, LUA_VERSION " " LUA_COPYRIGHT);
		147	}
		148
		149
		150	static void getargs (char *argv[], int n) {
131	int i;	151	int i;
132	lua_newtable(L);	152	lua_newtable(L);
133	for (i=0; argv[i]; i++) {	153	for (i=0; argv[i]; i++) {
134	/* arg[i] = argv[i] */	154	lua_pushnumber(L, i - n);
135	lua_pushnumber(L, i);
136	lua_pushstring(L, argv[i]);	155	lua_pushstring(L, argv[i]);
137	lua_settable(L, -3);	156	lua_rawset(L, -3);
138	}	157	}
139	/* arg.n = maximum index in table `arg' */	158	/* arg.n = maximum index in table `arg' */
140	lua_pushstring(L, "n");	159	lua_pushliteral(L, "n");
141	lua_pushnumber(L, i-1);	160	lua_pushnumber(L, i-n-1);
142	lua_settable(L, -3);	161	lua_rawset(L, -3);
143	}	162	}
144		163
145		164
146	static int l_getargs (lua_State *l) {	165	static int docall (int status) {
147	char argv = (char )lua_touserdata(l, -1);	166	if (status == 0) status = lcall(0, 1);
148	getargs(argv);	167	return report(status);
149	return 1;
150	}	168	}
151		169
152		170
153	static int file_input (const char *argv) {	171	static int file_input (const char *name) {
154	int result = ldo(lua_dofile, argv);	172	return docall(luaL_loadfile(L, name));
155	if (result) {	173	}
156	if (result == LUA_ERRFILE) {	174
157	fprintf(stderr, "lua: cannot execute file ");	175
158	perror(argv);	176	static int dostring (const char s, const char name) {
159	}	177	return docall(luaL_loadbuffer(L, s, strlen(s), name));
160	return EXIT_FAILURE;	178	}
		179
		180
		181	static int load_file (const char *name) {
		182	lua_pushliteral(L, "require");
		183	lua_rawget(L, LUA_GLOBALSINDEX);
		184	if (!lua_isfunction(L, -1)) { /* no `require' defined? */
		185	lua_pop(L, 1);
		186	return file_input(name);
		187	}
		188	else {
		189	lua_pushstring(L, name);
		190	return report(lcall(1, 1));
161	}	191	}
162	else
163	return EXIT_SUCCESS;
164	}	192	}
165		193
166		194
167	/* maximum length of an input string */	195	/*
		196	** this macro can be used by some `history' system to save lines
		197	** read in manual input
		198	*/
		199	#ifndef lua_saveline
		200	#define lua_saveline(L,line) /* empty */
		201	#endif
		202
		203
		204	/*
		205	** this macro defines a function to show the prompt and reads the
		206	** next line for manual input
		207	*/
		208	#ifndef lua_readline
		209	#define lua_readline(L,prompt) readline(L,prompt)
		210
		211	/* maximum length of an input line */
168	#ifndef MAXINPUT	212	#ifndef MAXINPUT
169	#define MAXINPUT BUFSIZ	213	#define MAXINPUT 512
170	#endif	214	#endif
171		215
172	static void manual_input (int version, int prompt) {	216
173	int cont = 1;	217	static int readline (lua_State l, const char prompt) {
174	if (version) print_version();	218	static char buffer[MAXINPUT];
175	while (cont) {	219	if (prompt) {
176	char buffer[MAXINPUT];	220	fputs(prompt, stdout);
177	int i = 0;	221	fflush(stdout);
178	if (prompt) {	222	}
179	const char *s;	223	if (fgets(buffer, sizeof(buffer), stdin) == NULL)
180	lua_getglobal(L, "_PROMPT");	224	return 0; /* read fails */
181	s = lua_tostring(L, -1);	225	else {
182	if (!s) s = PROMPT;	226	lua_pushstring(l, buffer);
183	fputs(s, stdout);	227	return 1;
184	lua_pop(L, 1); /* remove global */	228	}
185	}	229	}
186	for(;;) {	230
187	int c = getchar();	231	#endif
188	if (c == EOF) {	232
189	cont = 0;	233
190	break;	234	static const char *get_prompt (int firstline) {
191	}	235	const char *p = NULL;
192	else if (c == '\n') {	236	lua_pushstring(L, firstline ? "_PROMPT" : "_PROMPT2");
193	if (i>0 && buffer[i-1] == '\\')	237	lua_rawget(L, LUA_GLOBALSINDEX);
194	buffer[i-1] = '\n';	238	p = lua_tostring(L, -1);
195	else break;	239	if (p == NULL) p = (firstline ? PROMPT : PROMPT2);
196	}	240	lua_pop(L, 1); /* remove global */
197	else if (i >= MAXINPUT-1) {	241	return p;
198	fprintf(stderr, "lua: input line too long\n");	242	}
199	break;	243
200	}	244
201	else buffer[i++] = (char)c;	245	static int incomplete (int status) {
		246	if (status == LUA_ERRSYNTAX &&
		247	strstr(lua_tostring(L, -1), "near `<eof>'") != NULL) {
		248	lua_pop(L, 1);
		249	return 1;
		250	}
		251	else
		252	return 0;
		253	}
		254
		255
		256	static int load_string (void) {
		257	int status;
		258	lua_settop(L, 0);
		259	if (lua_readline(L, get_prompt(1)) == 0) /* no input? */
		260	return -1;
		261	if (lua_tostring(L, -1)[0] == '=') { /* line starts with `=' ? */
		262	lua_pushfstring(L, "return %s", lua_tostring(L, -1)+1);/* `=' -> `return' */
		263	lua_remove(L, -2); /* remove original line */
		264	}
		265	for (;;) { /* repeat until gets a complete line */
		266	status = luaL_loadbuffer(L, lua_tostring(L, 1), lua_strlen(L, 1), "=stdin");
		267	if (!incomplete(status)) break; /* cannot try to add lines? */
		268	if (lua_readline(L, get_prompt(0)) == 0) /* no more input? */
		269	return -1;
		270	lua_concat(L, lua_gettop(L)); /* join lines */
		271	}
		272	lua_saveline(L, lua_tostring(L, 1));
		273	lua_remove(L, 1); /* remove line */
		274	return status;
		275	}
		276
		277
		278	static void manual_input (void) {
		279	int status;
		280	const char *oldprogname = progname;
		281	progname = NULL;
		282	while ((status = load_string()) != -1) {
		283	if (status == 0) status = lcall(0, 0);
		284	report(status);
		285	if (status == 0 && lua_gettop(L) > 0) { /* any result to print? */
		286	lua_getglobal(L, "print");
		287	lua_insert(L, 1);
		288	if (lua_pcall(L, lua_gettop(L)-1, 0, 0) != 0)
		289	l_message(progname, lua_pushfstring(L, "error calling `print' (%s)",
		290	lua_tostring(L, -1)));
202	}	291	}
203	buffer[i] = '\0';
204	ldo(lua_dostring, buffer);
205	lua_settop(L, 0); /* remove eventual results */
206	}	292	}
207	printf("\n");	293	lua_settop(L, 0); /* clear stack */
		294	fputs("\n", stdout);
		295	progname = oldprogname;
208	}	296	}
209		297
210		298
211	static int handle_argv (char argv[], struct Options opt) {	299	static int handle_argv (char argv[], int interactive) {
212	if (opt->stacksize > 0) argv++; /* skip option `-s' (if present) */	300	if (argv[1] == NULL) { /* no more arguments? */
213	if (argv == NULL) { / no more arguments? */	301	if (stdin_is_tty()) {
214	if (isatty(0)) {	302	print_version();
215	manual_input(1, 1);	303	manual_input();
216	}	304	}
217	else	305	else
218	ldo(lua_dofile, NULL); /* executes stdin as a file */	306	file_input(NULL); /* executes stdin as a file */
219	}	307	}
220	else { /* other arguments; loop over them */	308	else { /* other arguments; loop over them */
221	int i;	309	int i;
222	for (i = 0; argv[i] != NULL; i++) {	310	for (i = 1; argv[i] != NULL; i++) {
223	if (argv[i][0] != '-') { /* not an option? */	311	if (argv[i][0] != '-') break; /* not an option? */
224	if (strchr(argv[i], '='))	312	switch (argv[i][1]) { /* option */
225	assign(argv[i]);	313	case '-': { /* `--' */
226	else	314	if (argv[i][2] != '\0') {
227	if (file_input(argv[i]) != EXIT_SUCCESS)	315	print_usage();
228	return EXIT_FAILURE; /* stop if file fails */	316	return 1;
229	}
230	else switch (argv[i][1]) { /* option */
231	case 0: {
232	ldo(lua_dofile, NULL); /* executes stdin as a file */
233	break;
234	}
235	case 'i': {
236	manual_input(0, 1);
237	break;
238	}
239	case 'q': {
240	manual_input(0, 0);
241	break;
242	}
243	case 'c': {
244	opt->toclose = 1;
245	break;
246	}	317	}
247	case 'v': {	318	i++; /* skip this argument */
248	print_version();	319	goto endloop; /* stop handling arguments */
249	break;	320	}
250	}	321	case '\0': {
251	case 'e': {	322	file_input(NULL); /* executes stdin as a file */
252	i++;	323	break;
253	if (argv[i] == NULL) {	324	}
254	print_message();	325	case 'i': {
255	return EXIT_FAILURE;	326	*interactive = 1;
256	}	327	break;
257	if (ldo(lua_dostring, argv[i]) != 0) {	328	}
258	fprintf(stderr, "lua: error running argument `%.99s'\n", argv[i]);	329	case 'v': {
259	return EXIT_FAILURE;	330	print_version();
260	}	331	break;
261	break;	332	}
262	}	333	case 'e': {
263	case 'f': {	334	const char *chunk = argv[i] + 2;
264	i++;	335	if (*chunk == '\0') chunk = argv[++i];
265	if (argv[i] == NULL) {	336	if (chunk == NULL) {
266	print_message();	337	print_usage();
267	return EXIT_FAILURE;	338	return 1;
268	}
269	getargs(argv+i); /* collect remaining arguments */
270	lua_setglobal(L, "arg");
271	return file_input(argv[i]); /* stop scanning arguments */
272	}
273	case 's': {
274	fprintf(stderr, "lua: stack size (`-s') must be the first option\n");
275	return EXIT_FAILURE;
276	}	339	}
277	default: {	340	if (dostring(chunk, "=<command line>") != 0)
278	print_message();	341	return 1;
279	return EXIT_FAILURE;	342	break;
		343	}
		344	case 'l': {
		345	const char *filename = argv[i] + 2;
		346	if (*filename == '\0') filename = argv[++i];
		347	if (filename == NULL) {
		348	print_usage();
		349	return 1;
280	}	350	}
		351	if (load_file(filename))
		352	return 1; /* stop if file fails */
		353	break;
		354	}
		355	case 'c': {
		356	l_message(progname, "option `-c' is deprecated");
		357	break;
		358	}
		359	case 's': {
		360	l_message(progname, "option `-s' is deprecated");
		361	break;
		362	}
		363	default: {
		364	print_usage();
		365	return 1;
281	}	366	}
		367	}
		368	} endloop:
		369	if (argv[i] != NULL) {
		370	const char *filename = argv[i];
		371	getargs(argv, i); /* collect arguments */
		372	lua_setglobal(L, "arg");
		373	return file_input(filename); /* stop scanning arguments */
282	}	374	}
283	}	375	}
284	return EXIT_SUCCESS;	376	return 0;
285	}	377	}
286		378
287		379
288	static void getstacksize (int argc, char argv[], struct Options opt) {	380	static void openstdlibs (lua_State *l) {
289	if (argc >= 2 && argv[1][0] == '-' && argv[1][1] == 's') {	381	const luaL_reg *lib = lualibs;
290	int stacksize = atoi(&argv[1][2]);	382	for (; lib->func; lib++) {
291	if (stacksize <= 0) {	383	lib->func(l); /* open library */
292	fprintf(stderr, "lua: invalid stack size ('%.20s')\n", &argv[1][2]);	384	lua_settop(l, 0); /* discard any results */
293	exit(EXIT_FAILURE);
294	}
295	opt->stacksize = stacksize;
296	}	385	}
		386	}
		387
		388
		389	static int handle_luainit (void) {
		390	const char *init = getenv("LUA_INIT");
		391	if (init == NULL) return 0; /* status OK */
		392	else if (init[0] == '@')
		393	return file_input(init+1);
297	else	394	else
298	opt->stacksize = 0; /* no stack size */	395	return dostring(init, "=LUA_INIT");
299	}	396	}
300		397
301		398
302	static void register_getargs (char *argv[]) {	399	struct Smain {
303	lua_pushuserdata(L, argv);	400	int argc;
304	lua_pushcclosure(L, l_getargs, 1);	401	char **argv;
305	lua_setglobal(L, "getargs");	402	int status;
		403	};
		404
		405
		406	static int pmain (lua_State *l) {
		407	struct Smain s = (struct Smain )lua_touserdata(l, 1);
		408	int status;
		409	int interactive = 0;
		410	if (s->argv[0] && s->argv[0][0]) progname = s->argv[0];
		411	L = l;
		412	lua_userinit(l); /* open libraries */
		413	status = handle_luainit();
		414	if (status == 0) {
		415	status = handle_argv(s->argv, &interactive);
		416	if (status == 0 && interactive) manual_input();
		417	}
		418	s->status = status;
		419	return 0;
306	}	420	}
307		421
308		422
309	int main (int argc, char *argv[]) {	423	int main (int argc, char *argv[]) {
310	struct Options opt;
311	int status;	424	int status;
312	opt.toclose = 0;	425	struct Smain s;
313	getstacksize(argc, argv, &opt); /* handle option `-s' */	426	lua_State l = lua_open(); / create state */
314	L = lua_open(opt.stacksize); /* create state */	427	if (l == NULL) {
315	userinit(); /* open libraries */	428	l_message(argv[0], "cannot create state: not enough memory");
316	register_getargs(argv); /* create `getargs' function */	429	return EXIT_FAILURE;
317	status = handle_argv(argv+1, &opt);	430	}
318	if (opt.toclose)	431	s.argc = argc;
319	lua_close(L);	432	s.argv = argv;
320	return status;	433	status = lua_cpcall(l, &pmain, &s);
		434	report(status);
		435	lua_close(l);
		436	return (status \|\| s.status) ? EXIT_FAILURE : EXIT_SUCCESS;
321	}	437	}
322		438

src/luac/Makefile+13−6

 include $(LUA)/config
-INCS= -I$(INC) $(EXTRA_INCS) -I..
+INCS= -I$(INC) -I.. $(EXTRA_INCS)
-OBJS= dump.o luac.o opt.o print.o stubs.o
+OBJS= luac.o print.o lopcodes.o
-SRCS= dump.c luac.c opt.c print.c stubs.c luac.h print.h
+SRCS= luac.c print.c
 T= $(BIN)/luac
-all: $T
+all:	$T
-$T: $(OBJS) $(LIB)/liblua.a
+$T:	$(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a
-	$(CC) -o $@ $(OBJS) -L$(LIB) -llua
+	$(CC) -o $@ $(MYLDFLAGS) $(OBJS) -L$(LIB) -llua -llualib $(EXTRA_LIBS)
+# print.c needs opcode names from lopcodes.c
+lopcodes.o:	../lopcodes.c ../lopcodes.h
+	$(CC) -o $@ -c $(CFLAGS) -DLUA_OPNAMES ../lopcodes.c
 $(LIB)/liblua.a:
 	cd ..; $(MAKE)
+$(LIB)/liblualib.a:
+	cd ../lib; $(MAKE)
 clean:
 	rm -f $(OBJS) $T

src/luac/README+4−8

 This is luac, the Lua compiler.
 There are man pages for it in both nroff and html in ../../doc.
-luac translates Lua programs into binary files that can be loaded and executed
+luac translates Lua programs into binary files that can be loaded latter.
-with lua_dofile in C or with dofile in Lua.
 The main advantages of pre-compiling chunks are: faster loading, protecting
 source code from user changes, and off-line syntax error detection.
 luac can also be used to learn about the Lua virtual machine.
-Here are the options that luac understands:
+Usage: /l/luac/luac [options] [filenames].  Available options are:
   -        process stdin
   -l       list
-  -o file  output file (default is "luac.out")
+  -o name  output to file `name' (default is "luac.out")
   -p       parse only
   -s       strip debug information
-  -t       test code integrity
   -v       show version information
+  --       stop handling options
 luac is also an example of how to use the internals of Lua (politely).
-Finally, luac does not need the runtime code, and stubs.c makes sure it is not
-linked into luac. This file also shows how to avoid linking the parser.

src/luac/dump.c+0−121

@@ -1,121 +0,0 @@
1	/*
2	** $Id: dump.c,v 1.30 2000/10/31 16:57:23 lhf Exp $
3	** save bytecodes to file
4	** See Copyright Notice in lua.h
5	*/
6
7	#include <stdio.h>
8	#include <stdlib.h>
9	#include <string.h>
10
11	#include "luac.h"
12
13	#define DumpVector(b,n,size,D) fwrite(b,size,n,D)
14	#define DumpBlock(b,size,D) fwrite(b,size,1,D)
15	#define DumpByte fputc
16
17	static void DumpInt(int x, FILE* D)
18	{
19	DumpBlock(&x,sizeof(x),D);
20	}
21
22	static void DumpSize(size_t x, FILE* D)
23	{
24	DumpBlock(&x,sizeof(x),D);
25	}
26
27	static void DumpNumber(Number x, FILE* D)
28	{
29	DumpBlock(&x,sizeof(x),D);
30	}
31
32	static void DumpString(const TString* s, FILE* D)
33	{
34	if (s==NULL \|\| s->str==NULL)
35	DumpSize(0,D);
36	else
37	{
38	size_t size=s->len+1; /* include trailing '\0' */
39	DumpSize(size,D);
40	DumpBlock(s->str,size,D);
41	}
42	}
43
44	static void DumpCode(const Proto* tf, FILE* D)
45	{
46	DumpInt(tf->ncode,D);
47	DumpVector(tf->code,tf->ncode,sizeof(*tf->code),D);
48	}
49
50	static void DumpLocals(const Proto* tf, FILE* D)
51	{
52	int i,n=tf->nlocvars;
53	DumpInt(n,D);
54	for (i=0; i<n; i++)
55	{
56	DumpString(tf->locvars[i].varname,D);
57	DumpInt(tf->locvars[i].startpc,D);
58	DumpInt(tf->locvars[i].endpc,D);
59	}
60	}
61
62	static void DumpLines(const Proto* tf, FILE* D)
63	{
64	DumpInt(tf->nlineinfo,D);
65	DumpVector(tf->lineinfo,tf->nlineinfo,sizeof(*tf->lineinfo),D);
66	}
67
68	static void DumpFunction(const Proto* tf, FILE* D);
69
70	static void DumpConstants(const Proto* tf, FILE* D)
71	{
72	int i,n;
73	DumpInt(n=tf->nkstr,D);
74	for (i=0; i<n; i++)
75	DumpString(tf->kstr[i],D);
76	DumpInt(tf->nknum,D);
77	DumpVector(tf->knum,tf->nknum,sizeof(*tf->knum),D);
78	DumpInt(n=tf->nkproto,D);
79	for (i=0; i<n; i++)
80	DumpFunction(tf->kproto[i],D);
81	}
82
83	static void DumpFunction(const Proto* tf, FILE* D)
84	{
85	DumpString(tf->source,D);
86	DumpInt(tf->lineDefined,D);
87	DumpInt(tf->numparams,D);
88	DumpByte(tf->is_vararg,D);
89	DumpInt(tf->maxstacksize,D);
90	DumpLocals(tf,D);
91	DumpLines(tf,D);
92	DumpConstants(tf,D);
93	DumpCode(tf,D);
94	if (ferror(D))
95	{
96	perror("luac: write error");
97	exit(1);
98	}
99	}
100
101	static void DumpHeader(FILE* D)
102	{
103	DumpByte(ID_CHUNK,D);
104	fputs(SIGNATURE,D);
105	DumpByte(VERSION,D);
106	DumpByte(luaU_endianess(),D);
107	DumpByte(sizeof(int),D);
108	DumpByte(sizeof(size_t),D);
109	DumpByte(sizeof(Instruction),D);
110	DumpByte(SIZE_INSTRUCTION,D);
111	DumpByte(SIZE_OP,D);
112	DumpByte(SIZE_B,D);
113	DumpByte(sizeof(Number),D);
114	DumpNumber(TEST_NUMBER,D);
115	}
116
117	void luaU_dumpchunk(const Proto* Main, FILE* D)
118	{
119	DumpHeader(D);
120	DumpFunction(Main,D);
121	}

src/luac/luac.c+106−118

 /*
-** $Id: luac.c,v 1.28 2000/11/06 20:06:27 lhf Exp $
+** $Id: luac.c,v 1.44 2003/04/07 20:34:20 lhf Exp $
-** lua compiler (saves bytecodes to files; also list binary files)
+** Lua compiler (saves bytecodes to files; also list bytecodes)
 ** See Copyright Notice in lua.h
 */
 #include <stdlib.h>
 #include <string.h>
-#include "lparser.h"
+#include "lua.h"
-#include "lstate.h"
+#include "lauxlib.h"
-#include "lzio.h"
-#include "luac.h"
-#define	OUTPUT	"luac.out"		/* default output file */
+#include "lfunc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lopcodes.h"
+#include "lstring.h"
+#include "lundump.h"
-static void usage(const char* message, const char* arg);
+#ifndef LUA_DEBUG
-static int doargs(int argc, const char* argv[]);
+#define luaB_opentests(L)
-static Proto* load(const char* filename);
+#endif
-static FILE* efopen(const char* name, const char* mode);
-static void strip(Proto* tf);
-static Proto* combine(Proto** P, int n);
-lua_State* lua_state=NULL;		/* lazy! */
+#ifndef PROGNAME
+#define PROGNAME	"luac"		/* program name */
+#endif
+#define	OUTPUT		"luac.out"	/* default output file */
 static int listing=0;			/* list bytecodes? */
 static int dumping=1;			/* dump bytecodes? */
 static int stripping=0;			/* strip debug information? */
-static int testing=0;			/* test integrity? */
+static char Output[]={ OUTPUT };	/* default output file name */
-static const char* output=OUTPUT;	/* output file name */
+static const char* output=Output;	/* output file name */
+static const char* progname=PROGNAME;	/* actual program name */
-#define	IS(s)	(strcmp(argv[i],s)==0)
+static void fatal(const char* message)
+{
+ fprintf(stderr,"%s: %s\n",progname,message);
+ exit(EXIT_FAILURE);
+}
-int main(int argc, const char* argv[])
+static void cannot(const char* name, const char* what, const char* mode)
 {
- Proto** P,*tf;
+ fprintf(stderr,"%s: cannot %s %sput file ",progname,what,mode);
- int i=doargs(argc,argv);
+ perror(name);
- argc-=i; argv+=i;
+ exit(EXIT_FAILURE);
- if (argc<=0) usage("no input files given",NULL);
- L=lua_open(0);
- P=luaM_newvector(L,argc,Proto*);
- for (i=0; i<argc; i++)
-  P[i]=load(IS("-")? NULL : argv[i]);
- tf=combine(P,argc);
- if (dumping) luaU_optchunk(tf);
- if (listing) luaU_printchunk(tf);
- if (testing) luaU_testchunk(tf);
- if (dumping)
- {
-  if (stripping) strip(tf);
-  luaU_dumpchunk(tf,efopen(output,"wb"));
- }
- return 0;
 }
 static void usage(const char* message, const char* arg)
 {
  if (message!=NULL)
  {
-  fprintf(stderr,"luac: "); fprintf(stderr,message,arg); fprintf(stderr,"\n");
+  fprintf(stderr,"%s: ",progname); fprintf(stderr,message,arg); fprintf(stderr,"\n");
  }
  fprintf(stderr,
- "usage: luac [options] [filenames].  Available options are:\n"
+ "usage: %s [options] [filenames].  Available options are:\n"
  "  -        process stdin\n"
  "  -l       list\n"
- "  -o file  output file (default is \"" OUTPUT "\")\n"
+ "  -o name  output to file `name' (default is \"" OUTPUT "\")\n"
  "  -p       parse only\n"
  "  -s       strip debug information\n"
- "  -t       test code integrity\n"
  "  -v       show version information\n"
- );
+ "  --       stop handling options\n",
- exit(1);
+ progname);
+ exit(EXIT_FAILURE);
 }
-static int doargs(int argc, const char* argv[])
+#define	IS(s)	(strcmp(argv[i],s)==0)
+static int doargs(int argc, char* argv[])
 {
  int i;
+ if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0];
  for (i=1; i<argc; i++)
  {
-  if (*argv[i]!='-')			/* end of options */
+  if (*argv[i]!='-')			/* end of options; keep it */
+   break;
+  else if (IS("--"))			/* end of options; skip it */
+  {
+   ++i;
    break;
+  }
   else if (IS("-"))			/* end of options; use stdin */
    return i;
   else if (IS("-l"))			/* list */
   else if (IS("-o"))			/* output file */
   {
    output=argv[++i];
-   if (output==NULL) usage(NULL,NULL);
+   if (output==NULL || *output==0) usage("`-o' needs argument",NULL);
   }
   else if (IS("-p"))			/* parse only */
    dumping=0;
   else if (IS("-s"))			/* strip debug information */
    stripping=1;
-  else if (IS("-t"))			/* test */
-  {
-   testing=1;
-   dumping=0;
-  }
   else if (IS("-v"))			/* show version */
   {
    printf("%s  %s\n",LUA_VERSION,LUA_COPYRIGHT);
-   if (argc==2) exit(0);
+   if (argc==2) exit(EXIT_SUCCESS);
   }
   else					/* unknown option */
    usage("unrecognized option `%s'",argv[i]);
  }
- if (i==argc && (listing || testing))
+ if (i==argc && (listing || !dumping))
  {
   dumping=0;
-  argv[--i]=OUTPUT;
+  argv[--i]=Output;
  }
  return i;
 }
-static Proto* load(const char* filename)
+static Proto* toproto(lua_State* L, int i)
 {
- Proto* tf;
+ const Closure* c=(const Closure*)lua_topointer(L,i);
- ZIO z;
+ return c->l.p;
- char source[512];
- FILE* f;
- int c,undump;
- if (filename==NULL)
- {
-  f=stdin;
-  filename="(stdin)";
- }
- else
-  f=efopen(filename,"r");
- c=ungetc(fgetc(f),f);
- if (ferror(f))
- {
-  fprintf(stderr,"luac: cannot read from ");
-  perror(filename);
-  exit(1);
- }
- undump=(c==ID_CHUNK);
- if (undump && f!=stdin)
- {
-  fclose(f);
-  f=efopen(filename,"rb");
- }
- sprintf(source,"@%.*s",Sizeof(source)-2,filename);
- luaZ_Fopen(&z,f,source);
- tf = undump ? luaU_undump(L,&z) : luaY_parser(L,&z);
- if (f!=stdin) fclose(f);
- return tf;
 }
-static Proto* combine(Proto** P, int n)
+static Proto* combine(lua_State* L, int n)
 {
  if (n==1)
-  return P[0];
+  return toproto(L,-1);
  else
  {
   int i,pc=0;
-  Proto* tf=luaF_newproto(L);
+  Proto* f=luaF_newproto(L);
-  tf->source=luaS_new(L,"=(luac)");
+  f->source=luaS_newliteral(L,"=(" PROGNAME ")");
-  tf->maxstacksize=1;
+  f->maxstacksize=1;
-  tf->kproto=P;
+  f->p=luaM_newvector(L,n,Proto*);
-  tf->nkproto=n;
+  f->sizep=n;
-  tf->ncode=2*n+1;
+  f->sizecode=2*n+1;
-  tf->code=luaM_newvector(L,tf->ncode,Instruction);
+  f->code=luaM_newvector(L,f->sizecode,Instruction);
   for (i=0; i<n; i++)
   {
-   tf->code[pc++]=CREATE_AB(OP_CLOSURE,i,0);
+   f->p[i]=toproto(L,i-n);
-   tf->code[pc++]=CREATE_AB(OP_CALL,0,0);
+   f->code[pc++]=CREATE_ABx(OP_CLOSURE,0,i);
+   f->code[pc++]=CREATE_ABC(OP_CALL,0,1,1);
   }
-  tf->code[pc++]=OP_END;
+  f->code[pc++]=CREATE_ABC(OP_RETURN,0,1,0);
-  return tf;
+  return f;
  }
 }
-static void strip(Proto* tf)
+static void strip(lua_State* L, Proto* f)
 {
- int i,n=tf->nkproto;
+ int i,n=f->sizep;
- tf->lineinfo=NULL;
+ luaM_freearray(L, f->lineinfo, f->sizelineinfo, int);
- tf->nlineinfo=0;
+ luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar);
- tf->source=luaS_new(L,"=(none)");
+ luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *);
- tf->locvars=NULL;
+ f->lineinfo=NULL; f->sizelineinfo=0;
- tf->nlocvars=0;
+ f->locvars=NULL;  f->sizelocvars=0;
- for (i=0; i<n; i++) strip(tf->kproto[i]);
+ f->upvalues=NULL; f->sizeupvalues=0;
+ f->source=luaS_newliteral(L,"=(none)");
+ for (i=0; i<n; i++) strip(L,f->p[i]);
 }
-static FILE* efopen(const char* name, const char* mode)
+static int writer(lua_State* L, const void* p, size_t size, void* u)
 {
- FILE* f=fopen(name,mode);
+ UNUSED(L);
- if (f==NULL)
+ return fwrite(p,size,1,(FILE*)u)==1;
- {
-  fprintf(stderr,"luac: cannot open %sput file ",*mode=='r' ? "in" : "out");
-  perror(name);
-  exit(1);
- }
- return f;
 }
-void luaU_testchunk(const Proto* Main)
+int main(int argc, char* argv[])
 {
- UNUSED(Main);
+ lua_State* L;
- fprintf(stderr,"luac: -t not operational in this version\n");
+ Proto* f;
- exit(1);
+ int i=doargs(argc,argv);
+ argc-=i; argv+=i;
+ if (argc<=0) usage("no input files given",NULL);
+ L=lua_open();
+ luaB_opentests(L);
+ for (i=0; i<argc; i++)
+ {
+  const char* filename=IS("-") ? NULL : argv[i];
+  if (luaL_loadfile(L,filename)!=0) fatal(lua_tostring(L,-1));
+ }
+ f=combine(L,argc);
+ if (listing) luaU_print(f);
+ if (dumping)
+ {
+  FILE* D=fopen(output,"wb");
+  if (D==NULL) cannot(output,"open","out");
+  if (stripping) strip(L,f);
+  luaU_dump(L,f,writer,D);
+  if (ferror(D)) cannot(output,"write","out");
+  fclose(D);
+ }
+ lua_close(L);
+ return 0;
 }

src/luac/luac.h+0−31

@@ -1,31 +0,0 @@
1	/*
2	** $Id: luac.h,v 1.18 2000/10/31 16:57:23 lhf Exp $
3	** definitions for luac
4	** See Copyright Notice in lua.h
5	*/
6
7	#include "ldebug.h"
8	#include "lfunc.h"
9	#include "lmem.h"
10	#include "lobject.h"
11	#include "lopcodes.h"
12	#include "lstring.h"
13	#include "ltable.h"
14	#include "lundump.h"
15
16	extern lua_State *lua_state;
17	#define L lua_state /* lazy! */
18
19	/* from dump.c */
20	void luaU_dumpchunk(const Proto* Main, FILE* D);
21
22	/* from opt.c */
23	void luaU_optchunk(Proto* Main);
24
25	/* from print.c */
26	void luaU_printchunk(const Proto* Main);
27
28	/* from test.c */
29	void luaU_testchunk(const Proto* Main);
30
31	#define Sizeof(x) ((int)sizeof(x))

src/luac/opt.c+0−127

@@ -1,127 +0,0 @@
1	/*
2	** $Id: opt.c,v 1.22 2000/10/31 16:57:23 lhf Exp $
3	** optimize bytecodes
4	** See Copyright Notice in lua.h
5	*/
6
7	#include <stdio.h>
8	#include <stdlib.h>
9	#include <string.h>
10
11	#include "luac.h"
12
13	static int MapConstant(Hash* t, int j, const TObject* key)
14	{
15	const TObject* o=luaH_get(L,t,key);
16	if (ttype(o)==LUA_TNUMBER)
17	return (int) nvalue(o);
18	else
19	{
20	TObject val;
21	ttype(&val)=LUA_TNUMBER;
22	nvalue(&val)=j;
23	*luaH_set(L,t,key)=val;
24	LUA_ASSERT(j>=0,"MapConstant returns negative!");
25	return j;
26	}
27	}
28
29	static int MapConstants(Proto* tf, Hash* map)
30	{
31	int i,j,k,n,m=0;
32	TObject o;
33	j=0; n=tf->nknum; ttype(&o)=LUA_TNUMBER;
34	for (i=0; i<n; i++)
35	{
36	nvalue(&o)=tf->knum[i];
37	k=MapConstant(map,j,&o);
38	if (k==j) j++;
39	}
40	m=j;
41	j=0; n=tf->nkstr; ttype(&o)=LUA_TSTRING;
42	for (i=0; i<n; i++)
43	{
44	tsvalue(&o)=tf->kstr[i];
45	k=MapConstant(map,j,&o);
46	if (k==j) j++;
47	}
48	return m+j;
49	}
50
51	static void PackConstants(Proto* tf, Hash* map)
52	{
53	int i,j,k,n;
54	TObject o;
55	#ifdef DEBUG
56	printf("%p before pack nknum=%d nkstr=%d\n",tf,tf->nknum,tf->nkstr);
57	#endif
58	j=0; n=tf->nknum; ttype(&o)=LUA_TNUMBER;
59	for (i=0; i<n; i++)
60	{
61	nvalue(&o)=tf->knum[i];
62	k=MapConstant(map,-1,&o);
63	if (k==j) tf->knum[j++]=tf->knum[i];
64	}
65	tf->nknum=j;
66	j=0; n=tf->nkstr; ttype(&o)=LUA_TSTRING;
67	for (i=0; i<n; i++)
68	{
69	tsvalue(&o)=tf->kstr[i];
70	k=MapConstant(map,-1,&o);
71	if (k==j) tf->kstr[j++]=tf->kstr[i];
72	}
73	tf->nkstr=j;
74	#ifdef DEBUG
75	printf("%p after pack nknum=%d nkstr=%d\n",tf,tf->nknum,tf->nkstr);
76	#endif
77	}
78
79	static void OptConstants(Proto* tf)
80	{
81	Instruction* p;
82	int n=tf->nknum+tf->nkstr;
83	Hash* map=luaH_new(L,n);
84	int m=MapConstants(tf,map);
85	#ifdef DEBUG
86	printf("%p n=%d m=%d %s\n",tf,n,m,(m==n)?"nothing to optimize":"yes!");
87	#endif
88	if (m==n) return;
89	for (p=tf->code;; p++)
90	{
91	Instruction i=*p;
92	int op=GET_OPCODE(i);
93	switch (op)
94	{
95	TObject o;
96	int j,k;
97	case OP_PUSHNUM: case OP_PUSHNEGNUM:
98	j=GETARG_U(i);
99	ttype(&o)=LUA_TNUMBER; nvalue(&o)=tf->knum[j];
100	k=MapConstant(map,-1,&o);
101	if (k!=j) *p=CREATE_U(op,k);
102	break;
103	case OP_PUSHSTRING: case OP_GETGLOBAL: case OP_GETDOTTED:
104	case OP_PUSHSELF: case OP_SETGLOBAL:
105	j=GETARG_U(i);
106	ttype(&o)=LUA_TSTRING; tsvalue(&o)=tf->kstr[j];
107	k=MapConstant(map,-1,&o);
108	if (k!=j) *p=CREATE_U(op,k);
109	break;
110	case OP_END:
111	PackConstants(tf,map);
112	luaH_free(L,map);
113	return;
114	default:
115	break;
116	}
117	}
118	}
119
120	#define OptFunction luaU_optchunk
121
122	void OptFunction(Proto* tf)
123	{
124	int i,n=tf->nkproto;
125	OptConstants(tf);
126	for (i=0; i<n; i++) OptFunction(tf->kproto[i]);
127	}

src/luac/print.c+171−53

@@ -1,31 +1,30 @@
1	/*	1	/*
2	** $Id: print.c,v 1.32 2000/11/06 20:04:36 lhf Exp $	2	** $Id: print.c,v 1.44 2003/04/07 20:34:20 lhf Exp $
3	** print bytecodes	3	** print bytecodes
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7	#include <stdio.h>	7	#include <stdio.h>
8	#include <stdlib.h>	8
9		9	#if 0
10	#include "luac.h"	10	#define DEBUG_PRINT
11		11	#endif
12	/* macros used in print.h, included in PrintCode */	12
13	#define P_OP(x) printf("%-11s\t",x)	13	#ifndef LUA_OPNAMES
14	#define P_NONE	14	#define LUA_OPNAMES
15	#define P_AB printf("%d %d",GETARG_A(i),GETARG_B(i))	15	#endif
16	#define P_F printf("%d %d\t; %p",GETARG_A(i),GETARG_B(i),tf->kproto[GETARG_A(i)])	16
17	#define P_J printf("%d\t; to %d",GETARG_S(i),GETARG_S(i)+at+1)	17	#include "ldebug.h"
18	#define P_Q PrintString(tf,GETARG_U(i))	18	#include "lobject.h"
19	#define P_K printf("%d\t; %s",GETARG_U(i),tf->kstr[GETARG_U(i)]->str)	19	#include "lopcodes.h"
20	#define P_L PrintLocal(tf,GETARG_U(i),at-1)	20	#include "lundump.h"
21	#define P_N printf("%d\t; " NUMBER_FMT,GETARG_U(i),tf->knum[GETARG_U(i)])	21
22	#define P_S printf("%d",GETARG_S(i))	22	#define Sizeof(x) ((int)sizeof(x))
23	#define P_U printf("%u",GETARG_U(i))	23	#define VOID(p) ((const void*)(p))
24		24
25	static void PrintString(const Proto* tf, int n)	25	static void PrintString(const Proto* f, int n)
26	{	26	{
27	const char* s=tf->kstr[n]->str;	27	const char* s=svalue(&f->k[n]);
28	printf("%d\t; ",n);
29	putchar('"');	28	putchar('"');
30	for (; *s; s++)	29	for (; *s; s++)
31	{	30	{
@@ -45,55 +44,174 @@ static void PrintString(const Proto* tf, int n) · 13 unmodified lines
45	putchar('"');	44	putchar('"');
46	}	45	}
47		46
48	static void PrintLocal(const Proto* tf, int n, int pc)	47	static void PrintConstant(const Proto* f, int i)
49	{	48	{
50	const char* s=luaF_getlocalname(tf,n+1,pc);	49	const TObject* o=&f->k[i];
51	printf("%u",n);	50	switch (ttype(o))
52	if (s!=NULL) printf("\t; %s",s);	51	{
		52	case LUA_TNUMBER:
		53	printf(LUA_NUMBER_FMT,nvalue(o));
		54	break;
		55	case LUA_TSTRING:
		56	PrintString(f,i);
		57	break;
		58	case LUA_TNIL:
		59	printf("nil");
		60	break;
		61	default: /* cannot happen */
		62	printf("? type=%d",ttype(o));
		63	break;
		64	}
53	}	65	}
54		66
55	static void PrintCode(const Proto* tf)	67	static void PrintCode(const Proto* f)
56	{	68	{
57	const Instruction* code=tf->code;	69	const Instruction* code=f->code;
58	const Instruction* p=code;	70	int pc,n=f->sizecode;
59	for (;;)	71	for (pc=0; pc<n; pc++)
60	{	72	{
61	int at=p-code+1;	73	Instruction i=code[pc];
62	Instruction i=*p;	74	OpCode o=GET_OPCODE(i);
63	int line=luaG_getline(tf->lineinfo,at-1,1,NULL);	75	int a=GETARG_A(i);
64	printf("%6d\t",at);	76	int b=GETARG_B(i);
65	if (line>=0) printf("[%d]\t",line); else printf("[-]\t");	77	int c=GETARG_C(i);
66	switch (GET_OPCODE(i)) {	78	int bc=GETARG_Bx(i);
67	#include "print.h"	79	int sbc=GETARG_sBx(i);
		80	int line=getline(f,pc);
		81	#if 0
		82	printf("%0lX",Sizeof(i)2,i);
		83	#endif
		84	printf("\t%d\t",pc+1);
		85	if (line>0) printf("[%d]\t",line); else printf("[-]\t");
		86	printf("%-9s\t",luaP_opnames[o]);
		87	switch (getOpMode(o))
		88	{
		89	case iABC: printf("%d %d %d",a,b,c); break;
		90	case iABx: printf("%d %d",a,bc); break;
		91	case iAsBx: printf("%d %d",a,sbc); break;
		92	}
		93	switch (o)
		94	{
		95	case OP_LOADK:
		96	printf("\t; "); PrintConstant(f,bc);
		97	break;
		98	case OP_GETUPVAL:
		99	case OP_SETUPVAL:
		100	printf("\t; %s", (f->sizeupvalues>0) ? getstr(f->upvalues[b]) : "-");
		101	break;
		102	case OP_GETGLOBAL:
		103	case OP_SETGLOBAL:
		104	printf("\t; %s",svalue(&f->k[bc]));
		105	break;
		106	case OP_GETTABLE:
		107	case OP_SELF:
		108	if (c>=MAXSTACK) { printf("\t; "); PrintConstant(f,c-MAXSTACK); }
		109	break;
		110	case OP_SETTABLE:
		111	case OP_ADD:
		112	case OP_SUB:
		113	case OP_MUL:
		114	case OP_DIV:
		115	case OP_POW:
		116	case OP_EQ:
		117	case OP_LT:
		118	case OP_LE:
		119	if (b>=MAXSTACK \|\| c>=MAXSTACK)
		120	{
		121	printf("\t; ");
		122	if (b>=MAXSTACK) PrintConstant(f,b-MAXSTACK); else printf("-");
		123	printf(" ");
		124	if (c>=MAXSTACK) PrintConstant(f,c-MAXSTACK);
		125	}
		126	break;
		127	case OP_JMP:
		128	case OP_FORLOOP:
		129	case OP_TFORPREP:
		130	printf("\t; to %d",sbc+pc+2);
		131	break;
		132	case OP_CLOSURE:
		133	printf("\t; %p",VOID(f->p[bc]));
		134	break;
		135	default:
		136	break;
68	}	137	}
69	printf("\n");	138	printf("\n");
70	if (i==OP_END) break;
71	p++;
72	}	139	}
73	}	140	}
74		141
75	#define IsMain(tf) (tf->lineDefined==0)	142	static const char* Source(const Proto* f)
		143	{
		144	const char* s=getstr(f->source);
		145	if (s=='@' \|\| s=='=')
		146	return s+1;
		147	else if (*s==LUA_SIGNATURE[0])
		148	return "(bstring)";
		149	else
		150	return "(string)";
		151	}
		152
		153	#define IsMain(f) (f->lineDefined==0)
76		154
77	#define SS(x) (x==1)?"":"s"	155	#define SS(x) (x==1)?"":"s"
78	#define S(x) x,SS(x)	156	#define S(x) x,SS(x)
79		157
80	static void PrintHeader(const Proto* tf)	158	static void PrintHeader(const Proto* f)
		159	{
		160	printf("\n%s <%s:%d> (%d instruction%s, %d bytes at %p)\n",
		161	IsMain(f)?"main":"function",Source(f),f->lineDefined,
		162	S(f->sizecode),f->sizecode*Sizeof(Instruction),VOID(f));
		163	printf("%d%s param%s, %d stack%s, %d upvalue%s, ",
		164	f->numparams,f->is_vararg?"+":"",SS(f->numparams),S(f->maxstacksize),
		165	S(f->nups));
		166	printf("%d local%s, %d constant%s, %d function%s\n",
		167	S(f->sizelocvars),S(f->sizek),S(f->sizep));
		168	}
		169
		170	#ifdef DEBUG_PRINT
		171	static void PrintConstants(const Proto* f)
		172	{
		173	int i,n=f->sizek;
		174	printf("constants (%d) for %p:\n",n,VOID(f));
		175	for (i=0; i<n; i++)
		176	{
		177	printf("\t%d\t",i);
		178	PrintConstant(f,i);
		179	printf("\n");
		180	}
		181	}
		182
		183	static void PrintLocals(const Proto* f)
81	{	184	{
82	printf("\n%s " SOURCE_FMT " (%d instruction%s/%d bytes at %p)\n",	185	int i,n=f->sizelocvars;
83	IsMain(tf)?"main":"function",SOURCE,	186	printf("locals (%d) for %p:\n",n,VOID(f));
84	S(tf->ncode),tf->ncode*Sizeof(Instruction),tf);	187	for (i=0; i<n; i++)
85	printf("%d%s param%s, %d stack%s, ",	188	{
86	tf->numparams,tf->is_vararg?"+":"",SS(tf->numparams),S(tf->maxstacksize));	189	printf("\t%d\t%s\t%d\t%d\n",
87	printf("%d local%s, %d string%s, %d number%s, %d function%s, %d line%s\n",	190	i,getstr(f->locvars[i].varname),f->locvars[i].startpc,f->locvars[i].endpc);
88	S(tf->nlocvars),S(tf->nkstr),S(tf->nknum),S(tf->nkproto),S(tf->nlineinfo));	191	}
89	}	192	}
90		193
91	#define PrintFunction luaU_printchunk	194	static void PrintUpvalues(const Proto* f)
		195	{
		196	int i,n=f->sizeupvalues;
		197	printf("upvalues (%d) for %p:\n",n,VOID(f));
		198	if (f->upvalues==NULL) return;
		199	for (i=0; i<n; i++)
		200	{
		201	printf("\t%d\t%s\n",i,getstr(f->upvalues[i]));
		202	}
		203	}
		204	#endif
92		205
93	void PrintFunction(const Proto* tf)	206	void luaU_print(const Proto* f)
94	{	207	{
95	int i,n=tf->nkproto;	208	int i,n=f->sizep;
96	PrintHeader(tf);	209	PrintHeader(f);
97	PrintCode(tf);	210	PrintCode(f);
98	for (i=0; i<n; i++) PrintFunction(tf->kproto[i]);	211	#ifdef DEBUG_PRINT
		212	PrintConstants(f);
		213	PrintLocals(f);
		214	PrintUpvalues(f);
		215	#endif
		216	for (i=0; i<n; i++) luaU_print(f->p[i]);
99	}	217	}

src/luac/print.h+0−55

@@ -1,55 +0,0 @@
1	/*
2	** $Id: print.h,v 1.1 2000/11/06 20:03:12 lhf Exp $
3	** extracted automatically from lopcodes.h by mkprint.lua -- DO NOT EDIT
4	** See Copyright Notice in lua.h
5	*/
6
7	case OP_END: P_OP("END"); P_NONE; break;
8	case OP_RETURN: P_OP("RETURN"); P_U; break;
9	case OP_CALL: P_OP("CALL"); P_AB; break;
10	case OP_TAILCALL: P_OP("TAILCALL"); P_AB; break;
11	case OP_PUSHNIL: P_OP("PUSHNIL"); P_U; break;
12	case OP_POP: P_OP("POP"); P_U; break;
13	case OP_PUSHINT: P_OP("PUSHINT"); P_S; break;
14	case OP_PUSHSTRING: P_OP("PUSHSTRING"); P_Q; break;
15	case OP_PUSHNUM: P_OP("PUSHNUM"); P_N; break;
16	case OP_PUSHNEGNUM: P_OP("PUSHNEGNUM"); P_N; break;
17	case OP_PUSHUPVALUE: P_OP("PUSHUPVALUE"); P_U; break;
18	case OP_GETLOCAL: P_OP("GETLOCAL"); P_L; break;
19	case OP_GETGLOBAL: P_OP("GETGLOBAL"); P_K; break;
20	case OP_GETTABLE: P_OP("GETTABLE"); P_NONE; break;
21	case OP_GETDOTTED: P_OP("GETDOTTED"); P_K; break;
22	case OP_GETINDEXED: P_OP("GETINDEXED"); P_L; break;
23	case OP_PUSHSELF: P_OP("PUSHSELF"); P_K; break;
24	case OP_CREATETABLE: P_OP("CREATETABLE"); P_U; break;
25	case OP_SETLOCAL: P_OP("SETLOCAL"); P_L; break;
26	case OP_SETGLOBAL: P_OP("SETGLOBAL"); P_K; break;
27	case OP_SETTABLE: P_OP("SETTABLE"); P_AB; break;
28	case OP_SETLIST: P_OP("SETLIST"); P_AB; break;
29	case OP_SETMAP: P_OP("SETMAP"); P_U; break;
30	case OP_ADD: P_OP("ADD"); P_NONE; break;
31	case OP_ADDI: P_OP("ADDI"); P_S; break;
32	case OP_SUB: P_OP("SUB"); P_NONE; break;
33	case OP_MULT: P_OP("MULT"); P_NONE; break;
34	case OP_DIV: P_OP("DIV"); P_NONE; break;
35	case OP_POW: P_OP("POW"); P_NONE; break;
36	case OP_CONCAT: P_OP("CONCAT"); P_U; break;
37	case OP_MINUS: P_OP("MINUS"); P_NONE; break;
38	case OP_NOT: P_OP("NOT"); P_NONE; break;
39	case OP_JMPNE: P_OP("JMPNE"); P_J; break;
40	case OP_JMPEQ: P_OP("JMPEQ"); P_J; break;
41	case OP_JMPLT: P_OP("JMPLT"); P_J; break;
42	case OP_JMPLE: P_OP("JMPLE"); P_J; break;
43	case OP_JMPGT: P_OP("JMPGT"); P_J; break;
44	case OP_JMPGE: P_OP("JMPGE"); P_J; break;
45	case OP_JMPT: P_OP("JMPT"); P_J; break;
46	case OP_JMPF: P_OP("JMPF"); P_J; break;
47	case OP_JMPONT: P_OP("JMPONT"); P_J; break;
48	case OP_JMPONF: P_OP("JMPONF"); P_J; break;
49	case OP_JMP: P_OP("JMP"); P_J; break;
50	case OP_PUSHNILJMP: P_OP("PUSHNILJMP"); P_NONE; break;
51	case OP_FORPREP: P_OP("FORPREP"); P_J; break;
52	case OP_FORLOOP: P_OP("FORLOOP"); P_J; break;
53	case OP_LFORPREP: P_OP("LFORPREP"); P_J; break;
54	case OP_LFORLOOP: P_OP("LFORLOOP"); P_J; break;
55	case OP_CLOSURE: P_OP("CLOSURE"); P_F; break;

src/luac/stubs.c+0−127

@@ -1,127 +0,0 @@
1	/*
2	** $Id: stubs.c,v 1.20 2000/10/31 16:57:23 lhf Exp $
3	** avoid runtime modules in luac
4	** See Copyright Notice in lua.h
5	*/
6
7	#include <stdio.h>
8	#include <stdlib.h>
9
10	#include "ldo.h"
11	#include "llex.h"
12	#include "luac.h"
13	#undef L
14
15	#ifndef NOSTUBS
16
17	const char luac_ident[] = "$luac: " LUA_VERSION " " LUA_COPYRIGHT " $\n"
18	"$Authors: " LUA_AUTHORS " $";
19
20	/*
21	* avoid lapi ldebug ldo lgc lstate ltm lvm
22	* use only lcode lfunc llex lmem lobject lparser lstring ltable lzio
23	*/
24
25	/* simplified from ldo.c */
26	void lua_error (lua_State* L, const char* s) {
27	UNUSED(L);
28	if (s) fprintf(stderr,"luac: %s\n",s);
29	exit(1);
30	}
31
32	/* simplified from ldo.c */
33	void luaD_breakrun (lua_State *L, int errcode) {
34	UNUSED(errcode);
35	lua_error(L,"memory allocation error");
36	}
37
38	/* simplified from lstate.c */
39	lua_State *lua_open (int stacksize) {
40	lua_State *L = luaM_new(NULL, lua_State);
41	if (L == NULL) return NULL; /* memory allocation error */
42	L->stack = NULL;
43	L->strt.size = L->udt.size = 0;
44	L->strt.nuse = L->udt.nuse = 0;
45	L->strt.hash = NULL;
46	L->udt.hash = NULL;
47	L->Mbuffer = NULL;
48	L->Mbuffsize = 0;
49	L->rootproto = NULL;
50	L->rootcl = NULL;
51	L->roottable = NULL;
52	L->TMtable = NULL;
53	L->last_tag = -1;
54	L->refArray = NULL;
55	L->refSize = 0;
56	L->refFree = NONEXT;
57	L->nblocks = sizeof(lua_State);
58	L->GCthreshold = MAX_INT; /* to avoid GC during pre-definitions */
59	L->callhook = NULL;
60	L->linehook = NULL;
61	L->allowhooks = 1;
62	L->errorJmp = NULL;
63	if (stacksize == 0)
64	stacksize = DEFAULT_STACK_SIZE;
65	else
66	stacksize += LUA_MINSTACK;
67	L->gt = luaH_new(L, 10); /* table of globals */
68	luaS_init(L);
69	luaX_init(L);
70	L->GCthreshold = 2*L->nblocks;
71	return L;
72	}
73
74	/* copied from ldebug.c */
75	int luaG_getline (int lineinfo, int pc, int refline, int prefi) {
76	int refi;
77	if (lineinfo == NULL \|\| pc == -1)
78	return -1; /* no line info or function is not active */
79	refi = prefi ? *prefi : 0;
80	if (lineinfo[refi] < 0)
81	refline += -lineinfo[refi++];
82	LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info");
83	while (lineinfo[refi] > pc) {
84	refline--;
85	refi--;
86	if (lineinfo[refi] < 0)
87	refline -= -lineinfo[refi--];
88	LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info");
89	}
90	for (;;) {
91	int nextline = refline + 1;
92	int nextref = refi + 1;
93	if (lineinfo[nextref] < 0)
94	nextline += -lineinfo[nextref++];
95	LUA_ASSERT(lineinfo[nextref] >= 0, "invalid line info");
96	if (lineinfo[nextref] > pc)
97	break;
98	refline = nextline;
99	refi = nextref;
100	}
101	if (prefi) *prefi = refi;
102	return refline;
103	}
104
105	/*
106	* the code below avoids the lexer and the parser (llex lparser lcode).
107	* it is useful if you only want to load binary files.
108	* this works for interpreters like lua.c too.
109	*/
110
111	#ifdef NOPARSER
112
113	#include "llex.h"
114	#include "lparser.h"
115
116	void luaX_init(lua_State *L) {
117	UNUSED(L);
118	}
119
120	Proto luaY_parser(lua_State L, ZIO *z) {
121	UNUSED(z);
122	lua_error(L,"parser not loaded");
123	return NULL;
124	}
125
126	#endif
127	#endif

src/lundump.c+176−134

@@ -1,243 +1,285 @@
1	/*	1	/*
2	** $Id: lundump.c,v 1.33 2000/10/31 16:57:23 lhf Exp $	2	** $Id: lundump.c,v 1.49 2003/04/07 20:34:20 lhf Exp $
3	** load bytecodes from files	3	** load pre-compiled Lua chunks
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7	#include <stdio.h>	7	#define lundump_c
8	#include <string.h>
9		8
		9	#include "lua.h"
		10
		11	#include "ldebug.h"
10	#include "lfunc.h"	12	#include "lfunc.h"
11	#include "lmem.h"	13	#include "lmem.h"
12	#include "lopcodes.h"	14	#include "lopcodes.h"
13	#include "lstring.h"	15	#include "lstring.h"
14	#include "lundump.h"	16	#include "lundump.h"
		17	#include "lzio.h"
15		18
16	#define LoadByte ezgetc	19	#define LoadByte (lu_byte) ezgetc
17		20
18	static const char* ZNAME (ZIO* Z)	21	typedef struct {
19	{	22	lua_State* L;
20	const char* s=zname(Z);	23	ZIO* Z;
21	return (*s=='@') ? s+1 : s;	24	Mbuffer* b;
22	}	25	int swap;
		26	const char* name;
		27	} LoadState;
23		28
24	static void unexpectedEOZ (lua_State* L, ZIO* Z)	29	static void unexpectedEOZ (LoadState* S)
25	{	30	{
26	luaO_verror(L,"unexpected end of file in `%.99s'",ZNAME(Z));	31	luaG_runerror(S->L,"unexpected end of file in %s",S->name);
27	}	32	}
28		33
29	static int ezgetc (lua_State* L, ZIO* Z)	34	static int ezgetc (LoadState* S)
30	{	35	{
31	int c=zgetc(Z);	36	int c=zgetc(S->Z);
32	if (c==EOZ) unexpectedEOZ(L,Z);	37	if (c==EOZ) unexpectedEOZ(S);
33	return c;	38	return c;
34	}	39	}
35		40
36	static void ezread (lua_State* L, ZIO* Z, void* b, int n)	41	static void ezread (LoadState* S, void* b, int n)
37	{	42	{
38	int r=zread(Z,b,n);	43	int r=luaZ_read(S->Z,b,n);
39	if (r!=0) unexpectedEOZ(L,Z);	44	if (r!=0) unexpectedEOZ(S);
40	}	45	}
41		46
42	static void LoadBlock (lua_State* L, void* b, size_t size, ZIO* Z, int swap)	47	static void LoadBlock (LoadState* S, void* b, size_t size)
43	{	48	{
44	if (swap)	49	if (S->swap)
45	{	50	{
46	char p=(char ) b+size-1;	51	char* p=(char*) b+size-1;
47	int n=size;	52	int n=size;
48	while (n--) *p--=(char)ezgetc(L,Z);	53	while (n--) *p--=(char)ezgetc(S);
49	}	54	}
50	else	55	else
51	ezread(L,Z,b,size);	56	ezread(S,b,size);
52	}	57	}
53		58
54	static void LoadVector (lua_State* L, void* b, int m, size_t size, ZIO* Z, int swap)	59	static void LoadVector (LoadState* S, void* b, int m, size_t size)
55	{	60	{
56	if (swap)	61	if (S->swap)
57	{	62	{
58	char q=(char ) b;	63	char* q=(char*) b;
59	while (m--)	64	while (m--)
60	{	65	{
61	char *p=q+size-1;	66	char* p=q+size-1;
62	int n=size;	67	int n=size;
63	while (n--) *p--=(char)ezgetc(L,Z);	68	while (n--) *p--=(char)ezgetc(S);
64	q+=size;	69	q+=size;
65	}	70	}
66	}	71	}
67	else	72	else
68	ezread(L,Z,b,m*size);	73	ezread(S,b,m*size);
69	}	74	}
70		75
71	static int LoadInt (lua_State* L, ZIO* Z, int swap)	76	static int LoadInt (LoadState* S)
72	{	77	{
73	int x;	78	int x;
74	LoadBlock(L,&x,sizeof(x),Z,swap);	79	LoadBlock(S,&x,sizeof(x));
		80	if (x<0) luaG_runerror(S->L,"bad integer in %s",S->name);
75	return x;	81	return x;
76	}	82	}
77		83
78	static size_t LoadSize (lua_State* L, ZIO* Z, int swap)	84	static size_t LoadSize (LoadState* S)
79	{	85	{
80	size_t x;	86	size_t x;
81	LoadBlock(L,&x,sizeof(x),Z,swap);	87	LoadBlock(S,&x,sizeof(x));
82	return x;	88	return x;
83	}	89	}
84		90
85	static Number LoadNumber (lua_State* L, ZIO* Z, int swap)	91	static lua_Number LoadNumber (LoadState* S)
86	{	92	{
87	Number x;	93	lua_Number x;
88	LoadBlock(L,&x,sizeof(x),Z,swap);	94	LoadBlock(S,&x,sizeof(x));
89	return x;	95	return x;
90	}	96	}
91		97
92	static TString* LoadString (lua_State* L, ZIO* Z, int swap)	98	static TString* LoadString (LoadState* S)
93	{	99	{
94	size_t size=LoadSize(L,Z,swap);	100	size_t size=LoadSize(S);
95	if (size==0)	101	if (size==0)
96	return NULL;	102	return NULL;
97	else	103	else
98	{	104	{
99	char* s=luaO_openspace(L,size);	105	char* s=luaZ_openspace(S->L,S->b,size);
100	LoadBlock(L,s,size,Z,0);	106	ezread(S,s,size);
101	return luaS_newlstr(L,s,size-1); /* remove trailing '\0' */	107	return luaS_newlstr(S->L,s,size-1); /* remove trailing '\0' */
102	}	108	}
103	}	109	}
104		110
105	static void LoadCode (lua_State* L, Proto* tf, ZIO* Z, int swap)	111	static void LoadCode (LoadState* S, Proto* f)
106	{	112	{
107	int size=LoadInt(L,Z,swap);	113	int size=LoadInt(S);
108	tf->code=luaM_newvector(L,size,Instruction);	114	f->code=luaM_newvector(S->L,size,Instruction);
109	LoadVector(L,tf->code,size,sizeof(*tf->code),Z,swap);	115	f->sizecode=size;
110	if (tf->code[size-1]!=OP_END) luaO_verror(L,"bad code in `%.99s'",ZNAME(Z));	116	LoadVector(S,f->code,size,sizeof(*f->code));
111	luaF_protook(L,tf,size);
112	}	117	}
113		118
114	static void LoadLocals (lua_State* L, Proto* tf, ZIO* Z, int swap)	119	static void LoadLocals (LoadState* S, Proto* f)
115	{	120	{
116	int i,n;	121	int i,n;
117	tf->nlocvars=n=LoadInt(L,Z,swap);	122	n=LoadInt(S);
118	tf->locvars=luaM_newvector(L,n,LocVar);	123	f->locvars=luaM_newvector(S->L,n,LocVar);
		124	f->sizelocvars=n;
119	for (i=0; i<n; i++)	125	for (i=0; i<n; i++)
120	{	126	{
121	tf->locvars[i].varname=LoadString(L,Z,swap);	127	f->locvars[i].varname=LoadString(S);
122	tf->locvars[i].startpc=LoadInt(L,Z,swap);	128	f->locvars[i].startpc=LoadInt(S);
123	tf->locvars[i].endpc=LoadInt(L,Z,swap);	129	f->locvars[i].endpc=LoadInt(S);
124	}	130	}
125	}	131	}
126		132
127	static void LoadLines (lua_State* L, Proto* tf, ZIO* Z, int swap)	133	static void LoadLines (LoadState* S, Proto* f)
128	{	134	{
129	int n;	135	int size=LoadInt(S);
130	tf->nlineinfo=n=LoadInt(L,Z,swap);	136	f->lineinfo=luaM_newvector(S->L,size,int);
131	tf->lineinfo=luaM_newvector(L,n,int);	137	f->sizelineinfo=size;
132	LoadVector(L,tf->lineinfo,n,sizeof(*tf->lineinfo),Z,swap);	138	LoadVector(S,f->lineinfo,size,sizeof(*f->lineinfo));
133	}	139	}
134		140
135	static Proto* LoadFunction (lua_State* L, ZIO* Z, int swap);	141	static void LoadUpvalues (LoadState* S, Proto* f)
		142	{
		143	int i,n;
		144	n=LoadInt(S);
		145	if (n!=0 && n!=f->nups)
		146	luaG_runerror(S->L,"bad nupvalues in %s: read %d; expected %d",
		147	S->name,n,f->nups);
		148	f->upvalues=luaM_newvector(S->L,n,TString*);
		149	f->sizeupvalues=n;
		150	for (i=0; i<n; i++) f->upvalues[i]=LoadString(S);
		151	}
136		152
137	static void LoadConstants (lua_State* L, Proto* tf, ZIO* Z, int swap)	153	static Proto* LoadFunction (LoadState* S, TString* p);
		154
		155	static void LoadConstants (LoadState* S, Proto* f)
138	{	156	{
139	int i,n;	157	int i,n;
140	tf->nkstr=n=LoadInt(L,Z,swap);	158	n=LoadInt(S);
141	tf->kstr=luaM_newvector(L,n,TString*);	159	f->k=luaM_newvector(S->L,n,TObject);
142	for (i=0; i<n; i++)	160	f->sizek=n;
143	tf->kstr[i]=LoadString(L,Z,swap);
144	tf->nknum=n=LoadInt(L,Z,swap);
145	tf->knum=luaM_newvector(L,n,Number);
146	LoadVector(L,tf->knum,n,sizeof(*tf->knum),Z,swap);
147	tf->nkproto=n=LoadInt(L,Z,swap);
148	tf->kproto=luaM_newvector(L,n,Proto*);
149	for (i=0; i<n; i++)	161	for (i=0; i<n; i++)
150	tf->kproto[i]=LoadFunction(L,Z,swap);	162	{
		163	TObject* o=&f->k[i];
		164	int t=LoadByte(S);
		165	switch (t)
		166	{
		167	case LUA_TNUMBER:
		168	setnvalue(o,LoadNumber(S));
		169	break;
		170	case LUA_TSTRING:
		171	setsvalue2n(o,LoadString(S));
		172	break;
		173	case LUA_TNIL:
		174	setnilvalue(o);
		175	break;
		176	default:
		177	luaG_runerror(S->L,"bad constant type (%d) in %s",t,S->name);
		178	break;
		179	}
		180	}
		181	n=LoadInt(S);
		182	f->p=luaM_newvector(S->L,n,Proto*);
		183	f->sizep=n;
		184	for (i=0; i<n; i++) f->p[i]=LoadFunction(S,f->source);
151	}	185	}
152		186
153	static Proto* LoadFunction (lua_State* L, ZIO* Z, int swap)	187	static Proto* LoadFunction (LoadState* S, TString* p)
154	{	188	{
155	Proto* tf=luaF_newproto(L);	189	Proto* f=luaF_newproto(S->L);
156	tf->source=LoadString(L,Z,swap);	190	f->source=LoadString(S); if (f->source==NULL) f->source=p;
157	tf->lineDefined=LoadInt(L,Z,swap);	191	f->lineDefined=LoadInt(S);
158	tf->numparams=LoadInt(L,Z,swap);	192	f->nups=LoadByte(S);
159	tf->is_vararg=LoadByte(L,Z);	193	f->numparams=LoadByte(S);
160	tf->maxstacksize=LoadInt(L,Z,swap);	194	f->is_vararg=LoadByte(S);
161	LoadLocals(L,tf,Z,swap);	195	f->maxstacksize=LoadByte(S);
162	LoadLines(L,tf,Z,swap);	196	LoadLines(S,f);
163	LoadConstants(L,tf,Z,swap);	197	LoadLocals(S,f);
164	LoadCode(L,tf,Z,swap);	198	LoadUpvalues(S,f);
165	return tf;	199	LoadConstants(S,f);
		200	LoadCode(S,f);
		201	#ifndef TRUST_BINARIES
		202	if (!luaG_checkcode(f)) luaG_runerror(S->L,"bad code in %s",S->name);
		203	#endif
		204	return f;
166	}	205	}
167		206
168	static void LoadSignature (lua_State* L, ZIO* Z)	207	static void LoadSignature (LoadState* S)
169	{	208	{
170	const char* s=SIGNATURE;	209	const char* s=LUA_SIGNATURE;
171	while (s!=0 && ezgetc(L,Z)==s)	210	while (s!=0 && ezgetc(S)==s)
172	++s;	211	++s;
173	if (*s!=0) luaO_verror(L,"bad signature in `%.99s'",ZNAME(Z));	212	if (*s!=0) luaG_runerror(S->L,"bad signature in %s",S->name);
174	}	213	}
175		214
176	static void TestSize (lua_State* L, int s, const char* what, ZIO* Z)	215	static void TestSize (LoadState* S, int s, const char* what)
177	{	216	{
178	int r=ezgetc(L,Z);	217	int r=LoadByte(S);
179	if (r!=s)	218	if (r!=s)
180	luaO_verror(L,"virtual machine mismatch in `%.99s':\n"	219	luaG_runerror(S->L,"virtual machine mismatch in %s: "
181	" %.20s is %d but read %d",ZNAME(Z),what,s,r);	220	"size of %s is %d but read %d",S->name,what,s,r);
182	}	221	}
183		222
184	#define TESTSIZE(s) TestSize(L,s,#s,Z)	223	#define TESTSIZE(s,w) TestSize(S,s,w)
185	#define V(v) v/16,v%16	224	#define V(v) v/16,v%16
186		225
187	static int LoadHeader (lua_State* L, ZIO* Z)	226	static void LoadHeader (LoadState* S)
188	{	227	{
189	int version,swap;	228	int version;
190	Number f=0,tf=TEST_NUMBER;	229	lua_Number x,tx=TEST_NUMBER;
191	LoadSignature(L,Z);	230	LoadSignature(S);
192	version=ezgetc(L,Z);	231	version=LoadByte(S);
193	if (version>VERSION)	232	if (version>VERSION)
194	luaO_verror(L,"`%.99s' too new:\n"	233	luaG_runerror(S->L,"%s too new: "
195	" read version %d.%d; expected at most %d.%d",	234	"read version %d.%d; expected at most %d.%d",
196	ZNAME(Z),V(version),V(VERSION));	235	S->name,V(version),V(VERSION));
197	if (version<VERSION0) /* check last major change */	236	if (version<VERSION0) /* check last major change */
198	luaO_verror(L,"`%.99s' too old:\n"	237	luaG_runerror(S->L,"%s too old: "
199	" read version %d.%d; expected at least %d.%d",	238	"read version %d.%d; expected at least %d.%d",
200	ZNAME(Z),V(version),V(VERSION));	239	S->name,V(version),V(VERSION0));
201	swap=(luaU_endianess()!=ezgetc(L,Z)); /* need to swap bytes? */	240	S->swap=(luaU_endianness()!=LoadByte(S)); /* need to swap bytes? */
202	TESTSIZE(sizeof(int));	241	TESTSIZE(sizeof(int),"int");
203	TESTSIZE(sizeof(size_t));	242	TESTSIZE(sizeof(size_t), "size_t");
204	TESTSIZE(sizeof(Instruction));	243	TESTSIZE(sizeof(Instruction), "Instruction");
205	TESTSIZE(SIZE_INSTRUCTION);	244	TESTSIZE(SIZE_OP, "OP");
206	TESTSIZE(SIZE_OP);	245	TESTSIZE(SIZE_A, "A");
207	TESTSIZE(SIZE_B);	246	TESTSIZE(SIZE_B, "B");
208	TESTSIZE(sizeof(Number));	247	TESTSIZE(SIZE_C, "C");
209	f=LoadNumber(L,Z,swap);	248	TESTSIZE(sizeof(lua_Number), "number");
210	if ((long)f!=(long)tf) /* disregard errors in last bit of fraction */	249	x=LoadNumber(S);
211	luaO_verror(L,"unknown number format in `%.99s':\n"	250	if ((long)x!=(long)tx) /* disregard errors in last bits of fraction */
212	" read " NUMBER_FMT "; expected " NUMBER_FMT, ZNAME(Z),f,tf);	251	luaG_runerror(S->L,"unknown number format in %s",S->name);
213	return swap;	252	}
214	}	253
215		254	static Proto* LoadChunk (LoadState* S)
216	static Proto* LoadChunk (lua_State* L, ZIO* Z)	255	{
217	{	256	LoadHeader(S);
218	return LoadFunction(L,Z,LoadHeader(L,Z));	257	return LoadFunction(S,NULL);
219	}	258	}
220		259
221	/*	260	/*
222	** load one chunk from a file or buffer	261	** load precompiled chunk
223	** return main if ok and NULL at EOF
224	*/	262	*/
225	Proto* luaU_undump (lua_State* L, ZIO* Z)	263	Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff)
226	{	264	{
227	Proto* tf=NULL;	265	LoadState S;
228	int c=zgetc(Z);	266	const char* s=zname(Z);
229	if (c==ID_CHUNK)	267	if (s=='@' \|\| s=='=')
230	tf=LoadChunk(L,Z);	268	S.name=s+1;
231	c=zgetc(Z);	269	else if (*s==LUA_SIGNATURE[0])
232	if (c!=EOZ)	270	S.name="binary string";
233	luaO_verror(L,"`%.99s' apparently contains more than one chunk",ZNAME(Z));	271	else
234	return tf;	272	S.name=s;
		273	S.L=L;
		274	S.Z=Z;
		275	S.b=buff;
		276	return LoadChunk(&S);
235	}	277	}
236		278
237	/*	279	/*
238	** find byte order	280	** find byte order
239	*/	281	*/
240	int luaU_endianess (void)	282	int luaU_endianness (void)
241	{	283	{
242	int x=1;	284	int x=1;
243	return (char)&x;	285	return (char)&x;

src/lundump.h+16−17

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lundump.h,v 1.21 2000/10/31 16:57:23 lhf Exp $	2	** $Id: lundump.h,v 1.30 2003/04/07 20:34:20 lhf Exp $
3	** load pre-compiled Lua chunks	3	** load pre-compiled Lua chunks
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -10,26 +10,25 @@ · 4 unmodified lines
10	#include "lobject.h"	10	#include "lobject.h"
11	#include "lzio.h"	11	#include "lzio.h"
12		12
13	/* load one chunk */	13	/* load one chunk; from lundump.c */
14	Proto* luaU_undump (lua_State* L, ZIO* Z);	14	Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff);
15		15
16	/* find byte order */	16	/* find byte order; from lundump.c */
17	int luaU_endianess (void);	17	int luaU_endianness (void);
18		18
19	/* definitions for headers of binary files */	19	/* dump one chunk; from ldump.c */
20	#define VERSION 0x40 /* last format change was in 4.0 */	20	void luaU_dump (lua_State* L, const Proto* Main, lua_Chunkwriter w, void* data);
21	#define VERSION0 0x40 /* last major change was in 4.0 */	21
22	#define ID_CHUNK 27 /* binary files start with ESC... */	22	/* print one chunk; from print.c */
23	#define SIGNATURE "Lua" /* ...followed by this signature */	23	void luaU_print (const Proto* Main);
24		24
25	/* formats for error messages */	25	/* definitions for headers of binary files */
26	#define SOURCE_FMT "<%d:%.99s>"	26	#define LUA_SIGNATURE "\033Lua" /* binary files start with "<esc>Lua" */
27	#define SOURCE tf->lineDefined,tf->source->str	27	#define VERSION 0x50 /* last format change was in 5.0 */
28	#define IN_FMT " in %p " SOURCE_FMT	28	#define VERSION0 0x50 /* last major change was in 5.0 */
29	#define IN tf,SOURCE
30		29
31	/* a multiple of PI for testing native format */	30	/* a multiple of PI for testing native format */
32	/* multiplying by 1E8 gives non-trivial integer values */	31	/* multiplying by 1E7 gives non-trivial integer values */
33	#define TEST_NUMBER 3.14159265358979323846E8	32	#define TEST_NUMBER ((lua_Number)3.14159265358979323846E7)
34		33
35	#endif	34	#endif

src/lvm.c+575−505

@@ -1,17 +1,21 @@
1	/*	1	/*
2	** $Id: lvm.c,v 1.146a 2000/10/26 12:47:05 roberto Exp $	2	** $Id: lvm.c,v 1.284 2003/04/03 13:35:34 roberto Exp $
3	** Lua virtual machine	3	** Lua virtual machine
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7		7
8	#include <stdio.h>	8	#include <stdarg.h>
9	#include <stdlib.h>	9	#include <stdlib.h>
10	#include <string.h>	10	#include <string.h>
11		11
		12	/* needed only when `lua_number2str' uses `sprintf' */
		13	#include <stdio.h>
		14
		15	#define lvm_c
		16
12	#include "lua.h"	17	#include "lua.h"
13		18
14	#include "lapi.h"
15	#include "ldebug.h"	19	#include "ldebug.h"
16	#include "ldo.h"	20	#include "ldo.h"
17	#include "lfunc.h"	21	#include "lfunc.h"
@@ -25,243 +29,225 @@ · 7 unmodified lines
25	#include "lvm.h"	29	#include "lvm.h"
26		30
27		31
28	#ifdef OLD_ANSI
29	#define strcoll(a,b) strcmp(a,b)
30	#endif
31
32		32
		33	/* function to convert a lua_Number to a string */
		34	#ifndef lua_number2str
		35	#define lua_number2str(s,n) sprintf((s), LUA_NUMBER_FMT, (n))
		36	#endif
33		37
34	/*
35	** Extra stack size to run a function:
36	** TAG_LINE(1), NAME(1), TM calls(3) (plus some extra...)
37	*/
38	#define EXTRA_STACK 8
39		38
		39	/* limit for table tag-method chains (to avoid loops) */
		40	#define MAXTAGLOOP 100
40		41
41		42
42	int luaV_tonumber (TObject *obj) {	43	const TObject luaV_tonumber (const TObject obj, TObject *n) {
43	if (ttype(obj) != LUA_TSTRING)	44	lua_Number num;
44	return 1;	45	if (ttisnumber(obj)) return obj;
45	else {	46	if (ttisstring(obj) && luaO_str2d(svalue(obj), &num)) {
46	if (!luaO_str2d(svalue(obj), &nvalue(obj)))	47	setnvalue(n, num);
47	return 2;	48	return n;
48	ttype(obj) = LUA_TNUMBER;
49	return 0;
50	}	49	}
		50	else
		51	return NULL;
51	}	52	}
52		53
53		54
54	int luaV_tostring (lua_State L, TObject obj) { /* LUA_NUMBER */	55	int luaV_tostring (lua_State *L, StkId obj) {
55	if (ttype(obj) != LUA_TNUMBER)	56	if (!ttisnumber(obj))
56	return 1;	57	return 0;
57	else {	58	else {
58	char s[32]; /* 16 digits, sign, point and \0 (+ some extra...) */	59	char s[32]; /* 16 digits, sign, point and \0 (+ some extra...) */
59	lua_number2str(s, nvalue(obj)); /* convert `s' to number */	60	lua_number2str(s, nvalue(obj));
60	tsvalue(obj) = luaS_new(L, s);	61	setsvalue2s(obj, luaS_new(L, s));
61	ttype(obj) = LUA_TSTRING;	62	return 1;
62	return 0;
63	}	63	}
64	}	64	}
65		65
66		66
67	static void traceexec (lua_State *L, StkId base, StkId top, lua_Hook linehook) {	67	static void traceexec (lua_State *L) {
68	CallInfo *ci = infovalue(base-1);	68	lu_byte mask = L->hookmask;
69	int *lineinfo = ci->func->f.l->lineinfo;	69	if (mask > LUA_MASKLINE) { /* instruction-hook set? */
70	int pc = (*ci->pc - ci->func->f.l->code) - 1;	70	if (L->hookcount == 0) {
71	int newline;	71	resethookcount(L);
72	if (pc == 0) { /* may be first time? */	72	luaD_callhook(L, LUA_HOOKCOUNT, -1);
73	ci->line = 1;	73	return;
74	ci->refi = 0;	74	}
75	ci->lastpc = pc+1; /* make sure it will call linehook */
76	}	75	}
77	newline = luaG_getline(lineinfo, pc, ci->line, &ci->refi);	76	if (mask & LUA_MASKLINE) {
78	/* calls linehook when enters a new line or jumps back (loop) */	77	CallInfo *ci = L->ci;
79	if (newline != ci->line \|\| pc <= ci->lastpc) {	78	Proto *p = ci_func(ci)->l.p;
80	ci->line = newline;	79	int newline = getline(p, pcRel(*ci->u.l.pc, p));
81	L->top = top;	80	if (!L->hookinit) {
82	luaD_lineHook(L, base-1, newline, linehook);	81	luaG_inithooks(L);
		82	return;
		83	}
		84	lua_assert(ci->state & CI_HASFRAME);
		85	if (pcRel(ci->u.l.pc, p) == 0) / tracing may be starting now? */
		86	ci->u.l.savedpc = ci->u.l.pc; / initialize `savedpc' */
		87	/* calls linehook when enters a new line or jumps back (loop) */
		88	if (*ci->u.l.pc <= ci->u.l.savedpc \|\|
		89	newline != getline(p, pcRel(ci->u.l.savedpc, p))) {
		90	luaD_callhook(L, LUA_HOOKLINE, newline);
		91	ci = L->ci; /* previous call may reallocate `ci' */
		92	}
		93	ci->u.l.savedpc = *ci->u.l.pc;
83	}	94	}
84	ci->lastpc = pc;
85	}	95	}
86		96
87		97
88	static Closure luaV_closure (lua_State L, int nelems) {	98	static void callTMres (lua_State L, const TObject f,
89	Closure *c = luaF_newclosure(L, nelems);	99	const TObject p1, const TObject p2) {
90	L->top -= nelems;	100	setobj2s(L->top, f); /* push function */
91	while (nelems--)	101	setobj2s(L->top+1, p1); /* 1st argument */
92	c->upvalue[nelems] = *(L->top+nelems);	102	setobj2s(L->top+2, p2); /* 2nd argument */
93	clvalue(L->top) = c;	103	luaD_checkstack(L, 3); /* cannot check before (could invalidate p1, p2) */
94	ttype(L->top) = LUA_TFUNCTION;	104	L->top += 3;
95	incr_top;	105	luaD_call(L, L->top - 3, 1);
96	return c;	106	L->top--; /* result will be in L->top */
97	}	107	}
98		108
99		109
100	void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems) {	110
101	Closure *cl = luaV_closure(L, nelems);	111	static void callTM (lua_State L, const TObject f,
102	cl->f.c = c;	112	const TObject p1, const TObject p2, const TObject *p3) {
103	cl->isC = 1;	113	setobj2s(L->top, f); /* push function */
		114	setobj2s(L->top+1, p1); /* 1st argument */
		115	setobj2s(L->top+2, p2); /* 2nd argument */
		116	setobj2s(L->top+3, p3); /* 3th argument */
		117	luaD_checkstack(L, 4); /* cannot check before (could invalidate p1...p3) */
		118	L->top += 4;
		119	luaD_call(L, L->top - 4, 0);
104	}	120	}
105		121
106		122
107	void luaV_Lclosure (lua_State L, Proto l, int nelems) {	123	static const TObject luaV_index (lua_State L, const TObject *t,
108	Closure *cl = luaV_closure(L, nelems);	124	TObject *key, int loop) {
109	cl->f.l = l;	125	const TObject *tm = fasttm(L, hvalue(t)->metatable, TM_INDEX);
110	cl->isC = 0;	126	if (tm == NULL) return &luaO_nilobject; /* no TM */
		127	if (ttisfunction(tm)) {
		128	callTMres(L, tm, t, key);
		129	return L->top;
		130	}
		131	else return luaV_gettable(L, tm, key, loop);
		132	}
		133
		134	static const TObject luaV_getnotable (lua_State L, const TObject *t,
		135	TObject *key, int loop) {
		136	const TObject *tm = luaT_gettmbyobj(L, t, TM_INDEX);
		137	if (ttisnil(tm))
		138	luaG_typeerror(L, t, "index");
		139	if (ttisfunction(tm)) {
		140	callTMres(L, tm, t, key);
		141	return L->top;
		142	}
		143	else return luaV_gettable(L, tm, key, loop);
111	}	144	}
112		145
113		146
114	/*	147	/*
115	** Function to index a table.	148	** Function to index a table.
116	** Receives the table at `t' and the key at top.	149	** Receives the table at `t' and the key at `key'.
		150	** leaves the result at `res'.
117	*/	151	*/
118	const TObject luaV_gettable (lua_State L, StkId t) {	152	const TObject luaV_gettable (lua_State L, const TObject t, TObject key,
119	Closure *tm;	153	int loop) {
120	int tg;	154	if (loop > MAXTAGLOOP)
121	if (ttype(t) == LUA_TTABLE && /* `t' is a table? */	155	luaG_runerror(L, "loop in gettable");
122	((tg = hvalue(t)->htag) == LUA_TTABLE \|\| /* with default tag? */	156	if (ttistable(t)) { /* `t' is a table? */
123	luaT_gettm(L, tg, TM_GETTABLE) == NULL)) { /* or no TM? */	157	Table *h = hvalue(t);
124	/* do a primitive get */	158	const TObject v = luaH_get(h, key); / do a primitive get */
125	const TObject *h = luaH_get(L, hvalue(t), L->top-1);	159	if (!ttisnil(v)) return v;
126	/* result is no nil or there is no `index' tag method? */	160	else return luaV_index(L, t, key, loop+1);
127	if (ttype(h) != LUA_TNIL \|\| ((tm=luaT_gettm(L, tg, TM_INDEX)) == NULL))
128	return h; /* return result */
129	/* else call `index' tag method */
130	}
131	else { /* try a `gettable' tag method */
132	tm = luaT_gettmbyObj(L, t, TM_GETTABLE);
133	}
134	if (tm != NULL) { /* is there a tag method? */
135	luaD_checkstack(L, 2);
136	(L->top+1) = (L->top-1); /* key */
137	L->top = t; /* table */
138	clvalue(L->top-1) = tm; /* tag method */
139	ttype(L->top-1) = LUA_TFUNCTION;
140	L->top += 2;
141	luaD_call(L, L->top - 3, 1);
142	return L->top - 1; /* call result */
143	}
144	else { /* no tag method */
145	luaG_typeerror(L, t, "index");
146	return NULL; /* to avoid warnings */
147	}	161	}
		162	else return luaV_getnotable(L, t, key, loop+1);
148	}	163	}
149		164
150		165
151	/*	166	/*
152	** Receives table at `t', key at `key' and value at top.	167	** Receives table at `t', key at `key' and value at `val'.
153	*/	168	*/
154	void luaV_settable (lua_State *L, StkId t, StkId key) {	169	void luaV_settable (lua_State L, const TObject t, TObject *key, StkId val) {
155	int tg;	170	const TObject *tm;
156	if (ttype(t) == LUA_TTABLE && /* `t' is a table? */	171	int loop = 0;
157	((tg = hvalue(t)->htag) == LUA_TTABLE \|\| /* with default tag? */	172	do {
158	luaT_gettm(L, tg, TM_SETTABLE) == NULL)) /* or no TM? */	173	if (ttistable(t)) { /* `t' is a table? */
159	luaH_set(L, hvalue(t), key) = (L->top-1); /* do a primitive set */	174	Table *h = hvalue(t);
160	else { /* try a `settable' tag method */	175	TObject oldval = luaH_set(L, h, key); / do a primitive set */
161	Closure *tm = luaT_gettmbyObj(L, t, TM_SETTABLE);	176	if (!ttisnil(oldval) \|\| /* result is no nil? */
162	if (tm != NULL) {	177	(tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) { /* or no TM? */
163	luaD_checkstack(L, 3);	178	setobj2t(oldval, val); /* write barrier */
164	(L->top+2) = (L->top-1);	179	return;
165	(L->top+1) = key;	180	}
166	(L->top) = t;	181	/* else will try the tag method */
167	clvalue(L->top-1) = tm;
168	ttype(L->top-1) = LUA_TFUNCTION;
169	L->top += 3;
170	luaD_call(L, L->top - 4, 0); /* call `settable' tag method */
171	}	182	}
172	else /* no tag method... */	183	else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX)))
173	luaG_typeerror(L, t, "index");	184	luaG_typeerror(L, t, "index");
174	}	185	if (ttisfunction(tm)) {
175	}	186	callTM(L, tm, t, key, val);
176		187	return;
177		188	}
178	const TObject luaV_getglobal (lua_State L, TString *s) {	189	t = tm; /* else repeat with `tm' */
179	const TObject *value = luaH_getstr(L->gt, s);	190	} while (++loop <= MAXTAGLOOP);
180	Closure *tm = luaT_gettmbyObj(L, value, TM_GETGLOBAL);	191	luaG_runerror(L, "loop in settable");
181	if (tm == NULL) /* is there a tag method? */
182	return value; /* default behavior */
183	else { /* tag method */
184	luaD_checkstack(L, 3);
185	clvalue(L->top) = tm;
186	ttype(L->top) = LUA_TFUNCTION;
187	tsvalue(L->top+1) = s; /* global name */
188	ttype(L->top+1) = LUA_TSTRING;
189	(L->top+2) = value;
190	L->top += 3;
191	luaD_call(L, L->top - 3, 1);
192	return L->top - 1;
193	}
194	}	192	}
195		193
196		194
197	void luaV_setglobal (lua_State L, TString s) {	195	static int call_binTM (lua_State L, const TObject p1, const TObject *p2,
198	const TObject *oldvalue = luaH_getstr(L->gt, s);	196	StkId res, TMS event) {
199	Closure *tm = luaT_gettmbyObj(L, oldvalue, TM_SETGLOBAL);	197	ptrdiff_t result = savestack(L, res);
200	if (tm == NULL) { /* is there a tag method? */	198	const TObject tm = luaT_gettmbyobj(L, p1, event); / try first operand */
201	if (oldvalue != &luaO_nilobject) {	199	if (ttisnil(tm))
202	/* cast to remove `const' is OK, because `oldvalue' != luaO_nilobject */	200	tm = luaT_gettmbyobj(L, p2, event); /* try second operand */
203	(TObject )oldvalue = *(L->top - 1);	201	if (!ttisfunction(tm)) return 0;
204	}	202	callTMres(L, tm, p1, p2);
205	else {	203	res = restorestack(L, result); /* previous call may change stack */
206	TObject key;	204	setobjs2s(res, L->top);
207	ttype(&key) = LUA_TSTRING;	205	return 1;
208	tsvalue(&key) = s;
209	luaH_set(L, L->gt, &key) = (L->top - 1);
210	}
211	}
212	else {
213	luaD_checkstack(L, 3);
214	(L->top+2) = (L->top-1); /* new value */
215	(L->top+1) = oldvalue;
216	ttype(L->top) = LUA_TSTRING;
217	tsvalue(L->top) = s;
218	clvalue(L->top-1) = tm;
219	ttype(L->top-1) = LUA_TFUNCTION;
220	L->top += 3;
221	luaD_call(L, L->top - 4, 0);
222	}
223	}	206	}
224		207
225		208
226	static int call_binTM (lua_State *L, StkId top, TMS event) {
227	/* try first operand */
228	Closure *tm = luaT_gettmbyObj(L, top-2, event);
229	L->top = top;
230	if (tm == NULL) {
231	tm = luaT_gettmbyObj(L, top-1, event); /* try second operand */
232	if (tm == NULL) {

915 more lines aren’t shown here.

src/lvm.h+17−14

This diff is large: its 44 lines aren’t shown here.

src/lzio.c+43−46

This diff is large: its 125 lines aren’t shown here.

src/lzio.h+37−26

This diff is large: its 90 lines aren’t shown here.

Lua 5.0

Keyboard shortcuts

General

Issues and pull requests

Issues, pull requests and Inbox

Repository code