plan9-archive/lua

src/Makefile+10−8

-# makefile for lua basic library
+# makefile for Lua core library
 LUA= ..
 OBJS=	\
 	lapi.o \
-	lauxlib.o \
+	lcode.o \
-	lbuffer.o \
+	ldebug.o \
-	lbuiltin.o \
 	ldo.o \
 	lfunc.o \
 	lgc.o \
 	lstate.o \
 	lstring.o \
 	ltable.o \
+	ltests.o \
 	ltm.o \
 	lundump.o \
 	lvm.o \
 SRCS=	\
 	lapi.c \
-	lauxlib.c \
+	lcode.c \
-	lbuffer.c \
+	ldebug.c \
-	lbuiltin.c \
 	ldo.c \
 	lfunc.c \
 	lgc.c \
 	lstate.c \
 	lstring.c \
 	ltable.c \
+	ltests.c \
 	ltm.c \
 	lundump.c \
 	lvm.c \
 	lzio.c \
 	lapi.h \
-	lbuiltin.h \
+	lcode.h \
+	ldebug.h \
 	ldo.h \
 	lfunc.h \
 	lgc.h \
 	llex.h \
+	llimits.h \
 	lmem.h \
 	lobject.h \
 	lopcodes.h \

src/lapi.c+298−498

@@ -1,15 +1,15 @@
1	/*	1	/*
2	** $Id: lapi.c,v 1.47b 1999/06/22 20:37:23 roberto Exp $	2	** $Id: lapi.c,v 1.110 2000/10/30 12:50:09 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 <stdlib.h>
9	#include <string.h>	8	#include <string.h>
10		9
		10	#include "lua.h"
		11
11	#include "lapi.h"	12	#include "lapi.h"
12	#include "lauxlib.h"
13	#include "ldo.h"	13	#include "ldo.h"
14	#include "lfunc.h"	14	#include "lfunc.h"
15	#include "lgc.h"	15	#include "lgc.h"
@@ -19,676 +19,476 @@ · 3 unmodified lines
19	#include "lstring.h"	19	#include "lstring.h"
20	#include "ltable.h"	20	#include "ltable.h"
21	#include "ltm.h"	21	#include "ltm.h"
22	#include "lua.h"
23	#include "luadebug.h"
24	#include "lvm.h"	22	#include "lvm.h"
25		23
26		24
27	char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"	25	const char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"
28	"$Authors: " LUA_AUTHORS " $";	26	"$Authors: " LUA_AUTHORS " $";
29
30
31
32	TObject *luaA_Address (lua_Object o) {
33	return (o != LUA_NOOBJECT) ? Address(o) : NULL;
34	}
35
36
37	static lua_Type normalized_type (TObject *o)
38	{
39	int t = ttype(o);
40	switch (t) {
41	case LUA_T_PMARK:
42	return LUA_T_PROTO;
43	case LUA_T_CMARK:
44	return LUA_T_CPROTO;
45	case LUA_T_CLMARK:
46	return LUA_T_CLOSURE;
47	default:
48	return t;
49	}
50	}
51		27
52		28
53	static void set_normalized (TObject d, TObject s)
54	{
55	d->value = s->value;
56	d->ttype = normalized_type(s);
57	}
58		29
		30	#define Index(L,i) ((i) >= 0 ? (L->Cbase+((i)-1)) : (L->top+(i)))
59		31
60	static TObject luaA_protovalue (TObject o)	32	#define api_incr_top(L) incr_top
61	{
62	return (normalized_type(o) == LUA_T_CLOSURE) ? protovalue(o) : o;
63	}
64		33
65		34
66	void luaA_packresults (void)
67	{
68	luaV_pack(L->Cstack.lua2C, L->Cstack.num, L->stack.top);
69	incr_top;
70	}
71		35
72		36
73	int luaA_passresults (void) {	37	TObject luaA_index (lua_State L, int index) {
74	L->Cstack.base = L->Cstack.lua2C; /* position of first result */	38	return Index(L, index);
75	return L->Cstack.num;
76	}	39	}
77		40
78		41
79	static void checkCparams (int nParams)	42	static TObject luaA_indexAcceptable (lua_State L, int index) {
80	{	43	if (index >= 0) {
81	if (L->stack.top-L->stack.stack < L->Cstack.base+nParams)	44	TObject *o = L->Cbase+(index-1);
82	lua_error("API error - wrong number of arguments in C2lua stack");	45	if (o >= L->top) return NULL;
83	}	46	else return o;
84		47	}
85		48	else return L->top+index;
86	static lua_Object put_luaObject (TObject *o) {
87	luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
88	L->stack.stack[L->Cstack.base++] = *o;
89	return L->Cstack.base; /* this is +1 real position (see Ref) */
90	}	49	}
91		50
92		51
93	static lua_Object put_luaObjectonTop (void) {	52	void luaA_pushobject (lua_State L, const TObject o) {
94	luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);	53	L->top = o;
95	L->stack.stack[L->Cstack.base++] = *(--L->stack.top);	54	incr_top;
96	return L->Cstack.base; /* this is +1 real position (see Ref) */
97	}	55	}
98		56
99		57	LUA_API int lua_stackspace (lua_State *L) {
100	static void top2LC (int n) {	58	return (L->stack_last - L->top);
101	/* Put the 'n' elements on the top as the Lua2C contents */
102	L->Cstack.base = (L->stack.top-L->stack.stack); /* new base */
103	L->Cstack.lua2C = L->Cstack.base-n; /* position of the new results */
104	L->Cstack.num = n; /* number of results */
105	}	59	}
106		60
107		61
108	lua_Object lua_pop (void) {
109	checkCparams(1);
110	return put_luaObjectonTop();
111	}
112
113		62
114	/*	63	/*
115	** Get a parameter, returning the object handle or LUA_NOOBJECT on error.	64	** basic stack manipulation
116	** 'number' must be 1 to get the first parameter.
117	*/	65	*/
118	lua_Object lua_lua2C (int number)
119	{
120	if (number <= 0 \|\| number > L->Cstack.num) return LUA_NOOBJECT;
121	/* Ref(L->stack.stack+(L->Cstack.lua2C+number-1)) ==
122	L->stack.stack+(L->Cstack.lua2C+number-1)-L->stack.stack+1 == */
123	return L->Cstack.lua2C+number;
124	}
125		66
126		67
127	int lua_callfunction (lua_Object function)	68	LUA_API int lua_gettop (lua_State *L) {
128	{	69	return (L->top - L->Cbase);
129	if (function == LUA_NOOBJECT)
130	return 1;
131	else {
132	luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
133	set_normalized(L->stack.stack+L->Cstack.base, Address(function));
134	return luaD_protectedrun();
135	}
136	}	70	}
137		71
138		72
139	lua_Object lua_gettagmethod (int tag, char *event)	73	LUA_API void lua_settop (lua_State *L, int index) {
140	{	74	if (index >= 0)
141	return put_luaObject(luaT_gettagmethod(tag, event));	75	luaD_adjusttop(L, L->Cbase, index);
		76	else
		77	L->top = L->top+index+1; /* index is negative */
142	}	78	}
143		79
144		80
145	lua_Object lua_settagmethod (int tag, char *event)	81	LUA_API void lua_remove (lua_State *L, int index) {
146	{	82	StkId p = luaA_index(L, index);
147	checkCparams(1);	83	while (++p < L->top) (p-1) = p;
148	luaT_settagmethod(tag, event, L->stack.top-1);	84	L->top--;
149	return put_luaObjectonTop();
150	}	85	}
151		86
152		87
153	lua_Object lua_seterrormethod (void) {	88	LUA_API void lua_insert (lua_State *L, int index) {
154	lua_Object temp;	89	StkId p = luaA_index(L, index);
155	checkCparams(1);	90	StkId q;
156	temp = lua_getglobal("_ERRORMESSAGE");	91	for (q = L->top; q>p; q--)
157	lua_setglobal("_ERRORMESSAGE");	92	q = (q-1);
158	return temp;	93	p = L->top;
159	}	94	}
160		95
161		96
162	lua_Object lua_gettable (void)	97	LUA_API void lua_pushvalue (lua_State *L, int index) {
163	{	98	L->top = luaA_index(L, index);
164	checkCparams(2);	99	api_incr_top(L);
165	luaV_gettable();
166	return put_luaObjectonTop();
167	}	100	}
168		101
169		102
170	lua_Object lua_rawgettable (void) {
171	checkCparams(2);
172	if (ttype(L->stack.top-2) != LUA_T_ARRAY)
173	lua_error("indexed expression not a table in rawgettable");
174	(L->stack.top-2) = luaH_get(avalue(L->stack.top-2), L->stack.top-1);
175	--L->stack.top;
176	return put_luaObjectonTop();
177	}
178
179		103
180	void lua_settable (void) {	104	/*
181	checkCparams(3);	105	** access functions (stack -> C)
182	luaD_checkstack(3); /* may need that to call T.M. */	106	*/
183	luaV_settable(L->stack.top-3);
184	L->stack.top -= 2; /* pop table and index */
185	}
186		107
187		108
188	void lua_rawsettable (void) {	109	LUA_API int lua_type (lua_State *L, int index) {
189	checkCparams(3);	110	StkId o = luaA_indexAcceptable(L, index);
190	luaV_rawsettable(L->stack.top-3);	111	return (o == NULL) ? LUA_TNONE : ttype(o);
191	}	112	}
192		113
193		114	LUA_API const char lua_typename (lua_State L, int t) {
194	lua_Object lua_createtable (void)	115	UNUSED(L);
195	{	116	return (t == LUA_TNONE) ? "no value" : luaO_typenames[t];
196	TObject o;
197	luaC_checkGC();
198	avalue(&o) = luaH_new(0);
199	ttype(&o) = LUA_T_ARRAY;
200	return put_luaObject(&o);
201	}	117	}
202		118
203		119
204	lua_Object lua_getglobal (char *name)	120	LUA_API int lua_iscfunction (lua_State *L, int index) {
205	{	121	StkId o = luaA_indexAcceptable(L, index);
206	luaD_checkstack(2); /* may need that to call T.M. */	122	return (o == NULL) ? 0 : iscfunction(o);
207	luaV_getglobal(luaS_new(name));
208	return put_luaObjectonTop();
209	}	123	}
210		124
		125	LUA_API int lua_isnumber (lua_State *L, int index) {
		126	TObject *o = luaA_indexAcceptable(L, index);
		127	return (o == NULL) ? 0 : (tonumber(o) == 0);
		128	}
211		129
212	lua_Object lua_rawgetglobal (char *name)	130	LUA_API int lua_isstring (lua_State *L, int index) {
213	{	131	int t = lua_type(L, index);
214	TaggedString *ts = luaS_new(name);	132	return (t == LUA_TSTRING \|\| t == LUA_TNUMBER);
215	return put_luaObject(&ts->u.s.globalval);
216	}	133	}
217		134
218		135
219	void lua_setglobal (char *name)	136	LUA_API int lua_tag (lua_State *L, int index) {
220	{	137	StkId o = luaA_indexAcceptable(L, index);
221	checkCparams(1);	138	return (o == NULL) ? LUA_NOTAG : luaT_tag(o);
222	luaD_checkstack(2); /* may need that to call T.M. */
223	luaV_setglobal(luaS_new(name));
224	}	139	}
225		140
		141	LUA_API int lua_equal (lua_State *L, int index1, int index2) {
		142	StkId o1 = luaA_indexAcceptable(L, index1);
		143	StkId o2 = luaA_indexAcceptable(L, index2);
		144	if (o1 == NULL \|\| o2 == NULL) return 0; /* index out-of-range */
		145	else return luaO_equalObj(o1, o2);
		146	}
226		147
227	void lua_rawsetglobal (char *name)	148	LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {
228	{	149	StkId o1 = luaA_indexAcceptable(L, index1);
229	TaggedString *ts = luaS_new(name);	150	StkId o2 = luaA_indexAcceptable(L, index2);
230	checkCparams(1);	151	if (o1 == NULL \|\| o2 == NULL) return 0; /* index out-of-range */
231	luaS_rawsetglobal(ts, --L->stack.top);	152	else return luaV_lessthan(L, o1, o2, L->top);
232	}	153	}
233		154
234		155
235		156
236	int lua_isnil (lua_Object o)	157	LUA_API double lua_tonumber (lua_State *L, int index) {
237	{	158	StkId o = luaA_indexAcceptable(L, index);
238	return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL);	159	return (o == NULL \|\| tonumber(o)) ? 0 : nvalue(o);
239	}	160	}
240		161
241	int lua_istable (lua_Object o)	162	LUA_API const char lua_tostring (lua_State L, int index) {
242	{	163	StkId o = luaA_indexAcceptable(L, index);
243	return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY);	164	return (o == NULL \|\| tostring(L, o)) ? NULL : svalue(o);
244	}	165	}
245		166
246	int lua_isuserdata (lua_Object o)	167	LUA_API size_t lua_strlen (lua_State *L, int index) {
247	{	168	StkId o = luaA_indexAcceptable(L, index);
248	return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA);	169	return (o == NULL \|\| tostring(L, o)) ? 0 : tsvalue(o)->len;
249	}	170	}
250		171
251	int lua_iscfunction (lua_Object o)	172	LUA_API lua_CFunction lua_tocfunction (lua_State *L, int index) {
252	{	173	StkId o = luaA_indexAcceptable(L, index);
253	return (lua_tag(o) == LUA_T_CPROTO);	174	return (o == NULL \|\| !iscfunction(o)) ? NULL : clvalue(o)->f.c;
254	}	175	}
255		176
256	int lua_isnumber (lua_Object o)	177	LUA_API void lua_touserdata (lua_State L, int index) {
257	{	178	StkId o = luaA_indexAcceptable(L, index);
258	return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0);	179	return (o == NULL \|\| ttype(o) != LUA_TUSERDATA) ? NULL :
		180	tsvalue(o)->u.d.value;
259	}	181	}
260		182
261	int lua_isstring (lua_Object o)	183	LUA_API const void lua_topointer (lua_State L, int index) {
262	{	184	StkId o = luaA_indexAcceptable(L, index);
263	int t = lua_tag(o);	185	if (o == NULL) return NULL;
264	return (t == LUA_T_STRING) \|\| (t == LUA_T_NUMBER);	186	switch (ttype(o)) {
		187	case LUA_TTABLE:
		188	return hvalue(o);
		189	case LUA_TFUNCTION:
		190	return clvalue(o);
		191	default: return NULL;
		192	}
265	}	193	}
266		194
267	int lua_isfunction (lua_Object o)
268	{
269	int t = lua_tag(o);
270	return (t == LUA_T_PROTO) \|\| (t == LUA_T_CPROTO);
271	}
272		195
273		196
274	double lua_getnumber (lua_Object object)	197	/*
275	{	198	** push functions (C -> stack)
276	if (object == LUA_NOOBJECT) return 0.0;	199	*/
277	if (tonumber(Address(object))) return 0.0;
278	else return (nvalue(Address(object)));
279	}
280		200
281	char *lua_getstring (lua_Object object)
282	{
283	luaC_checkGC(); /* "tostring" may create a new string */
284	if (object == LUA_NOOBJECT \|\| tostring(Address(object)))
285	return NULL;
286	else return (svalue(Address(object)));
287	}
288		201
289	long lua_strlen (lua_Object object)	202	LUA_API void lua_pushnil (lua_State *L) {
290	{	203	ttype(L->top) = LUA_TNIL;
291	luaC_checkGC(); /* "tostring" may create a new string */	204	api_incr_top(L);
292	if (object == LUA_NOOBJECT \|\| tostring(Address(object)))
293	return 0L;
294	else return (tsvalue(Address(object))->u.s.len);
295	}	205	}
296		206
297	void *lua_getuserdata (lua_Object object)
298	{
299	if (object == LUA_NOOBJECT \|\| ttype(Address(object)) != LUA_T_USERDATA)
300	return NULL;
301	else return tsvalue(Address(object))->u.d.v;
302	}
303		207
304	lua_CFunction lua_getcfunction (lua_Object object)	208	LUA_API void lua_pushnumber (lua_State *L, double n) {
305	{	209	nvalue(L->top) = n;
306	if (!lua_iscfunction(object))	210	ttype(L->top) = LUA_TNUMBER;
307	return NULL;	211	api_incr_top(L);
308	else return fvalue(luaA_protovalue(Address(object)));
309	}	212	}
310		213
311		214
312	void lua_pushnil (void)	215	LUA_API void lua_pushlstring (lua_State L, const char s, size_t len) {
313	{	216	tsvalue(L->top) = luaS_newlstr(L, s, len);
314	ttype(L->stack.top) = LUA_T_NIL;	217	ttype(L->top) = LUA_TSTRING;
315	incr_top;	218	api_incr_top(L);
316	}	219	}
317		220
318	void lua_pushnumber (double n)
319	{
320	ttype(L->stack.top) = LUA_T_NUMBER;
321	nvalue(L->stack.top) = n;
322	incr_top;
323	}
324		221
325	void lua_pushlstring (char *s, long len)	222	LUA_API void lua_pushstring (lua_State L, const char s) {
326	{
327	tsvalue(L->stack.top) = luaS_newlstr(s, len);
328	ttype(L->stack.top) = LUA_T_STRING;
329	incr_top;
330	luaC_checkGC();
331	}
332
333	void lua_pushstring (char *s)
334	{
335	if (s == NULL)	223	if (s == NULL)
336	lua_pushnil();	224	lua_pushnil(L);
337	else	225	else
338	lua_pushlstring(s, strlen(s));	226	lua_pushlstring(L, s, strlen(s));
339	}	227	}
340		228
341	void lua_pushcclosure (lua_CFunction fn, int n)
342	{
343	if (fn == NULL)
344	lua_error("API error - attempt to push a NULL Cfunction");
345	checkCparams(n);
346	ttype(L->stack.top) = LUA_T_CPROTO;
347	fvalue(L->stack.top) = fn;
348	incr_top;
349	luaV_closure(n);
350	luaC_checkGC();
351	}
352		229
353	void lua_pushusertag (void *u, int tag)	230	LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
354	{	231	luaV_Cclosure(L, fn, n);
355	if (tag < 0 && tag != LUA_ANYTAG)
356	luaT_realtag(tag); /* error if tag is not valid */
357	tsvalue(L->stack.top) = luaS_createudata(u, tag);
358	ttype(L->stack.top) = LUA_T_USERDATA;
359	incr_top;
360	luaC_checkGC();
361	}	232	}
362		233
363	void luaA_pushobject (TObject *o)
364	{
365	L->stack.top = o;
366	incr_top;
367	}
368		234
369	void lua_pushobject (lua_Object o) {	235	LUA_API void lua_pushusertag (lua_State L, void u, int tag) {
370	if (o == LUA_NOOBJECT)	236	/* ORDER LUA_T */
371	lua_error("API error - attempt to push a NOOBJECT");	237	if (!(tag == LUA_ANYTAG \|\| tag == LUA_TUSERDATA \|\| validtag(tag)))
372	set_normalized(L->stack.top, Address(o));	238	luaO_verror(L, "invalid tag for a userdata (%d)", tag);
373	incr_top;	239	tsvalue(L->top) = luaS_createudata(L, u, tag);
		240	ttype(L->top) = LUA_TUSERDATA;
		241	api_incr_top(L);
374	}	242	}
375		243
376		244
377	int lua_tag (lua_Object lo)
378	{
379	if (lo == LUA_NOOBJECT)
380	return LUA_T_NIL;
381	else {
382	TObject *o = Address(lo);
383	int t;
384	switch (t = ttype(o)) {
385	case LUA_T_USERDATA:
386	return o->value.ts->u.d.tag;
387	case LUA_T_ARRAY:
388	return o->value.a->htag;
389	case LUA_T_PMARK:
390	return LUA_T_PROTO;
391	case LUA_T_CMARK:
392	return LUA_T_CPROTO;
393	case LUA_T_CLOSURE: case LUA_T_CLMARK:
394	return o->value.cl->consts[0].ttype;
395	#ifdef DEBUG
396	case LUA_T_LINE:
397	LUA_INTERNALERROR("invalid type");
398	#endif
399	default:
400	return t;
401	}
402	}
403	}
404
405		245
406	void lua_settag (int tag)	246	/*
407	{	247	** get functions (Lua -> stack)
408	checkCparams(1);	248	*/
409	luaT_realtag(tag);
410	switch (ttype(L->stack.top-1)) {
411	case LUA_T_ARRAY:
412	(L->stack.top-1)->value.a->htag = tag;
413	break;
414	case LUA_T_USERDATA:
415	(L->stack.top-1)->value.ts->u.d.tag = tag;
416	break;
417	default:
418	luaL_verror("cannot change the tag of a %.20s",
419	luaO_typename(L->stack.top-1));
420	}
421	L->stack.top--;
422	}
423		249
424		250
425	TaggedString luaA_nextvar (TaggedString g) {	251	LUA_API void lua_getglobal (lua_State L, const char name) {
426	if (g == NULL)	252	StkId top = L->top;
427	g = (TaggedString )L->rootglobal.next; / first variable */	253	top = luaV_getglobal(L, luaS_new(L, name));
428	else {	254	L->top = top;
429	/* check whether name is in global var list */	255	api_incr_top(L);
430	luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
431	g = (TaggedString )g->head.next; / get next */
432	}
433	while (g && g->u.s.globalval.ttype == LUA_T_NIL) /* skip globals with nil */
434	g = (TaggedString *)g->head.next;
435	if (g) {
436	ttype(L->stack.top) = LUA_T_STRING; tsvalue(L->stack.top) = g;
437	incr_top;
438	luaA_pushobject(&g->u.s.globalval);
439	}
440	return g;
441	}	256	}
442		257
443		258
444	char lua_nextvar (char varname) {	259	LUA_API void lua_gettable (lua_State *L, int index) {
445	TaggedString *g = (varname == NULL) ? NULL : luaS_new(varname);	260	StkId t = Index(L, index);
446	g = luaA_nextvar(g);	261	StkId top = L->top;
447	if (g) {	262	(top-1) = luaV_gettable(L, t);
448	top2LC(2);	263	L->top = top; /* tag method may change top */
449	return g->str;
450	}
451	else {
452	top2LC(0);
453	return NULL;
454	}
455	}	264	}
456		265
457		266
458	int luaA_next (Hash *t, int i) {	267	LUA_API void lua_rawget (lua_State *L, int index) {
459	int tsize = nhash(t);	268	StkId t = Index(L, index);
460	for (; i<tsize; i++) {	269	LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected");
461	Node *n = node(t, i);	270	(L->top - 1) = luaH_get(L, hvalue(t), L->top - 1);
462	if (ttype(val(n)) != LUA_T_NIL) {
463	luaA_pushobject(ref(n));
464	luaA_pushobject(val(n));
465	return i+1; /* index to be used next time */
466	}
467	}
468	return 0; /* no more elements */
469	}	271	}
470		272
471		273
472	int lua_next (lua_Object o, int i) {	274	LUA_API void lua_rawgeti (lua_State *L, int index, int n) {
473	TObject *t = Address(o);	275	StkId o = Index(L, index);
474	if (ttype(t) != LUA_T_ARRAY)	276	LUA_ASSERT(ttype(o) == LUA_TTABLE, "table expected");
475	lua_error("API error - object is not a table in `lua_next'");	277	L->top = luaH_getnum(hvalue(o), n);
476	i = luaA_next(avalue(t), i);	278	api_incr_top(L);
477	top2LC((i==0) ? 0 : 2);
478	return i;
479	}	279	}
480		280
481		281
482		282	LUA_API void lua_getglobals (lua_State *L) {
483	/*	283	hvalue(L->top) = L->gt;
484	** {======================================================	284	ttype(L->top) = LUA_TTABLE;
485	** To manipulate some state information	285	api_incr_top(L);
486	** =======================================================
487	*/
488
489	lua_State lua_setstate (lua_State st) {
490	lua_State *old = lua_state;
491	lua_state = st;
492	return old;
493	}	286	}
494		287
495	lua_LHFunction lua_setlinehook (lua_LHFunction func) {
496	lua_LHFunction old = L->linehook;
497	L->linehook = func;
498	return old;
499	}
500		288
501	lua_CHFunction lua_setcallhook (lua_CHFunction func) {	289	LUA_API int lua_getref (lua_State *L, int ref) {
502	lua_CHFunction old = L->callhook;	290	if (ref == LUA_REFNIL)
503	L->callhook = func;	291	ttype(L->top) = LUA_TNIL;
504	return old;	292	else if (0 <= ref && ref < L->refSize &&
		293	(L->refArray[ref].st == LOCK \|\| L->refArray[ref].st == HOLD))
		294	*L->top = L->refArray[ref].o;
		295	else
		296	return 0;
		297	api_incr_top(L);
		298	return 1;
505	}	299	}
506		300
507	int lua_setdebug (int debug) {	301
508	int old = L->debug;	302	LUA_API void lua_newtable (lua_State *L) {
509	L->debug = debug;	303	hvalue(L->top) = luaH_new(L, 0);
510	return old;	304	ttype(L->top) = LUA_TTABLE;
		305	api_incr_top(L);
511	}	306	}
512		307
513	/* }====================================================== */
514		308
515		309
516	/*	310	/*
517	** {======================================================	311	** set functions (stack -> Lua)
518	** Debug interface
519	** =======================================================
520	*/	312	*/
521		313
522		314
523	lua_Function lua_stackedfunction (int level)	315	LUA_API void lua_setglobal (lua_State L, const char name) {
524	{	316	StkId top = L->top;
525	StkId i;	317	luaV_setglobal(L, luaS_new(L, name));
526	for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--) {	318	L->top = top-1; /* remove element from the top */
527	int t = L->stack.stack[i].ttype;
528	if (t == LUA_T_CLMARK \|\| t == LUA_T_PMARK \|\| t == LUA_T_CMARK)
529	if (level-- == 0)
530	return Ref(L->stack.stack+i);
531	}
532	return LUA_NOOBJECT;
533	}	319	}
534		320
535		321
536	int lua_nups (lua_Function func) {	322	LUA_API void lua_settable (lua_State *L, int index) {
537	TObject *o = luaA_Address(func);	323	StkId t = Index(L, index);
538	return (!o \|\| normalized_type(o) != LUA_T_CLOSURE) ? 0 : o->value.cl->nelems;	324	StkId top = L->top;
		325	luaV_settable(L, t, top-2);
		326	L->top = top-2; /* pop index and value */
539	}	327	}
540		328
541		329
542	int lua_currentline (lua_Function func)	330	LUA_API void lua_rawset (lua_State *L, int index) {
543	{	331	StkId t = Index(L, index);
544	TObject *f = Address(func);	332	LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected");
545	return (f+1 < L->stack.top && (f+1)->ttype == LUA_T_LINE) ?	333	luaH_set(L, hvalue(t), L->top-2) = (L->top-1);
546	(f+1)->value.i : -1;	334	L->top -= 2;
547	}	335	}
548		336
549		337
550	lua_Object lua_getlocal (lua_Function func, int local_number, char **name) {	338	LUA_API void lua_rawseti (lua_State *L, int index, int n) {
551	/* check whether func is a Lua function */	339	StkId o = Index(L, index);
552	if (lua_tag(func) != LUA_T_PROTO)	340	LUA_ASSERT(ttype(o) == LUA_TTABLE, "table expected");
553	return LUA_NOOBJECT;	341	luaH_setint(L, hvalue(o), n) = (L->top-1);
554	else {	342	L->top--;
555	TObject *f = Address(func);
556	TProtoFunc *fp = luaA_protovalue(f)->value.tf;
557	*name = luaF_getlocalname(fp, local_number, lua_currentline(func));
558	if (*name) {
559	/* if "name", there must be a LUA_T_LINE /
560	/* therefore, f+2 points to function base */
561	return put_luaObject((f+2)+(local_number-1));
562	}
563	else
564	return LUA_NOOBJECT;
565	}
566	}	343	}
567		344
568		345
569	int lua_setlocal (lua_Function func, int local_number)	346	LUA_API void lua_setglobals (lua_State *L) {
570	{	347	StkId newtable = --L->top;
571	/* check whether func is a Lua function */	348	LUA_ASSERT(ttype(newtable) == LUA_TTABLE, "table expected");
572	if (lua_tag(func) != LUA_T_PROTO)	349	L->gt = hvalue(newtable);
573	return 0;
574	else {
575	TObject *f = Address(func);
576	TProtoFunc *fp = luaA_protovalue(f)->value.tf;
577	char *name = luaF_getlocalname(fp, local_number, lua_currentline(func));
578	checkCparams(1);
579	--L->stack.top;
580	if (name) {
581	/* if "name", there must be a LUA_T_LINE */
582	/* therefore, f+2 points to function base */
583	((f+2)+(local_number-1)) = L->stack.top;
584	return 1;
585	}
586	else
587	return 0;
588	}
589	}	350	}
590		351
591		352
592	void lua_funcinfo (lua_Object func, char *source, int linedefined) {	353	LUA_API int lua_ref (lua_State *L, int lock) {
593	if (!lua_isfunction(func))	354	int ref;
594	lua_error("API error - `funcinfo' called with a non-function value");	355	if (ttype(L->top-1) == LUA_TNIL)
		356	ref = LUA_REFNIL;
595	else {	357	else {
596	TObject *f = luaA_protovalue(Address(func));	358	if (L->refFree != NONEXT) { /* is there a free place? */
597	if (normalized_type(f) == LUA_T_PROTO) {	359	ref = L->refFree;
598	*source = tfvalue(f)->source->str;	360	L->refFree = L->refArray[ref].st;
599	*linedefined = tfvalue(f)->lineDefined;
600	}	361	}
601	else {	362	else { /* no more free places */
602	*source = "(C)";	363	luaM_growvector(L, L->refArray, L->refSize, 1, struct Ref,
603	*linedefined = -1;	364	"reference table overflow", MAX_INT);
		365	L->nblocks += sizeof(struct Ref);
		366	ref = L->refSize++;
604	}	367	}
		368	L->refArray[ref].o = *(L->top-1);
		369	L->refArray[ref].st = lock ? LOCK : HOLD;
605	}	370	}
		371	L->top--;
		372	return ref;
606	}	373	}
607		374
608		375
609	static int checkfunc (TObject *o)	376	/*
610	{	377	** "do" functions (run Lua code)
611	return luaO_equalObj(o, L->stack.top);	378	** (most of them are in ldo.c)
612	}	379	*/
613
614		380
615	char lua_getobjname (lua_Object o, char *name)	381	LUA_API void lua_rawcall (lua_State *L, int nargs, int nresults) {
616	{ /* try to find a name for given function */	382	luaD_call(L, L->top-(nargs+1), nresults);
617	set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc" */
618	if ((*name = luaS_travsymbol(checkfunc)) != NULL)
619	return "global";
620	else if ((*name = luaT_travtagmethods(checkfunc)) != NULL)
621	return "tag-method";
622	else return "";
623	}	383	}
624		384
625	/* }====================================================== */
626
627		385
628	/*	386	/*
629	** {======================================================	387	** Garbage-collection functions
630	** BLOCK mechanism
631	** =======================================================
632	*/	388	*/
633		389
		390	/* GC values are expressed in Kbytes: #bytes/2^10 */
		391	#define GCscale(x) ((int)((x)>>10))
		392	#define GCunscale(x) ((unsigned long)(x)<<10)
634		393
635	#ifndef MAX_C_BLOCKS	394	LUA_API int lua_getgcthreshold (lua_State *L) {
636	#define MAX_C_BLOCKS 1000 /* arbitrary limit */	395	return GCscale(L->GCthreshold);
637	#endif	396	}
638
639		397
640	void lua_beginblock (void) {	398	LUA_API int lua_getgccount (lua_State *L) {
641	luaM_growvector(L->Cblocks, L->numCblocks, 1, struct C_Lua_Stack,	399	return GCscale(L->nblocks);
642	"too many nested blocks", MAX_C_BLOCKS);
643	L->Cblocks[L->numCblocks] = L->Cstack;
644	L->numCblocks++;
645	}	400	}
646		401
647	void lua_endblock (void) {	402	LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold) {
648	--L->numCblocks;	403	if (newthreshold > GCscale(ULONG_MAX))
649	L->Cstack = L->Cblocks[L->numCblocks];	404	L->GCthreshold = ULONG_MAX;
650	luaD_adjusttop(L->Cstack.base);	405	else
		406	L->GCthreshold = GCunscale(newthreshold);
		407	luaC_checkGC(L);
651	}	408	}
652		409
653		410
		411	/*
		412	** miscellaneous functions
		413	*/
654		414
655	int lua_ref (int lock) {	415	LUA_API void lua_settag (lua_State *L, int tag) {
656	int ref;	416	luaT_realtag(L, tag);
657	checkCparams(1);	417	switch (ttype(L->top-1)) {
658	ref = luaC_ref(L->stack.top-1, lock);	418	case LUA_TTABLE:
659	L->stack.top--;	419	hvalue(L->top-1)->htag = tag;
660	return ref;	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	}
661	}	428	}
662		429
663		430
664		431	LUA_API void lua_unref (lua_State *L, int ref) {
665	lua_Object lua_getref (int ref) {	432	if (ref >= 0) {
666	TObject *o = luaC_getref(ref);	433	LUA_ASSERT(ref < L->refSize && L->refArray[ref].st < 0, "invalid ref");
667	return (o ? put_luaObject(o) : LUA_NOOBJECT);	434	L->refArray[ref].st = L->refFree;
		435	L->refFree = ref;
		436	}
668	}	437	}
669		438
670	/* }====================================================== */
671		439
		440	LUA_API int lua_next (lua_State *L, int index) {
		441	StkId t = luaA_index(L, index);
		442	Node *n;
		443	LUA_ASSERT(ttype(t) == LUA_TTABLE, "table expected");
		444	n = luaH_next(L, hvalue(t), luaA_index(L, -1));
		445	if (n) {
		446	(L->top-1) = key(n);
		447	L->top = val(n);
		448	api_incr_top(L);
		449	return 1;
		450	}
		451	else { /* no more elements */
		452	L->top -= 1; /* remove key */
		453	return 0;
		454	}
		455	}
672		456
673		457
674	#ifdef LUA_COMPAT2_5	458	LUA_API int lua_getn (lua_State *L, int index) {
675	/*	459	Hash *h = hvalue(luaA_index(L, index));
676	** API: set a function as a fallback	460	const TObject value = luaH_getstr(h, luaS_new(L, "n")); / value = h.n */
677	*/	461	if (ttype(value) == LUA_TNUMBER)
		462	return (int)nvalue(value);
		463	else {
		464	Number max = 0;
		465	int i = h->size;
		466	Node *n = h->node;
		467	while (i--) {
		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	}
		476	}
		477
678		478
679	static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults) {	479	LUA_API void lua_concat (lua_State *L, int n) {
680	luaD_openstack(nParams);	480	StkId top = L->top;
681	(L->stack.top-nParams)->ttype = LUA_T_CPROTO;	481	luaV_strconc(L, n, top);
682	(L->stack.top-nParams)->value.f = f;	482	L->top = top-(n-1);
683	luaD_calln(nParams, nResults);	483	luaC_checkGC(L);
684	}	484	}
685		485
686		486
687	lua_Object lua_setfallback (char *name, lua_CFunction fallback) {	487	LUA_API void lua_newuserdata (lua_State L, size_t size) {
688	lua_pushstring(name);	488	TString *ts = luaS_newudata(L, size, NULL);
689	lua_pushcfunction(fallback);	489	tsvalue(L->top) = ts;
690	do_unprotectedrun(luaT_setfallback, 2, 1);	490	ttype(L->top) = LUA_TUSERDATA;
691	return put_luaObjectonTop();	491	api_incr_top(L);
		492	return ts->u.d.value;
692	}	493	}
693	#endif
694		494

src/lapi.h+3−8

 /*
-** $Id: lapi.h,v 1.4 1999/02/23 14:57:28 roberto Exp $
+** $Id: lapi.h,v 1.20 2000/08/31 14:08:27 roberto Exp $
 ** Auxiliary functions from Lua API
 ** See Copyright Notice in lua.h
 */
 #define lapi_h
-#include "lua.h"
 #include "lobject.h"
-TObject *luaA_Address (lua_Object o);
+TObject *luaA_index (lua_State *L, int index);
-void luaA_pushobject (TObject *o);
+void luaA_pushobject (lua_State *L, const TObject *o);
-void luaA_packresults (void);
-int luaA_passresults (void);
-TaggedString *luaA_nextvar (TaggedString *g);
-int luaA_next (Hash *t, int i);
 #endif

src/lauxlib.c+0−133

@@ -1,133 +0,0 @@
1	/*
2	** $Id: lauxlib.c,v 1.17 1999/03/11 18:59:19 roberto Exp $
3	** Auxiliary functions for building Lua libraries
4	** See Copyright Notice in lua.h
5	*/
6
7
8	#include <stdarg.h>
9	#include <stdio.h>
10	#include <string.h>
11
12	/* Please Notice: This file uses only the official API of Lua
13	** Any function declared here could be written as an application function.
14	** With care, these functions can be used by other libraries.
15	*/
16
17	#include "lauxlib.h"
18	#include "lua.h"
19	#include "luadebug.h"
20
21
22
23	int luaL_findstring (char name, char list[]) {
24	int i;
25	for (i=0; list[i]; i++)
26	if (strcmp(list[i], name) == 0)
27	return i;
28	return -1; /* name not found */
29	}
30
31	void luaL_argerror (int numarg, char *extramsg) {
32	lua_Function f = lua_stackedfunction(0);
33	char *funcname;
34	lua_getobjname(f, &funcname);
35	numarg -= lua_nups(f);
36	if (funcname == NULL)
37	funcname = "?";
38	if (extramsg == NULL)
39	luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname);
40	else
41	luaL_verror("bad argument #%d to function `%.50s' (%.100s)",
42	numarg, funcname, extramsg);
43	}
44
45	char luaL_check_lstr (int numArg, long len)
46	{
47	lua_Object o = lua_getparam(numArg);
48	luaL_arg_check(lua_isstring(o), numArg, "string expected");
49	if (len) *len = lua_strlen(o);
50	return lua_getstring(o);
51	}
52
53	char luaL_opt_lstr (int numArg, char def, long *len)
54	{
55	return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
56	luaL_check_lstr(numArg, len);
57	}
58
59	double luaL_check_number (int numArg)
60	{
61	lua_Object o = lua_getparam(numArg);
62	luaL_arg_check(lua_isnumber(o), numArg, "number expected");
63	return lua_getnumber(o);
64	}
65
66
67	double luaL_opt_number (int numArg, double def)
68	{
69	return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
70	luaL_check_number(numArg);
71	}
72
73
74	lua_Object luaL_tablearg (int arg)
75	{
76	lua_Object o = lua_getparam(arg);
77	luaL_arg_check(lua_istable(o), arg, "table expected");
78	return o;
79	}
80
81	lua_Object luaL_functionarg (int arg)
82	{
83	lua_Object o = lua_getparam(arg);
84	luaL_arg_check(lua_isfunction(o), arg, "function expected");
85	return o;
86	}
87
88	lua_Object luaL_nonnullarg (int numArg)
89	{
90	lua_Object o = lua_getparam(numArg);
91	luaL_arg_check(o != LUA_NOOBJECT, numArg, "value expected");
92	return o;
93	}
94
95	void luaL_openlib (struct luaL_reg *l, int n)
96	{
97	int i;
98	lua_open(); /* make sure lua is already open */
99	for (i=0; i<n; i++)
100	lua_register(l[i].name, l[i].func);
101	}
102
103
104	void luaL_verror (char *fmt, ...)
105	{
106	char buff[500];
107	va_list argp;
108	va_start(argp, fmt);
109	vsprintf(buff, fmt, argp);
110	va_end(argp);
111	lua_error(buff);
112	}
113
114
115	void luaL_chunkid (char out, char source, int len) {
116	len -= 13; /* 13 = strlen("string ''...\0") */
117	if (*source == '@')
118	sprintf(out, "file `%.*s'", len, source+1);
119	else if (*source == '(')
120	strcpy(out, "(C code)");
121	else {
122	char b = strchr(source , '\n'); / stop string at first new line */
123	int lim = (b && (b-source)<len) ? b-source : len;
124	sprintf(out, "string `%.*s'", lim, source);
125	strcpy(out+lim+(13-5), "...'"); /* 5 = strlen("...'\0") */
126	}
127	}
128
129
130	void luaL_filesource (char out, char filename, int len) {
131	if (filename == NULL) filename = "(stdin)";
132	sprintf(out, "@%.s", len-2, filename); / -2 for '@' and '\0' */
133	}

src/lbuffer.c+0−75

@@ -1,75 +0,0 @@
1	/*
2	** $Id: lbuffer.c,v 1.9 1999/02/26 15:48:55 roberto Exp $
3	** Auxiliary functions for building Lua libraries
4	** See Copyright Notice in lua.h
5	*/
6
7
8	#include <stdio.h>
9
10	#include "lauxlib.h"
11	#include "lmem.h"
12	#include "lstate.h"
13
14
15	/*-------------------------------------------------------
16	** Auxiliary buffer
17	-------------------------------------------------------*/
18
19
20	#define EXTRABUFF 32
21
22
23	#define openspace(size) if (L->Mbuffnext+(size) > L->Mbuffsize) Openspace(size)
24
25	static void Openspace (int size) {
26	lua_State l = L; / to optimize */
27	size += EXTRABUFF;
28	l->Mbuffsize = l->Mbuffnext+size;
29	luaM_growvector(l->Mbuffer, l->Mbuffnext, size, char, arrEM, MAX_INT);
30	}
31
32
33	char *luaL_openspace (int size) {
34	openspace(size);
35	return L->Mbuffer+L->Mbuffnext;
36	}
37
38
39	void luaL_addchar (int c) {
40	openspace(1);
41	L->Mbuffer[L->Mbuffnext++] = (char)c;
42	}
43
44
45	void luaL_resetbuffer (void) {
46	L->Mbuffnext = L->Mbuffbase;
47	}
48
49
50	void luaL_addsize (int n) {
51	L->Mbuffnext += n;
52	}
53
54	int luaL_getsize (void) {
55	return L->Mbuffnext-L->Mbuffbase;
56	}
57
58	int luaL_newbuffer (int size) {
59	int old = L->Mbuffbase;
60	openspace(size);
61	L->Mbuffbase = L->Mbuffnext;
62	return old;
63	}
64
65
66	void luaL_oldbuffer (int old) {
67	L->Mbuffnext = L->Mbuffbase;
68	L->Mbuffbase = old;
69	}
70
71
72	char *luaL_buffer (void) {
73	return L->Mbuffer+L->Mbuffbase;
74	}
75

src/lbuiltin.c+0−736

@@ -1,736 +0,0 @@
1	/*
2	** $Id: lbuiltin.c,v 1.59 1999/06/17 17:04:03 roberto Exp $
3	** Built-in functions
4	** See Copyright Notice in lua.h
5	*/
6
7
8	#include <ctype.h>
9	#include <stdio.h>
10	#include <stdlib.h>
11	#include <string.h>
12
13	#include "lapi.h"
14	#include "lauxlib.h"
15	#include "lbuiltin.h"
16	#include "ldo.h"
17	#include "lfunc.h"
18	#include "lmem.h"
19	#include "lobject.h"
20	#include "lstate.h"
21	#include "lstring.h"
22	#include "ltable.h"
23	#include "ltm.h"
24	#include "lua.h"
25	#include "lundump.h"
26	#include "lvm.h"
27
28
29
30	/*
31	** {======================================================
32	** Auxiliary functions
33	** =======================================================
34	*/
35
36
37	static void pushtagstring (TaggedString *s) {
38	TObject o;
39	o.ttype = LUA_T_STRING;
40	o.value.ts = s;
41	luaA_pushobject(&o);
42	}
43
44
45	static real getsize (Hash *h) {
46	real max = 0;
47	int i;
48	for (i = 0; i<nhash(h); i++) {
49	Node *n = h->node+i;
50	if (ttype(ref(n)) == LUA_T_NUMBER &&
51	ttype(val(n)) != LUA_T_NIL &&
52	nvalue(ref(n)) > max)
53	max = nvalue(ref(n));
54	}
55	return max;
56	}
57
58
59	static real getnarg (Hash *a) {
60	TObject index;
61	TObject *value;
62	/* value = table.n */
63	ttype(&index) = LUA_T_STRING;
64	tsvalue(&index) = luaS_new("n");
65	value = luaH_get(a, &index);
66	return (ttype(value) == LUA_T_NUMBER) ? nvalue(value) : getsize(a);
67	}
68
69
70	static Hash *gethash (int arg) {
71	return avalue(luaA_Address(luaL_tablearg(arg)));
72	}
73
74	/* }====================================================== */
75
76
77	/*
78	** {======================================================
79	** Functions that use only the official API
80	** =======================================================
81	*/
82
83
84	/*
85	** If your system does not support "stderr", redefine this function, or
86	** redefine _ERRORMESSAGE so that it won't need _ALERT.
87	*/
88	static void luaB_alert (void) {
89	fputs(luaL_check_string(1), stderr);
90	}
91
92
93	/*
94	** Standard implementation of _ERRORMESSAGE.
95	** The library "iolib" redefines _ERRORMESSAGE for better error information.
96	*/
97	static void error_message (void) {
98	lua_Object al = lua_rawgetglobal("_ALERT");
99	if (lua_isfunction(al)) { /* avoid error loop if _ALERT is not defined */
100	char buff[600];
101	sprintf(buff, "lua error: %.500s\n", luaL_check_string(1));
102	lua_pushstring(buff);
103	lua_callfunction(al);
104	}
105	}
106
107
108	/*
109	** If your system does not support "stdout", just remove this function.
110	** If you need, you can define your own "print" function, following this
111	** model but changing "fputs" to put the strings at a proper place
112	** (a console window or a log file, for instance).
113	*/
114	#ifndef MAXPRINT
115	#define MAXPRINT 40 /* arbitrary limit */
116	#endif
117
118	static void luaB_print (void) {
119	lua_Object args[MAXPRINT];
120	lua_Object obj;
121	int n = 0;
122	int i;
123	while ((obj = lua_getparam(n+1)) != LUA_NOOBJECT) {
124	luaL_arg_check(n < MAXPRINT, n+1, "too many arguments");
125	args[n++] = obj;
126	}
127	for (i=0; i<n; i++) {
128	lua_pushobject(args[i]);
129	if (lua_call("tostring"))
130	lua_error("error in `tostring' called by `print'");
131	obj = lua_getresult(1);
132	if (!lua_isstring(obj))
133	lua_error("`tostring' must return a string to `print'");
134	if (i>0) fputs("\t", stdout);
135	fputs(lua_getstring(obj), stdout);
136	}
137	fputs("\n", stdout);
138	}
139
140
141	static void luaB_tonumber (void) {
142	int base = luaL_opt_int(2, 10);
143	if (base == 10) { /* standard conversion */
144	lua_Object o = lua_getparam(1);
145	if (lua_isnumber(o)) lua_pushnumber(lua_getnumber(o));
146	else lua_pushnil(); /* not a number */
147	}
148	else {
149	char *s = luaL_check_string(1);
150	long n;
151	luaL_arg_check(0 <= base && base <= 36, 2, "base out of range");
152	n = strtol(s, &s, base);
153	while (isspace((unsigned char)s)) s++; / skip trailing spaces */
154	if (s) lua_pushnil(); / invalid format: return nil */
155	else lua_pushnumber(n);
156	}
157	}
158
159
160	static void luaB_error (void) {
161	lua_error(lua_getstring(lua_getparam(1)));
162	}
163
164	static void luaB_setglobal (void) {
165	char *n = luaL_check_string(1);
166	lua_Object value = luaL_nonnullarg(2);
167	lua_pushobject(value);
168	lua_setglobal(n);
169	lua_pushobject(value); /* return given value */
170	}
171
172	static void luaB_rawsetglobal (void) {
173	char *n = luaL_check_string(1);
174	lua_Object value = luaL_nonnullarg(2);
175	lua_pushobject(value);
176	lua_rawsetglobal(n);
177	lua_pushobject(value); /* return given value */
178	}
179
180	static void luaB_getglobal (void) {
181	lua_pushobject(lua_getglobal(luaL_check_string(1)));
182	}
183
184	static void luaB_rawgetglobal (void) {
185	lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
186	}
187
188	static void luaB_luatag (void) {
189	lua_pushnumber(lua_tag(lua_getparam(1)));
190	}
191
192	static void luaB_settag (void) {
193	lua_Object o = luaL_tablearg(1);
194	lua_pushobject(o);
195	lua_settag(luaL_check_int(2));
196	lua_pushobject(o); /* return first argument */
197	}
198
199	static void luaB_newtag (void) {
200	lua_pushnumber(lua_newtag());
201	}
202
203	static void luaB_copytagmethods (void) {
204	lua_pushnumber(lua_copytagmethods(luaL_check_int(1),
205	luaL_check_int(2)));
206	}
207
208	static void luaB_rawgettable (void) {
209	lua_pushobject(luaL_nonnullarg(1));
210	lua_pushobject(luaL_nonnullarg(2));
211	lua_pushobject(lua_rawgettable());
212	}
213
214	static void luaB_rawsettable (void) {
215	lua_pushobject(luaL_nonnullarg(1));
216	lua_pushobject(luaL_nonnullarg(2));
217	lua_pushobject(luaL_nonnullarg(3));
218	lua_rawsettable();
219	}
220
221	static void luaB_settagmethod (void) {
222	lua_Object nf = luaL_nonnullarg(3);
223	lua_pushobject(nf);
224	lua_pushobject(lua_settagmethod(luaL_check_int(1), luaL_check_string(2)));
225	}
226
227	static void luaB_gettagmethod (void) {
228	lua_pushobject(lua_gettagmethod(luaL_check_int(1), luaL_check_string(2)));
229	}
230
231	static void luaB_seterrormethod (void) {
232	lua_Object nf = luaL_functionarg(1);
233	lua_pushobject(nf);
234	lua_pushobject(lua_seterrormethod());
235	}
236
237	static void luaB_collectgarbage (void) {
238	lua_pushnumber(lua_collectgarbage(luaL_opt_int(1, 0)));
239	}
240
241	/* }====================================================== */
242
243
244	/*
245	** {======================================================
246	** Functions that could use only the official API but
247	** do not, for efficiency.
248	** =======================================================
249	*/
250
251	static void luaB_dostring (void) {
252	long l;
253	char *s = luaL_check_lstr(1, &l);
254	if (*s == ID_CHUNK)
255	lua_error("`dostring' cannot run pre-compiled code");
256	if (lua_dobuffer(s, l, luaL_opt_string(2, s)) == 0)
257	if (luaA_passresults() == 0)
258	lua_pushuserdata(NULL); /* at least one result to signal no errors */
259	}
260
261
262	static void luaB_dofile (void) {
263	char *fname = luaL_opt_string(1, NULL);
264	if (lua_dofile(fname) == 0)
265	if (luaA_passresults() == 0)
266	lua_pushuserdata(NULL); /* at least one result to signal no errors */
267	}
268
269
270	static void luaB_call (void) {
271	lua_Object f = luaL_nonnullarg(1);
272	Hash *arg = gethash(2);
273	char *options = luaL_opt_string(3, "");
274	lua_Object err = lua_getparam(4);
275	int narg = (int)getnarg(arg);
276	int i, status;
277	if (err != LUA_NOOBJECT) { /* set new error method */
278	lua_pushobject(err);
279	err = lua_seterrormethod();
280	}
281	/* push arg[1...n] */
282	luaD_checkstack(narg);
283	for (i=0; i<narg; i++)
284	(L->stack.top++) = luaH_getint(arg, i+1);
285	status = lua_callfunction(f);
286	if (err != LUA_NOOBJECT) { /* restore old error method */
287	lua_pushobject(err);
288	lua_seterrormethod();
289	}
290	if (status != 0) { /* error in call? */
291	if (strchr(options, 'x')) {
292	lua_pushnil();
293	return; /* return nil to signal the error */
294	}
295	else
296	lua_error(NULL);
297	}
298	else { /* no errors */
299	if (strchr(options, 'p'))
300	luaA_packresults();
301	else
302	luaA_passresults();
303	}
304	}
305
306
307	static void luaB_nextvar (void) {
308	TObject *o = luaA_Address(luaL_nonnullarg(1));
309	TaggedString *g;
310	if (ttype(o) == LUA_T_NIL)
311	g = NULL;
312	else {
313	luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
314	g = tsvalue(o);
315	}
316	if (!luaA_nextvar(g))
317	lua_pushnil();
318	}
319
320
321	static void luaB_next (void) {
322	Hash *a = gethash(1);
323	TObject *k = luaA_Address(luaL_nonnullarg(2));
324	int i = (ttype(k) == LUA_T_NIL) ? 0 : luaH_pos(a, k)+1;
325	if (luaA_next(a, i) == 0)
326	lua_pushnil();
327	}
328
329
330	static void luaB_tostring (void) {
331	lua_Object obj = lua_getparam(1);
332	TObject *o = luaA_Address(obj);
333	char buff[64];
334	switch (ttype(o)) {
335	case LUA_T_NUMBER:
336	lua_pushstring(lua_getstring(obj));
337	return;
338	case LUA_T_STRING:
339	lua_pushobject(obj);
340	return;
341	case LUA_T_ARRAY:
342	sprintf(buff, "table: %p", (void *)o->value.a);
343	break;
344	case LUA_T_CLOSURE:
345	sprintf(buff, "function: %p", (void *)o->value.cl);
346	break;
347	case LUA_T_PROTO:
348	sprintf(buff, "function: %p", (void *)o->value.tf);
349	break;
350	case LUA_T_CPROTO:
351	sprintf(buff, "function: %p", (void *)o->value.f);
352	break;
353	case LUA_T_USERDATA:
354	sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
355	break;
356	case LUA_T_NIL:
357	lua_pushstring("nil");
358	return;
359	default:
360	LUA_INTERNALERROR("invalid type");
361	}
362	lua_pushstring(buff);
363	}
364
365
366	static void luaB_type (void) {
367	lua_Object o = luaL_nonnullarg(1);
368	lua_pushstring(luaO_typename(luaA_Address(o)));
369	lua_pushnumber(lua_tag(o));
370	}
371
372	/* }====================================================== */
373
374
375
376	/*
377	** {======================================================
378	** "Extra" functions
379	** These functions can be written in Lua, so you can
380	** delete them if you need a tiny Lua implementation.
381	** If you delete them, remove their entries in array
382	** "builtin_funcs".
383	** =======================================================
384	*/
385
386	static void luaB_assert (void) {
387	lua_Object p = lua_getparam(1);
388	if (p == LUA_NOOBJECT \|\| lua_isnil(p))
389	luaL_verror("assertion failed! %.100s", luaL_opt_string(2, ""));
390	}
391
392
393	static void luaB_foreachi (void) {
394	Hash *t = gethash(1);
395	int i;
396	int n = (int)getnarg(t);
397	TObject f;
398	/* 'f' cannot be a pointer to TObject, because it is on the stack, and the
399	stack may be reallocated by the call. Moreover, some C compilers do not
400	initialize structs, so we must do the assignment after the declaration */
401	f = *luaA_Address(luaL_functionarg(2));
402	luaD_checkstack(3); /* for f, ref, and val */
403	for (i=1; i<=n; i++) {
404	*(L->stack.top++) = f;
405	ttype(L->stack.top) = LUA_T_NUMBER; nvalue(L->stack.top++) = i;
406	(L->stack.top++) = luaH_getint(t, i);
407	luaD_calln(2, 1);
408	if (ttype(L->stack.top-1) != LUA_T_NIL)
409	return;
410	L->stack.top--;
411	}
412	}
413
414
415	static void luaB_foreach (void) {
416	Hash *a = gethash(1);
417	int i;
418	TObject f; /* see comment in 'foreachi' */
419	f = *luaA_Address(luaL_functionarg(2));
420	luaD_checkstack(3); /* for f, ref, and val */
421	for (i=0; i<a->nhash; i++) {
422	Node *nd = &(a->node[i]);
423	if (ttype(val(nd)) != LUA_T_NIL) {
424	*(L->stack.top++) = f;
425	(L->stack.top++) = ref(nd);
426	(L->stack.top++) = val(nd);
427	luaD_calln(2, 1);
428	if (ttype(L->stack.top-1) != LUA_T_NIL)
429	return;
430	L->stack.top--; /* remove result */
431	}
432	}
433	}
434
435
436	static void luaB_foreachvar (void) {
437	GCnode *g;
438	TObject f; /* see comment in 'foreachi' */
439	f = *luaA_Address(luaL_functionarg(1));
440	luaD_checkstack(4); /* for extra var name, f, var name, and globalval */
441	for (g = L->rootglobal.next; g; g = g->next) {
442	TaggedString s = (TaggedString )g;
443	if (s->u.s.globalval.ttype != LUA_T_NIL) {
444	pushtagstring(s); /* keep (extra) s on stack to avoid GC */
445	*(L->stack.top++) = f;
446	pushtagstring(s);
447	*(L->stack.top++) = s->u.s.globalval;
448	luaD_calln(2, 1);
449	if (ttype(L->stack.top-1) != LUA_T_NIL) {
450	L->stack.top--;
451	(L->stack.top-1) = L->stack.top; /* remove extra s */
452	return;
453	}
454	L->stack.top-=2; /* remove result and extra s */
455	}
456	}
457	}
458
459
460	static void luaB_getn (void) {
461	lua_pushnumber(getnarg(gethash(1)));
462	}
463
464
465	static void luaB_tinsert (void) {
466	Hash *a = gethash(1);
467	lua_Object v = lua_getparam(3);
468	int n = (int)getnarg(a);
469	int pos;
470	if (v != LUA_NOOBJECT)
471	pos = luaL_check_int(2);
472	else { /* called with only 2 arguments */
473	v = luaL_nonnullarg(2);
474	pos = n+1;
475	}
476	luaV_setn(a, n+1); /* a.n = n+1 */
477	for ( ;n>=pos; n--)
478	luaH_move(a, n, n+1); /* a[n+1] = a[n] */
479	luaH_setint(a, pos, luaA_Address(v)); /* a[pos] = v */
480	}
481
482
483	static void luaB_tremove (void) {
484	Hash *a = gethash(1);
485	int n = (int)getnarg(a);
486	int pos = luaL_opt_int(2, n);
487	if (n <= 0) return; /* table is "empty" */
488	luaA_pushobject(luaH_getint(a, pos)); /* result = a[pos] */
489	for ( ;pos<n; pos++)
490	luaH_move(a, pos+1, pos); /* a[pos] = a[pos+1] */
491	luaV_setn(a, n-1); /* a.n = n-1 */
492	luaH_setint(a, n, &luaO_nilobject); /* a[n] = nil */
493	}
494
495
496	/* {
497	** Quicksort
498	*/
499
500	static void swap (Hash *a, int i, int j) {
501	TObject temp;
502	temp = *luaH_getint(a, i);
503	luaH_move(a, j, i);
504	luaH_setint(a, j, &temp);
505	}
506
507	static int sort_comp (lua_Object f, TObject a, TObject b) {
508	/* notice: the caller (auxsort) must check stack space */
509	if (f != LUA_NOOBJECT) {
510	(L->stack.top) = luaA_Address(f);
511	(L->stack.top+1) = a;
512	(L->stack.top+2) = b;
513	L->stack.top += 3;
514	luaD_calln(2, 1);
515	}
516	else { /* a < b? */
517	(L->stack.top) = a;
518	(L->stack.top+1) = b;
519	L->stack.top += 2;
520	luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
521	}
522	return ttype(--(L->stack.top)) != LUA_T_NIL;
523	}
524
525	static void auxsort (Hash *a, int l, int u, lua_Object f) {
526	while (l < u) { /* for tail recursion */
527	TObject *P;
528	int i, j;
529	/* sort elements a[l], a[(l+u)/2] and a[u] */
530	if (sort_comp(f, luaH_getint(a, u), luaH_getint(a, l))) /* a[l]>a[u]? */
531	swap(a, l, u);
532	if (u-l == 1) break; /* only 2 elements */
533	i = (l+u)/2;
534	P = luaH_getint(a, i);
535	if (sort_comp(f, P, luaH_getint(a, l))) /* a[l]>a[i]? */
536	swap(a, l, i);
537	else if (sort_comp(f, luaH_getint(a, u), P)) /* a[i]>a[u]? */
538	swap(a, i, u);
539	if (u-l == 2) break; /* only 3 elements */
540	P = L->stack.top++;
541	P = luaH_getint(a, i); /* save pivot on stack (for GC) */
542	swap(a, i, u-1); /* put median element as pivot (a[u-1]) */
543	/* a[l] <= P == a[u-1] <= a[u], only needs to sort from l+1 to u-2 */
544	i = l; j = u-1;
545	for (;;) {
546	/* invariant: a[l..i] <= P <= a[j..u] */
547	while (sort_comp(f, luaH_getint(a, ++i), P)) /* stop when a[i] >= P */
548	if (i>u) lua_error("invalid order function for sorting");
549	while (sort_comp(f, P, luaH_getint(a, --j))) /* stop when a[j] <= P */
550	if (j<l) lua_error("invalid order function for sorting");
551	if (j<i) break;
552	swap(a, i, j);
553	}
554	swap(a, u-1, i); /* swap pivot (a[u-1]) with a[i] */
555	L->stack.top--; /* remove pivot from stack */
556	/* a[l..i-1] <= a[i] == P <= a[i+1..u] */
557	/* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */
558	if (i-l < u-i) {
559	j=l; i=i-1; l=i+2;
560	}
561	else {
562	j=i+1; i=u; u=j-2;
563	}
564	auxsort(a, j, i, f); /* call recursively the smaller one */
565	} /* repeat the routine for the larger one */
566	}
567
568	static void luaB_sort (void) {
569	lua_Object t = lua_getparam(1);
570	Hash *a = gethash(1);
571	int n = (int)getnarg(a);
572	lua_Object func = lua_getparam(2);
573	luaL_arg_check(func == LUA_NOOBJECT \|\| lua_isfunction(func), 2,
574	"function expected");
575	luaD_checkstack(4); /* for Pivot, f, a, b (sort_comp) */
576	auxsort(a, 1, n, func);
577	lua_pushobject(t);
578	}
579
580	/* }}===================================================== */
581
582
583	/*
584	** ====================================================== */
585
586
587
588	#ifdef DEBUG
589	/*
590	** {======================================================
591	** some DEBUG functions
592	** =======================================================
593	*/
594
595	static void mem_query (void) {
596	lua_pushnumber(totalmem);
597	lua_pushnumber(numblocks);
598	}
599
600
601	static void query_strings (void) {
602	lua_pushnumber(L->string_root[luaL_check_int(1)].nuse);
603	}
604
605
606	static void countlist (void) {
607	char *s = luaL_check_string(1);
608	GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next :
609	(s[0]=='p') ? L->rootproto.next : L->rootglobal.next;
610	int i=0;
611	while (l) {
612	i++;
613	l = l->next;
614	}
615	lua_pushnumber(i);
616	}
617
618
619	static void testC (void) {
620	#define getnum(s) ((*s++) - '0')
621	#define getname(s) (nome[0] = *s++, nome)
622
623	static int locks[10];
624	lua_Object reg[10];
625	char nome[2];
626	char *s = luaL_check_string(1);
627	nome[1] = 0;
628	for (;;) {
629	switch (*s++) {
630	case '0': case '1': case '2': case '3': case '4':
631	case '5': case '6': case '7': case '8': case '9':
632	lua_pushnumber(*(s-1) - '0');
633	break;
634
635	case 'c': reg[getnum(s)] = lua_createtable(); break;
636	case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s)));
637	lua_pushcclosure(f, getnum(s));
638	break;
639	}
640	case 'P': reg[getnum(s)] = lua_pop(); break;
641	case 'g': { int n=getnum(s); reg[n]=lua_getglobal(getname(s)); break; }
642	case 'G': { int n = getnum(s);
643	reg[n] = lua_rawgetglobal(getname(s));
644	break;
645	}
646	case 'l': locks[getnum(s)] = lua_ref(1); break;
647	case 'L': locks[getnum(s)] = lua_ref(0); break;
648	case 'r': { int n=getnum(s); reg[n]=lua_getref(locks[getnum(s)]); break; }
649	case 'u': lua_unref(locks[getnum(s)]); break;
650	case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
651	case '=': lua_setglobal(getname(s)); break;
652	case 's': lua_pushstring(getname(s)); break;
653	case 'o': lua_pushobject(reg[getnum(s)]); break;
654	case 'f': lua_call(getname(s)); break;
655	case 'i': reg[getnum(s)] = lua_gettable(); break;
656	case 'I': reg[getnum(s)] = lua_rawgettable(); break;
657	case 't': lua_settable(); break;
658	case 'T': lua_rawsettable(); break;
659	case 'N' : lua_pushstring(lua_nextvar(lua_getstring(reg[getnum(s)])));
660	break;
661	case 'n' : { int n=getnum(s);
662	n=lua_next(reg[n], (int)lua_getnumber(reg[getnum(s)]));
663	lua_pushnumber(n); break;
664	}
665	default: luaL_verror("unknown command in `testC': %c", *(s-1));
666	}
667	if (*s == 0) return;
668	if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
669	}
670	}
671
672	/* }====================================================== */
673	#endif
674
675
676
677	static struct luaL_reg builtin_funcs[] = {
678	#ifdef LUA_COMPAT2_5
679	{"setfallback", luaT_setfallback},
680	#endif
681	#ifdef DEBUG
682	{"testC", testC},
683	{"totalmem", mem_query},
684	{"count", countlist},
685	{"querystr", query_strings},
686	#endif
687	{"_ALERT", luaB_alert},
688	{"_ERRORMESSAGE", error_message},
689	{"call", luaB_call},
690	{"collectgarbage", luaB_collectgarbage},
691	{"copytagmethods", luaB_copytagmethods},
692	{"dofile", luaB_dofile},
693	{"dostring", luaB_dostring},
694	{"error", luaB_error},
695	{"getglobal", luaB_getglobal},
696	{"gettagmethod", luaB_gettagmethod},
697	{"newtag", luaB_newtag},
698	{"next", luaB_next},
699	{"nextvar", luaB_nextvar},
700	{"print", luaB_print},
701	{"rawgetglobal", luaB_rawgetglobal},
702	{"rawgettable", luaB_rawgettable},
703	{"rawsetglobal", luaB_rawsetglobal},
704	{"rawsettable", luaB_rawsettable},
705	{"seterrormethod", luaB_seterrormethod},
706	{"setglobal", luaB_setglobal},
707	{"settag", luaB_settag},
708	{"settagmethod", luaB_settagmethod},
709	{"tag", luaB_luatag},
710	{"tonumber", luaB_tonumber},
711	{"tostring", luaB_tostring},
712	{"type", luaB_type},
713	/* "Extra" functions */
714	{"assert", luaB_assert},
715	{"foreach", luaB_foreach},
716	{"foreachi", luaB_foreachi},
717	{"foreachvar", luaB_foreachvar},
718	{"getn", luaB_getn},
719	{"sort", luaB_sort},
720	{"tinsert", luaB_tinsert},
721	{"tremove", luaB_tremove}
722	};
723
724
725	#define INTFUNCSIZE (sizeof(builtin_funcs)/sizeof(builtin_funcs[0]))
726
727
728	void luaB_predefine (void) {
729	/* pre-register mem error messages, to avoid loop when error arises */
730	luaS_newfixedstring(tableEM);
731	luaS_newfixedstring(memEM);
732	luaL_openlib(builtin_funcs, (sizeof(builtin_funcs)/sizeof(builtin_funcs[0])));
733	lua_pushstring(LUA_VERSION);
734	lua_setglobal("_VERSION");
735	}
736

src/lbuiltin.h+0−14

@@ -1,14 +0,0 @@
1	/*
2	** $Id: lbuiltin.h,v 1.1 1997/09/16 19:25:59 roberto Exp $
3	** Built-in functions
4	** See Copyright Notice in lua.h
5	*/
6
7	#ifndef lbuiltin_h
8	#define lbuiltin_h
9
10
11	void luaB_predefine (void);
12
13
14	#endif

src/lcode.c+701−0

@@ -0,0 +1,701 @@
	1	/*
	2	** $Id: lcode.c,v 1.51 2000/09/29 12:42:13 roberto Exp $
	3	** Code generator for Lua
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7
	8	#include "stdlib.h"
	9
	10	#include "lua.h"
	11
	12	#include "lcode.h"
	13	#include "ldo.h"
	14	#include "llex.h"
	15	#include "lmem.h"
	16	#include "lobject.h"
	17	#include "lopcodes.h"
	18	#include "lparser.h"
	19
	20
	21	void luaK_error (LexState ls, const char msg) {
	22	luaX_error(ls, msg, ls->t.token);
	23	}
	24
	25
	26	/*
	27	** Returns the the previous instruction, for optimizations.
	28	** If there is a jump target between this and the current instruction,
	29	** returns a dummy instruction to avoid wrong optimizations.
	30	*/
	31	static Instruction previous_instruction (FuncState *fs) {
	32	if (fs->pc > fs->lasttarget) /* no jumps to current position? */
	33	return fs->f->code[fs->pc-1]; /* returns previous instruction */
	34	else
	35	return CREATE_0(OP_END); /* no optimizations after an `END' */
	36	}
	37
	38
	39	int luaK_jump (FuncState *fs) {
	40	int j = luaK_code1(fs, OP_JMP, NO_JUMP);
	41	if (j == fs->lasttarget) { /* possible jumps to this jump? */
	42	luaK_concat(fs, &j, fs->jlt); /* keep them on hold */
	43	fs->jlt = NO_JUMP;
	44	}
	45	return j;
	46	}
	47
	48
	49	static void luaK_fixjump (FuncState *fs, int pc, int dest) {
	50	Instruction *jmp = &fs->f->code[pc];
	51	if (dest == NO_JUMP)
	52	SETARG_S(jmp, NO_JUMP); / point to itself to represent end of list */
	53	else { /* jump is relative to position following jump instruction */
	54	int offset = dest-(pc+1);
	55	if (abs(offset) > MAXARG_S)
	56	luaK_error(fs->ls, "control structure too long");
	57	SETARG_S(*jmp, offset);
	58	}
	59	}
	60
	61
	62	static int luaK_getjump (FuncState *fs, int pc) {
	63	int offset = GETARG_S(fs->f->code[pc]);
	64	if (offset == NO_JUMP) /* point to itself represents end of list */
	65	return NO_JUMP; /* end of list */
	66	else
	67	return (pc+1)+offset; /* turn offset into absolute position */
	68	}
	69
	70
	71	/*
	72	** returns current `pc' and marks it as a jump target (to avoid wrong
	73	** optimizations with consecutive instructions not in the same basic block).
	74	** discharge list of jumps to last target.
	75	*/
	76	int luaK_getlabel (FuncState *fs) {
	77	if (fs->pc != fs->lasttarget) {
	78	int lasttarget = fs->lasttarget;
	79	fs->lasttarget = fs->pc;
	80	luaK_patchlist(fs, fs->jlt, lasttarget); /* discharge old list `jlt' */
	81	fs->jlt = NO_JUMP; /* nobody jumps to this new label (yet) */
	82	}
	83	return fs->pc;
	84	}
	85
	86
	87	void luaK_deltastack (FuncState *fs, int delta) {
	88	fs->stacklevel += delta;
	89	if (fs->stacklevel > fs->f->maxstacksize) {
	90	if (fs->stacklevel > MAXSTACK)
	91	luaK_error(fs->ls, "function or expression too complex");
	92	fs->f->maxstacksize = fs->stacklevel;
	93	}
	94	}
	95
	96
	97	void luaK_kstr (LexState *ls, int c) {
	98	luaK_code1(ls->fs, OP_PUSHSTRING, c);
	99	}
	100
	101
	102	static int number_constant (FuncState *fs, Number r) {
	103	/* check whether `r' has appeared within the last LOOKBACKNUMS entries */
	104	Proto *f = fs->f;
	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	}
	124
	125
	126	void luaK_adjuststack (FuncState *fs, int n) {
	127	if (n > 0)
	128	luaK_code1(fs, OP_POP, n);
	129	else
	130	luaK_code1(fs, OP_PUSHNIL, -n);
	131	}
	132
	133
	134	int luaK_lastisopen (FuncState *fs) {
	135	/* check whether last instruction is an open function call */
	136	Instruction i = previous_instruction(fs);
	137	if (GET_OPCODE(i) == OP_CALL && GETARG_B(i) == MULT_RET)
	138	return 1;
	139	else return 0;
	140	}
	141
	142
	143	void luaK_setcallreturns (FuncState *fs, int nresults) {
	144	if (luaK_lastisopen(fs)) { /* expression is an open function call? */
	145	SETARG_B(fs->f->code[fs->pc-1], nresults); /* set number of results */
	146	luaK_deltastack(fs, nresults); /* push results */
	147	}
	148	}
	149
	150
	151	static int discharge (FuncState fs, expdesc var) {
	152	switch (var->k) {
	153	case VLOCAL:
	154	luaK_code1(fs, OP_GETLOCAL, var->u.index);
	155	break;
	156	case VGLOBAL:
	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	}
	165	var->k = VEXP;
	166	var->u.l.t = var->u.l.f = NO_JUMP;
	167	return 1;
	168	}
	169
	170
	171	static void discharge1 (FuncState fs, expdesc var) {
	172	discharge(fs, var);
	173	/* if it has jumps then it is already discharged */
	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	}
	177
	178
	179	void luaK_storevar (LexState ls, const expdesc var) {
	180	FuncState *fs = ls->fs;
	181	switch (var->k) {
	182	case VLOCAL:
	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	}
	194	}
	195
	196
	197	static OpCode invertjump (OpCode op) {
	198	switch (op) {
	199	case OP_JMPNE: return OP_JMPEQ;
	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	}
	212
	213
	214	static void luaK_patchlistaux (FuncState *fs, int list, int target,
	215	OpCode special, int special_target) {
	216	Instruction *code = fs->f->code;
	217	while (list != NO_JUMP) {
	218	int next = luaK_getjump(fs, list);
	219	Instruction *i = &code[list];
	220	OpCode op = GET_OPCODE(*i);
	221	if (op == special) /* this `op' already has a value */
	222	luaK_fixjump(fs, list, special_target);
	223	else {
	224	luaK_fixjump(fs, list, target); /* do the patch */
	225	if (op == OP_JMPONT) /* remove eventual values */
	226	SET_OPCODE(*i, OP_JMPT);
	227	else if (op == OP_JMPONF)
	228	SET_OPCODE(*i, OP_JMPF);
	229	}
	230	list = next;
	231	}
	232	}
	233
	234
	235	void luaK_patchlist (FuncState *fs, int list, int target) {
	236	if (target == fs->lasttarget) /* same target that list `jlt'? */
	237	luaK_concat(fs, &fs->jlt, list); /* delay fixing */
	238	else
	239	luaK_patchlistaux(fs, list, target, OP_END, 0);
	240	}
	241
	242
	243	static int need_value (FuncState *fs, int list, OpCode hasvalue) {
	244	/* check whether list has a jump without a value */
	245	for (; list != NO_JUMP; list = luaK_getjump(fs, list))
	246	if (GET_OPCODE(fs->f->code[list]) != hasvalue) return 1;
	247	return 0; /* not found */
	248	}
	249
	250
	251	void luaK_concat (FuncState fs, int l1, int l2) {
	252	if (*l1 == NO_JUMP)
	253	*l1 = l2;
	254	else {
	255	int list = *l1;
	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	}
	266
	267
	268	static void luaK_testgo (FuncState fs, expdesc v, int invert, OpCode jump) {
	269	int prevpos; /* position of last instruction */
	270	Instruction *previous;
	271	int golist, exitlist;
	272	if (!invert) {
	273	golist = &v->u.l.f; /* go if false */
	274	exitlist = &v->u.l.t; /* exit if true */
	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	}
	290	luaK_concat(fs, exitlist, prevpos); /* insert last jump in `exitlist' */
	291	luaK_patchlist(fs, *golist, luaK_getlabel(fs));
	292	*golist = NO_JUMP;
	293	}
	294
	295
	296	void luaK_goiftrue (FuncState fs, expdesc v, int keepvalue) {
	297	luaK_testgo(fs, v, 1, keepvalue ? OP_JMPONF : OP_JMPF);
	298	}
	299
	300
	301	static void luaK_goiffalse (FuncState fs, expdesc v, int keepvalue) {
	302	luaK_testgo(fs, v, 0, keepvalue ? OP_JMPONT : OP_JMPT);
	303	}
	304
	305
	306	static int code_label (FuncState *fs, OpCode op, int arg) {
	307	luaK_getlabel(fs); /* those instructions may be jump targets */
	308	return luaK_code1(fs, op, arg);
	309	}
	310
	311
	312	void luaK_tostack (LexState ls, expdesc v, int onlyone) {
	313	FuncState *fs = ls->fs;
	314	if (!discharge(fs, v)) { /* `v' is an expression? */
	315	OpCode previous = GET_OPCODE(fs->f->code[fs->pc-1]);
	316	if (!ISJUMP(previous) && v->u.l.f == NO_JUMP && v->u.l.t == NO_JUMP) {
	317	/* expression has no jumps */
	318	if (onlyone)
	319	luaK_setcallreturns(fs, 1); /* call must return 1 value */
	320	}
	321	else { /* expression has jumps */
	322	int final; /* position after whole expression */
	323	int j = NO_JUMP; /* eventual jump over values */
	324	int p_nil = NO_JUMP; /* position of an eventual PUSHNIL */
	325	int p_1 = NO_JUMP; /* position of an eventual PUSHINT */
	326	if (ISJUMP(previous) \|\| need_value(fs, v->u.l.f, OP_JMPONF)
	327	\|\| need_value(fs, v->u.l.t, OP_JMPONT)) {
	328	/* expression needs values */
	329	if (ISJUMP(previous))
	330	luaK_concat(fs, &v->u.l.t, fs->pc-1); /* put `previous' in t. list */
	331	else {
	332	j = code_label(fs, OP_JMP, NO_JUMP); /* to jump over both pushes */
	333	/* correct stack for compiler and symbolic execution */
	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	}
	345	}
	346	}
	347
	348
	349	void luaK_prefix (LexState ls, UnOpr op, expdesc v) {
	350	FuncState *fs = ls->fs;
	351	if (op == OPR_MINUS) {
	352	luaK_tostack(ls, v, 1);
	353	luaK_code0(fs, OP_MINUS);
	354	}
	355	else { /* op == NOT */
	356	Instruction *previous;
	357	discharge1(fs, v);
	358	previous = &fs->f->code[fs->pc-1];
	359	if (ISJUMP(GET_OPCODE(*previous)))
	360	SET_OPCODE(previous, invertjump(GET_OPCODE(previous)));
	361	else
	362	luaK_code0(fs, OP_NOT);
	363	/* interchange true and false lists */
	364	{ int temp = v->u.l.f; v->u.l.f = v->u.l.t; v->u.l.t = temp; }
	365	}
	366	}
	367
	368
	369	void luaK_infix (LexState ls, BinOpr op, expdesc v) {
	370	FuncState *fs = ls->fs;
	371	switch (op) {
	372	case OPR_AND:
	373	luaK_goiftrue(fs, v, 1);
	374	break;
	375	case OPR_OR:
	376	luaK_goiffalse(fs, v, 1);
	377	break;
	378	default:
	379	luaK_tostack(ls, v, 1); /* all other binary operators need a value */
	380	}
	381	}
	382
	383
	384
	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
	396
	397	void luaK_posfix (LexState ls, BinOpr op, expdesc v1, expdesc *v2) {
	398	FuncState *fs = ls->fs;
	399	switch (op) {
	400	case OPR_AND: {
	401	LUA_ASSERT(v1->u.l.t == NO_JUMP, "list must be closed");
	402	discharge1(fs, v2);
	403	v1->u.l.t = v2->u.l.t;
	404	luaK_concat(fs, &v1->u.l.f, v2->u.l.f);
	405	break;
	406	}
	407	case OPR_OR: {
	408	LUA_ASSERT(v1->u.l.f == NO_JUMP, "list must be closed");
	409	discharge1(fs, v2);
	410	v1->u.l.f = v2->u.l.f;
	411	luaK_concat(fs, &v1->u.l.t, v2->u.l.t);
	412	break;
	413	}
	414	default: {
	415	luaK_tostack(ls, v2, 1); /* `v2' must be a value */
	416	luaK_code1(fs, codes[op].opcode, codes[op].arg);
	417	}
	418	}
	419	}
	420
	421
	422	static void codelineinfo (FuncState *fs) {
	423	Proto *f = fs->f;
	424	LexState *ls = fs->ls;
	425	if (ls->lastline > fs->lastline) {
	426	luaM_growvector(fs->L, f->lineinfo, f->nlineinfo, 2, int,
	427	"line info overflow", MAX_INT);
	428	if (ls->lastline > fs->lastline+1)
	429	f->lineinfo[f->nlineinfo++] = -(ls->lastline - (fs->lastline+1));
	430	f->lineinfo[f->nlineinfo++] = fs->pc;
	431	fs->lastline = ls->lastline;
	432	}
	433	}
	434
	435
	436	int luaK_code0 (FuncState *fs, OpCode o) {
	437	return luaK_code2(fs, o, 0, 0);
	438	}
	439
	440
	441	int luaK_code1 (FuncState *fs, OpCode o, int arg1) {
	442	return luaK_code2(fs, o, arg1, 0);
	443	}
	444
	445
	446	int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2) {
	447	Instruction i = previous_instruction(fs);
	448	int delta = luaK_opproperties[o].push - luaK_opproperties[o].pop;
	449	int optm = 0; /* 1 when there is an optimization */
	450	switch (o) {
	451	case OP_CLOSURE: {
	452	delta = -arg2+1;
	453	break;
	454	}
	455	case OP_SETTABLE: {
	456	delta = -arg2;
	457	break;
	458	}
	459	case OP_SETLIST: {
	460	if (arg2 == 0) return NO_JUMP; /* nothing to do */
	461	delta = -arg2;
	462	break;
	463	}
	464	case OP_SETMAP: {
	465	if (arg1 == 0) return NO_JUMP; /* nothing to do */
	466	delta = -2*arg1;
	467	break;
	468	}
	469	case OP_RETURN: {
	470	if (GET_OPCODE(i) == OP_CALL && GETARG_B(i) == MULT_RET) {
	471	SET_OPCODE(i, OP_TAILCALL);
	472	SETARG_B(i, arg1);
	473	optm = 1;
	474	}
	475	break;
	476	}
	477	case OP_PUSHNIL: {
	478	if (arg1 == 0) return NO_JUMP; /* nothing to do */
	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;
	485	}
	486	case OP_POP: {
	487	if (arg1 == 0) return NO_JUMP; /* nothing to do */
	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;
	494	}
	495	case OP_GETTABLE: {
	496	switch(GET_OPCODE(i)) {
	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;
	508	}
	509	case OP_ADD: {
	510	switch(GET_OPCODE(i)) {
	511	case OP_PUSHINT: SET_OPCODE(i, OP_ADDI); optm = 1; break; /* `a+k' */
	512	default: break;
	513	}
	514	break;
	515	}
	516	case OP_SUB: {
	517	switch(GET_OPCODE(i)) {
	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;
	525	}
	526	case OP_CONCAT: {
	527	delta = -arg1+1;
	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;
	536	}
	537	case OP_MINUS: {
	538	switch(GET_OPCODE(i)) {
	539	case OP_PUSHINT: /* `-k' */
	540	SETARG_S(i, -GETARG_S(i));
	541	optm = 1;
	542	break;
	543	case OP_PUSHNUM: /* `-k' */
	544	SET_OPCODE(i, OP_PUSHNEGNUM);
	545	optm = 1;
	546	break;
	547	default: break;
	548	}
	549	break;
	550	}
	551	case OP_JMPNE: {
	552	if (i == CREATE_U(OP_PUSHNIL, 1)) { /* `a~=nil' */
	553	i = CREATE_S(OP_JMPT, NO_JUMP);
	554	optm = 1;
	555	}
	556	break;
	557	}
	558	case OP_JMPEQ: {
	559	if (i == CREATE_U(OP_PUSHNIL, 1)) { /* `a==nil' */
	560	i = CREATE_0(OP_NOT);
	561	delta = -1; /* just undo effect of previous PUSHNIL */
	562	optm = 1;
	563	}
	564	break;
	565	}
	566	case OP_JMPT:
	567	case OP_JMPONT: {
	568	switch (GET_OPCODE(i)) {
	569	case OP_NOT: {
	570	i = CREATE_S(OP_JMPF, NO_JUMP);
	571	optm = 1;
	572	break;
	573	}
	574	case OP_PUSHINT: {
	575	if (o == OP_JMPT) { /* JMPONT must keep original integer value */
	576	i = CREATE_S(OP_JMP, NO_JUMP);
	577	optm = 1;
	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;
	592	}
	593	case OP_JMPF:
	594	case OP_JMPONF: {
	595	switch (GET_OPCODE(i)) {
	596	case OP_NOT: {
	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;
	616	}
	617	case OP_GETDOTTED:
	618	case OP_GETINDEXED:
	619	case OP_TAILCALL:
	620	case OP_ADDI: {
	621	LUA_INTERNALERROR("instruction used only for optimizations");
	622	break;
	623	}
	624	default: {
	625	LUA_ASSERT(delta != VD, "invalid delta");
	626	break;
	627	}
	628	}
	629	luaK_deltastack(fs, delta);
	630	if (optm) { /* optimize: put instruction in place of last one */
	631	fs->f->code[fs->pc-1] = i; /* change previous instruction */
	632	return fs->pc-1; /* do not generate new instruction */
	633	}
	634	/* else build new instruction */
	635	switch ((enum Mode)luaK_opproperties[o].mode) {
	636	case iO: i = CREATE_0(o); break;
	637	case iU: i = CREATE_U(o, arg1); break;
	638	case iS: i = CREATE_S(o, arg1); break;
	639	case iAB: i = CREATE_AB(o, arg1, arg2); break;
	640	}
	641	codelineinfo(fs);
	642	/* put new instruction in code array */
	643	luaM_growvector(fs->L, fs->f->code, fs->pc, 1, Instruction,
	644	"code size overflow", MAX_INT);
	645	fs->f->code[fs->pc] = i;
	646	return fs->pc++;
	647	}
	648
	649
	650	const struct OpProperties luaK_opproperties[NUM_OPCODES] = {
	651	{iO, 0, 0}, /* OP_END */
	652	{iU, 0, 0}, /* OP_RETURN */
	653	{iAB, 0, 0}, /* OP_CALL */
	654	{iAB, 0, 0}, /* OP_TAILCALL */
	655	{iU, VD, 0}, /* OP_PUSHNIL */
	656	{iU, VD, 0}, /* OP_POP */
	657	{iS, 1, 0}, /* OP_PUSHINT */
	658	{iU, 1, 0}, /* OP_PUSHSTRING */
	659	{iU, 1, 0}, /* OP_PUSHNUM */
	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

src/lcode.h+70−0

@@ -0,0 +1,70 @@
	1	/*
	2	** $Id: lcode.h,v 1.16 2000/08/09 14:49:13 roberto Exp $
	3	** Code generator for Lua
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7	#ifndef lcode_h
	8	#define lcode_h
	9
	10	#include "llex.h"
	11	#include "lobject.h"
	12	#include "lopcodes.h"
	13	#include "lparser.h"
	14
	15
	16	/*
	17	** Marks the end of a patch list. It is an invalid value both as an absolute
	18	** address, and as a list link (would link an element to itself).
	19	*/
	20	#define NO_JUMP (-1)
	21
	22
	23	/*
	24	** grep "ORDER OPR" if you change these enums
	25	*/
	26	typedef enum BinOpr {
	27	OPR_ADD, OPR_SUB, OPR_MULT, OPR_DIV, OPR_POW,
	28	OPR_CONCAT,
	29	OPR_NE, OPR_EQ, OPR_LT, OPR_LE, OPR_GT, OPR_GE,
	30	OPR_AND, OPR_OR,
	31	OPR_NOBINOPR
	32	} BinOpr;
	33
	34	typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_NOUNOPR } UnOpr;
	35
	36
	37	enum Mode {iO, iU, iS, iAB}; /* instruction format */
	38
	39	#define VD 100 /* flag for variable delta */
	40
	41	extern const struct OpProperties {
	42	char mode;
	43	unsigned char push;
	44	unsigned char pop;
	45	} luaK_opproperties[];
	46
	47
	48	void luaK_error (LexState ls, const char msg);
	49	int luaK_code0 (FuncState *fs, OpCode o);
	50	int luaK_code1 (FuncState *fs, OpCode o, int arg1);
	51	int luaK_code2 (FuncState *fs, OpCode o, int arg1, int arg2);
	52	int luaK_jump (FuncState *fs);
	53	void luaK_patchlist (FuncState *fs, int list, int target);
	54	void luaK_concat (FuncState fs, int l1, int l2);
	55	void luaK_goiftrue (FuncState fs, expdesc v, int keepvalue);
	56	int luaK_getlabel (FuncState *fs);
	57	void luaK_deltastack (FuncState *fs, int delta);
	58	void luaK_kstr (LexState *ls, int c);
	59	void luaK_number (FuncState *fs, Number f);
	60	void luaK_adjuststack (FuncState *fs, int n);
	61	int luaK_lastisopen (FuncState *fs);
	62	void luaK_setcallreturns (FuncState *fs, int nresults);
	63	void luaK_tostack (LexState ls, expdesc v, int onlyone);
	64	void luaK_storevar (LexState ls, const expdesc var);
	65	void luaK_prefix (LexState ls, UnOpr op, expdesc v);
	66	void luaK_infix (LexState ls, BinOpr op, expdesc v);
	67	void luaK_posfix (LexState ls, BinOpr op, expdesc v1, expdesc *v2);
	68
	69
	70	#endif

src/ldebug.c+466−0

@@ -0,0 +1,466 @@
	1	/*
	2	** $Id: ldebug.c,v 1.50 2000/10/30 12:38:50 roberto Exp $
	3	** Debug Interface
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7
	8	#include <stdlib.h>
	9
	10	#include "lua.h"
	11
	12	#include "lapi.h"
	13	#include "lcode.h"
	14	#include "ldebug.h"
	15	#include "ldo.h"
	16	#include "lfunc.h"
	17	#include "lobject.h"
	18	#include "lopcodes.h"
	19	#include "lstate.h"
	20	#include "lstring.h"
	21	#include "ltable.h"
	22	#include "ltm.h"
	23	#include "luadebug.h"
	24
	25
	26
	27	static const char getfuncname (lua_State L, StkId f, const char **name);
	28
	29
	30	static void setnormalized (TObject d, const TObject s) {
	31	if (ttype(s) == LUA_TMARK) {
	32	clvalue(d) = infovalue(s)->func;
	33	ttype(d) = LUA_TFUNCTION;
	34	}
	35	else d = s;
	36	}
	37
	38
	39	static int isLmark (StkId o) {
	40	return (o && ttype(o) == LUA_TMARK && !infovalue(o)->func->isC);
	41	}
	42
	43
	44	LUA_API lua_Hook lua_setcallhook (lua_State *L, lua_Hook func) {
	45	lua_Hook oldhook = L->callhook;
	46	L->callhook = func;
	47	return oldhook;
	48	}
	49
	50
	51	LUA_API lua_Hook lua_setlinehook (lua_State *L, lua_Hook func) {
	52	lua_Hook oldhook = L->linehook;
	53	L->linehook = func;
	54	return oldhook;
	55	}
	56
	57
	58	static StkId aux_stackedfunction (lua_State *L, int level, StkId top) {
	59	int i;
	60	for (i = (top-1) - L->stack; i>=0; i--) {
	61	if (is_T_MARK(L->stack[i].ttype)) {
	62	if (level == 0)
	63	return L->stack+i;
	64	level--;
	65	}
	66	}
	67	return NULL;
	68	}
	69
	70
	71	LUA_API int lua_getstack (lua_State L, int level, lua_Debug ar) {
	72	StkId f = aux_stackedfunction(L, level, L->top);
	73	if (f == NULL) return 0; /* there is no such level */
	74	else {
	75	ar->_func = f;
	76	return 1;
	77	}
	78	}
	79
	80
	81	static int nups (StkId f) {
	82	switch (ttype(f)) {
	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	}
	91
	92
	93	int luaG_getline (int lineinfo, int pc, int refline, int prefi) {
	94	int refi;
	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	}
	122
	123
	124	static int currentpc (StkId f) {
	125	CallInfo *ci = infovalue(f);
	126	LUA_ASSERT(isLmark(f), "function has no pc");
	127	if (ci->pc)
	128	return (*ci->pc - ci->func->f.l->code) - 1;
	129	else
	130	return -1; /* function is not active */
	131	}
	132
	133
	134	static int currentline (StkId f) {
	135	if (!isLmark(f))
	136	return -1; /* only active lua functions have current-line information */
	137	else {
	138	CallInfo *ci = infovalue(f);
	139	int *lineinfo = ci->func->f.l->lineinfo;
	140	return luaG_getline(lineinfo, currentpc(f), 1, NULL);
	141	}
	142	}
	143
	144
	145
	146	static Proto *getluaproto (StkId f) {
	147	return (isLmark(f) ? infovalue(f)->func->f.l : NULL);
	148	}
	149
	150
	151	LUA_API const char lua_getlocal (lua_State L, const lua_Debug *ar, int n) {
	152	const char *name;
	153	StkId f = ar->_func;
	154	Proto *fp = getluaproto(f);
	155	if (!fp) return NULL; /* `f' is not a Lua function? */
	156	name = luaF_getlocalname(fp, n, currentpc(f));
	157	if (!name) return NULL;
	158	luaA_pushobject(L, (f+1)+(n-1)); /* push value */
	159	return name;
	160	}
	161
	162
	163	LUA_API const char lua_setlocal (lua_State L, const lua_Debug *ar, int n) {
	164	const char *name;
	165	StkId f = ar->_func;
	166	Proto *fp = getluaproto(f);
	167	L->top--; /* pop new value */
	168	if (!fp) return NULL; /* `f' is not a Lua function? */
	169	name = luaF_getlocalname(fp, n, currentpc(f));
	170	if (!name \|\| name[0] == '(') return NULL; /* `(' starts private locals */
	171	((f+1)+(n-1)) = L->top;
	172	return name;
	173	}
	174
	175
	176	static void infoLproto (lua_Debug ar, Proto f) {
	177	ar->source = f->source->str;
	178	ar->linedefined = f->lineDefined;
	179	ar->what = "Lua";
	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;
	198	ar->what = "C";
	199	}
	200	else
	201	infoLproto(ar, cl->f.l);
	202	luaO_chunkid(ar->short_src, ar->source, sizeof(ar->short_src));
	203	if (ar->linedefined == 0)
	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	}
	218	return NULL;
	219	}
	220
	221
	222	static const char travglobals (lua_State L, const TObject *o) {
	223	Hash *g = L->gt;
	224	int i;
	225	for (i=0; i<g->size; i++) {
	226	if (luaO_equalObj(o, val(node(g, i))) &&
	227	ttype(key(node(g, i))) == LUA_TSTRING)
	228	return tsvalue(key(node(g, i)))->str;
	229	}
	230	return NULL;
	231	}
	232
	233
	234	static void getname (lua_State L, StkId f, lua_Debug ar) {
	235	TObject o;
	236	setnormalized(&o, f);
	237	/* try to find a name for given function */
	238	if ((ar->name = travglobals(L, &o)) != NULL)
	239	ar->namewhat = "global";
	240	/* not found: try tag methods */
	241	else if ((ar->name = travtagmethods(L, &o)) != NULL)
	242	ar->namewhat = "tag-method";
	243	else ar->namewhat = ""; /* not found at all */
	244	}
	245
	246
	247	LUA_API int lua_getinfo (lua_State L, const char what, lua_Debug *ar) {
	248	StkId func;
	249	int isactive = (*what != '>');
	250	if (isactive)
	251	func = ar->_func;
	252	else {
	253	what++; /* skip the '>' */
	254	func = L->top - 1;
	255	}
	256	for (; *what; what++) {
	257	switch (*what) {
	258	case 'S': {
	259	funcinfo(L, ar, func);
	260	break;
	261	}
	262	case 'l': {
	263	ar->currentline = currentline(func);
	264	break;
	265	}
	266	case 'u': {
	267	ar->nups = nups(func);
	268	break;
	269	}
	270	case 'n': {
	271	ar->namewhat = (isactive) ? getfuncname(L, func, &ar->name) : NULL;
	272	if (ar->namewhat == NULL)
	273	getname(L, func, ar);
	274	break;
	275	}
	276	case 'f': {
	277	setnormalized(L->top, func);
	278	incr_top; /* push function */
	279	break;
	280	}
	281	default: return 0; /* invalid option */
	282	}
	283	}
	284	if (!isactive) L->top--; /* pop function */
	285	return 1;
	286	}
	287
	288
	289	/*
	290	** {======================================================
	291	** Symbolic Execution
	292	** =======================================================
	293	*/
	294
	295
	296	static int pushpc (int *stack, int pc, int top, int n) {
	297	while (n--)
	298	stack[top++] = pc-1;
	299	return top;
	300	}
	301
	302
	303	static Instruction luaG_symbexec (const Proto *pt, int lastpc, int stackpos) {
	304	int stack[MAXSTACK]; /* stores last instruction that changed a stack entry */
	305	const Instruction *code = pt->code;
	306	int top = pt->numparams;
	307	int pc = 0;
	308	if (pt->is_vararg) /* varargs? */
	309	top++; /* `arg' */
	310	while (pc < lastpc) {
	311	const Instruction i = code[pc++];
	312	LUA_ASSERT(0 <= top && top <= pt->maxstacksize, "wrong stack");
	313	switch (GET_OPCODE(i)) {
	314	case OP_RETURN: {
	315	LUA_ASSERT(top >= GETARG_U(i), "wrong stack");
	316	top = GETARG_U(i);
	317	break;
	318	}
	319	case OP_TAILCALL: {
	320	LUA_ASSERT(top >= GETARG_A(i), "wrong stack");
	321	top = GETARG_B(i);
	322	break;
	323	}
	324	case OP_CALL: {
	325	int nresults = GETARG_B(i);
	326	if (nresults == MULT_RET) nresults = 1;
	327	LUA_ASSERT(top >= GETARG_A(i), "wrong stack");
	328	top = pushpc(stack, pc, GETARG_A(i), nresults);
	329	break;
	330	}
	331	case OP_PUSHNIL: {
	332	top = pushpc(stack, pc, top, GETARG_U(i));
	333	break;
	334	}
	335	case OP_POP: {
	336	top -= GETARG_U(i);
	337	break;
	338	}
	339	case OP_SETTABLE:
	340	case OP_SETLIST: {
	341	top -= GETARG_B(i);
	342	break;
	343	}
	344	case OP_SETMAP: {
	345	top -= 2*GETARG_U(i);
	346	break;
	347	}
	348	case OP_CONCAT: {
	349	top -= GETARG_U(i);
	350	stack[top++] = pc-1;
	351	break;
	352	}
	353	case OP_CLOSURE: {
	354	top -= GETARG_B(i);
	355	stack[top++] = pc-1;
	356	break;
	357	}
	358	case OP_JMPONT:
	359	case OP_JMPONF: {
	360	int newpc = pc + GETARG_S(i);
	361	/* jump is forward and do not skip `lastpc'? */
	362	if (pc < newpc && newpc <= lastpc) {
	363	stack[top-1] = pc-1; /* value comes from `and'/`or' */
	364	pc = newpc; /* do the jump */
	365	}
	366	else
	367	top--; /* do not jump; pop value */
	368	break;
	369	}
	370	default: {
	371	OpCode op = GET_OPCODE(i);
	372	LUA_ASSERT(luaK_opproperties[op].push != VD,
	373	"invalid opcode for default");
	374	top -= luaK_opproperties[op].pop;
	375	LUA_ASSERT(top >= 0, "wrong stack");
	376	top = pushpc(stack, pc, top, luaK_opproperties[op].push);
	377	}
	378	}
	379	}
	380	return code[stack[stackpos]];
	381	}
	382
	383
	384	static const char getobjname (lua_State L, StkId obj, const char **name) {
	385	StkId func = aux_stackedfunction(L, 0, obj);
	386	if (!isLmark(func))
	387	return NULL; /* not an active Lua function */
	388	else {
	389	Proto *p = infovalue(func)->func->f.l;
	390	int pc = currentpc(func);
	391	int stackpos = obj - (func+1); /* func+1 == function base */
	392	Instruction i = luaG_symbexec(p, pc, stackpos);
	393	LUA_ASSERT(pc != -1, "function must be active");
	394	switch (GET_OPCODE(i)) {
	395	case OP_GETGLOBAL: {
	396	*name = p->kstr[GETARG_U(i)]->str;
	397	return "global";
	398	}
	399	case OP_GETLOCAL: {
	400	*name = luaF_getlocalname(p, GETARG_U(i)+1, pc);
	401	LUA_ASSERT(*name, "local must exist");
	402	return "local";
	403	}
	404	case OP_PUSHSELF:
	405	case OP_GETDOTTED: {
	406	*name = p->kstr[GETARG_U(i)]->str;
	407	return "field";
	408	}
	409	default:
	410	return NULL; /* no useful name found */
	411	}
	412	}
	413	}
	414
	415
	416	static const char getfuncname (lua_State L, StkId f, const char **name) {
	417	StkId func = aux_stackedfunction(L, 0, f); /* calling function */
	418	if (!isLmark(func))
	419	return NULL; /* not an active Lua function */
	420	else {
	421	Proto *p = infovalue(func)->func->f.l;
	422	int pc = currentpc(func);
	423	Instruction i;
	424	if (pc == -1) return NULL; /* function is not activated */
	425	i = p->code[pc];
	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	}
	434
	435
	436	/* }====================================================== */
	437
	438
	439	void luaG_typeerror (lua_State L, StkId o, const char op) {
	440	const char *name;
	441	const char *kind = getobjname(L, o, &name);
	442	const char *t = luaO_typename(o);
	443	if (kind)
	444	luaO_verror(L, "attempt to %.30s %.20s `%.40s' (a %.10s value)",
	445	op, kind, name, t);
	446	else
	447	luaO_verror(L, "attempt to %.30s a %.10s value", op, t);
	448	}
	449
	450
	451	void luaG_binerror (lua_State L, StkId p1, int t, const char op) {
	452	if (ttype(p1) == t) p1++;
	453	LUA_ASSERT(ttype(p1) != t, "must be an error");
	454	luaG_typeerror(L, p1, op);
	455	}
	456
	457
	458	void luaG_ordererror (lua_State *L, StkId top) {
	459	const char *t1 = luaO_typename(top-2);
	460	const char *t2 = luaO_typename(top-1);
	461	if (t1[2] == t2[2])
	462	luaO_verror(L, "attempt to compare two %.10s values", t1);
	463	else
	464	luaO_verror(L, "attempt to compare %.10s with %.10s", t1, t2);
	465	}
	466

src/ldebug.h+21−0

@@ -0,0 +1,21 @@
	1	/*
	2	** $Id: ldebug.h,v 1.7 2000/10/05 12:14:08 roberto Exp $
	3	** Auxiliary functions from Debug Interface module
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7	#ifndef ldebug_h
	8	#define ldebug_h
	9
	10
	11	#include "lstate.h"
	12	#include "luadebug.h"
	13
	14
	15	void luaG_typeerror (lua_State L, StkId o, const char op);
	16	void luaG_binerror (lua_State L, StkId p1, int t, const char op);
	17	int luaG_getline (int lineinfo, int pc, int refline, int refi);
	18	void luaG_ordererror (lua_State *L, StkId top);
	19
	20
	21	#endif

src/ldo.c+271−273

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: ldo.c,v 1.45b 1999/06/22 20:37:23 roberto Exp $	2	** $Id: ldo.c,v 1.109 2000/10/30 12:38:50 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,378 +10,376 @@ · 4 unmodified lines
10	#include <stdlib.h>	10	#include <stdlib.h>
11	#include <string.h>	11	#include <string.h>
12		12
13	#include "lauxlib.h"	13	#include "lua.h"
		14
		15	#include "ldebug.h"
14	#include "ldo.h"	16	#include "ldo.h"
15	#include "lfunc.h"
16	#include "lgc.h"	17	#include "lgc.h"
17	#include "lmem.h"	18	#include "lmem.h"
18	#include "lobject.h"	19	#include "lobject.h"
19	#include "lparser.h"	20	#include "lparser.h"
20	#include "lstate.h"	21	#include "lstate.h"
21	#include "lstring.h"	22	#include "lstring.h"
		23	#include "ltable.h"
22	#include "ltm.h"	24	#include "ltm.h"
23	#include "lua.h"
24	#include "luadebug.h"
25	#include "lundump.h"	25	#include "lundump.h"
26	#include "lvm.h"	26	#include "lvm.h"
27	#include "lzio.h"	27	#include "lzio.h"
28		28
29		29
		30	/* space to handle stack overflow errors */
		31	#define EXTRA_STACK (2*LUA_MINSTACK)
30		32
31	#ifndef STACK_LIMIT
32	#define STACK_LIMIT 6000 /* arbitrary limit */
33	#endif
34
35
36
37	#define STACK_UNIT 128
38		33
39		34	void luaD_init (lua_State *L, int stacksize) {
40	#ifdef DEBUG	35	L->stack = luaM_newvector(L, stacksize+EXTRA_STACK, TObject);
41	#undef STACK_UNIT	36	L->nblocks += stacksize*sizeof(TObject);
42	#define STACK_UNIT 2	37	L->stack_last = L->stack+(stacksize-1);
43	#endif	38	L->stacksize = stacksize;
44		39	L->Cbase = L->top = L->stack;
45
46	void luaD_init (void) {
47	L->stack.stack = luaM_newvector(STACK_UNIT, TObject);
48	L->stack.top = L->stack.stack;
49	L->stack.last = L->stack.stack+(STACK_UNIT-1);
50	}	40	}
51		41
52		42
53	void luaD_checkstack (int n) {	43	void luaD_checkstack (lua_State *L, int n) {
54	struct Stack *S = &L->stack;	44	if (L->stack_last - L->top <= n) { /* stack overflow? */
55	if (S->last-S->top <= n) {	45	if (L->stack_last-L->stack > (L->stacksize-1)) {
56	StkId top = S->top-S->stack;	46	/* overflow while handling overflow */
57	int stacksize = (S->last-S->stack)+STACK_UNIT+n;	47	luaD_breakrun(L, LUA_ERRERR); /* break run without error message */
58	luaM_reallocvector(S->stack, stacksize, TObject);	48	}
59	S->last = S->stack+(stacksize-1);	49	else {
60	S->top = S->stack + top;	50	L->stack_last += EXTRA_STACK; /* to be used by error message */
61	if (stacksize >= STACK_LIMIT) { /* stack overflow? */	51	lua_error(L, "stack overflow");
62	if (lua_stackedfunction(100) == LUA_NOOBJECT) /* 100 funcs on stack? */
63	lua_error("Lua2C - C2Lua overflow"); /* doesn't look like a rec. loop */
64	else
65	lua_error("stack size overflow");
66	}	52	}
67	}	53	}
68	}	54	}
69		55
70		56
		57	static void restore_stack_limit (lua_State *L) {
		58	if (L->top - L->stack < L->stacksize - 1)
		59	L->stack_last = L->stack + (L->stacksize-1);
		60	}
		61
		62
71	/*	63	/*
72	** Adjust stack. Set top to the given value, pushing NILs if needed.	64	** Adjust stack. Set top to base+extra, pushing NILs if needed.
		65	** (we cannot add base+extra unless we are sure it fits in the stack;
		66	** otherwise the result of such operation on pointers is undefined)
73	*/	67	*/
74	void luaD_adjusttop (StkId newtop) {	68	void luaD_adjusttop (lua_State *L, StkId base, int extra) {
75	int diff = newtop-(L->stack.top-L->stack.stack);	69	int diff = extra-(L->top-base);
76	if (diff <= 0)	70	if (diff <= 0)
77	L->stack.top += diff;	71	L->top = base+extra;
78	else {	72	else {
79	luaD_checkstack(diff);	73	luaD_checkstack(L, diff);
80	while (diff--)	74	while (diff--)
81	ttype(L->stack.top++) = LUA_T_NIL;	75	ttype(L->top++) = LUA_TNIL;
82	}	76	}
83	}	77	}
84		78
85		79
86	/*	80	/*
87	** Open a hole below "nelems" from the L->stack.top.	81	** Open a hole inside the stack at `pos'
88	*/	82	*/
89	void luaD_openstack (int nelems) {	83	static void luaD_openstack (lua_State *L, StkId pos) {
90	luaO_memup(L->stack.top-nelems+1, L->stack.top-nelems,	84	int i = L->top-pos;
91	nelems*sizeof(TObject));	85	while (i--) pos[i+1] = pos[i];
92	incr_top;	86	incr_top;
93	}	87	}
94		88
95		89
96	void luaD_lineHook (int line) {	90	static void dohook (lua_State L, lua_Debug ar, lua_Hook hook) {
97	struct C_Lua_Stack oldCLS = L->Cstack;	91	StkId old_Cbase = L->Cbase;
98	StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;	92	StkId old_top = L->Cbase = L->top;
99	L->Cstack.num = 0;	93	luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
100	(*L->linehook)(line);	94	L->allowhooks = 0; /* cannot call hooks inside a hook */
101	L->stack.top = L->stack.stack+old_top;	95	(*hook)(L, ar);
102	L->Cstack = oldCLS;	96	LUA_ASSERT(L->allowhooks == 0, "invalid allow");
		97	L->allowhooks = 1;
		98	L->top = old_top;
		99	L->Cbase = old_Cbase;
103	}	100	}
104		101
105		102
106	void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn) {	103	void luaD_lineHook (lua_State *L, StkId func, int line, lua_Hook linehook) {
107	struct C_Lua_Stack oldCLS = L->Cstack;	104	if (L->allowhooks) {
108	StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;	105	lua_Debug ar;
109	L->Cstack.num = 0;	106	ar._func = func;
110	if (isreturn)	107	ar.event = "line";
111	(*L->callhook)(LUA_NOOBJECT, "(return)", 0);	108	ar.currentline = line;
112	else {	109	dohook(L, &ar, linehook);
113	TObject *f = L->stack.stack+base-1;
114	if (tf)
115	(*L->callhook)(Ref(f), tf->source->str, tf->lineDefined);
116	else
117	(*L->callhook)(Ref(f), "(C)", -1);
118	}	110	}
119	L->stack.top = L->stack.stack+old_top;
120	L->Cstack = oldCLS;
121	}	111	}
122		112
123		113
124	/*	114	static void luaD_callHook (lua_State *L, StkId func, lua_Hook callhook,
125	** Call a C function.	115	const char *event) {
126	** Cstack.num is the number of arguments; Cstack.lua2C points to the	116	if (L->allowhooks) {
127	** first argument. Returns an index to the first result from C.	117	lua_Debug ar;
128	*/	118	ar._func = func;
129	static StkId callC (lua_CFunction f, StkId base) {	119	ar.event = event;
130	struct C_Lua_Stack *cls = &L->Cstack;	120	infovalue(func)->pc = NULL; /* function is not active */
131	struct C_Lua_Stack oldCLS = *cls;	121	dohook(L, &ar, callhook);
132	StkId firstResult;	122	}
133	int numarg = (L->stack.top-L->stack.stack) - base;
134	cls->num = numarg;
135	cls->lua2C = base;
136	cls->base = base+numarg; /* == top-stack */
137	if (L->callhook)
138	luaD_callHook(base, NULL, 0);
139	(f)(); / do the actual call */
140	if (L->callhook) /* func may have changed callhook */
141	luaD_callHook(base, NULL, 1);
142	firstResult = cls->base;
143	*cls = oldCLS;
144	return firstResult;
145	}	123	}
146		124
147		125
148	static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base) {	126	static StkId callCclosure (lua_State L, const struct Closure cl, StkId base) {
149	TObject *pbase;	127	int nup = cl->nupvalues; /* number of upvalues */
150	int nup = cl->nelems; /* number of upvalues */	128	StkId old_Cbase = L->Cbase;
151	luaD_checkstack(nup);	129	int n;
152	pbase = L->stack.stack+base; /* care: previous call may change this */	130	L->Cbase = base; /* new base for C function */
153	/* open space for upvalues as extra arguments */	131	luaD_checkstack(L, nup+LUA_MINSTACK); /* ensure minimum stack size */
154	luaO_memup(pbase+nup, pbase, (L->stack.top-pbase)*sizeof(TObject));	132	for (n=0; n<nup; n++) /* copy upvalues as extra arguments */
155	/* copy upvalues into stack */	133	*(L->top++) = cl->upvalue[n];
156	memcpy(pbase, cl->consts+1, nup*sizeof(TObject));	134	n = (cl->f.c)(L); / do the actual call */
157	L->stack.top += nup;	135	L->Cbase = old_Cbase; /* restore old C base */
158	return callC(f, base);	136	return L->top - n; /* return index of first result */
159	}	137	}
160		138
161		139
162	void luaD_callTM (TObject *f, int nParams, int nResults) {	140	void luaD_callTM (lua_State L, Closure f, int nParams, int nResults) {
163	luaD_openstack(nParams);	141	StkId base = L->top - nParams;
164	(L->stack.top-nParams-1) = f;	142	luaD_openstack(L, base);
165	luaD_calln(nParams, nResults);	143	clvalue(base) = f;
		144	ttype(base) = LUA_TFUNCTION;
		145	luaD_call(L, base, nResults);
166	}	146	}
167		147
168		148
169	/*	149	/*
170	** Call a function (C or Lua). The parameters must be on the stack,	150	** Call a function (C or Lua). The function to be called is at *func.
171	** between [top-nArgs,top). The function to be called is right below the	151	** The arguments are on the stack, right after the function.
172	** arguments.	152	** When returns, the results are on the stack, starting at the original
173	** When returns, the results are on the stack, between [top-nArgs-1,top).	153	** function position.
174	** The number of results is nResults, unless nResults=MULT_RET.	154	** The number of results is nResults, unless nResults=LUA_MULTRET.
175	*/	155	*/
176	void luaD_calln (int nArgs, int nResults) {	156	void luaD_call (lua_State *L, StkId func, int nResults) {
177	struct Stack S = &L->stack; / to optimize */	157	lua_Hook callhook;
178	StkId base = (S->top-S->stack)-nArgs;
179	TObject *func = S->stack+base-1;
180	StkId firstResult;	158	StkId firstResult;
181	int i;	159	CallInfo ci;
182	switch (ttype(func)) {	160	Closure *cl;
183	case LUA_T_CPROTO:	161	if (ttype(func) != LUA_TFUNCTION) {
184	ttype(func) = LUA_T_CMARK;	162	/* `func' is not a function; check the `function' tag method */
185	firstResult = callC(fvalue(func), base);	163	Closure *tm = luaT_gettmbyObj(L, func, TM_FUNCTION);
186	break;	164	if (tm == NULL)
187	case LUA_T_PROTO:	165	luaG_typeerror(L, func, "call");
188	ttype(func) = LUA_T_PMARK;	166	luaD_openstack(L, func);
189	firstResult = luaV_execute(NULL, tfvalue(func), base);	167	clvalue(func) = tm; /* tag method is the new function to be called */
190	break;	168	ttype(func) = LUA_TFUNCTION;
191	case LUA_T_CLOSURE: {	169	}
192	Closure *c = clvalue(func);	170	cl = clvalue(func);
193	TObject *proto = &(c->consts[0]);	171	ci.func = cl;
194	ttype(func) = LUA_T_CLMARK;	172	infovalue(func) = &ci;
195	firstResult = (ttype(proto) == LUA_T_CPROTO) ?	173	ttype(func) = LUA_TMARK;
196	callCclosure(c, fvalue(proto), base) :	174	callhook = L->callhook;
197	luaV_execute(c, tfvalue(proto), base);	175	if (callhook)
198	break;	176	luaD_callHook(L, func, callhook, "call");
199	}	177	firstResult = (cl->isC ? callCclosure(L, cl, func+1) :
200	default: { /* func is not a function */	178	luaV_execute(L, cl, func+1));
201	/* Check the tag method for invalid functions */	179	if (callhook) /* same hook that was active at entry */
202	TObject *im = luaT_getimbyObj(func, IM_FUNCTION);	180	luaD_callHook(L, func, callhook, "return");
203	if (ttype(im) == LUA_T_NIL)	181	LUA_ASSERT(ttype(func) == LUA_TMARK, "invalid tag");
204	lua_error("call expression not a function");	182	/* move results to `func' (to erase parameters and function) */
205	luaD_callTM(im, (S->top-S->stack)-(base-1), nResults);	183	if (nResults == LUA_MULTRET) {
206	return;	184	while (firstResult < L->top) /* copy all results */
		185	func++ = firstResult++;
		186	L->top = func;
		187	}
		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 */
207	}	195	}
208	}	196	}
209	/* adjust the number of results */	197	luaC_checkGC(L);
210	if (nResults == MULT_RET)
211	nResults = (S->top-S->stack)-firstResult;
212	else
213	luaD_adjusttop(firstResult+nResults);
214	/* move results to base-1 (to erase parameters and function) */
215	base--;
216	for (i=0; i<nResults; i++)
217	(S->stack+base+i) = (S->stack+firstResult+i);
218	S->top -= firstResult-base;
219	}	198	}
220		199
221		200
222	/*	201	/*
223	** Traverse all objects on L->stack.stack	202	** Execute a protected call.
224	*/	203	*/
225	void luaD_travstack (int (fn)(TObject ))	204	struct CallS { /* data to `f_call' */
226	{	205	StkId func;
227	StkId i;	206	int nresults;
228	for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--)	207	};
229	fn(L->stack.stack+i);	208
		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);
230	}	212	}
231		213
232		214
233		215	LUA_API int lua_call (lua_State *L, int nargs, int nresults) {
234	static void message (char *s) {	216	StkId func = L->top - (nargs+1); /* function to be called */
235	TObject *em = &(luaS_new("_ERRORMESSAGE")->u.s.globalval);	217	struct CallS c;
236	if (ttype(em) == LUA_T_PROTO \|\| ttype(em) == LUA_T_CPROTO \|\|	218	int status;
237	ttype(em) == LUA_T_CLOSURE) {	219	c.func = func; c.nresults = nresults;
238	L->stack.top = em;	220	status = luaD_runprotected(L, f_call, &c);
239	incr_top;	221	if (status != 0) /* an error occurred? */
240	lua_pushstring(s);	222	L->top = func; /* remove parameters from the stack */
241	luaD_calln(1, 0);
242	}
243	}
244
245	/*
246	** Reports an error, and jumps up to the available recover label
247	*/
248	void lua_error (char *s) {
249	if (s) message(s);
250	if (L->errorJmp)
251	longjmp(L->errorJmp->b, 1);
252	else {
253	message("exit(1). Unable to recover.\n");
254	exit(1);
255	}
256	}
257
258
259	/*
260	** Execute a protected call. Assumes that function is at L->Cstack.base and
261	** parameters are on top of it. Leave nResults on the stack.
262	*/
263	int luaD_protectedrun (void) {
264	volatile struct C_Lua_Stack oldCLS = L->Cstack;
265	struct lua_longjmp myErrorJmp;
266	volatile int status;
267	struct lua_longjmp *volatile oldErr = L->errorJmp;
268	L->errorJmp = &myErrorJmp;
269	if (setjmp(myErrorJmp.b) == 0) {
270	StkId base = L->Cstack.base;
271	luaD_calln((L->stack.top-L->stack.stack)-base-1, MULT_RET);
272	L->Cstack.lua2C = base; /* position of the new results */
273	L->Cstack.num = (L->stack.top-L->stack.stack) - base;
274	L->Cstack.base = base + L->Cstack.num; /* incorporate results on stack */
275	status = 0;
276	}
277	else { /* an error occurred: restore L->Cstack and L->stack.top */
278	L->Cstack = oldCLS;
279	L->stack.top = L->stack.stack+L->Cstack.base;
280	status = 1;
281	}
282	L->errorJmp = oldErr;
283	return status;	223	return status;
284	}	224	}
285		225
286		226
287	/*	227	/*
288	** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load	228	** Execute a protected parser.
289	*/	229	*/
290	static int protectedparser (ZIO *z, int bin) {	230	struct ParserS { /* data to `f_parser' */
291	volatile struct C_Lua_Stack oldCLS = L->Cstack;	231	ZIO *z;
292	struct lua_longjmp myErrorJmp;	232	int bin;
293	volatile int status;	233	};
294	TProtoFunc *volatile tf;
295	struct lua_longjmp *volatile oldErr = L->errorJmp;
296	L->errorJmp = &myErrorJmp;
297	if (setjmp(myErrorJmp.b) == 0) {
298	tf = bin ? luaU_undump1(z) : luaY_parser(z);
299	status = 0;
300	}
301	else { /* an error occurred: restore L->Cstack and L->stack.top */
302	L->Cstack = oldCLS;
303	L->stack.top = L->stack.stack+L->Cstack.base;
304	tf = NULL;
305	status = 1;
306	}
307	L->errorJmp = oldErr;
308	if (status) return 1; /* error code */
309	if (tf == NULL) return 2; /* 'natural' end */
310	luaD_adjusttop(L->Cstack.base+1); /* one slot for the pseudo-function */
311	L->stack.stack[L->Cstack.base].ttype = LUA_T_PROTO;
312	L->stack.stack[L->Cstack.base].value.tf = tf;
313	luaV_closure(0);
314	return 0;
315	}
316
317		234
318	static int do_main (ZIO *z, int bin) {	235	static void f_parser (lua_State L, void ud) {
319	int status;	236	struct ParserS p = (struct ParserS )ud;
320	int debug = L->debug; /* save debug status */	237	Proto *tf = p->bin ? luaU_undump(L, p->z) : luaY_parser(L, p->z);
321	do {	238	luaV_Lclosure(L, tf, 0);
322	long old_blocks = (luaC_checkGC(), L->nblocks);
323	status = protectedparser(z, bin);
324	if (status == 1) return 1; /* error */
325	else if (status == 2) return 0; /* 'natural' end */
326	else {
327	unsigned long newelems2 = 2*(L->nblocks-old_blocks);
328	L->GCthreshold += newelems2;
329	status = luaD_protectedrun();
330	L->GCthreshold -= newelems2;
331	}
332	} while (bin && status == 0);
333	L->debug = debug; /* restore debug status */
334	return status;
335	}	239	}
336		240
337		241
338	void luaD_gcIM (TObject *o)	242	static int protectedparser (lua_State L, ZIO z, int bin) {
339	{	243	struct ParserS p;
340	TObject *im = luaT_getimbyObj(o, IM_GC);	244	unsigned long old_blocks;
341	if (ttype(im) != LUA_T_NIL) {	245	int status;
342	L->stack.top = o;	246	p.z = z; p.bin = bin;
343	incr_top;	247	luaC_checkGC(L);
344	luaD_callTM(im, 1, 0);	248	old_blocks = L->nblocks;
		249	status = luaD_runprotected(L, f_parser, &p);
		250	if (status == 0) {
		251	/* add new memory to threshold (as it probably will stay) */
		252	L->GCthreshold += (L->nblocks - old_blocks);
345	}	253	}
		254	else if (status == LUA_ERRRUN) /* an error occurred: correct error code */
		255	status = LUA_ERRSYNTAX;
		256	return status;
346	}	257	}
347		258
348		259
349	#define MAXFILENAME 260 /* maximum part of a file name kept */	260	static int parse_file (lua_State L, const char filename) {
350
351	int lua_dofile (char *filename) {
352	ZIO z;	261	ZIO z;
353	int status;	262	int status;
354	int c;	263	int bin; /* flag for file mode */
355	int bin;	264	int c; /* look ahead char */
356	char source[MAXFILENAME];
357	FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");	265	FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
358	if (f == NULL)	266	if (f == NULL) return LUA_ERRFILE; /* unable to open file */
359	return 2;
360	luaL_filesource(source, filename, sizeof(source));
361	c = fgetc(f);	267	c = fgetc(f);
362	ungetc(c, f);	268	ungetc(c, f);
363	bin = (c == ID_CHUNK);	269	bin = (c == ID_CHUNK);
364	if (bin && f != stdin) {	270	if (bin && f != stdin) {
365	f = freopen(filename, "rb", f); /* set binary mode */	271	f = freopen(filename, "rb", f); /* set binary mode */
366	if (f == NULL) return 2;	272	if (f == NULL) return LUA_ERRFILE; /* unable to reopen file */
367	}	273	}
368	luaZ_Fopen(&z, f, source);	274	lua_pushstring(L, "@");
369	status = do_main(&z, bin);	275	lua_pushstring(L, (filename == NULL) ? "(stdin)" : filename);
		276	lua_concat(L, 2);
		277	filename = lua_tostring(L, -1); /* filename = '@'..filename */
		278	lua_pop(L, 1); /* OK: there is no GC during parser */
		279	luaZ_Fopen(&z, f, filename);
		280	status = protectedparser(L, &z, bin);
370	if (f != stdin)	281	if (f != stdin)
371	fclose(f);	282	fclose(f);
372	return status;	283	return status;
373	}	284	}
374		285
375		286
376	int lua_dostring (char *str) {	287	LUA_API int lua_dofile (lua_State L, const char filename) {
377	return lua_dobuffer(str, strlen(str), str);	288	int status = parse_file(L, filename);
		289	if (status == 0) /* parse OK? */
		290	status = lua_call(L, 0, LUA_MULTRET); /* call main */
		291	return status;
378	}	292	}
379		293
380		294
381	int lua_dobuffer (char buff, int size, char name) {	295	static int parse_buffer (lua_State L, const char buff, size_t size,
		296	const char *name) {
382	ZIO z;	297	ZIO z;
383	if (!name) name = "?";	298	if (!name) name = "?";
384	luaZ_mopen(&z, buff, size, name);	299	luaZ_mopen(&z, buff, size, name);
385	return do_main(&z, buff[0]==ID_CHUNK);	300	return protectedparser(L, &z, buff[0]==ID_CHUNK);
386	}	301	}
387		302
		303
		304	LUA_API int lua_dobuffer (lua_State L, const char buff, size_t size, const char *name) {
		305	int status = parse_buffer(L, buff, size, name);
		306	if (status == 0) /* parse OK? */
		307	status = lua_call(L, 0, LUA_MULTRET); /* call main */
		308	return status;
		309	}
		310
		311
		312	LUA_API int lua_dostring (lua_State L, const char str) {
		313	return lua_dobuffer(L, str, strlen(str), str);
		314	}
		315
		316
		317	/*
		318	** {======================================================
		319	** Error-recover functions (based on long jumps)
		320	** =======================================================
		321	*/
		322
		323	/* chain list of long jump buffers */
		324	struct lua_longjmp {
		325	jmp_buf b;
		326	struct lua_longjmp *previous;
		327	volatile int status; /* error code */
		328	};
		329
		330
		331	static void message (lua_State L, const char s) {
		332	const TObject *em = luaH_getglobal(L, LUA_ERRORMESSAGE);
		333	if (ttype(em) == LUA_TFUNCTION) {
		334	L->top = em;
		335	incr_top;
		336	lua_pushstring(L, s);
		337	luaD_call(L, L->top-2, 0);
		338	}
		339	}
		340
		341
		342	/*
		343	** Reports an error, and jumps up to the available recovery label
		344	*/
		345	LUA_API void lua_error (lua_State L, const char s) {
		346	if (s) message(L, s);
		347	luaD_breakrun(L, LUA_ERRRUN);
		348	}
		349
		350
		351	void luaD_breakrun (lua_State *L, int errcode) {
		352	if (L->errorJmp) {
		353	L->errorJmp->status = errcode;
		354	longjmp(L->errorJmp->b, 1);
		355	}
		356	else {
		357	if (errcode != LUA_ERRMEM)
		358	message(L, "unable to recover; exiting\n");
		359	exit(EXIT_FAILURE);
		360	}
		361	}
		362
		363
		364	int luaD_runprotected (lua_State L, void (f)(lua_State , void ), void *ud) {
		365	StkId oldCbase = L->Cbase;
		366	StkId oldtop = L->top;
		367	struct lua_longjmp lj;
		368	int allowhooks = L->allowhooks;
		369	lj.status = 0;
		370	lj.previous = L->errorJmp; /* chain new error handler */
		371	L->errorJmp = &lj;
		372	if (setjmp(lj.b) == 0)
		373	(*f)(L, ud);
		374	else { /* an error occurred: restore the state */
		375	L->allowhooks = allowhooks;
		376	L->Cbase = oldCbase;
		377	L->top = oldtop;
		378	restore_stack_limit(L);
		379	}
		380	L->errorJmp = lj.previous; /* restore old error handler */
		381	return lj.status;
		382	}
		383
		384	/* }====================================================== */
		385

src/ldo.h+10−23

 /*
-** $Id: ldo.h,v 1.6 1999/06/22 20:37:23 roberto Exp $
+** $Id: ldo.h,v 1.28 2000/10/06 12:45:25 roberto Exp $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
 #include "lstate.h"
-#define MULT_RET        255
 /*
 ** macro to increment stack top.
 ** There must be always an empty slot at the L->stack.top
 */
-#define incr_top { if (L->stack.top >= L->stack.last) luaD_checkstack(1); \
+#define incr_top {if (L->top == L->stack_last) luaD_checkstack(L, 1); L->top++;}
-                   L->stack.top++; }
-/* macros to convert from lua_Object to (TObject *) and back */
-#define Address(lo)     ((lo)+L->stack.stack-1)
-#define Ref(st)         ((st)-L->stack.stack+1)
+void luaD_init (lua_State *L, int stacksize);
+void luaD_adjusttop (lua_State *L, StkId base, int extra);
+void luaD_lineHook (lua_State *L, StkId func, int line, lua_Hook linehook);
+void luaD_call (lua_State *L, StkId func, int nResults);
+void luaD_callTM (lua_State *L, Closure *f, int nParams, int nResults);
+void luaD_checkstack (lua_State *L, int n);
-void luaD_init (void);
+void luaD_breakrun (lua_State *L, int errcode);
-void luaD_adjusttop (StkId newtop);
+int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud);
-void luaD_openstack (int nelems);
-void luaD_lineHook (int line);
-void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn);
-void luaD_calln (int nArgs, int nResults);
-void luaD_callTM (TObject *f, int nParams, int nResults);
-int luaD_protectedrun (void);
-void luaD_gcIM (TObject *o);
-void luaD_travstack (int (*fn)(TObject *));
-void luaD_checkstack (int n);
 #endif

src/lfunc.c+66−55

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lfunc.c,v 1.10 1999/03/04 21:17:26 roberto Exp $	2	** $Id: lfunc.c,v 1.34 2000/10/30 12:20:29 roberto Exp $
3	** Auxiliary functions to manipulate prototypes and closures	3	** Auxiliary functions to manipulate prototypes and closures
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -7,92 +7,103 @@ · 1 unmodified line
7		7
8	#include <stdlib.h>	8	#include <stdlib.h>
9		9
		10	#include "lua.h"
		11
10	#include "lfunc.h"	12	#include "lfunc.h"
11	#include "lmem.h"	13	#include "lmem.h"
12	#include "lstate.h"	14	#include "lstate.h"
13		15
14	#define gcsizeproto(p) 5 /* approximate "weight" for a prototype */
15	#define gcsizeclosure(c) 1 /* approximate "weight" for a closure */
16		16
		17	#define sizeclosure(n) ((int)sizeof(Closure) + (int)sizeof(TObject)*((n)-1))
17		18
18		19
19	Closure *luaF_newclosure (int nelems)	20	Closure luaF_newclosure (lua_State L, int nelems) {
20	{	21	int size = sizeclosure(nelems);
21	Closure c = (Closure )luaM_malloc(sizeof(Closure)+nelems*sizeof(TObject));	22	Closure c = (Closure )luaM_malloc(L, size);
22	luaO_insertlist(&(L->rootcl), (GCnode *)c);	23	c->next = L->rootcl;
23	L->nblocks += gcsizeclosure(c);	24	L->rootcl = c;
24	c->nelems = nelems;	25	c->mark = c;
		26	c->nupvalues = nelems;
		27	L->nblocks += size;
25	return c;	28	return c;
26	}	29	}
27		30
28		31
29	TProtoFunc *luaF_newproto (void)	32	Proto luaF_newproto (lua_State L) {
30	{	33	Proto *f = luaM_new(L, Proto);
31	TProtoFunc *f = luaM_new(TProtoFunc);	34	f->knum = NULL;
		35	f->nknum = 0;
		36	f->kstr = NULL;
		37	f->nkstr = 0;
		38	f->kproto = NULL;
		39	f->nkproto = 0;
32	f->code = NULL;	40	f->code = NULL;
		41	f->ncode = 0;
		42	f->numparams = 0;
		43	f->is_vararg = 0;
		44	f->maxstacksize = 0;
		45	f->marked = 0;
		46	f->lineinfo = NULL;
		47	f->nlineinfo = 0;
		48	f->nlocvars = 0;
		49	f->locvars = NULL;
33	f->lineDefined = 0;	50	f->lineDefined = 0;
34	f->source = NULL;	51	f->source = NULL;
35	f->consts = NULL;	52	f->next = L->rootproto; /* chain in list of protos */
36	f->nconsts = 0;	53	L->rootproto = f;
37	f->locvars = NULL;
38	luaO_insertlist(&(L->rootproto), (GCnode *)f);
39	L->nblocks += gcsizeproto(f);
40	return f;	54	return f;
41	}	55	}
42		56
43		57
		58	static size_t protosize (Proto *f) {
		59	return sizeof(Proto)
		60	+ f->nknum*sizeof(Number)
		61	+ f->nkstrsizeof(TString )
		62	+ f->nkprotosizeof(Proto )
		63	+ f->ncode*sizeof(Instruction)
		64	+ f->nlocvars*sizeof(struct LocVar)
		65	+ f->nlineinfo*sizeof(int);
		66	}
44		67
45	static void freefunc (TProtoFunc *f)	68
46	{	69	void luaF_protook (lua_State L, Proto f, int pc) {
47	luaM_free(f->code);	70	f->ncode = pc; /* signal that proto was properly created */
48	luaM_free(f->locvars);	71	L->nblocks += protosize(f);
49	luaM_free(f->consts);
50	luaM_free(f);
51	}	72	}
52		73
53		74
54	void luaF_freeproto (TProtoFunc *l)	75	void luaF_freeproto (lua_State L, Proto f) {
55	{	76	if (f->ncode > 0) /* function was properly created? */
56	while (l) {	77	L->nblocks -= protosize(f);
57	TProtoFunc next = (TProtoFunc )l->head.next;	78	luaM_free(L, f->code);
58	L->nblocks -= gcsizeproto(l);	79	luaM_free(L, f->locvars);
59	freefunc(l);	80	luaM_free(L, f->kstr);
60	l = next;	81	luaM_free(L, f->knum);
61	}	82	luaM_free(L, f->kproto);
		83	luaM_free(L, f->lineinfo);
		84	luaM_free(L, f);
62	}	85	}
63		86
64		87
65	void luaF_freeclosure (Closure *l)	88	void luaF_freeclosure (lua_State L, Closure c) {
66	{	89	L->nblocks -= sizeclosure(c->nupvalues);
67	while (l) {	90	luaM_free(L, c);
68	Closure next = (Closure )l->head.next;
69	L->nblocks -= gcsizeclosure(l);
70	luaM_free(l);
71	l = next;
72	}
73	}	91	}
74		92
75		93
76	/*	94	/*
77	** Look for n-th local variable at line "line" in function "func".	95	** Look for n-th local variable at line `line' in function `func'.
78	** Returns NULL if not found.	96	** Returns NULL if not found.
79	*/	97	*/
80	char luaF_getlocalname (TProtoFunc func, int local_number, int line)	98	const char luaF_getlocalname (const Proto f, int local_number, int pc) {
81	{	99	int i;
82	int count = 0;	100	for (i = 0; i<f->nlocvars && f->locvars[i].startpc <= pc; i++) {
83	char *varname = NULL;	101	if (pc < f->locvars[i].endpc) { /* is variable active? */
84	LocVar *lv = func->locvars;	102	local_number--;
85	if (lv == NULL)	103	if (local_number == 0)
86	return NULL;	104	return f->locvars[i].varname->str;
87	for (; lv->line != -1 && lv->line < line; lv++) {
88	if (lv->varname) { /* register */
89	if (++count == local_number)
90	varname = lv->varname->str;
91	}	105	}
92	else /* unregister */
93	if (--count < local_number)
94	varname = NULL;
95	}	106	}
96	return varname;	107	return NULL; /* not found */
97	}	108	}
98		109

src/lfunc.h+8−7

@@ -1,6 +1,6 @@
1	/*	1	/*
2	** $Id: lfunc.h,v 1.5 1997/12/15 16:17:20 roberto Exp $	2	** $Id: lfunc.h,v 1.13 2000/09/29 12:42:13 roberto Exp $
3	** Lua Function structures	3	** Auxiliary functions to manipulate prototypes and closures
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
@@ -12,12 +12,13 @@ · 5 unmodified lines
12		12
13		13
14		14
15	TProtoFunc *luaF_newproto (void);	15	Proto luaF_newproto (lua_State L);
16	Closure *luaF_newclosure (int nelems);	16	void luaF_protook (lua_State L, Proto f, int pc);
17	void luaF_freeproto (TProtoFunc *l);	17	Closure luaF_newclosure (lua_State L, int nelems);
18	void luaF_freeclosure (Closure *l);	18	void luaF_freeproto (lua_State L, Proto f);
		19	void luaF_freeclosure (lua_State L, Closure c);
19		20
20	char luaF_getlocalname (TProtoFunc func, int local_number, int line);	21	const char luaF_getlocalname (const Proto func, int local_number, int pc);
21		22
22		23
23	#endif	24	#endif

src/lgc.c+260−182

@@ -1,9 +1,10 @@
1	/*	1	/*
2	** $Id: lgc.c,v 1.23 1999/03/04 21:17:26 roberto Exp $	2	** $Id: lgc.c,v 1.72 2000/10/26 12:47:05 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 "lua.h"
7		8
8	#include "ldo.h"	9	#include "ldo.h"
9	#include "lfunc.h"	10	#include "lfunc.h"
@@ -14,262 +15,339 @@ · 4 unmodified lines
14	#include "lstring.h"	15	#include "lstring.h"
15	#include "ltable.h"	16	#include "ltable.h"
16	#include "ltm.h"	17	#include "ltm.h"
17	#include "lua.h"
18		18
19		19
		20	typedef struct GCState {
		21	Hash tmark; / list of marked tables to be visited */
		22	Closure cmark; / list of marked closures to be visited */
		23	} GCState;
20		24
21	static int markobject (TObject *o);
22		25
23		26
		27	static void markobject (GCState st, TObject o);
24		28
25	/*
26	** =======================================================
27	** REF mechanism
28	** =======================================================
29	*/
30		29
		30	/* mark a string; marks larger than 1 cannot be changed */
		31	#define strmark(s) {if ((s)->marked == 0) (s)->marked = 1;}
31		32
32	int luaC_ref (TObject *o, int lock) {	33
33	int ref;	34
34	if (ttype(o) == LUA_T_NIL)	35	static void protomark (Proto *f) {
35	ref = -1; /* special ref for nil */	36	if (!f->marked) {
36	else {	37	int i;
37	for (ref=0; ref<L->refSize; ref++)	38	f->marked = 1;
38	if (L->refArray[ref].status == FREE)	39	strmark(f->source);
39	break;	40	for (i=0; i<f->nkstr; i++)
40	if (ref == L->refSize) { /* no more empty spaces? */	41	strmark(f->kstr[i]);
41	luaM_growvector(L->refArray, L->refSize, 1, struct ref, refEM, MAX_INT);	42	for (i=0; i<f->nkproto; i++)
42	L->refSize++;	43	protomark(f->kproto[i]);
43	}	44	for (i=0; i<f->nlocvars; i++) /* mark local-variable names */
44	L->refArray[ref].o = *o;	45	strmark(f->locvars[i].varname);
45	L->refArray[ref].status = lock ? LOCK : HOLD;
46	}	46	}
47	return ref;
48	}	47	}
49		48
50		49
51	void lua_unref (int ref)	50	static void markstack (lua_State L, GCState st) {
52	{	51	StkId o;
53	if (ref >= 0 && ref < L->refSize)	52	for (o=L->stack; o<L->top; o++)
54	L->refArray[ref].status = FREE;	53	markobject(st, o);
55	}	54	}
56		55
57		56
58	TObject* luaC_getref (int ref)	57	static void marklock (lua_State L, GCState st) {
59	{	58	int i;
60	if (ref == -1)	59	for (i=0; i<L->refSize; i++) {
61	return &luaO_nilobject;	60	if (L->refArray[i].st == LOCK)
62	if (ref >= 0 && ref < L->refSize &&	61	markobject(st, &L->refArray[i].o);
63	(L->refArray[ref].status == LOCK \|\| L->refArray[ref].status == HOLD))	62	}
64	return &L->refArray[ref].o;
65	else
66	return NULL;
67	}	63	}
68		64
69		65
70	static void travlock (void)	66	static void markclosure (GCState st, Closure cl) {
71	{	67	if (!ismarked(cl)) {
72	int i;	68	if (!cl->isC)
73	for (i=0; i<L->refSize; i++)	69	protomark(cl->f.l);
74	if (L->refArray[i].status == LOCK)	70	cl->mark = st->cmark; /* chain it for later traversal */
75	markobject(&L->refArray[i].o);	71	st->cmark = cl;
		72	}
		73	}
		74
		75
		76	static void marktagmethods (lua_State L, GCState st) {
		77	int e;
		78	for (e=0; e<TM_N; e++) {
		79	int t;
		80	for (t=0; t<=L->last_tag; t++) {
		81	Closure *cl = luaT_gettm(L, t, e);
		82	if (cl) markclosure(st, cl);
		83	}
		84	}
		85	}
		86
		87
		88	static void markobject (GCState st, TObject o) {
		89	switch (ttype(o)) {
		90	case LUA_TUSERDATA: case LUA_TSTRING:
		91	strmark(tsvalue(o));
		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	}
		109
		110
		111	static void markall (lua_State *L) {
		112	GCState st;
		113	st.cmark = NULL;
		114	st.tmark = L->gt; /* put table of globals in mark list */
		115	L->gt->mark = NULL;
		116	marktagmethods(L, &st); /* mark tag methods */
		117	markstack(L, &st); /* mark stack objects */
		118	marklock(L, &st); /* mark locked objects */
		119	for (;;) { /* mark tables and closures */
		120	if (st.cmark) {
		121	int i;
		122	Closure f = st.cmark; / get first closure from list */
		123	st.cmark = f->mark; /* remove it from list */
		124	for (i=0; i<f->nupvalues; i++) /* mark its upvalues */
		125	markobject(&st, &f->upvalue[i]);
		126	}
		127	else if (st.tmark) {
		128	int i;
		129	Hash h = st.tmark; / get first table from list */
		130	st.tmark = h->mark; /* remove it from list */
		131	for (i=0; i<h->size; i++) {
		132	Node *n = node(h, i);
		133	if (ttype(key(n)) != LUA_TNIL) {
		134	if (ttype(val(n)) == LUA_TNIL)
		135	luaH_remove(h, key(n)); /* dead element; try to remove it */
		136	markobject(&st, &n->key);
		137	markobject(&st, &n->val);
		138	}
		139	}
		140	}
		141	else break; /* nothing else to mark */
		142	}
76	}	143	}
77		144
78		145
79	static int ismarked (TObject *o)	146	static int hasmark (const TObject *o) {
80	{
81	/* valid only for locked objects */	147	/* valid only for locked objects */
82	switch (o->ttype) {	148	switch (o->ttype) {
83	case LUA_T_STRING: case LUA_T_USERDATA:	149	case LUA_TSTRING: case LUA_TUSERDATA:
84	return o->value.ts->head.marked;	150	return tsvalue(o)->marked;
85	case LUA_T_ARRAY:	151	case LUA_TTABLE:
86	return o->value.a->head.marked;	152	return ismarked(hvalue(o));
87	case LUA_T_CLOSURE:	153	case LUA_TFUNCTION:
88	return o->value.cl->head.marked;	154	return ismarked(clvalue(o));
89	case LUA_T_PROTO:	155	default: /* number */
90	return o->value.tf->head.marked;
91	#ifdef DEBUG
92	case LUA_T_LINE: case LUA_T_CLMARK:
93	case LUA_T_CMARK: case LUA_T_PMARK:
94	LUA_INTERNALERROR("invalid type");
95	#endif
96	default: /* nil, number or cproto */
97	return 1;	156	return 1;
98	}	157	}
99	}	158	}
100		159
101		160
102	static void invalidaterefs (void)	161	/* macro for internal debugging; check if a link of free refs is valid */
103	{	162	#define VALIDLINK(L, st,n) (NONEXT <= (st) && (st) < (n))
		163
		164	static void invalidaterefs (lua_State *L) {
		165	int n = L->refSize;
104	int i;	166	int i;
105	for (i=0; i<L->refSize; i++)	167	for (i=0; i<n; i++) {
106	if (L->refArray[i].status == HOLD && !ismarked(&L->refArray[i].o))	168	struct Ref *r = &L->refArray[i];
107	L->refArray[i].status = COLLECTED;	169	if (r->st == HOLD && !hasmark(&r->o))
		170	r->st = COLLECTED;
		171	LUA_ASSERT((r->st == LOCK && hasmark(&r->o)) \|\|
		172	(r->st == HOLD && hasmark(&r->o)) \|\|
		173	r->st == COLLECTED \|\|
		174	r->st == NONEXT \|\|
		175	(r->st < n && VALIDLINK(L, L->refArray[r->st].st, n)),
		176	"inconsistent ref table");
		177	}
		178	LUA_ASSERT(VALIDLINK(L, L->refFree, n), "inconsistent ref table");
108	}	179	}
109		180
110		181
111		182
112	void luaC_hashcallIM (Hash *l)	183	static void collectproto (lua_State *L) {
113	{	184	Proto **p = &L->rootproto;
114	TObject t;	185	Proto *next;
115	ttype(&t) = LUA_T_ARRAY;	186	while ((next = *p) != NULL) {
116	for (; l; l=(Hash *)l->head.next) {	187	if (next->marked) {
117	avalue(&t) = l;	188	next->marked = 0;
118	luaD_gcIM(&t);	189	p = &next->next;
		190	}
		191	else {
		192	*p = next->next;
		193	luaF_freeproto(L, next);
		194	}
119	}	195	}
120	}	196	}
121		197
122		198
123	void luaC_strcallIM (TaggedString *l)	199	static void collectclosure (lua_State *L) {
124	{	200	Closure **p = &L->rootcl;
125	TObject o;	201	Closure *next;
126	ttype(&o) = LUA_T_USERDATA;	202	while ((next = *p) != NULL) {
127	for (; l; l=(TaggedString *)l->head.next)	203	if (ismarked(next)) {
128	if (l->constindex == -1) { /* is userdata? */	204	next->mark = next; /* unmark */
129	tsvalue(&o) = l;	205	p = &next->next;
130	luaD_gcIM(&o);	206	}
		207	else {
		208	*p = next->next;
		209	luaF_freeclosure(L, next);
131	}	210	}
		211	}
132	}	212	}
133		213
134		214
135		215	static void collecttable (lua_State *L) {
136	static GCnode listcollect (GCnode l)	216	Hash **p = &L->roottable;
137	{	217	Hash *next;
138	GCnode *frees = NULL;	218	while ((next = *p) != NULL) {
139	while (l) {	219	if (ismarked(next)) {
140	GCnode *next = l->next;	220	next->mark = next; /* unmark */
141	l->marked = 0;	221	p = &next->next;
142	while (next && !next->marked) {	222	}
143	l->next = next->next;	223	else {
144	next->next = frees;	224	*p = next->next;
145	frees = next;	225	luaH_free(L, next);
146	next = l->next;
147	}	226	}
148	l = next;
149	}	227	}
150	return frees;
151	}	228	}
152		229
153		230
154	static void strmark (TaggedString *s)	231	static void checktab (lua_State L, stringtable tb) {
155	{	232	if (tb->nuse < (lint32)(tb->size/4) && tb->size > 10)
156	if (!s->head.marked)	233	luaS_resize(L, tb, tb->size/2); /* table is too big */
157	s->head.marked = 1;
158	}	234	}
159		235
160		236
161	static void protomark (TProtoFunc *f) {	237	static void collectstrings (lua_State *L, int all) {
162	if (!f->head.marked) {	238	int i;
163	int i;	239	for (i=0; i<L->strt.size; i++) { /* for each list */
164	f->head.marked = 1;	240	TString **p = &L->strt.hash[i];
165	strmark(f->source);	241	TString *next;
166	for (i=0; i<f->nconsts; i++)	242	while ((next = *p) != NULL) {
167	markobject(&f->consts[i]);	243	if (next->marked && !all) { /* preserve? */
		244	if (next->marked < FIXMARK) /* does not change FIXMARKs */
		245	next->marked = 0;
		246	p = &next->nexthash;
		247	}
		248	else { /* collect */
		249	*p = next->nexthash;
		250	L->strt.nuse--;
		251	L->nblocks -= sizestring(next->len);
		252	luaM_free(L, next);
		253	}
		254	}
168	}	255	}
		256	checktab(L, &L->strt);
169	}	257	}
170		258
171		259
172	static void closuremark (Closure *f)	260	static void collectudata (lua_State *L, int all) {
173	{	261	int i;
174	if (!f->head.marked) {	262	for (i=0; i<L->udt.size; i++) { /* for each list */
175	int i;	263	TString **p = &L->udt.hash[i];
176	f->head.marked = 1;	264	TString *next;
177	for (i=f->nelems; i>=0; i--)	265	while ((next = *p) != NULL) {
178	markobject(&f->consts[i]);	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	}
179	}	280	}
		281	checktab(L, &L->udt);
180	}	282	}
181		283
182		284
183	static void hashmark (Hash *h)	285	#define MINBUFFER 256
184	{	286	static void checkMbuffer (lua_State *L) {
185	if (!h->head.marked) {	287	if (L->Mbuffsize > MINBUFFER2) { / is buffer too big? */
186	int i;	288	size_t newsize = L->Mbuffsize/2; /* still larger than MINBUFFER */
187	h->head.marked = 1;	289	L->nblocks += (newsize - L->Mbuffsize)*sizeof(char);
188	for (i=0; i<nhash(h); i++) {	290	L->Mbuffsize = newsize;
189	Node *n = node(h,i);	291	luaM_reallocvector(L, L->Mbuffer, newsize, char);
190	if (ttype(ref(n)) != LUA_T_NIL) {
191	markobject(&n->ref);
192	markobject(&n->val);
193	}
194	}
195	}	292	}
196	}	293	}
197		294
198		295
199	static void globalmark (void)	296	static void callgcTM (lua_State L, const TObject o) {
200	{	297	Closure *tm = luaT_gettmbyObj(L, o, TM_GC);
201	TaggedString *g;	298	if (tm != NULL) {
202	for (g=(TaggedString )L->rootglobal.next; g; g=(TaggedString )g->head.next){	299	int oldah = L->allowhooks;
203	LUA_ASSERT(g->constindex >= 0, "userdata in global list");	300	L->allowhooks = 0; /* stop debug hooks during GC tag methods */
204	if (g->u.s.globalval.ttype != LUA_T_NIL) {	301	luaD_checkstack(L, 2);
205	markobject(&g->u.s.globalval);	302	clvalue(L->top) = tm;
206	strmark(g); /* cannot collect non nil global variables */	303	ttype(L->top) = LUA_TFUNCTION;
207	}	304	(L->top+1) = o;
		305	L->top += 2;
		306	luaD_call(L, L->top-2, 0);
		307	L->allowhooks = oldah; /* restore hooks */
208	}	308	}
209	}	309	}
210		310
211		311
212	static int markobject (TObject *o)	312	static void callgcTMudata (lua_State *L) {
213	{	313	int tag;
214	switch (ttype(o)) {	314	TObject o;
215	case LUA_T_USERDATA: case LUA_T_STRING:	315	ttype(&o) = LUA_TUSERDATA;
216	strmark(tsvalue(o));	316	L->GCthreshold = 2L->nblocks; / avoid GC during tag methods */
217	break;	317	for (tag=L->last_tag; tag>=0; tag--) { /* for each tag (in reverse order) */
218	case LUA_T_ARRAY:	318	TString *udata;
219	hashmark(avalue(o));	319	while ((udata = L->TMtable[tag].collected) != NULL) {
220	break;	320	L->TMtable[tag].collected = udata->nexthash; /* remove it from list */
221	case LUA_T_CLOSURE: case LUA_T_CLMARK:	321	tsvalue(&o) = udata;
222	closuremark(o->value.cl);	322	callgcTM(L, &o);
223	break;	323	luaM_free(L, udata);
224	case LUA_T_PROTO: case LUA_T_PMARK:	324	}
225	protomark(o->value.tf);
226	break;
227	default: break; /* numbers, cprotos, etc */
228	}	325	}
229	return 0;
230	}	326	}
231		327
232		328
233		329	void luaC_collect (lua_State *L, int all) {
234	static void markall (void)	330	collectudata(L, all);
235	{	331	callgcTMudata(L);
236	luaD_travstack(markobject); /* mark stack objects */	332	collectstrings(L, all);
237	globalmark(); /* mark global variable values and names */	333	collecttable(L);
238	travlock(); /* mark locked objects */	334	collectproto(L);
239	luaT_travtagmethods(markobject); /* mark fallbacks */	335	collectclosure(L);
240	}	336	}
241		337
242		338
243	long lua_collectgarbage (long limit)	339	static void luaC_collectgarbage (lua_State *L) {
244	{	340	markall(L);
245	unsigned long recovered = L->nblocks; /* to subtract nblocks after gc */	341	invalidaterefs(L); /* check unlocked references */
246	Hash *freetable;	342	luaC_collect(L, 0);
247	TaggedString *freestr;	343	checkMbuffer(L);
248	TProtoFunc *freefunc;	344	L->GCthreshold = 2L->nblocks; / set new threshold */
249	Closure *freeclos;	345	callgcTM(L, &luaO_nilobject);
250	markall();
251	invalidaterefs();
252	freestr = luaS_collector();
253	freetable = (Hash *)listcollect(&(L->roottable));
254	freefunc = (TProtoFunc *)listcollect(&(L->rootproto));
255	freeclos = (Closure *)listcollect(&(L->rootcl));
256	L->GCthreshold = 4; / to avoid GC during GC */
257	luaC_hashcallIM(freetable); /* GC tag methods for tables */
258	luaC_strcallIM(freestr); /* GC tag methods for userdata */
259	luaD_gcIM(&luaO_nilobject); /* GC tag method for nil (signal end of GC) */
260	luaH_free(freetable);
261	luaS_free(freestr);
262	luaF_freeproto(freefunc);
263	luaF_freeclosure(freeclos);
264	recovered = recovered-L->nblocks;
265	L->GCthreshold = (limit == 0) ? 2*L->nblocks : L->nblocks+limit;
266	return recovered;
267	}	346	}
268		347
269		348
270	void luaC_checkGC (void)	349	void luaC_checkGC (lua_State *L) {
271	{
272	if (L->nblocks >= L->GCthreshold)	350	if (L->nblocks >= L->GCthreshold)
273	lua_collectgarbage(0);	351	luaC_collectgarbage(L);
274	}	352	}
275		353

src/lgc.h+3−6

 /*
-** $Id: lgc.h,v 1.4 1997/12/01 20:31:25 roberto Exp $
+** $Id: lgc.h,v 1.8 2000/10/02 14:47:43 roberto Exp $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
 #include "lobject.h"
-void luaC_checkGC (void);
+void luaC_collect (lua_State *L, int all);
-TObject* luaC_getref (int ref);
+void luaC_checkGC (lua_State *L);
-int luaC_ref (TObject *o, int lock);
-void luaC_hashcallIM (Hash *l);
-void luaC_strcallIM (TaggedString *l);
 #endif

src/lib/Makefile+3−3

@@ -1,4 +1,4 @@
1	# makefile for lua standard library	1	# makefile for Lua standard library
2		2
3	LUA= ../..	3	LUA= ../..
4		4
@@ -7,8 +7,8 @@ include $(LUA)/config · 2 unmodified lines
7	# actually only used in liolib.c	7	# actually only used in liolib.c
8	EXTRA_DEFS= $(POPEN)	8	EXTRA_DEFS= $(POPEN)
9		9
10	OBJS= linit.o ldblib.o liolib.o lmathlib.o lstrlib.o	10	OBJS= lauxlib.o lbaselib.o ldblib.o liolib.o lmathlib.o lstrlib.o
11	SRCS= linit.c ldblib.c liolib.c lmathlib.c lstrlib.c	11	SRCS= lauxlib.c lbaselib.c ldblib.c liolib.c lmathlib.c lstrlib.c
12		12
13	T= $(LIB)/liblualib.a	13	T= $(LIB)/liblualib.a
14		14

src/lib/README+4−2

@@ -1,4 +1,6 @@
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	It is implemented entirely on top of the official Lua API as declared in lua.h,
3	using src/lauxlib.c, which contains several useful functions.	3	using lauxlib.c, which contains several useful functions for writing libraries.
4	The code can be read as an example of how to export C functions to Lua.	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
		6	C functions to Lua.

src/lib/lauxlib.c+216−0

@@ -0,0 +1,216 @@
	1	/*
	2	** $Id: lauxlib.c,v 1.43 2000/10/30 13:07:48 roberto Exp $
	3	** Auxiliary functions for building Lua libraries
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7
	8	#include <stdarg.h>
	9	#include <stdio.h>
	10	#include <string.h>
	11
	12	/* This file uses only the official API of Lua.
	13	** Any function declared here could be written as an application function.
	14	** With care, these functions can be used by other libraries.
	15	*/
	16
	17	#include "lua.h"
	18
	19	#include "lauxlib.h"
	20	#include "luadebug.h"
	21
	22
	23
	24	LUALIB_API int luaL_findstring (const char name, const char const list[]) {
	25	int i;
	26	for (i=0; list[i]; i++)
	27	if (strcmp(list[i], name) == 0)
	28	return i;
	29	return -1; /* name not found */
	30	}
	31
	32	LUALIB_API void luaL_argerror (lua_State L, int narg, const char extramsg) {
	33	lua_Debug ar;
	34	lua_getstack(L, 0, &ar);
	35	lua_getinfo(L, "n", &ar);
	36	if (ar.name == NULL)
	37	ar.name = "?";
	38	luaL_verror(L, "bad argument #%d to `%.50s' (%.100s)",
	39	narg, ar.name, extramsg);
	40	}
	41
	42
	43	static void type_error (lua_State *L, int narg, int t) {
	44	char buff[50];
	45	sprintf(buff, "%.8s expected, got %.8s", lua_typename(L, t),
	46	lua_typename(L, lua_type(L, narg)));
	47	luaL_argerror(L, narg, buff);
	48	}
	49
	50
	51	LUALIB_API void luaL_checkstack (lua_State L, int space, const char mes) {
	52	if (space > lua_stackspace(L))
	53	luaL_verror(L, "stack overflow (%.30s)", mes);
	54	}
	55
	56
	57	LUALIB_API void luaL_checktype(lua_State *L, int narg, int t) {
	58	if (lua_type(L, narg) != t)
	59	type_error(L, narg, t);
	60	}
	61
	62
	63	LUALIB_API void luaL_checkany (lua_State *L, int narg) {
	64	if (lua_type(L, narg) == LUA_TNONE)
	65	luaL_argerror(L, narg, "value expected");
	66	}
	67
	68
	69	LUALIB_API const char luaL_check_lstr (lua_State L, int narg, size_t *len) {
	70	const char *s = lua_tostring(L, narg);
	71	if (!s) type_error(L, narg, LUA_TSTRING);
	72	if (len) *len = lua_strlen(L, narg);
	73	return s;
	74	}
	75
	76
	77	LUALIB_API const char luaL_opt_lstr (lua_State L, int narg, const char def, size_t len) {
	78	if (lua_isnull(L, narg)) {
	79	if (len)
	80	*len = (def ? strlen(def) : 0);
	81	return def;
	82	}
	83	else return luaL_check_lstr(L, narg, len);
	84	}
	85
	86
	87	LUALIB_API double luaL_check_number (lua_State *L, int narg) {
	88	double d = lua_tonumber(L, narg);
	89	if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */
	90	type_error(L, narg, LUA_TNUMBER);
	91	return d;
	92	}
	93
	94
	95	LUALIB_API double luaL_opt_number (lua_State *L, int narg, double def) {
	96	if (lua_isnull(L, narg)) return def;
	97	else return luaL_check_number(L, narg);
	98	}
	99
	100
	101	LUALIB_API void luaL_openlib (lua_State L, const struct luaL_reg l, int n) {
	102	int i;
	103	for (i=0; i<n; i++)
	104	lua_register(L, l[i].name, l[i].func);
	105	}
	106
	107
	108	LUALIB_API void luaL_verror (lua_State L, const char fmt, ...) {
	109	char buff[500];
	110	va_list argp;
	111	va_start(argp, fmt);
	112	vsprintf(buff, fmt, argp);
	113	va_end(argp);
	114	lua_error(L, buff);
	115	}
	116
	117
	118	/*
	119	** {======================================================
	120	** Generic Buffer manipulation
	121	** =======================================================
	122	*/
	123
	124
	125	#define buffempty(B) ((B)->p == (B)->buffer)
	126	#define bufflen(B) ((B)->p - (B)->buffer)
	127	#define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B)))
	128
	129	#define LIMIT (LUA_MINSTACK/2)
	130
	131
	132	static int emptybuffer (luaL_Buffer *B) {
	133	size_t l = bufflen(B);
	134	if (l == 0) return 0; /* put nothing on stack */
	135	else {
	136	lua_pushlstring(B->L, B->buffer, l);
	137	B->p = B->buffer;
	138	B->level++;
	139	return 1;
	140	}
	141	}
	142
	143
	144	static void adjuststack (luaL_Buffer *B) {
	145	if (B->level > 1) {
	146	lua_State *L = B->L;
	147	int toget = 1; /* number of levels to concat */
	148	size_t toplen = lua_strlen(L, -1);
	149	do {
	150	size_t l = lua_strlen(L, -(toget+1));
	151	if (B->level - toget + 1 >= LIMIT \|\| toplen > l) {
	152	toplen += l;
	153	toget++;
	154	}
	155	else break;
	156	} while (toget < B->level);
	157	if (toget >= 2) {
	158	lua_concat(L, toget);
	159	B->level = B->level - toget + 1;
	160	}
	161	}
	162	}
	163
	164
	165	LUALIB_API char luaL_prepbuffer (luaL_Buffer B) {
	166	if (emptybuffer(B))
	167	adjuststack(B);
	168	return B->buffer;
	169	}
	170
	171
	172	LUALIB_API void luaL_addlstring (luaL_Buffer B, const char s, size_t l) {
	173	while (l--)
	174	luaL_putchar(B, *s++);
	175	}
	176
	177
	178	LUALIB_API void luaL_addstring (luaL_Buffer B, const char s) {
	179	luaL_addlstring(B, s, strlen(s));
	180	}
	181
	182
	183	LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
	184	emptybuffer(B);
	185	if (B->level == 0)
	186	lua_pushlstring(B->L, NULL, 0);
	187	else if (B->level > 1)
	188	lua_concat(B->L, B->level);
	189	B->level = 1;
	190	}
	191
	192
	193	LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
	194	lua_State *L = B->L;
	195	size_t vl = lua_strlen(L, -1);
	196	if (vl <= bufffree(B)) { /* fit into buffer? */
	197	memcpy(B->p, lua_tostring(L, -1), vl); /* put it there */
	198	B->p += vl;
	199	lua_pop(L, 1); /* remove from stack */
	200	}
	201	else {
	202	if (emptybuffer(B))
	203	lua_insert(L, -2); /* put buffer before new value */
	204	B->level++; /* add new value into B stack */
	205	adjuststack(B);
	206	}
	207	}
	208
	209
	210	LUALIB_API void luaL_buffinit (lua_State L, luaL_Buffer B) {
	211	B->L = L;
	212	B->p = B->buffer;
	213	B->level = 0;
	214	}
	215
	216	/* }====================================================== */

src/lib/lbaselib.c+651−0

@@ -0,0 +1,651 @@
	1	/*
	2	** $Id: lbaselib.c,v 1.17 2000/11/06 13:45:18 roberto Exp $
	3	** Basic library
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7
	8
	9	#include <ctype.h>
	10	#include <stdio.h>
	11	#include <stdlib.h>
	12	#include <string.h>
	13
	14	#include "lua.h"
	15
	16	#include "lauxlib.h"
	17	#include "luadebug.h"
	18	#include "lualib.h"
	19
	20
	21
	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
	60	/*
	61	** If your system does not support `stdout', you can just remove this function.
	62	** If you need, you can define your own `print' function, following this
	63	** model but changing `fputs' to put the strings at a proper place
	64	** (a console window or a log file, for instance).
	65	*/
	66	static int luaB_print (lua_State *L) {
	67	int n = lua_gettop(L); /* number of arguments */
	68	int i;
	69	lua_getglobal(L, "tostring");
	70	for (i=1; i<=n; i++) {
	71	const char *s;
	72	lua_pushvalue(L, -1); /* function to be called */
	73	lua_pushvalue(L, i); /* value to print */
	74	lua_rawcall(L, 1, 1);
	75	s = lua_tostring(L, -1); /* get result */
	76	if (s == NULL)
	77	lua_error(L, "`tostring' must return a string to `print'");
	78	if (i>1) fputs("\t", stdout);
	79	fputs(s, stdout);
	80	lua_pop(L, 1); /* pop result */
	81	}
	82	fputs("\n", stdout);
	83	return 0;
	84	}
	85
	86
	87	static int luaB_tonumber (lua_State *L) {
	88	int base = luaL_opt_int(L, 2, 10);
	89	if (base == 10) { /* standard conversion */
	90	luaL_checkany(L, 1);
	91	if (lua_isnumber(L, 1)) {
	92	lua_pushnumber(L, lua_tonumber(L, 1));
	93	return 1;
	94	}
	95	}
	96	else {
	97	const char *s1 = luaL_check_string(L, 1);
	98	char *s2;
	99	unsigned long n;
	100	luaL_arg_check(L, 2 <= base && base <= 36, 2, "base out of range");
	101	n = strtoul(s1, &s2, base);
	102	if (s1 != s2) { /* at least one valid digit? */
	103	while (isspace((unsigned char)s2)) s2++; / skip trailing spaces */
	104	if (s2 == '\0') { / no invalid trailing characters? */
	105	lua_pushnumber(L, n);
	106	return 1;
	107	}
	108	}
	109	}
	110	lua_pushnil(L); /* else not a number */
	111	return 1;
	112	}
	113
	114
	115	static int luaB_error (lua_State *L) {
	116	lua_error(L, luaL_opt_string(L, 1, NULL));
	117	return 0; /* to avoid warnings */
	118	}
	119
	120	static int luaB_setglobal (lua_State *L) {
	121	luaL_checkany(L, 2);
	122	lua_setglobal(L, luaL_check_string(L, 1));
	123	return 0;
	124	}
	125
	126	static int luaB_getglobal (lua_State *L) {
	127	lua_getglobal(L, luaL_check_string(L, 1));
	128	return 1;
	129	}
	130
	131	static int luaB_tag (lua_State *L) {
	132	luaL_checkany(L, 1);
	133	lua_pushnumber(L, lua_tag(L, 1));
	134	return 1;
	135	}
	136
	137	static int luaB_settag (lua_State *L) {
	138	luaL_checktype(L, 1, LUA_TTABLE);
	139	lua_pushvalue(L, 1); /* push table */
	140	lua_settag(L, luaL_check_int(L, 2));
	141	return 1; /* return table */
	142	}
	143
	144	static int luaB_newtag (lua_State *L) {
	145	lua_pushnumber(L, lua_newtag(L));
	146	return 1;
	147	}
	148
	149	static int luaB_copytagmethods (lua_State *L) {
	150	lua_pushnumber(L, lua_copytagmethods(L, luaL_check_int(L, 1),
	151	luaL_check_int(L, 2)));
	152	return 1;
	153	}
	154
	155	static int luaB_globals (lua_State *L) {
	156	lua_getglobals(L); /* value to be returned */
	157	if (!lua_isnull(L, 1)) {
	158	luaL_checktype(L, 1, LUA_TTABLE);
	159	lua_pushvalue(L, 1); /* new table of globals */
	160	lua_setglobals(L);
	161	}
	162	return 1;
	163	}
	164
	165	static int luaB_rawget (lua_State *L) {
	166	luaL_checktype(L, 1, LUA_TTABLE);
	167	luaL_checkany(L, 2);
	168	lua_rawget(L, -2);
	169	return 1;
	170	}
	171
	172	static int luaB_rawset (lua_State *L) {
	173	luaL_checktype(L, 1, LUA_TTABLE);
	174	luaL_checkany(L, 2);
	175	luaL_checkany(L, 3);
	176	lua_rawset(L, -3);
	177	return 1;
	178	}
	179
	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
	204	static int luaB_gcinfo (lua_State *L) {
	205	lua_pushnumber(L, lua_getgccount(L));
	206	lua_pushnumber(L, lua_getgcthreshold(L));
	207	return 2;
	208	}
	209
	210
	211	static int luaB_collectgarbage (lua_State *L) {
	212	lua_setgcthreshold(L, luaL_opt_int(L, 1, 0));
	213	return 0;
	214	}
	215
	216
	217	static int luaB_type (lua_State *L) {
	218	luaL_checkany(L, 1);
	219	lua_pushstring(L, lua_typename(L, lua_type(L, 1)));
	220	return 1;
	221	}
	222
	223
	224	static int luaB_next (lua_State *L) {
	225	luaL_checktype(L, 1, LUA_TTABLE);
	226	lua_settop(L, 2); /* create a 2nd argument if there isn't one */
	227	if (lua_next(L, 1))
	228	return 2;
	229	else {
	230	lua_pushnil(L);
	231	return 1;
	232	}
	233	}
	234
	235
	236	static int passresults (lua_State *L, int status, int oldtop) {
	237	static const char *const errornames[] =
	238	{"ok", "run-time error", "file error", "syntax error",
	239	"memory error", "error in error handling"};
	240	if (status == 0) {
	241	int nresults = lua_gettop(L) - oldtop;
	242	if (nresults > 0)
	243	return nresults; /* results are already on the stack */
	244	else {
	245	lua_pushuserdata(L, NULL); /* at least one result to signal no errors */
	246	return 1;
	247	}
	248	}
	249	else { /* error */
	250	lua_pushnil(L);
	251	lua_pushstring(L, errornames[status]); /* error code */
	252	return 2;
	253	}
	254	}
	255
	256	static int luaB_dostring (lua_State *L) {
	257	int oldtop = lua_gettop(L);
	258	size_t l;
	259	const char *s = luaL_check_lstr(L, 1, &l);
	260	if (s == '\27') / binary files start with ESC... */
	261	lua_error(L, "`dostring' cannot run pre-compiled code");
	262	return passresults(L, lua_dobuffer(L, s, l, luaL_opt_string(L, 2, s)), oldtop);
	263	}
	264
	265
	266	static int luaB_dofile (lua_State *L) {
	267	int oldtop = lua_gettop(L);
	268	const char *fname = luaL_opt_string(L, 1, NULL);
	269	return passresults(L, lua_dofile(L, fname), oldtop);
	270	}
	271
	272
	273	static int luaB_call (lua_State *L) {
	274	int oldtop;
	275	const char *options = luaL_opt_string(L, 3, "");
	276	int err = 0; /* index of old error method */
	277	int i, status;
	278	int n;
	279	luaL_checktype(L, 2, LUA_TTABLE);
	280	n = lua_getn(L, 2);
	281	if (!lua_isnull(L, 4)) { /* set new error method */
	282	lua_getglobal(L, LUA_ERRORMESSAGE);
	283	err = lua_gettop(L); /* get index */
	284	lua_pushvalue(L, 4);
	285	lua_setglobal(L, LUA_ERRORMESSAGE);
	286	}
	287	oldtop = lua_gettop(L); /* top before function-call preparation */
	288	/* push function */
	289	lua_pushvalue(L, 1);
	290	luaL_checkstack(L, n, "too many arguments");
	291	for (i=0; i<n; i++) /* push arg[1...n] */
	292	lua_rawgeti(L, 2, i+1);
	293	status = lua_call(L, n, LUA_MULTRET);
	294	if (err != 0) { /* restore old error method */
	295	lua_pushvalue(L, err);
	296	lua_setglobal(L, LUA_ERRORMESSAGE);
	297	}
	298	if (status != 0) { /* error in call? */
	299	if (strchr(options, 'x'))
	300	lua_pushnil(L); /* return nil to signal the error */
	301	else
	302	lua_error(L, NULL); /* propagate error without additional messages */
	303	return 1;
	304	}
	305	if (strchr(options, 'p')) /* pack results? */
	306	lua_error(L, "deprecated option `p' in `call'");
	307	return lua_gettop(L) - oldtop; /* results are already on the stack */
	308	}
	309
	310
	311	static int luaB_tostring (lua_State *L) {
	312	char buff[64];
	313	switch (lua_type(L, 1)) {
	314	case LUA_TNUMBER:
	315	lua_pushstring(L, lua_tostring(L, 1));
	316	return 1;
	317	case LUA_TSTRING:
	318	lua_pushvalue(L, 1);
	319	return 1;
	320	case LUA_TTABLE:
	321	sprintf(buff, "table: %p", lua_topointer(L, 1));
	322	break;
	323	case LUA_TFUNCTION:
	324	sprintf(buff, "function: %p", lua_topointer(L, 1));
	325	break;
	326	case LUA_TUSERDATA:
	327	sprintf(buff, "userdata(%d): %p", lua_tag(L, 1), lua_touserdata(L, 1));
	328	break;
	329	case LUA_TNIL:
	330	lua_pushstring(L, "nil");
	331	return 1;
	332	default:
	333	luaL_argerror(L, 1, "value expected");
	334	}
	335	lua_pushstring(L, buff);
	336	return 1;
	337	}
	338
	339
	340	static int luaB_foreachi (lua_State *L) {
	341	int n, i;
	342	luaL_checktype(L, 1, LUA_TTABLE);
	343	luaL_checktype(L, 2, LUA_TFUNCTION);
	344	n = lua_getn(L, 1);
	345	for (i=1; i<=n; i++) {
	346	lua_pushvalue(L, 2); /* function */
	347	lua_pushnumber(L, i); /* 1st argument */
	348	lua_rawgeti(L, 1, i); /* 2nd argument */
	349	lua_rawcall(L, 2, 1);
	350	if (!lua_isnil(L, -1))
	351	return 1;
	352	lua_pop(L, 1); /* remove nil result */
	353	}
	354	return 0;
	355	}
	356
	357
	358	static int luaB_foreach (lua_State *L) {
	359	luaL_checktype(L, 1, LUA_TTABLE);
	360	luaL_checktype(L, 2, LUA_TFUNCTION);
	361	lua_pushnil(L); /* first index */
	362	for (;;) {
	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	}
	373	}
	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;
	388	}
	389
	390
	391	static int luaB_tinsert (lua_State *L) {
	392	int v = lua_gettop(L); /* last argument: to be inserted */
	393	int n, pos;
	394	luaL_checktype(L, 1, LUA_TTABLE);
	395	n = lua_getn(L, 1);
	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
	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
	432
	433
	434
	435	/*
	436	** {======================================================
	437	** Quicksort
	438	** (based on `Algorithms in MODULA-3', Robert Sedgewick;
	439	** Addison-Wesley, 1993.)
	440	*/
	441
	442
	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
	448	static int sort_comp (lua_State *L, int a, int b) {
	449	/* WARNING: the caller (auxsort) must ensure stack space */
	450	if (!lua_isnil(L, 2)) { /* function? */
	451	int res;
	452	lua_pushvalue(L, 2);
	453	lua_pushvalue(L, a-1); /* -1 to compensate function */
	454	lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */
	455	lua_rawcall(L, 2, 1);
	456	res = !lua_isnil(L, -1);
	457	lua_pop(L, 1);
	458	return res;
	459	}
	460	else /* a < b? */
	461	return lua_lessthan(L, a, b);
	462	}
	463
	464	static void auxsort (lua_State *L, int l, int u) {
	465	while (l < u) { /* for tail recursion */
	466	int i, j;
	467	/* sort elements a[l], a[(l+u)/2] and a[u] */
	468	lua_rawgeti(L, 1, l);
	469	lua_rawgeti(L, 1, u);
	470	if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */
	471	set2(L, l, u); /* swap a[l] - a[u] */
	472	else
	473	lua_pop(L, 2);
	474	if (u-l == 1) break; /* only 2 elements */
	475	i = (l+u)/2;
	476	lua_rawgeti(L, 1, i);
	477	lua_rawgeti(L, 1, l);
	478	if (sort_comp(L, -2, -1)) /* a[i]<a[l]? */
	479	set2(L, i, l);
	480	else {
	481	lua_pop(L, 1); /* remove a[l] */
	482	lua_rawgeti(L, 1, u);
	483	if (sort_comp(L, -1, -2)) /* a[u]<a[i]? */
	484	set2(L, i, u);
	485	else
	486	lua_pop(L, 2);
	487	}
	488	if (u-l == 2) break; /* only 3 elements */
	489	lua_rawgeti(L, 1, i); /* Pivot */
	490	lua_pushvalue(L, -1);
	491	lua_rawgeti(L, 1, u-1);
	492	set2(L, i, u-1);
	493	/* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */
	494	i = l; j = u-1;
	495	for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */
	496	/* repeat ++i until a[i] >= P */
	497	while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) {
	498	if (i>u) lua_error(L, "invalid order function for sorting");
	499	lua_pop(L, 1); /* remove a[i] */
	500	}
	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	}
	510	set2(L, i, j);
	511	}
	512	lua_rawgeti(L, 1, u-1);
	513	lua_rawgeti(L, 1, i);
	514	set2(L, u-1, i); /* swap pivot (a[u-1]) with a[i] */
	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	}
	520	else {
	521	j=i+1; i=u; u=j-2;
	522	}
	523	auxsort(L, j, i); /* call recursively the smaller one */
	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	}
	537
	538	/* }====================================================== */
	539
	540
	541
	542	/*
	543	** {======================================================
	544	** Deprecated functions to manipulate global environment.
	545	** =======================================================
	546	*/
	547
	548
	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
	558
	559	#ifdef LUA_DEPRECATEDFUNCS
	560
	561	/*
	562	** call corresponding function inserting `globals' as first argument
	563	*/
	564	static int deprecated_func (lua_State *L) {
	565	lua_insert(L, 1); /* upvalue is the function to be called */
	566	lua_getglobals(L);
	567	lua_insert(L, 2); /* table of globals is 1o argument */
	568	lua_rawcall(L, lua_gettop(L)-1, LUA_MULTRET);
	569	return lua_gettop(L); /* return all results */
	570	}
	571
	572
	573	static void deprecated_funcs (lua_State *L) {
	574	int i;
	575	for (i=0; i<num_deprecated; i++) {
	576	lua_pushcfunction(L, deprecated_names[i].func);
	577	lua_pushcclosure(L, deprecated_func, 1);
	578	lua_setglobal(L, deprecated_names[i].name);
	579	}
	580	}
	581
	582
	583	#else
	584
	585	/*
	586	** gives an explicit error in any attempt to call a deprecated function
	587	*/
	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	}
	592
	593
	594	static void deprecated_funcs (lua_State *L) {
	595	int i;
	596	for (i=0; i<num_deprecated; i++) {
	597	lua_pushstring(L, deprecated_names[i].name);
	598	lua_pushcclosure(L, deprecated_func, 1);
	599	lua_setglobal(L, deprecated_names[i].name);
	600	}
	601	}
	602
	603	#endif
	604
	605	/* }====================================================== */
	606
	607	static const struct luaL_reg base_funcs[] = {
	608	{LUA_ALERT, luaB__ALERT},
	609	{LUA_ERRORMESSAGE, luaB__ERRORMESSAGE},
	610	{"call", luaB_call},
	611	{"collectgarbage", luaB_collectgarbage},
	612	{"copytagmethods", luaB_copytagmethods},
	613	{"dofile", luaB_dofile},
	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	};
	642
	643
	644
	645	LUALIB_API void lua_baselibopen (lua_State *L) {
	646	luaL_openl(L, base_funcs);
	647	lua_pushstring(L, LUA_VERSION);
	648	lua_setglobal(L, "_VERSION");
	649	deprecated_funcs(L);
	650	}
	651

src/lib/ldblib.c+124−153

 /*
-** $Id: ldblib.c,v 1.5 1999/03/04 21:17:26 roberto Exp $
+** $Id: ldblib.c,v 1.29 2000/11/06 17:58:38 roberto Exp $
 ** Interface from Lua to its debug API
 ** See Copyright Notice in lua.h
 */
+#include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
-#include "lauxlib.h"
 #include "lua.h"
+#include "lauxlib.h"
 #include "luadebug.h"
 #include "lualib.h"
-static void settabss (lua_Object t, char *i, char *v) {
+static void settabss (lua_State *L, const char *i, const char *v) {
-  lua_pushobject(t);
+  lua_pushstring(L, i);
-  lua_pushstring(i);
+  lua_pushstring(L, v);
-  lua_pushstring(v);
+  lua_settable(L, -3);
-  lua_settable();
 }
-static void settabsi (lua_Object t, char *i, int v) {
+static void settabsi (lua_State *L, const char *i, int v) {
-  lua_pushobject(t);
+  lua_pushstring(L, i);
-  lua_pushstring(i);
+  lua_pushnumber(L, v);
-  lua_pushnumber(v);
+  lua_settable(L, -3);
-  lua_settable();
 }
-static lua_Object getfuncinfo (lua_Object func) {
+static int getinfo (lua_State *L) {
-  lua_Object result = lua_createtable();
+  lua_Debug ar;
-  char *str;
+  const char *options = luaL_opt_string(L, 2, "flnSu");
-  int line;
+  char buff[20];
-  lua_funcinfo(func, &str, &line);
+  if (lua_isnumber(L, 1)) {
-  if (line == -1)  /* C function? */
+    if (!lua_getstack(L, (int)lua_tonumber(L, 1), &ar)) {
-    settabss(result, "kind", "C");
+      lua_pushnil(L);  /* level out of range */
-  else if (line == 0) {  /* "main"? */
+      return 1;
-      settabss(result, "kind", "chunk");
-      settabss(result, "source", str);
     }
-  else {  /* Lua function */
-    settabss(result, "kind", "Lua");
-    settabsi(result, "def_line", line);
-    settabss(result, "source", str);
   }
-  if (line != 0) {  /* is it not a "main"? */
+  else if (lua_isfunction(L, 1)) {
-    char *kind = lua_getobjname(func, &str);
+    lua_pushvalue(L, 1);
-    if (*kind) {
+    sprintf(buff, ">%.10s", options);
-      settabss(result, "name", str);
+    options = buff;
-      settabss(result, "where", kind);
+  }
+  else
+    luaL_argerror(L, 1, "function or level expected");
+  if (!lua_getinfo(L, options, &ar))
+    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);
+        settabsi(L, "linedefined", ar.linedefined);
+        settabss(L, "what", ar.what);
+        break;
+      case 'l':
+        settabsi(L, "currentline", ar.currentline);
+        break;
+      case 'u':
+        settabsi(L, "nups", ar.nups);
+        break;
+      case 'n':
+        settabss(L, "name", ar.name);
+        settabss(L, "namewhat", ar.namewhat);
+        break;
+      case 'f':
+        lua_pushstring(L, "func");
+        lua_pushvalue(L, -3);
+        lua_settable(L, -3);
+        break;
     }
   }
-  return result;
+  return 1;  /* return table */
 }
-static void getstack (void) {
+static int getlocal (lua_State *L) {
-  lua_Object func = lua_stackedfunction(luaL_check_int(1));
+  lua_Debug ar;
-  if (func == LUA_NOOBJECT)  /* level out of range? */
+  const char *name;
-    return;
+  if (!lua_getstack(L, luaL_check_int(L, 1), &ar))  /* level out of range? */
-  else {
+    luaL_argerror(L, 1, "level out of range");
-    lua_Object result = getfuncinfo(func);
+  name = lua_getlocal(L, &ar, luaL_check_int(L, 2));
-    int currline = lua_currentline(func);
+  if (name) {
-    if (currline > 0)
+    lua_pushstring(L, name);
-      settabsi(result, "current", currline);
+    lua_pushvalue(L, -2);
-    lua_pushobject(result);
+    return 2;
-    lua_pushstring("func");
-    lua_pushobject(func);
-    lua_settable();  /* result.func = func */
-    lua_pushobject(result);
   }
-}
-static void funcinfo (void) {
-  lua_pushobject(getfuncinfo(luaL_functionarg(1)));
-}
-static int findlocal (lua_Object func, int arg) {
-  lua_Object v = lua_getparam(arg);
-  if (lua_isnumber(v))
-    return (int)lua_getnumber(v);
   else {
-    char *name = luaL_check_string(arg);
+    lua_pushnil(L);
-    int i = 0;
+    return 1;
-    int result = -1;
-    char *vname;
-    while (lua_getlocal(func, ++i, &vname) != LUA_NOOBJECT) {
-      if (strcmp(name, vname) == 0)
-        result = i;  /* keep looping to get the last var with this name */
-    }
-    if (result == -1)
-      luaL_verror("no local variable `%.50s' at given level", name);
-    return result;
   }
 }
-static void getlocal (void) {
+static int setlocal (lua_State *L) {
-  lua_Object func = lua_stackedfunction(luaL_check_int(1));
+  lua_Debug ar;
-  lua_Object val;
+  if (!lua_getstack(L, luaL_check_int(L, 1), &ar))  /* level out of range? */
-  char *name;
+    luaL_argerror(L, 1, "level out of range");
-  if (func == LUA_NOOBJECT)  /* level out of range? */
+  luaL_checkany(L, 3);
-    return;  /* return nil */
+  lua_pushstring(L, lua_setlocal(L, &ar, luaL_check_int(L, 2)));
-  else if (lua_getparam(2) != LUA_NOOBJECT) {  /* 2nd argument? */
+  return 1;
-    if ((val = lua_getlocal(func, findlocal(func, 2), &name)) != LUA_NOOBJECT) {
-      lua_pushobject(val);
-      lua_pushstring(name);
-    }
-    /* else return nil */
-  }
-  else {  /* collect all locals in a table */
-    lua_Object result = lua_createtable();
-    int i;
-    for (i=1; ;i++) {
-      if ((val = lua_getlocal(func, i, &name)) == LUA_NOOBJECT)
-        break;
-      lua_pushobject(result);
-      lua_pushstring(name);
-      lua_pushobject(val);
-      lua_settable();  /* result[name] = value */
-    }
-    lua_pushobject(result);
-  }
 }
-static void setlocal (void) {
-  lua_Object func = lua_stackedfunction(luaL_check_int(1));
-  int numvar;
-  luaL_arg_check(func != LUA_NOOBJECT, 1, "level out of range");
-  numvar = findlocal(func, 2);
-  lua_pushobject(luaL_nonnullarg(3));
-  if (!lua_setlocal(func, numvar))
-    lua_error("no such local variable");
-}
+/* dummy variables (to define unique addresses) */
+static char key1, key2;
+#define KEY_CALLHOOK	(&key1)
+#define KEY_LINEHOOK	(&key2)
-static int linehook = -1;  /* Lua reference to line hook function */
+static void hookf (lua_State *L, void *key) {
-static int callhook = -1;  /* Lua reference to call hook function */
+  lua_getregistry(L);
+  lua_pushuserdata(L, key);
+  lua_gettable(L, -2);
+  if (lua_isfunction(L, -1)) {
+    lua_pushvalue(L, 1);
+    lua_rawcall(L, 1, 0);
+  }
+  else
+    lua_pop(L, 1);  /* pop result from gettable */
+  lua_pop(L, 1);  /* pop table */
+}
-static void dohook (int ref) {
+static void callf (lua_State *L, lua_Debug *ar) {
-  lua_LHFunction oldlinehook = lua_setlinehook(NULL);
+  lua_pushstring(L, ar->event);
-  lua_CHFunction oldcallhook = lua_setcallhook(NULL);
+  hookf(L, KEY_CALLHOOK);
-  lua_callfunction(lua_getref(ref));
-  lua_setlinehook(oldlinehook);
-  lua_setcallhook(oldcallhook);
 }
-static void linef (int line) {
+static void linef (lua_State *L, lua_Debug *ar) {
-  lua_pushnumber(line);
+  lua_pushnumber(L, ar->currentline);
-  dohook(linehook);
+  hookf(L, KEY_LINEHOOK);
 }
-static void callf (lua_Function func, char *file, int line) {
+static void sethook (lua_State *L, void *key, lua_Hook hook,
-  if (func != LUA_NOOBJECT) {
+                     lua_Hook (*sethookf)(lua_State * L, lua_Hook h)) {
-    lua_pushobject(func);
+  lua_settop(L, 1);
-    lua_pushstring(file);
+  if (lua_isnil(L, 1))
-    lua_pushnumber(line);
+    (*sethookf)(L, NULL);
-  }
+  else if (lua_isfunction(L, 1))
-  dohook(callhook);
+    (*sethookf)(L, hook);
+  else
+    luaL_argerror(L, 1, "function expected");
+  lua_getregistry(L);
+  lua_pushuserdata(L, key);
+  lua_pushvalue(L, -1);  /* dup key */
+  lua_gettable(L, -3);   /* get old value */
+  lua_pushvalue(L, -2);  /* key (again) */
+  lua_pushvalue(L, 1);
+  lua_settable(L, -5);  /* set new value */
 }
-static void setcallhook (void) {
+static int setcallhook (lua_State *L) {
-  lua_Object f = lua_getparam(1);
+  sethook(L, KEY_CALLHOOK, callf, lua_setcallhook);
-  lua_unref(callhook);
+  return 1;
-  if (f == LUA_NOOBJECT) {
-    callhook = -1;
-    lua_setcallhook(NULL);
-  }
-  else {
-    lua_pushobject(f);
-    callhook = lua_ref(1);
-    lua_setcallhook(callf);
-  }
 }
-static void setlinehook (void) {
+static int setlinehook (lua_State *L) {
-  lua_Object f = lua_getparam(1);
+  sethook(L, KEY_LINEHOOK, linef, lua_setlinehook);
-  lua_unref(linehook);
+  return 1;
-  if (f == LUA_NOOBJECT) {
-    linehook = -1;
-    lua_setlinehook(NULL);
-  }
-  else {
-    lua_pushobject(f);
-    linehook = lua_ref(1);
-    lua_setlinehook(linef);
-  }
 }
-static struct luaL_reg dblib[] = {
+static const struct luaL_reg dblib[] = {
-  {"funcinfo", funcinfo},
   {"getlocal", getlocal},
-  {"getstack", getstack},
+  {"getinfo", getinfo},
   {"setcallhook", setcallhook},
   {"setlinehook", setlinehook},
   {"setlocal", setlocal}
 };
-void lua_dblibopen (void) {
+LUALIB_API void lua_dblibopen (lua_State *L) {
-  luaL_openlib(dblib, (sizeof(dblib)/sizeof(dblib[0])));
+  luaL_openl(L, dblib);
 }

src/lib/linit.c+0−17

@@ -1,17 +0,0 @@
1	/*
2	** $Id: linit.c,v 1.1 1999/01/08 16:49:32 roberto Exp $
3	** Initialization of libraries for lua.c
4	** See Copyright Notice in lua.h
5	*/
6
7	#include "lua.h"
8	#include "lualib.h"
9
10
11	void lua_userinit (void) {
12	lua_iolibopen();
13	lua_strlibopen();
14	lua_mathlibopen();
15	lua_dblibopen();
16	}
17

src/lib/liolib.c+432−297

@@ -1,67 +1,78 @@
1	/*	1	/*
2	** $Id: liolib.c,v 1.41 1999/06/23 13:48:39 roberto Exp $	2	** $Id: liolib.c,v 1.91 2000/10/31 13:10:24 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 <errno.h>	8	#include <ctype.h>
9	#include <stdio.h>	9	#include <stdio.h>
10	#include <stdlib.h>	10	#include <stdlib.h>
11	#include <string.h>	11	#include <string.h>
12	#include <time.h>	12	#include <time.h>
13		13
14	#include "lauxlib.h"
15	#include "lua.h"	14	#include "lua.h"
		15
		16	#include "lauxlib.h"
16	#include "luadebug.h"	17	#include "luadebug.h"
17	#include "lualib.h"	18	#include "lualib.h"
18		19
19		20
20	#ifndef OLD_ANSI	21	#ifndef OLD_ANSI
		22	#include <errno.h>
21	#include <locale.h>	23	#include <locale.h>
		24	#define realloc(b,s) ((b) == NULL ? malloc(s) : (realloc)(b, s))
		25	#define free(b) if (b) (free)(b)
22	#else	26	#else
23	/* no support for locale and for strerror: fake them */	27	/* no support for locale and for strerror: fake them */
24	#define setlocale(a,b) 0	28	#define setlocale(a,b) ((void)a, strcmp((b),"C")==0?"C":NULL)
25	#define LC_ALL 0	29	#define LC_ALL 0
26	#define LC_COLLATE 0	30	#define LC_COLLATE 0
27	#define LC_CTYPE 0	31	#define LC_CTYPE 0
28	#define LC_MONETARY 0	32	#define LC_MONETARY 0
29	#define LC_NUMERIC 0	33	#define LC_NUMERIC 0
30	#define LC_TIME 0	34	#define LC_TIME 0
31	#define strerror(e) "(no error message provided by operating system)"	35	#define strerror(e) "generic I/O error"
		36	#define errno (-1)
32	#endif	37	#endif
33		38
34		39
35	#define IOTAG 1
36
37	#define FIRSTARG 2 /* 1st is upvalue */
38
39	#define CLOSEDTAG(tag) ((tag)-1) /* assume that CLOSEDTAG = iotag-1 */
40
41
42	#define FINPUT "_INPUT"
43	#define FOUTPUT "_OUTPUT"
44
45		40
46	#ifdef POPEN	41	#ifdef POPEN
47	FILE *popen();	42	/* FILE *popen();
48	int pclose();	43	int pclose(); */
49	#define CLOSEFILE(f) {if (pclose(f) == -1) fclose(f);}	44	#define CLOSEFILE(L, f) ((pclose(f) == -1) ? fclose(f) : 0)
50	#else	45	#else
51	/* no support for popen */	46	/* no support for popen */
52	#define popen(x,y) NULL /* that is, popen always fails */	47	#define popen(x,y) NULL /* that is, popen always fails */
53	#define CLOSEFILE(f) {fclose(f);}	48	#define CLOSEFILE(L, f) (fclose(f))
54	#endif	49	#endif
55		50
56		51
		52	#define INFILE 0
		53	#define OUTFILE 1
		54
		55	typedef struct IOCtrl {
		56	int ref[2]; /* ref for strings _INPUT/_OUTPUT */
		57	int iotag; /* tag for file handles */
		58	int closedtag; /* tag for closed handles */
		59	} IOCtrl;
		60
		61
		62
		63	static const char *const filenames[] = {"_INPUT", "_OUTPUT"};
57		64
58	static void pushresult (int i) {	65
59	if (i)	66	static int pushresult (lua_State *L, int i) {
60	lua_pushuserdata(NULL);	67	if (i) {
		68	lua_pushuserdata(L, NULL);
		69	return 1;
		70	}
61	else {	71	else {
62	lua_pushnil();	72	lua_pushnil(L);
63	lua_pushstring(strerror(errno));	73	lua_pushstring(L, strerror(errno));
64	lua_pushnumber(errno);	74	lua_pushnumber(L, errno);
		75	return 3;;
65	}	76	}
66	}	77	}
67		78
@@ -72,138 +83,138 @@ static void pushresult (int i) { · 4 unmodified lines
72	** =======================================================	83	** =======================================================
73	*/	84	*/
74		85
75	static int gettag (void) {
76	return (int)lua_getnumber(lua_getparam(IOTAG));
77	}
78		86
79		87	static FILE gethandle (lua_State L, IOCtrl *ctrl, int f) {
80	static int ishandle (lua_Object f) {	88	void *p = lua_touserdata(L, f);
81	if (lua_isuserdata(f)) {	89	if (p != NULL) { /* is `f' a userdata ? */
82	int tag = gettag();	90	int ftag = lua_tag(L, f);
83	if (lua_tag(f) == CLOSEDTAG(tag))	91	if (ftag == ctrl->iotag) /* does it have the correct tag? */
84	lua_error("cannot access a closed file");	92	return (FILE *)p;
85	return lua_tag(f) == tag;	93	else if (ftag == ctrl->closedtag)
		94	lua_error(L, "cannot access a closed file");
		95	/* else go through */
86	}	96	}
87	else return 0;	97	return NULL;
88	}	98	}
89		99
90		100
91	static FILE getfilebyname (char name) {	101	static FILE getnonullfile (lua_State L, IOCtrl *ctrl, int arg) {
92	lua_Object f = lua_getglobal(name);	102	FILE *f = gethandle(L, ctrl, arg);
93	if (!ishandle(f))	103	luaL_arg_check(L, f, arg, "invalid file handle");
94	luaL_verror("global variable `%.50s' is not a file handle", name);	104	return f;
95	return lua_getuserdata(f);
96	}
97
98
99	static FILE *getfile (int arg) {
100	lua_Object f = lua_getparam(arg);
101	return (ishandle(f)) ? lua_getuserdata(f) : NULL;
102	}	105	}
103		106
104		107
105	static FILE *getnonullfile (int arg) {	108	static FILE getfilebyref (lua_State L, IOCtrl *ctrl, int inout) {
106	FILE *f = getfile(arg);	109	FILE *f;
107	luaL_arg_check(f, arg, "invalid file handle");	110	lua_getglobals(L);
		111	lua_getref(L, ctrl->ref[inout]);
		112	lua_rawget(L, -2);
		113	f = gethandle(L, ctrl, -1);
		114	if (f == NULL)
		115	luaL_verror(L, "global variable `%.10s' is not a file handle",
		116	filenames[inout]);
108	return f;	117	return f;
109	}	118	}
110		119
111		120
112	static FILE getfileparam (char name, int *arg) {	121	static void setfilebyname (lua_State L, IOCtrl ctrl, FILE *f,
113	FILE f = getfile(arg);	122	const char *name) {
114	if (f) {	123	lua_pushusertag(L, f, ctrl->iotag);
115	(*arg)++;	124	lua_setglobal(L, name);
116	return f;
117	}
118	else
119	return getfilebyname(name);
120	}	125	}
121		126
122		127
123	static void closefile (FILE *f) {	128	#define setfile(L,ctrl,f,inout) (setfilebyname(L,ctrl,f,filenames[inout]))
124	if (f != stdin && f != stdout) {
125	int tag = gettag();
126	CLOSEFILE(f);
127	lua_pushusertag(f, tag);
128	lua_settag(CLOSEDTAG(tag));
129	}
130	}
131		129
132		130
133	static void io_close (void) {	131	static int setreturn (lua_State L, IOCtrl ctrl, FILE *f, int inout) {
134	closefile(getnonullfile(FIRSTARG));	132	if (f == NULL)
		133	return pushresult(L, 0);
		134	else {
		135	setfile(L, ctrl, f, inout);
		136	lua_pushusertag(L, f, ctrl->iotag);
		137	return 1;
		138	}
135	}	139	}
136		140
137		141
138	static void gc_close (void) {	142	static int closefile (lua_State L, IOCtrl ctrl, FILE *f) {
139	FILE *f = getnonullfile(FIRSTARG);	143	if (f == stdin \|\| f == stdout \|\| f == stderr)
140	if (f != stdin && f != stdout && f != stderr) {	144	return 1;
141	CLOSEFILE(f);	145	else {
		146	lua_pushusertag(L, f, ctrl->iotag);
		147	lua_settag(L, ctrl->closedtag);
		148	return (CLOSEFILE(L, f) == 0);
142	}	149	}
143	}	150	}
144		151
145		152
146	static void io_open (void) {	153	static int io_close (lua_State *L) {
147	FILE *f = fopen(luaL_check_string(FIRSTARG), luaL_check_string(FIRSTARG+1));	154	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
148	if (f) lua_pushusertag(f, gettag());	155	lua_pop(L, 1); /* remove upvalue */
149	else pushresult(0);	156	return pushresult(L, closefile(L, ctrl, getnonullfile(L, ctrl, 1)));
150	}	157	}
151		158
152		159
153	static void setfile (FILE f, char name, int tag) {	160	static int file_collect (lua_State *L) {
154	lua_pushusertag(f, tag);	161	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
155	lua_setglobal(name);	162	FILE *f = getnonullfile(L, ctrl, 1);
		163	if (f != stdin && f != stdout && f != stderr)
		164	CLOSEFILE(L, f);
		165	return 0;
156	}	166	}
157		167
158		168
159	static void setreturn (FILE f, char name) {	169	static int io_open (lua_State *L) {
160	if (f == NULL)	170	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
161	pushresult(0);	171	FILE *f;
162	else {	172	lua_pop(L, 1); /* remove upvalue */
163	int tag = gettag();	173	f = fopen(luaL_check_string(L, 1), luaL_check_string(L, 2));
164	setfile(f, name, tag);	174	if (f) {
165	lua_pushusertag(f, tag);	175	lua_pushusertag(L, f, ctrl->iotag);
		176	return 1;
166	}	177	}
		178	else
		179	return pushresult(L, 0);
167	}	180	}
168		181
169		182
170	static void io_readfrom (void) {	183
		184	static int io_fromto (lua_State L, int inout, const char mode) {
		185	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
171	FILE *current;	186	FILE *current;
172	lua_Object f = lua_getparam(FIRSTARG);	187	lua_pop(L, 1); /* remove upvalue */
173	if (f == LUA_NOOBJECT) {	188	if (lua_isnull(L, 1)) {
174	closefile(getfilebyname(FINPUT));	189	closefile(L, ctrl, getfilebyref(L, ctrl, inout));
175	current = stdin;	190	current = (inout == 0) ? stdin : stdout;
176	}	191	}
177	else if (lua_tag(f) == gettag()) /* deprecated option */	192	else if (lua_tag(L, 1) == ctrl->iotag) /* deprecated option */
178	current = lua_getuserdata(f);	193	current = (FILE *)lua_touserdata(L, 1);
179	else {	194	else {
180	char *s = luaL_check_string(FIRSTARG);	195	const char *s = luaL_check_string(L, 1);
181	current = (*s == '\|') ? popen(s+1, "r") : fopen(s, "r");	196	current = (*s == '\|') ? popen(s+1, mode) : fopen(s, mode);
182	}	197	}
183	setreturn(current, FINPUT);	198	return setreturn(L, ctrl, current, inout);
184	}	199	}
185		200
186		201
187	static void io_writeto (void) {	202	static int io_readfrom (lua_State *L) {
188	FILE *current;	203	return io_fromto(L, INFILE, "r");
189	lua_Object f = lua_getparam(FIRSTARG);
190	if (f == LUA_NOOBJECT) {
191	closefile(getfilebyname(FOUTPUT));
192	current = stdout;
193	}
194	else if (lua_tag(f) == gettag()) /* deprecated option */
195	current = lua_getuserdata(f);
196	else {
197	char *s = luaL_check_string(FIRSTARG);
198	current = (*s == '\|') ? popen(s+1,"w") : fopen(s, "w");
199	}
200	setreturn(current, FOUTPUT);
201	}	204	}
202		205
203		206
204	static void io_appendto (void) {	207	static int io_writeto (lua_State *L) {
205	FILE *current = fopen(luaL_check_string(FIRSTARG), "a");	208	return io_fromto(L, OUTFILE, "w");
206	setreturn(current, FOUTPUT);	209	}
		210
		211
		212	static int io_appendto (lua_State *L) {
		213	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
		214	FILE *current;
		215	lua_pop(L, 1); /* remove upvalue */
		216	current = fopen(luaL_check_string(L, 1), "a");
		217	return setreturn(L, ctrl, current, OUTFILE);
207	}	218	}
208		219
209		220
@@ -215,6 +226,9 @@ static void io_appendto (void) { · 5 unmodified lines
215	*/	226	*/
216		227
217		228
		229
		230	#ifdef LUA_COMPAT_READPATTERN
		231
218	/*	232	/*
219	** We cannot lookahead without need, because this can lock stdin.	233	** We cannot lookahead without need, because this can lock stdin.
220	** This flag signals when we need to read a next char.	234	** This flag signals when we need to read a next char.
@@ -222,9 +236,11 @@ static void io_appendto (void) { · 1 unmodified line
222	#define NEED_OTHER (EOF-1) /* just some flag different from EOF */	236	#define NEED_OTHER (EOF-1) /* just some flag different from EOF */
223		237
224		238
225	static int read_pattern (FILE f, char p) {	239	static int read_pattern (lua_State L, FILE f, const char *p) {
226	int inskip = 0; /* {skip} level */	240	int inskip = 0; /* {skip} level */
227	int c = NEED_OTHER;	241	int c = NEED_OTHER;
		242	luaL_Buffer b;
		243	luaL_buffinit(L, &b);
228	while (*p != '\0') {	244	while (*p != '\0') {
229	switch (*p) {	245	switch (*p) {
230	case '{':	246	case '{':
@@ -232,17 +248,17 @@ static int read_pattern (FILE f, char p) { · 1 unmodified line
232	p++;	248	p++;
233	continue;	249	continue;
234	case '}':	250	case '}':
235	if (!inskip) lua_error("unbalanced braces in read pattern");	251	if (!inskip) lua_error(L, "unbalanced braces in read pattern");
236	inskip--;	252	inskip--;
237	p++;	253	p++;
238	continue;	254	continue;
239	default: {	255	default: {
240	char ep = luaI_classend(p); / get what is next */	256	const char ep = luaI_classend(L, p); / get what is next */
241	int m; /* match result */	257	int m; /* match result */
242	if (c == NEED_OTHER) c = getc(f);	258	if (c == NEED_OTHER) c = getc(f);
243	m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep);	259	m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep);
244	if (m) {	260	if (m) {
245	if (!inskip) luaL_addchar(c);	261	if (!inskip) luaL_putchar(&b, c);
246	c = NEED_OTHER;	262	c = NEED_OTHER;
247	}	263	}
248	switch (*ep) {	264	switch (*ep) {
@@ -253,7 +269,7 @@ static int read_pattern (FILE f, char p) { · 4 unmodified lines
253	while (m) { /* reads the same item until it fails */	269	while (m) { /* reads the same item until it fails */
254	c = getc(f);	270	c = getc(f);
255	m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep);	271	m = (c==EOF) ? 0 : luaI_singlematch(c, p, ep);
256	if (m && !inskip) luaL_addchar(c);	272	if (m && !inskip) luaL_putchar(&b, c);
257	}	273	}
258	/* go through to continue reading the pattern */	274	/* go through to continue reading the pattern */
259	case '?': /* optional */	275	case '?': /* optional */
@@ -267,116 +283,210 @@ static int read_pattern (FILE f, char p) { · 7 unmodified lines
267	}	283	}
268	} break_while:	284	} break_while:
269	if (c != NEED_OTHER) ungetc(c, f);	285	if (c != NEED_OTHER) ungetc(c, f);
		286	luaL_pushresult(&b); /* close buffer */
270	return (*p == '\0');	287	return (*p == '\0');
271	}	288	}
272		289
		290	#else
		291
		292	#define read_pattern(L, f, p) (lua_error(L, "read patterns are deprecated"), 0)
273		293
274	static int read_number (FILE *f) {	294	#endif
		295
		296
		297	static int read_number (lua_State L, FILE f) {
275	double d;	298	double d;
276	if (fscanf(f, "%lf", &d) == 1) {	299	if (fscanf(f, "%lf", &d) == 1) {
277	lua_pushnumber(d);	300	lua_pushnumber(L, d);
278	return 1;	301	return 1;
279	}	302	}
280	else return 0; /* read fails */	303	else return 0; /* read fails */
281	}	304	}
282		305
283		306
284	#define HUNK_LINE 1024	307	static int read_word (lua_State L, FILE f) {
285	#define HUNK_FILE BUFSIZ	308	int c;
		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);
		317	luaL_pushresult(&b); /* close buffer */
		318	return (lua_strlen(L, -1) > 0);
		319	}
286		320
287	static int read_line (FILE *f) {	321
288	/* equivalent to: return read_pattern(f, "[^\n]{\n}"); /	322	static int read_line (lua_State L, FILE f) {
289	int n;	323	int n = 0;
290	char *b;	324	luaL_Buffer b;
291	do {	325	luaL_buffinit(L, &b);
292	b = luaL_openspace(HUNK_LINE);	326	for (;;) {
293	if (!fgets(b, HUNK_LINE, f)) return 0; /* read fails */	327	char *p = luaL_prepbuffer(&b);
294	n = strlen(b);	328	if (!fgets(p, LUAL_BUFFERSIZE, f)) /* read fails? */
295	luaL_addsize(n);	329	break;
296	} while (b[n-1] != '\n');	330	n = strlen(p);
297	luaL_addsize(-1); /* remove '\n' */	331	if (p[n-1] != '\n')
298	return 1;	332	luaL_addsize(&b, n);
		333	else {
		334	luaL_addsize(&b, n-1); /* do not add the `\n' */
		335	break;
		336	}
		337	}
		338	luaL_pushresult(&b); /* close buffer */
		339	return (n > 0); /* read something? */
299	}	340	}
300		341
301		342
302	static void read_file (FILE *f) {	343	static void read_file (lua_State L, FILE f) {
303	/* equivalent to: return read_pattern(f, "."); /	344	size_t len = 0;
304	int n;	345	size_t size = BUFSIZ;
305	do {	346	char *buffer = NULL;
306	char *b = luaL_openspace(HUNK_FILE);	347	for (;;) {
307	n = fread(b, sizeof(char), HUNK_FILE, f);	348	char newbuffer = (char )realloc(buffer, size);
308	luaL_addsize(n);	349	if (newbuffer == NULL) {
309	} while (n==HUNK_FILE);	350	free(buffer);
		351	lua_error(L, "not enough memory to read a file");
		352	}
		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	}
		358	lua_pushlstring(L, buffer, len);
		359	free(buffer);
310	}	360	}
311		361
312		362
313	static void io_read (void) {	363	static int read_chars (lua_State L, FILE f, size_t n) {
314	static char options[] = {"n", "l", "a", ".", "w", NULL};	364	char *buffer;
315	int arg = FIRSTARG;	365	size_t n1;
316	FILE *f = getfileparam(FINPUT, &arg);	366	char statbuff[BUFSIZ];
317	char p = luaL_opt_string(arg++, "l");	367	if (n <= BUFSIZ)
318	do { /* repeat for each part */	368	buffer = statbuff;
319	long l;	369	else {
		370	buffer = (char *)malloc(n);
		371	if (buffer == NULL)
		372	lua_error(L, "not enough memory to read a file");
		373	}
		374	n1 = fread(buffer, sizeof(char), n, f);
		375	lua_pushlstring(L, buffer, n1);
		376	if (buffer != statbuff) free(buffer);
		377	return (n1 > 0 \|\| n == 0);
		378	}
		379
		380
		381	static int io_read (lua_State *L) {
		382	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
		383	int lastarg = lua_gettop(L) - 1;
		384	int firstarg = 1;
		385	FILE *f = gethandle(L, ctrl, firstarg);
		386	int n;
		387	if (f) firstarg++;
		388	else f = getfilebyref(L, ctrl, INFILE); /* get _INPUT */
		389	lua_pop(L, 1);
		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	}
		395	else /* ensure stack space for all results and for auxlib's buffer */
		396	luaL_checkstack(L, lastarg-firstarg+1+LUA_MINSTACK, "too many arguments");
		397	for (n = firstarg; n<=lastarg; n++) {
320	int success;	398	int success;
321	luaL_resetbuffer();	399	if (lua_isnumber(L, n))
322	switch (luaL_findstring(p, options)) {	400	success = read_chars(L, f, (size_t)lua_tonumber(L, n));
323	case 0: /* number */	401	else {
324	if (!read_number(f)) return; /* read fails */	402	const char *p = luaL_check_string(L, n);
325	continue; /* number is already pushed; avoid the "pushstring" */	403	if (p[0] != '*')
326	case 1: /* line */	404	success = read_pattern(L, f, p); /* deprecated! */
327	success = read_line(f);	405	else {
328	break;	406	switch (p[1]) {
329	case 2: case 3: /* file */	407	case 'n': /* number */
330	read_file(f);	408	if (!read_number(L, f)) goto endloop; /* read fails */
331	success = 1; /* always success */	409	continue; /* number is already pushed; avoid the "pushstring" */
332	break;	410	case 'l': /* line */
333	case 4: /* word */	411	success = read_line(L, f);
334	success = read_pattern(f, "{%s*}%S+");	412	break;
335	break;	413	case 'a': /* file */
336	default:	414	read_file(L, f);
337	success = read_pattern(f, p);	415	success = 1; /* always success */
		416	break;
		417	case 'w': /* word */
		418	success = read_word(L, f);
		419	break;
		420	default:
		421	luaL_argerror(L, n, "invalid format");
		422	success = 0; /* to avoid warnings */
		423	}
		424	}
338	}	425	}
339	l = luaL_getsize();	426	if (!success) {
340	if (!success && l==0) return; /* read fails */	427	lua_pop(L, 1); /* remove last result */
341	lua_pushlstring(luaL_buffer(), l);	428	break; /* read fails */
342	} while ((p = luaL_opt_string(arg++, NULL)) != NULL);	429	}
		430	} endloop:
		431	return n - firstarg;
343	}	432	}
344		433
345	/* }====================================================== */	434	/* }====================================================== */
346		435
347		436
348	static void io_write (void) {	437	static int io_write (lua_State *L) {
349	int arg = FIRSTARG;	438	int lastarg = lua_gettop(L) - 1;
350	FILE *f = getfileparam(FOUTPUT, &arg);	439	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
		440	int arg = 1;
351	int status = 1;	441	int status = 1;
352	char *s;	442	FILE *f = gethandle(L, ctrl, arg);
353	long l;	443	if (f) arg++;
354	while ((s = luaL_opt_lstr(arg++, NULL, &l)) != NULL)	444	else f = getfilebyref(L, ctrl, OUTFILE); /* get _OUTPUT */
355	status = status && ((long)fwrite(s, 1, l, f) == l);	445	for (; arg <= lastarg; arg++) {
356	pushresult(status);	446	if (lua_type(L, arg) == LUA_TNUMBER) { /* LUA_NUMBER */
		447	/* optimization: could be done exactly as for strings */
		448	status = status && fprintf(f, "%.16g", lua_tonumber(L, arg)) > 0;
		449	}
		450	else {
		451	size_t l;
		452	const char *s = luaL_check_lstr(L, arg, &l);
		453	status = status && (fwrite(s, sizeof(char), l, f) == l);
		454	}
		455	}
		456	pushresult(L, status);
		457	return 1;
357	}	458	}
358		459
359		460
360	static void io_seek (void) {	461	static int io_seek (lua_State *L) {
361	static int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};	462	static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
362	static char *modenames[] = {"set", "cur", "end", NULL};	463	static const char *const modenames[] = {"set", "cur", "end", NULL};
363	FILE *f = getnonullfile(FIRSTARG);	464	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
364	int op = luaL_findstring(luaL_opt_string(FIRSTARG+1, "cur"), modenames);	465	FILE *f;
365	long offset = luaL_opt_long(FIRSTARG+2, 0);	466	int op;
366	luaL_arg_check(op != -1, FIRSTARG+1, "invalid mode");	467	long offset;
		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");
367	op = fseek(f, offset, mode[op]);	473	op = fseek(f, offset, mode[op]);
368	if (op)	474	if (op)
369	pushresult(0); /* error */	475	return pushresult(L, 0); /* error */
370	else	476	else {
371	lua_pushnumber(ftell(f));	477	lua_pushnumber(L, ftell(f));
		478	return 1;
		479	}
372	}	480	}
373		481
374		482
375	static void io_flush (void) {	483	static int io_flush (lua_State *L) {
376	FILE *f = getfile(FIRSTARG);	484	IOCtrl ctrl = (IOCtrl )lua_touserdata(L, -1);
377	luaL_arg_check(f \|\| lua_getparam(FIRSTARG) == LUA_NOOBJECT, FIRSTARG,	485	FILE *f;
378	"invalid file handle");	486	lua_pop(L, 1); /* remove upvalue */
379	pushresult(fflush(f) == 0);	487	f = gethandle(L, ctrl, 1);
		488	luaL_arg_check(L, f \|\| lua_isnull(L, 1), 1, "invalid file handle");
		489	return pushresult(L, fflush(f) == 0);
380	}	490	}
381		491
382	/* }====================================================== */	492	/* }====================================================== */
@@ -388,145 +498,165 @@ static void io_flush (void) { · 5 unmodified lines
388	** =======================================================	498	** =======================================================
389	*/	499	*/
390		500
391	static void io_execute (void) {	501	static int io_execute (lua_State *L) {
392	lua_pushnumber(system(luaL_check_string(1)));	502	lua_pushnumber(L, system(luaL_check_string(L, 1)));
		503	return 1;
393	}	504	}
394		505
395		506
396	static void io_remove (void) {	507	static int io_remove (lua_State *L) {
397	pushresult(remove(luaL_check_string(1)) == 0);	508	return pushresult(L, remove(luaL_check_string(L, 1)) == 0);
398	}	509	}
399		510
400		511
401	static void io_rename (void) {	512	static int io_rename (lua_State *L) {
402	pushresult(rename(luaL_check_string(1),	513	return pushresult(L, rename(luaL_check_string(L, 1),
403	luaL_check_string(2)) == 0);	514	luaL_check_string(L, 2)) == 0);
404	}	515	}
405		516
406		517
407	static void io_tmpname (void) {	518	static int io_tmpname (lua_State *L) {
408	lua_pushstring(tmpnam(NULL));	519	lua_pushstring(L, tmpnam(NULL));
		520	return 1;
409	}	521	}
410		522
411		523
412		524
413	static void io_getenv (void) {	525	static int io_getenv (lua_State *L) {
414	lua_pushstring(getenv(luaL_check_string(1))); /* if NULL push nil */	526	lua_pushstring(L, getenv(luaL_check_string(L, 1))); /* if NULL push nil */
		527	return 1;
415	}	528	}
416		529
417		530
418	static void io_clock (void) {	531	static int io_clock (lua_State *L) {
419	lua_pushnumber(((double)clock())/CLOCKS_PER_SEC);	532	lua_pushnumber(L, ((double)clock())/CLOCKS_PER_SEC);
		533	return 1;
420	}	534	}
421		535
422		536
423	static void io_date (void) {	537	static int io_date (lua_State *L) {
424	char b[256];	538	char b[256];
425	char *s = luaL_opt_string(1, "%c");	539	const char *s = luaL_opt_string(L, 1, "%c");
426	struct tm *tm;	540	struct tm *stm;
427	time_t t;	541	time_t t;
428	time(&t); tm = localtime(&t);	542	time(&t); stm = localtime(&t);
429	if (strftime(b,sizeof(b),s,tm))	543	if (strftime(b, sizeof(b), s, stm))
430	lua_pushstring(b);	544	lua_pushstring(L, b);
431	else	545	else
432	lua_error("invalid `date' format");	546	lua_error(L, "invalid `date' format");
		547	return 1;
433	}	548	}
434		549
435		550
436	static void setloc (void) {	551	static int setloc (lua_State *L) {
437	static int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC,	552	static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,
438	LC_TIME};	553	LC_NUMERIC, LC_TIME};
439	static char *catnames[] = {"all", "collate", "ctype", "monetary",	554	static const char *const catnames[] = {"all", "collate", "ctype", "monetary",
440	"numeric", "time", NULL};	555	"numeric", "time", NULL};
441	int op = luaL_findstring(luaL_opt_string(2, "all"), catnames);	556	int op = luaL_findstring(luaL_opt_string(L, 2, "all"), catnames);
442	luaL_arg_check(op != -1, 2, "invalid option");	557	luaL_arg_check(L, op != -1, 2, "invalid option");
443	lua_pushstring(setlocale(cat[op], luaL_check_string(1)));	558	lua_pushstring(L, setlocale(cat[op], luaL_check_string(L, 1)));
		559	return 1;
444	}	560	}
445		561
446		562
447	static void io_exit (void) {	563	static int io_exit (lua_State *L) {
448	lua_Object o = lua_getparam(1);	564	exit(luaL_opt_int(L, 1, EXIT_SUCCESS));
449	exit(lua_isnumber(o) ? (int)lua_getnumber(o) : 1);	565	return 0; /* to avoid warnings */
450	}	566	}
451		567
452	/* }====================================================== */	568	/* }====================================================== */
453		569
454		570
455		571
456	static void io_debug (void) {	572	static int io_debug (lua_State *L) {
457	for (;;) {	573	for (;;) {
458	char buffer[250];	574	char buffer[250];
459	fprintf(stderr, "lua_debug> ");	575	fprintf(stderr, "lua_debug> ");
460	if (fgets(buffer, sizeof(buffer), stdin) == 0 \|\|	576	if (fgets(buffer, sizeof(buffer), stdin) == 0 \|\|
461	strcmp(buffer, "cont\n") == 0)	577	strcmp(buffer, "cont\n") == 0)
462	return;	578	return 0;
463	lua_dostring(buffer);	579	lua_dostring(L, buffer);
		580	lua_settop(L, 0); /* remove eventual returns */
464	}	581	}
465	}	582	}
466		583
467		584
		585	#define LEVELS1 12 /* size of the first part of the stack */
		586	#define LEVELS2 10 /* size of the second part of the stack */
468		587
469	#define MESSAGESIZE 150	588	static int errorfb (lua_State *L) {
470	#define MAXMESSAGE (MESSAGESIZE*10)
471
472
473	#define MAXSRC 60
474
475
476	static void errorfb (void) {
477	char buff[MAXMESSAGE];
478	int level = 1; /* skip level 0 (it's this function) */	589	int level = 1; /* skip level 0 (it's this function) */
479	lua_Object func;	590	int firstpart = 1; /* still before eventual `...' */
480	sprintf(buff, "lua error: %.200s\n", lua_getstring(lua_getparam(1)));	591	lua_Debug ar;
481	while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) {	592	luaL_Buffer b;
482	char *name;	593	luaL_buffinit(L, &b);
483	int currentline;	594	luaL_addstring(&b, "error: ");
484	char *chunkname;	595	luaL_addstring(&b, luaL_check_string(L, 1));
485	char buffchunk[MAXSRC];	596	luaL_addstring(&b, "\n");
486	int linedefined;	597	while (lua_getstack(L, level++, &ar)) {
487	lua_funcinfo(func, &chunkname, &linedefined);	598	char buff[120]; /* enough to fit following `sprintf's */
488	luaL_chunkid(buffchunk, chunkname, sizeof(buffchunk));	599	if (level == 2)
489	if (level == 2) strcat(buff, "Active Stack:\n");	600	luaL_addstring(&b, "stack traceback:\n");
490	strcat(buff, " ");	601	else if (level > LEVELS1 && firstpart) {
491	if (strlen(buff) > MAXMESSAGE-MESSAGESIZE) {	602	/* no more than `LEVELS2' more levels? */
492	strcat(buff, "...\n");	603	if (!lua_getstack(L, level+LEVELS2, &ar))
493	break; /* buffer is full */	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;
494	}	612	}
495	switch (*lua_getobjname(func, &name)) {	613	sprintf(buff, "%4d: ", level-1);
496	case 'g':	614	luaL_addstring(&b, buff);
497	sprintf(buff+strlen(buff), "function `%.50s'", name);	615	lua_getinfo(L, "Snl", &ar);
		616	switch (*ar.namewhat) {
		617	case 'g': case 'l': /* global, local */
		618	sprintf(buff, "function `%.50s'", ar.name);
498	break;	619	break;
499	case 't':	620	case 'f': /* field */
500	sprintf(buff+strlen(buff), "`%.50s' tag method", name);	621	sprintf(buff, "method `%.50s'", ar.name);
		622	break;
		623	case 't': /* tag method */
		624	sprintf(buff, "`%.50s' tag method", ar.name);
501	break;	625	break;
502	default: {	626	default: {
503	if (linedefined == 0)	627	if (ar.what == 'm') / main? */
504	sprintf(buff+strlen(buff), "main of %.70s", buffchunk);	628	sprintf(buff, "main of %.70s", ar.short_src);
505	else if (linedefined < 0)	629	else if (ar.what == 'C') / C function? */
506	sprintf(buff+strlen(buff), "%.70s", buffchunk);	630	sprintf(buff, "%.70s", ar.short_src);
507	else	631	else
508	sprintf(buff+strlen(buff), "function <%d:%.70s>",	632	sprintf(buff, "function <%d:%.70s>", ar.linedefined, ar.short_src);
509	linedefined, buffchunk);	633	ar.source = NULL; /* do not print source again */
510	chunkname = NULL;
511	}	634	}
512	}	635	}
513	if ((currentline = lua_currentline(func)) > 0)	636	luaL_addstring(&b, buff);
514	sprintf(buff+strlen(buff), " at line %d", currentline);	637	if (ar.currentline > 0) {
515	if (chunkname)	638	sprintf(buff, " at line %d", ar.currentline);
516	sprintf(buff+strlen(buff), " [%.70s]", buffchunk);	639	luaL_addstring(&b, buff);
517	strcat(buff, "\n");	640	}
		641	if (ar.source) {
		642	sprintf(buff, " [%.70s]", ar.short_src);
		643	luaL_addstring(&b, buff);
		644	}
		645	luaL_addstring(&b, "\n");
518	}	646	}
519	func = lua_rawgetglobal("_ALERT");	647	luaL_pushresult(&b);
520	if (lua_isfunction(func)) { /* avoid error loop if _ALERT is not defined */	648	lua_getglobal(L, LUA_ALERT);
521	lua_pushstring(buff);	649	if (lua_isfunction(L, -1)) { /* avoid loop if _ALERT is not defined */
522	lua_callfunction(func);	650	lua_pushvalue(L, -2); /* error message */
		651	lua_rawcall(L, 1, 0);
523	}	652	}
		653	return 0;
524	}	654	}
525		655
526		656
527		657
528	static struct luaL_reg iolib[] = {	658	static const struct luaL_reg iolib[] = {
529	{"_ERRORMESSAGE", errorfb},	659	{LUA_ERRORMESSAGE, errorfb},
530	{"clock", io_clock},	660	{"clock", io_clock},
531	{"date", io_date},	661	{"date", io_date},
532	{"debug", io_debug},	662	{"debug", io_debug},
@@ -540,7 +670,7 @@ static struct luaL_reg iolib[] = { · 7 unmodified lines
540	};	670	};
541		671
542		672
543	static struct luaL_reg iolibtag[] = {	673	static const struct luaL_reg iolibtag[] = {
544	{"appendto", io_appendto},	674	{"appendto", io_appendto},
545	{"closefile", io_close},	675	{"closefile", io_close},
546	{"flush", io_flush},	676	{"flush", io_flush},
@@ -553,31 +683,36 @@ static struct luaL_reg iolibtag[] = { · 6 unmodified lines
553	};	683	};
554		684
555		685
556	static void openwithtags (void) {	686	static void openwithcontrol (lua_State *L) {
557	int i;	687	IOCtrl ctrl = (IOCtrl )lua_newuserdata(L, sizeof(IOCtrl));
558	int iotag = lua_newtag();	688	unsigned int i;
559	lua_newtag(); /* alloc CLOSEDTAG: assume that CLOSEDTAG = iotag-1 */	689	ctrl->iotag = lua_newtag(L);
		690	ctrl->closedtag = lua_newtag(L);
560	for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) {	691	for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) {
561	/* put iotag as upvalue for these functions */	692	/* put `ctrl' as upvalue for these functions */
562	lua_pushnumber(iotag);	693	lua_pushvalue(L, -1);
563	lua_pushcclosure(iolibtag[i].func, 1);	694	lua_pushcclosure(L, iolibtag[i].func, 1);
564	lua_setglobal(iolibtag[i].name);	695	lua_setglobal(L, iolibtag[i].name);
565	}	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);
566	/* predefined file handles */	702	/* predefined file handles */
567	setfile(stdin, FINPUT, iotag);	703	setfile(L, ctrl, stdin, INFILE);
568	setfile(stdout, FOUTPUT, iotag);	704	setfile(L, ctrl, stdout, OUTFILE);
569	setfile(stdin, "_STDIN", iotag);	705	setfilebyname(L, ctrl, stdin, "_STDIN");
570	setfile(stdout, "_STDOUT", iotag);	706	setfilebyname(L, ctrl, stdout, "_STDOUT");
571	setfile(stderr, "_STDERR", iotag);	707	setfilebyname(L, ctrl, stderr, "_STDERR");
572	/* close file when collected */	708	/* close files when collected */
573	lua_pushnumber(iotag);	709	lua_pushcclosure(L, file_collect, 1); /* pops `ctrl' from stack */
574	lua_pushcclosure(gc_close, 1);	710	lua_settagmethod(L, ctrl->iotag, "gc");
575	lua_settagmethod(iotag, "gc");	711	}
576	}	712
577		713
578	void lua_iolibopen (void) {	714	LUALIB_API void lua_iolibopen (lua_State *L) {
579	/* register lib functions */	715	luaL_openl(L, iolib);
580	luaL_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));	716	openwithcontrol(L);
581	openwithtags();
582	}	717	}
583		718

src/lib/lmathlib.c+114−79

@@ -1,6 +1,6 @@
1	/*	1	/*
2	** $Id: lmathlib.c,v 1.17 1999/07/07 17:54:08 roberto Exp $	2	** $Id: lmathlib.c,v 1.32 2000/10/31 13:10:24 roberto Exp $
3	** Lua standard mathematical library	3	** Standard mathematical library
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
@@ -8,14 +8,15 @@ · 1 unmodified line
8	#include <stdlib.h>	8	#include <stdlib.h>
9	#include <math.h>	9	#include <math.h>
10		10
11	#include "lauxlib.h"
12	#include "lua.h"	11	#include "lua.h"
		12
		13	#include "lauxlib.h"
13	#include "lualib.h"	14	#include "lualib.h"
14		15
15		16
16	#undef PI	17	#undef PI
17	#define PI (3.14159265358979323846)	18	#define PI (3.14159265358979323846)
18	#define RADIANS_PER_DEGREE (PI/180.0)	19	#define RADIANS_PER_DEGREE (PI/180.0)
19		20
20		21
21		22
@@ -32,139 +33,173 @@ · 10 unmodified lines
32	#endif	33	#endif
33		34
34		35
35	static void math_abs (void) {	36	static int math_abs (lua_State *L) {
36	lua_pushnumber(fabs(luaL_check_number(1)));	37	lua_pushnumber(L, fabs(luaL_check_number(L, 1)));
		38	return 1;
37	}	39	}
38		40
39	static void math_sin (void) {	41	static int math_sin (lua_State *L) {
40	lua_pushnumber(sin(TORAD(luaL_check_number(1))));	42	lua_pushnumber(L, sin(TORAD(luaL_check_number(L, 1))));
		43	return 1;
41	}	44	}
42		45
43	static void math_cos (void) {	46	static int math_cos (lua_State *L) {
44	lua_pushnumber(cos(TORAD(luaL_check_number(1))));	47	lua_pushnumber(L, cos(TORAD(luaL_check_number(L, 1))));
		48	return 1;
45	}	49	}
46		50
47	static void math_tan (void) {	51	static int math_tan (lua_State *L) {
48	lua_pushnumber(tan(TORAD(luaL_check_number(1))));	52	lua_pushnumber(L, tan(TORAD(luaL_check_number(L, 1))));
		53	return 1;
49	}	54	}
50		55
51	static void math_asin (void) {	56	static int math_asin (lua_State *L) {
52	lua_pushnumber(FROMRAD(asin(luaL_check_number(1))));	57	lua_pushnumber(L, FROMRAD(asin(luaL_check_number(L, 1))));
		58	return 1;
53	}	59	}
54		60
55	static void math_acos (void) {	61	static int math_acos (lua_State *L) {
56	lua_pushnumber(FROMRAD(acos(luaL_check_number(1))));	62	lua_pushnumber(L, FROMRAD(acos(luaL_check_number(L, 1))));
		63	return 1;
57	}	64	}
58		65
59	static void math_atan (void) {	66	static int math_atan (lua_State *L) {
60	lua_pushnumber(FROMRAD(atan(luaL_check_number(1))));	67	lua_pushnumber(L, FROMRAD(atan(luaL_check_number(L, 1))));
		68	return 1;
61	}	69	}
62		70
63	static void math_atan2 (void) {	71	static int math_atan2 (lua_State *L) {
64	lua_pushnumber(FROMRAD(atan2(luaL_check_number(1), luaL_check_number(2))));	72	lua_pushnumber(L, FROMRAD(atan2(luaL_check_number(L, 1), luaL_check_number(L, 2))));
		73	return 1;
65	}	74	}
66		75
67	static void math_ceil (void) {	76	static int math_ceil (lua_State *L) {
68	lua_pushnumber(ceil(luaL_check_number(1)));	77	lua_pushnumber(L, ceil(luaL_check_number(L, 1)));
		78	return 1;
69	}	79	}
70		80
71	static void math_floor (void) {	81	static int math_floor (lua_State *L) {
72	lua_pushnumber(floor(luaL_check_number(1)));	82	lua_pushnumber(L, floor(luaL_check_number(L, 1)));
		83	return 1;
73	}	84	}
74		85
75	static void math_mod (void) {	86	static int math_mod (lua_State *L) {
76	lua_pushnumber(fmod(luaL_check_number(1), luaL_check_number(2)));	87	lua_pushnumber(L, fmod(luaL_check_number(L, 1), luaL_check_number(L, 2)));
		88	return 1;
77	}	89	}
78		90
79	static void math_sqrt (void) {	91	static int math_sqrt (lua_State *L) {
80	lua_pushnumber(sqrt(luaL_check_number(1)));	92	lua_pushnumber(L, sqrt(luaL_check_number(L, 1)));
		93	return 1;
81	}	94	}
82		95
83	static void math_pow (void) {	96	static int math_pow (lua_State *L) {
84	lua_pushnumber(pow(luaL_check_number(1), luaL_check_number(2)));	97	lua_pushnumber(L, pow(luaL_check_number(L, 1), luaL_check_number(L, 2)));
		98	return 1;
85	}	99	}
86		100
87	static void math_log (void) {	101	static int math_log (lua_State *L) {
88	lua_pushnumber(log(luaL_check_number(1)));	102	lua_pushnumber(L, log(luaL_check_number(L, 1)));
		103	return 1;
89	}	104	}
90		105
91	static void math_log10 (void) {	106	static int math_log10 (lua_State *L) {
92	lua_pushnumber(log10(luaL_check_number(1)));	107	lua_pushnumber(L, log10(luaL_check_number(L, 1)));
		108	return 1;
93	}	109	}
94		110
95	static void math_exp (void) {	111	static int math_exp (lua_State *L) {
96	lua_pushnumber(exp(luaL_check_number(1)));	112	lua_pushnumber(L, exp(luaL_check_number(L, 1)));
		113	return 1;
97	}	114	}
98		115
99	static void math_deg (void) {	116	static int math_deg (lua_State *L) {
100	lua_pushnumber(luaL_check_number(1)/RADIANS_PER_DEGREE);	117	lua_pushnumber(L, luaL_check_number(L, 1)/RADIANS_PER_DEGREE);
		118	return 1;
101	}	119	}
102		120
103	static void math_rad (void) {	121	static int math_rad (lua_State *L) {
104	lua_pushnumber(luaL_check_number(1)*RADIANS_PER_DEGREE);	122	lua_pushnumber(L, luaL_check_number(L, 1)*RADIANS_PER_DEGREE);
		123	return 1;
105	}	124	}
106		125
107	static void math_frexp (void) {	126	static int math_frexp (lua_State *L) {
108	int e;	127	int e;
109	lua_pushnumber(frexp(luaL_check_number(1), &e));	128	lua_pushnumber(L, frexp(luaL_check_number(L, 1), &e));
110	lua_pushnumber(e);	129	lua_pushnumber(L, e);
		130	return 2;
111	}	131	}
112		132
113	static void math_ldexp (void) {	133	static int math_ldexp (lua_State *L) {
114	lua_pushnumber(ldexp(luaL_check_number(1), luaL_check_int(2)));	134	lua_pushnumber(L, ldexp(luaL_check_number(L, 1), luaL_check_int(L, 2)));
		135	return 1;
115	}	136	}
116		137
117		138
118		139
119	static void math_min (void) {	140	static int math_min (lua_State *L) {
120	int i = 1;	141	int n = lua_gettop(L); /* number of arguments */
121	double dmin = luaL_check_number(i);	142	double dmin = luaL_check_number(L, 1);
122	while (lua_getparam(++i) != LUA_NOOBJECT) {	143	int i;
123	double d = luaL_check_number(i);	144	for (i=2; i<=n; i++) {
		145	double d = luaL_check_number(L, i);
124	if (d < dmin)	146	if (d < dmin)
125	dmin = d;	147	dmin = d;
126	}	148	}
127	lua_pushnumber(dmin);	149	lua_pushnumber(L, dmin);
		150	return 1;
128	}	151	}
129		152
130		153
131	static void math_max (void) {	154	static int math_max (lua_State *L) {
132	int i = 1;	155	int n = lua_gettop(L); /* number of arguments */
133	double dmax = luaL_check_number(i);	156	double dmax = luaL_check_number(L, 1);
134	while (lua_getparam(++i) != LUA_NOOBJECT) {	157	int i;
135	double d = luaL_check_number(i);	158	for (i=2; i<=n; i++) {
		159	double d = luaL_check_number(L, i);
136	if (d > dmax)	160	if (d > dmax)
137	dmax = d;	161	dmax = d;
138	}	162	}
139	lua_pushnumber(dmax);	163	lua_pushnumber(L, dmax);
		164	return 1;
140	}	165	}
141		166
142		167
143	static void math_random (void) {	168	static int math_random (lua_State *L) {
144	/* the '%' avoids the (rare) case of r==1, and is needed also because on	169	/* the '%' avoids the (rare) case of r==1, and is needed also because on
145	some systems (SunOS!) "rand()" may return a value bigger than RAND_MAX */	170	some systems (SunOS!) "rand()" may return a value larger than RAND_MAX */
146	double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX;	171	double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX;
147	int l = luaL_opt_int(1, 0);	172	switch (lua_gettop(L)) { /* check number of arguments */
148	if (l == 0)	173	case 0: { /* no arguments */
149	lua_pushnumber(r);	174	lua_pushnumber(L, r); /* Number between 0 and 1 */
150	else {	175	break;
151	int u = luaL_opt_int(2, 0);	176	}
152	if (u == 0) {	177	case 1: { /* only upper limit */
153	u = l;	178	int u = luaL_check_int(L, 1);
154	l = 1;	179	luaL_arg_check(L, 1<=u, 1, "interval is empty");
		180	lua_pushnumber(L, (int)(ru)+1); / integer between 1 and `u' */
		181	break;
		182	}
		183	case 2: { /* lower and upper limits */
		184	int l = luaL_check_int(L, 1);
		185	int u = luaL_check_int(L, 2);
		186	luaL_arg_check(L, l<=u, 2, "interval is empty");
		187	lua_pushnumber(L, (int)(r(u-l+1))+l); / integer between `l' and `u' */
		188	break;
155	}	189	}
156	luaL_arg_check(l<=u, 1, "interval is empty");	190	default: lua_error(L, "wrong number of arguments");
157	lua_pushnumber((int)(r*(u-l+1))+l);
158	}	191	}
		192	return 1;
159	}	193	}
160		194
161		195
162	static void math_randomseed (void) {	196	static int math_randomseed (lua_State *L) {
163	srand(luaL_check_int(1));	197	srand(luaL_check_int(L, 1));
		198	return 0;
164	}	199	}
165		200
166		201
167	static struct luaL_reg mathlib[] = {	202	static const struct luaL_reg mathlib[] = {
168	{"abs", math_abs},	203	{"abs", math_abs},
169	{"sin", math_sin},	204	{"sin", math_sin},
170	{"cos", math_cos},	205	{"cos", math_cos},
@@ -193,11 +228,11 @@ static struct luaL_reg mathlib[] = { · 22 unmodified lines
193	/*	228	/*
194	** Open math library	229	** Open math library
195	*/	230	*/
196	void lua_mathlibopen (void) {	231	LUALIB_API void lua_mathlibopen (lua_State *L) {
197	luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));	232	luaL_openl(L, mathlib);
198	lua_pushcfunction(math_pow);	233	lua_pushcfunction(L, math_pow);
199	lua_pushnumber(0); /* to get its tag */	234	lua_settagmethod(L, LUA_TNUMBER, "pow");
200	lua_settagmethod(lua_tag(lua_pop()), "pow");	235	lua_pushnumber(L, PI);
201	lua_pushnumber(PI); lua_setglobal("PI");	236	lua_setglobal(L, "PI");
202	}	237	}
203		238

src/lib/lstrlib.c+265−238

 /*
-** $Id: lstrlib.c,v 1.32 1999/06/17 17:04:03 roberto Exp $
+** $Id: lstrlib.c,v 1.56 2000/10/27 16:15:53 roberto Exp $
-** Standard library for strings and pattern-matching
+** Standard library for string operations and pattern-matching
 ** See Copyright Notice in lua.h
 */
 #include <ctype.h>
+#include <stddef.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
-#include "lauxlib.h"
 #include "lua.h"
-#include "lualib.h"
-static void addnchar (char *s, int n)
-{
-  char *b = luaL_openspace(n);
-  memcpy(b, s, n);
-  luaL_addsize(n);
-}
+#include "lauxlib.h"
+#include "lualib.h"
-static void str_len (void)
-{
-  long l;
-  luaL_check_lstr(1, &l);
-  lua_pushnumber(l);
-}
-static void closeandpush (void) {
+static int str_len (lua_State *L) {
-  lua_pushlstring(luaL_buffer(), luaL_getsize());
+  size_t l;
+  luaL_check_lstr(L, 1, &l);
+  lua_pushnumber(L, l);
+  return 1;
 }
-static long posrelat (long pos, long len) {
+static long posrelat (long pos, size_t len) {
   /* relative string position: negative means back from end */
-  return (pos>=0) ? pos : len+pos+1;
+  return (pos>=0) ? pos : (long)len+pos+1;
 }
-static void str_sub (void) {
+static int str_sub (lua_State *L) {
-  long l;
+  size_t l;
-  char *s = luaL_check_lstr(1, &l);
+  const char *s = luaL_check_lstr(L, 1, &l);
-  long start = posrelat(luaL_check_long(2), l);
+  long start = posrelat(luaL_check_long(L, 2), l);
-  long end = posrelat(luaL_opt_long(3, -1), l);
+  long end = posrelat(luaL_opt_long(L, 3, -1), l);
   if (start < 1) start = 1;
-  if (end > l) end = l;
+  if (end > (long)l) end = l;
   if (start <= end)
-    lua_pushlstring(s+start-1, end-start+1);
+    lua_pushlstring(L, s+start-1, end-start+1);
-  else lua_pushstring("");
+  else lua_pushstring(L, "");
+  return 1;
 }
-static void str_lower (void) {
+static int str_lower (lua_State *L) {
-  long l;
+  size_t l;
-  int i;
+  size_t i;
-  char *s = luaL_check_lstr(1, &l);
+  luaL_Buffer b;
-  luaL_resetbuffer();
+  const char *s = luaL_check_lstr(L, 1, &l);
+  luaL_buffinit(L, &b);
   for (i=0; i<l; i++)
-    luaL_addchar(tolower((unsigned char)(s[i])));
+    luaL_putchar(&b, tolower((unsigned char)(s[i])));
-  closeandpush();
+  luaL_pushresult(&b);
+  return 1;
 }
-static void str_upper (void) {
+static int str_upper (lua_State *L) {
-  long l;
+  size_t l;
-  int i;
+  size_t i;
-  char *s = luaL_check_lstr(1, &l);
+  luaL_Buffer b;
-  luaL_resetbuffer();
+  const char *s = luaL_check_lstr(L, 1, &l);
+  luaL_buffinit(L, &b);
   for (i=0; i<l; i++)
-    luaL_addchar(toupper((unsigned char)(s[i])));
+    luaL_putchar(&b, toupper((unsigned char)(s[i])));
-  closeandpush();
+  luaL_pushresult(&b);
+  return 1;
 }
-static void str_rep (void)
+static int str_rep (lua_State *L) {
-{
+  size_t l;
-  long l;
+  luaL_Buffer b;
-  char *s = luaL_check_lstr(1, &l);
+  const char *s = luaL_check_lstr(L, 1, &l);
-  int n = luaL_check_int(2);
+  int n = luaL_check_int(L, 2);
-  luaL_resetbuffer();
+  luaL_buffinit(L, &b);
   while (n-- > 0)
-    addnchar(s, l);
+    luaL_addlstring(&b, s, l);
-  closeandpush();
+  luaL_pushresult(&b);
+  return 1;
 }
-static void str_byte (void) {
+static int str_byte (lua_State *L) {
-  long l;
+  size_t l;
-  char *s = luaL_check_lstr(1, &l);
+  const char *s = luaL_check_lstr(L, 1, &l);
-  long pos = posrelat(luaL_opt_long(2, 1), l);
+  long pos = posrelat(luaL_opt_long(L, 2, 1), l);
-  luaL_arg_check(0<pos && pos<=l, 2,  "out of range");
+  luaL_arg_check(L, 0<pos && (size_t)pos<=l, 2,  "out of range");
-  lua_pushnumber((unsigned char)s[pos-1]);
+  lua_pushnumber(L, (unsigned char)s[pos-1]);
+  return 1;
 }
-static void str_char (void) {
+static int str_char (lua_State *L) {
-  int i = 0;
+  int n = lua_gettop(L);  /* number of arguments */
-  luaL_resetbuffer();
+  int i;
-  while (lua_getparam(++i) != LUA_NOOBJECT) {
+  luaL_Buffer b;
-    double c = luaL_check_number(i);
+  luaL_buffinit(L, &b);
-    luaL_arg_check((unsigned char)c == c, i, "invalid value");
+  for (i=1; i<=n; i++) {
-    luaL_addchar((unsigned char)c);
+    int c = luaL_check_int(L, i);
+    luaL_arg_check(L, (unsigned char)c == c, i, "invalid value");
+    luaL_putchar(&b, (unsigned char)c);
   }
-  closeandpush();
+  luaL_pushresult(&b);
+  return 1;
 }
 ** =======================================================
 */
-#ifndef MAX_CAPT
+#ifndef MAX_CAPTURES
-#define MAX_CAPT 32  /* arbitrary limit */
+#define MAX_CAPTURES 32  /* arbitrary limit */
 #endif
 struct Capture {
-  char *src_end;  /* end ('\0') of source string */
+  const char *src_end;  /* end ('\0') of source string */
   int level;  /* total number of captures (finished or unfinished) */
   struct {
-    char *init;
+    const char *init;
-    int len;  /* -1 signals unfinished capture */
+    long len;  /* -1 signals unfinished capture */
-  } capture[MAX_CAPT];
+  } capture[MAX_CAPTURES];
 };
-#define ESC	'%'
+#define ESC		'%'
-#define SPECIALS  "^$*+?.([%-"
+#define SPECIALS	"^$*+?.([%-"
-static void push_captures (struct Capture *cap) {
+static int check_capture (lua_State *L, int l, struct Capture *cap) {
-  int i;
-  for (i=0; i<cap->level; i++) {
-    int l = cap->capture[i].len;
-    if (l == -1) lua_error("unfinished capture");
-    lua_pushlstring(cap->capture[i].init, l);
-  }
-}
-static int check_cap (int l, struct Capture *cap) {
   l -= '1';
   if (!(0 <= l && l < cap->level && cap->capture[l].len != -1))
-    lua_error("invalid capture index");
+    lua_error(L, "invalid capture index");
   return l;
 }
-static int capture_to_close (struct Capture *cap) {
+static int capture_to_close (lua_State *L, struct Capture *cap) {
   int level = cap->level;
   for (level--; level>=0; level--)
     if (cap->capture[level].len == -1) return level;
-  lua_error("invalid pattern capture");
+  lua_error(L, "invalid pattern capture");
   return 0;  /* to avoid warnings */
 }
-char *luaI_classend (char *p) {
+const char *luaI_classend (lua_State *L, const char *p) {
   switch (*p++) {
     case ESC:
-      if (*p == '\0')
+      if (*p == '\0') lua_error(L, "malformed pattern (ends with `%')");
-        luaL_verror("incorrect pattern (ends with `%c')", ESC);
       return p+1;
     case '[':
       if (*p == '^') p++;
-      if (*p == ']') p++;
+      do {  /* look for a ']' */
-      p = strchr(p, ']');
+        if (*p == '\0') lua_error(L, "malformed pattern (missing `]')");
-      if (!p) lua_error("incorrect pattern (missing `]')");
+        if (*(p++) == ESC && *p != '\0') p++;  /* skip escapes (e.g. '%]') */
+      } while (*p != ']');
       return p+1;
     default:
       return p;
 }
-static int matchclass (int c, int cl) {
+static int match_class (int c, int cl) {
   int res;
   switch (tolower(cl)) {
     case 'a' : res = isalpha(c); break;
-static int matchbracketclass (int c, char *p, char *end) {
+static int matchbracketclass (int c, const char *p, const char *endclass) {
   int sig = 1;
   if (*(p+1) == '^') {
     sig = 0;
     p++;  /* skip the '^' */
   }
-  while (++p < end) {
+  while (++p < endclass) {
     if (*p == ESC) {
       p++;
-      if ((p < end) && matchclass(c, (unsigned char)*p))
+      if (match_class(c, (unsigned char)*p))
         return sig;
     }
-    else if ((*(p+1) == '-') && (p+2 < end)) {
+    else if ((*(p+1) == '-') && (p+2 < endclass)) {
       p+=2;
       if ((int)(unsigned char)*(p-2) <= c && c <= (int)(unsigned char)*p)
         return sig;
     }
-    else if ((unsigned char)*p == c) return sig;
+    else if ((int)(unsigned char)*p == c) return sig;
   }
   return !sig;
 }
-int luaI_singlematch (int c, char *p, char *ep) {
+int luaI_singlematch (int c, const char *p, const char *ep) {
   switch (*p) {
     case '.':  /* matches any char */
       return 1;
     case ESC:
-      return matchclass(c, (unsigned char)*(p+1));
+      return match_class(c, (unsigned char)*(p+1));
     case '[':
       return matchbracketclass(c, p, ep-1);
     default:
 }
-static char *match (char *s, char *p, struct Capture *cap);
+static const char *match (lua_State *L, const char *s, const char *p,
+                          struct Capture *cap);
-static char *matchbalance (char *s, char *p, struct Capture *cap) {
+static const char *matchbalance (lua_State *L, const char *s, const char *p,
+                                 struct Capture *cap) {
   if (*p == 0 || *(p+1) == 0)
-    lua_error("unbalanced pattern");
+    lua_error(L, "unbalanced pattern");
   if (*s != *p) return NULL;
   else {
     int b = *p;
 }
-static char *max_expand (char *s, char *p, char *ep, struct Capture *cap) {
+static const char *max_expand (lua_State *L, const char *s, const char *p,
-  int i = 0;  /* counts maximum expand for item */
+                               const char *ep, struct Capture *cap) {
+  long i = 0;  /* counts maximum expand for item */
   while ((s+i)<cap->src_end && luaI_singlematch((unsigned char)*(s+i), p, ep))
     i++;
-  /* keeps trying to match mith the maximum repetitions */
+  /* keeps trying to match with the maximum repetitions */
   while (i>=0) {
-    char *res = match((s+i), ep+1, cap);
+    const char *res = match(L, (s+i), ep+1, cap);
     if (res) return res;
     i--;  /* else didn't match; reduce 1 repetition to try again */
   }
 }
-static char *min_expand (char *s, char *p, char *ep, struct Capture *cap) {
+static const char *min_expand (lua_State *L, const char *s, const char *p,
+                               const char *ep, struct Capture *cap) {
   for (;;) {
-    char *res = match(s, ep+1, cap);
+    const char *res = match(L, s, ep+1, cap);
     if (res != NULL)
       return res;
     else if (s<cap->src_end && luaI_singlematch((unsigned char)*s, p, ep))
 }
-static char *start_capt (char *s, char *p, struct Capture *cap) {
+static const char *start_capture (lua_State *L, const char *s, const char *p,
-  char *res;
+                                  struct Capture *cap) {
+  const char *res;
   int level = cap->level;
-  if (level >= MAX_CAPT) lua_error("too many captures");
+  if (level >= MAX_CAPTURES) lua_error(L, "too many captures");
   cap->capture[level].init = s;
   cap->capture[level].len = -1;
   cap->level = level+1;
-  if ((res=match(s, p+1, cap)) == NULL)  /* match failed? */
+  if ((res=match(L, s, p+1, cap)) == NULL)  /* match failed? */
     cap->level--;  /* undo capture */
   return res;
 }
-static char *end_capt (char *s, char *p, struct Capture *cap) {
+static const char *end_capture (lua_State *L, const char *s, const char *p,
-  int l = capture_to_close(cap);
+                                struct Capture *cap) {
-  char *res;
+  int l = capture_to_close(L, cap);
+  const char *res;
   cap->capture[l].len = s - cap->capture[l].init;  /* close capture */
-  if ((res = match(s, p+1, cap)) == NULL)  /* match failed? */
+  if ((res = match(L, s, p+1, cap)) == NULL)  /* match failed? */
     cap->capture[l].len = -1;  /* undo capture */
   return res;
 }
-static char *match_capture (char *s, int level, struct Capture *cap) {
+static const char *match_capture (lua_State *L, const char *s, int level,
-  int l = check_cap(level, cap);
+                                  struct Capture *cap) {
-  int len = cap->capture[l].len;
+  int l = check_capture(L, level, cap);
-  if (cap->src_end-s >= len &&
+  size_t len = cap->capture[l].len;
+  if ((size_t)(cap->src_end-s) >= len &&
       memcmp(cap->capture[l].init, s, len) == 0)
     return s+len;
   else return NULL;
 }
-static char *match (char *s, char *p, struct Capture *cap) {
+static const char *match (lua_State *L, const char *s, const char *p,
+                          struct Capture *cap) {
   init: /* using goto's to optimize tail recursion */
   switch (*p) {
     case '(':  /* start capture */
-      return start_capt(s, p, cap);
+      return start_capture(L, s, p, cap);
     case ')':  /* end capture */
-      return end_capt(s, p, cap);
+      return end_capture(L, s, p, cap);
     case ESC:  /* may be %[0-9] or %b */
       if (isdigit((unsigned char)(*(p+1)))) {  /* capture? */
-        s = match_capture(s, *(p+1), cap);
+        s = match_capture(L, s, *(p+1), cap);
         if (s == NULL) return NULL;
-        p+=2; goto init;  /* else return match(p+2, s, cap) */
+        p+=2; goto init;  /* else return match(L, s, p+2, cap) */
       }
       else if (*(p+1) == 'b') {  /* balanced string? */
-        s = matchbalance(s, p+2, cap);
+        s = matchbalance(L, s, p+2, cap);
         if (s == NULL) return NULL;
-        p+=4; goto init;  /* else return match(p+4, s, cap); */
+        p+=4; goto init;  /* else return match(L, s, p+4, cap); */
       }
       else goto dflt;  /* case default */
     case '\0':  /* end of pattern */
         return (s == cap->src_end) ? s : NULL;  /* check end of string */
       else goto dflt;
     default: dflt: {  /* it is a pattern item */
-      char *ep = luaI_classend(p);  /* points to what is next */
+      const char *ep = luaI_classend(L, p);  /* points to what is next */
       int m = s<cap->src_end && luaI_singlematch((unsigned char)*s, p, ep);
       switch (*ep) {
         case '?': {  /* optional */
-          char *res;
+          const char *res;
-          if (m && ((res=match(s+1, ep+1, cap)) != NULL))
+          if (m && ((res=match(L, s+1, ep+1, cap)) != NULL))
             return res;
-          p=ep+1; goto init;  /* else return match(s, ep+1, cap); */
+          p=ep+1; goto init;  /* else return match(L, s, ep+1, cap); */
         }
         case '*':  /* 0 or more repetitions */
-          return max_expand(s, p, ep, cap);
+          return max_expand(L, s, p, ep, cap);
         case '+':  /* 1 or more repetitions */
-          return (m ? max_expand(s+1, p, ep, cap) : NULL);
+          return (m ? max_expand(L, s+1, p, ep, cap) : NULL);
         case '-':  /* 0 or more repetitions (minimum) */
-          return min_expand(s, p, ep, cap);
+          return min_expand(L, s, p, ep, cap);
         default:
           if (!m) return NULL;
-          s++; p=ep; goto init;  /* else return match(s+1, ep, cap); */
+          s++; p=ep; goto init;  /* else return match(L, s+1, ep, cap); */
+      }
+    }
+  }
+}
+static const char *lmemfind (const char *s1, size_t l1,
+                             const char *s2, size_t l2) {
+  if (l2 == 0) return s1;  /* empty strings are everywhere */
+  else if (l2 > l1) return NULL;  /* avoids a negative `l1' */
+  else {
+    const char *init;  /* to search for a `*s2' inside `s1' */
+    l2--;  /* 1st char will be checked by `memchr' */
+    l1 = l1-l2;  /* `s2' cannot be found after that */
+    while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) {
+      init++;   /* 1st char is already checked */
+      if (memcmp(init, s2+1, l2) == 0)
+        return init-1;
+      else {  /* correct `l1' and `s1' to try again */
+        l1 -= init-s1;
+        s1 = init;
       }
     }
+    return NULL;  /* not found */
   }
 }
-static void str_find (void) {
+static int push_captures (lua_State *L, struct Capture *cap) {
-  long l;
+  int i;
-  char *s = luaL_check_lstr(1, &l);
+  luaL_checkstack(L, cap->level, "too many captures");
-  char *p = luaL_check_string(2);
+  for (i=0; i<cap->level; i++) {
-  long init = posrelat(luaL_opt_long(3, 1), l) - 1;
+    int l = cap->capture[i].len;
+    if (l == -1) lua_error(L, "unfinished capture");
+    lua_pushlstring(L, cap->capture[i].init, l);
+  }
+  return cap->level;  /* number of strings pushed */
+}
+static int str_find (lua_State *L) {
+  size_t l1, l2;
+  const char *s = luaL_check_lstr(L, 1, &l1);
+  const char *p = luaL_check_lstr(L, 2, &l2);
+  long init = posrelat(luaL_opt_long(L, 3, 1), l1) - 1;
   struct Capture cap;
-  luaL_arg_check(0 <= init && init <= l, 3, "out of range");
+  luaL_arg_check(L, 0 <= init && (size_t)init <= l1, 3, "out of range");
-  if (lua_getparam(4) != LUA_NOOBJECT ||
+  if (lua_gettop(L) > 3 ||  /* extra argument? */
-      strpbrk(p, SPECIALS) == NULL) {  /* no special characters? */
+      strpbrk(p, SPECIALS) == NULL) {  /* or no special characters? */
-    char *s2 = strstr(s+init, p);
+    const char *s2 = lmemfind(s+init, l1-init, p, l2);
     if (s2) {
-      lua_pushnumber(s2-s+1);
+      lua_pushnumber(L, s2-s+1);
-      lua_pushnumber(s2-s+strlen(p));
+      lua_pushnumber(L, s2-s+l2);
-      return;
+      return 2;
     }
   }
   else {
     int anchor = (*p == '^') ? (p++, 1) : 0;
-    char *s1=s+init;
+    const char *s1=s+init;
-    cap.src_end = s+l;
+    cap.src_end = s+l1;
     do {
-      char *res;
+      const char *res;
       cap.level = 0;
-      if ((res=match(s1, p, &cap)) != NULL) {
+      if ((res=match(L, s1, p, &cap)) != NULL) {
-        lua_pushnumber(s1-s+1);  /* start */
+        lua_pushnumber(L, s1-s+1);  /* start */
-        lua_pushnumber(res-s);   /* end */
+        lua_pushnumber(L, res-s);   /* end */
-        push_captures(&cap);
+        return push_captures(L, &cap) + 2;
-        return;
       }
     } while (s1++<cap.src_end && !anchor);
   }
-  lua_pushnil();  /* if arrives here, it didn't find */
+  lua_pushnil(L);  /* not found */
+  return 1;
 }
-static void add_s (lua_Object newp, struct Capture *cap) {
+static void add_s (lua_State *L, luaL_Buffer *b, struct Capture *cap) {
-  if (lua_isstring(newp)) {
+  if (lua_isstring(L, 3)) {
-    char *news = lua_getstring(newp);
+    const char *news = lua_tostring(L, 3);
-    int l = lua_strlen(newp);
+    size_t l = lua_strlen(L, 3);
-    int i;
+    size_t i;
     for (i=0; i<l; i++) {
       if (news[i] != ESC)
-        luaL_addchar(news[i]);
+        luaL_putchar(b, news[i]);
       else {
         i++;  /* skip ESC */
         if (!isdigit((unsigned char)news[i]))
-          luaL_addchar(news[i]);
+          luaL_putchar(b, news[i]);
         else {
-          int level = check_cap(news[i], cap);
+          int level = check_capture(L, news[i], cap);
-          addnchar(cap->capture[level].init, cap->capture[level].len);
+          luaL_addlstring(b, cap->capture[level].init, cap->capture[level].len);
         }
       }
     }
   }
   else {  /* is a function */
-    lua_Object res;
+    int n;
-    int status;
+    lua_pushvalue(L, 3);
-    int oldbuff;
+    n = push_captures(L, cap);
-    lua_beginblock();
+    lua_rawcall(L, n, 1);
-    push_captures(cap);
+    if (lua_isstring(L, -1))
-    /* function may use buffer, so save it and create a new one */
+      luaL_addvalue(b);  /* add return to accumulated result */
-    oldbuff = luaL_newbuffer(0);
+    else
-    status = lua_callfunction(newp);
+      lua_pop(L, 1);  /* function result is not a string: pop it */
-    /* restore old buffer */
-    luaL_oldbuffer(oldbuff);
-    if (status != 0) {
-      lua_endblock();
-      lua_error(NULL);
-    }
-    res = lua_getresult(1);
-    if (lua_isstring(res))
-      addnchar(lua_getstring(res), lua_strlen(res));
-    lua_endblock();
   }
 }
-static void str_gsub (void) {
+static int str_gsub (lua_State *L) {
-  long srcl;
+  size_t srcl;
-  char *src = luaL_check_lstr(1, &srcl);
+  const char *src = luaL_check_lstr(L, 1, &srcl);
-  char *p = luaL_check_string(2);
+  const char *p = luaL_check_string(L, 2);
-  lua_Object newp = lua_getparam(3);
+  int max_s = luaL_opt_int(L, 4, srcl+1);
-  int max_s = luaL_opt_int(4, srcl+1);
   int anchor = (*p == '^') ? (p++, 1) : 0;
   int n = 0;
   struct Capture cap;
-  luaL_arg_check(lua_isstring(newp) || lua_isfunction(newp), 3,
+  luaL_Buffer b;
-                 "string or function expected");
+  luaL_arg_check(L,
-  luaL_resetbuffer();
+    lua_gettop(L) >= 3 && (lua_isstring(L, 3) || lua_isfunction(L, 3)),
+    3, "string or function expected");
+  luaL_buffinit(L, &b);
   cap.src_end = src+srcl;
   while (n < max_s) {
-    char *e;
+    const char *e;
     cap.level = 0;
-    e = match(src, p, &cap);
+    e = match(L, src, p, &cap);
     if (e) {
       n++;
-      add_s(newp, &cap);
+      add_s(L, &b, &cap);
     }
     if (e && e>src) /* non empty match? */
       src = e;  /* skip it */
     else if (src < cap.src_end)
-      luaL_addchar(*src++);
+      luaL_putchar(&b, *src++);
     else break;
     if (anchor) break;
   }
-  addnchar(src, cap.src_end-src);
+  luaL_addlstring(&b, src, cap.src_end-src);
-  closeandpush();
+  luaL_pushresult(&b);
-  lua_pushnumber(n);  /* number of substitutions */
+  lua_pushnumber(L, n);  /* number of substitutions */
+  return 2;
 }
 /* }====================================================== */
-static void luaI_addquoted (int arg) {
+static void luaI_addquoted (lua_State *L, luaL_Buffer *b, int arg) {
-  long l;
+  size_t l;
-  char *s = luaL_check_lstr(arg, &l);
+  const char *s = luaL_check_lstr(L, arg, &l);
-  luaL_addchar('"');
+  luaL_putchar(b, '"');
   while (l--) {
     switch (*s) {
       case '"':  case '\\':  case '\n':
-        luaL_addchar('\\');
+        luaL_putchar(b, '\\');
-        luaL_addchar(*s);
+        luaL_putchar(b, *s);
         break;
-      case '\0': addnchar("\\000", 4); break;
+      case '\0': luaL_addlstring(b, "\\000", 4); break;
-      default: luaL_addchar(*s);
+      default: luaL_putchar(b, *s);
     }
     s++;
   }
-  luaL_addchar('"');
+  luaL_putchar(b, '"');
 }
+/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */
+#define MAX_ITEM	512
 /* maximum size of each format specification (such as '%-099.99d') */
-#define MAX_FORMAT 20  /* arbitrary limit */
+#define MAX_FORMAT	20
-static void str_format (void) {
+static int str_format (lua_State *L) {
   int arg = 1;
-  char *strfrmt = luaL_check_string(arg);
+  const char *strfrmt = luaL_check_string(L, arg);
-  luaL_resetbuffer();
+  luaL_Buffer b;
+  luaL_buffinit(L, &b);
   while (*strfrmt) {
     if (*strfrmt != '%')
-      luaL_addchar(*strfrmt++);
+      luaL_putchar(&b, *strfrmt++);
     else if (*++strfrmt == '%')
-      luaL_addchar(*strfrmt++);  /* %% */
+      luaL_putchar(&b, *strfrmt++);  /* %% */
     else { /* format item */
       struct Capture cap;
       char form[MAX_FORMAT];  /* to store the format ('%...') */
-      char *buff;  /* to store the formatted item */
+      char buff[MAX_ITEM];  /* to store the formatted item */
-      char *initf = strfrmt;
+      const char *initf = strfrmt;
       form[0] = '%';
       if (isdigit((unsigned char)*initf) && *(initf+1) == '$') {
         arg = *initf - '0';
       arg++;
       cap.src_end = strfrmt+strlen(strfrmt)+1;
       cap.level = 0;
-      strfrmt = match(initf, "[-+ #0]*(%d*)%.?(%d*)", &cap);
+      strfrmt = match(L, initf, "[-+ #0]*(%d*)%.?(%d*)", &cap);
       if (cap.capture[0].len > 2 || cap.capture[1].len > 2 ||  /* < 100? */
           strfrmt-initf > MAX_FORMAT-2)
-        lua_error("invalid format (width or precision too long)");
+        lua_error(L, "invalid format (width or precision too long)");
       strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */
       form[strfrmt-initf+2] = 0;
-      buff = luaL_openspace(512);  /* 512 > size of format('%99.99f', -1e308) */
       switch (*strfrmt++) {
         case 'c':  case 'd':  case 'i':
-          sprintf(buff, form, luaL_check_int(arg));
+          sprintf(buff, form, luaL_check_int(L, arg));
           break;
         case 'o':  case 'u':  case 'x':  case 'X':
-          sprintf(buff, form, (unsigned int)luaL_check_number(arg));
+          sprintf(buff, form, (unsigned int)luaL_check_number(L, arg));
           break;
         case 'e':  case 'E': case 'f': case 'g': case 'G':
-          sprintf(buff, form, luaL_check_number(arg));
+          sprintf(buff, form, luaL_check_number(L, arg));
           break;
         case 'q':
-          luaI_addquoted(arg);
+          luaI_addquoted(L, &b, arg);
           continue;  /* skip the "addsize" at the end */
         case 's': {
-          long l;
+          size_t l;
-          char *s = luaL_check_lstr(arg, &l);
+          const char *s = luaL_check_lstr(L, arg, &l);
           if (cap.capture[1].len == 0 && l >= 100) {
-            /* no precision and string is too big to be formatted;
+            /* no precision and string is too long to be formatted;
                keep original string */
-            addnchar(s, l);
+            lua_pushvalue(L, arg);
+            luaL_addvalue(&b);
             continue;  /* skip the "addsize" at the end */
           }
           else {
           }
         }
         default:  /* also treat cases 'pnLlh' */
-          lua_error("invalid option in `format'");
+          lua_error(L, "invalid option in `format'");
       }
-      luaL_addsize(strlen(buff));
+      luaL_addlstring(&b, buff, strlen(buff));
     }
   }
-  closeandpush();  /* push the result */
+  luaL_pushresult(&b);
+  return 1;
 }
-static struct luaL_reg strlib[] = {
+static const struct luaL_reg strlib[] = {
 {"strlen", str_len},
 {"strsub", str_sub},
 {"strlower", str_lower},
 /*
 ** Open string library
 */
-void strlib_open (void)
+LUALIB_API void lua_strlibopen (lua_State *L) {
-{
+  luaL_openl(L, strlib);
-  luaL_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
 }

src/llex.c+219−276

@@ -1,71 +1,85 @@
1	/*	1	/*
2	** $Id: llex.c,v 1.36 1999/06/17 17:04:03 roberto Exp $	2	** $Id: llex.c,v 1.72 2000/10/20 16:39:03 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>
9	#include <string.h>	10	#include <string.h>
10		11
11	#include "lauxlib.h"	12	#include "lua.h"
		13
12	#include "llex.h"	14	#include "llex.h"
13	#include "lmem.h"	15	#include "lmem.h"
14	#include "lobject.h"	16	#include "lobject.h"
15	#include "lparser.h"	17	#include "lparser.h"
16	#include "lstate.h"	18	#include "lstate.h"
17	#include "lstring.h"	19	#include "lstring.h"
		20	#include "ltable.h"
18	#include "luadebug.h"	21	#include "luadebug.h"
19	#include "lzio.h"	22	#include "lzio.h"
20		23
21		24
22		25
23	#define next(LS) (LS->current = zgetc(LS->lex_z))	26	#define next(LS) (LS->current = zgetc(LS->z))
24
25		27
26	#define save(c) luaL_addchar(c)
27	#define save_and_next(LS) (save(LS->current), next(LS))
28		28
29		29
30	char *reserved [] = {"and", "do", "else", "elseif", "end", "function",	30	/* ORDER RESERVED */
31	"if", "local", "nil", "not", "or", "repeat", "return", "then",	31	static const char *const token2string [] = {
32	"until", "while"};	32	"and", "break", "do", "else", "elseif", "end", "for",
		33	"function", "if", "local", "nil", "not", "or", "repeat", "return", "then",
		34	"until", "while", "", "..", "...", "==", ">=", "<=", "~=", "", "", "<eof>"};
33		35
34		36
35	void luaX_init (void) {	37	void luaX_init (lua_State *L) {
36	int i;	38	int i;
37	for (i=0; i<(sizeof(reserved)/sizeof(reserved[0])); i++) {	39	for (i=0; i<NUM_RESERVED; i++) {
38	TaggedString *ts = luaS_new(reserved[i]);	40	TString *ts = luaS_new(L, token2string[i]);
39	ts->head.marked = FIRST_RESERVED+i; /* reserved word (always > 255) */	41	ts->marked = (unsigned char)(RESERVEDMARK+i); /* reserved word */
40	}	42	}
41	}	43	}
42		44
43		45
44	#define MAXSRC 80	46	#define MAXSRC 80
45		47
46	void luaX_syntaxerror (LexState ls, char s, char *token) {	48
		49	void luaX_checklimit (LexState ls, int val, int limit, const char msg) {
		50	if (val > limit) {
		51	char buff[100];
		52	sprintf(buff, "too many %.50s (limit=%d)", msg, limit);
		53	luaX_error(ls, buff, ls->t.token);
		54	}
		55	}
		56
		57
		58	void luaX_syntaxerror (LexState ls, const char s, const char *token) {
47	char buff[MAXSRC];	59	char buff[MAXSRC];
48	luaL_chunkid(buff, zname(ls->lex_z), sizeof(buff));	60	luaO_chunkid(buff, ls->source->str, sizeof(buff));
49	if (token[0] == '\0')	61	luaO_verror(ls->L, "%.99s;\n last token read: `%.30s' at line %d in %.80s",
50	token = "<eof>";
51	luaL_verror("%.100s;\n last token read: `%.50s' at line %d in %.80s",
52	s, token, ls->linenumber, buff);	62	s, token, ls->linenumber, buff);
53	}	63	}
54		64
55		65
56	void luaX_error (LexState ls, char s) {	66	void luaX_error (LexState ls, const char s, int token) {
57	save('\0');	67	char buff[TOKEN_LEN];
58	luaX_syntaxerror(ls, s, luaL_buffer());	68	luaX_token2str(token, buff);
		69	if (buff[0] == '\0')
		70	luaX_syntaxerror(ls, s, ls->L->Mbuffer);
		71	else
		72	luaX_syntaxerror(ls, s, buff);
59	}	73	}
60		74
61		75
62	void luaX_token2str (int token, char *s) {	76	void luaX_token2str (int token, char *s) {
63	if (token < 255) {	77	if (token < 256) {
64	s[0] = (char)token;	78	s[0] = (char)token;
65	s[1] = '\0';	79	s[1] = '\0';
66	}	80	}
67	else	81	else
68	strcpy(s, reserved[token-FIRST_RESERVED]);	82	strcpy(s, token2string[token-FIRST_RESERVED]);
69	}	83	}
70		84
71		85
@@ -76,200 +90,199 @@ static void luaX_invalidchar (LexState *ls, int c) { · 4 unmodified lines
76	}	90	}
77		91
78		92
79	static void firstline (LexState *LS)	93	static void inclinenumber (LexState *LS) {
80	{	94	next(LS); /* skip '\n' */
81	int c = zgetc(LS->lex_z);	95	++LS->linenumber;
82	if (c == '#')	96	luaX_checklimit(LS, LS->linenumber, MAX_INT, "lines in a chunk");
83	while ((c=zgetc(LS->lex_z)) != '\n' && c != EOZ) /* skip first line */;
84	zungetc(LS->lex_z);
85	}	97	}
86		98
87		99
88	void luaX_setinput (LexState LS, ZIO z)	100	void luaX_setinput (lua_State L, LexState LS, ZIO z, TString source) {
89	{	101	LS->L = L;
90	LS->current = '\n';	102	LS->lookahead.token = TK_EOS; /* no look-ahead token */
91	LS->linenumber = 0;	103	LS->z = z;
92	LS->iflevel = 0;
93	LS->ifstate[0].skip = 0;
94	LS->ifstate[0].elsepart = 1; /* to avoid a free $else */
95	LS->lex_z = z;
96	LS->fs = NULL;	104	LS->fs = NULL;
97	firstline(LS);	105	LS->linenumber = 1;
98	luaL_resetbuffer();	106	LS->lastline = 1;
		107	LS->source = source;
		108	next(LS); /* read first char */
		109	if (LS->current == '#') {
		110	do { /* skip first line */
		111	next(LS);
		112	} while (LS->current != '\n' && LS->current != EOZ);
		113	}
99	}	114	}
100		115
101		116
102		117
103	/*	118	/*
104	** =======================================================	119	** =======================================================
105	** PRAGMAS	120	** LEXICAL ANALYZER
106	** =======================================================	121	** =======================================================
107	*/	122	*/
108		123
109	#ifndef PRAGMASIZE
110	#define PRAGMASIZE 80 /* arbitrary limit */
111	#endif
112		124
113	static void skipspace (LexState *LS) {	125	/* use Mbuffer to store names, literal strings and numbers */
114	while (LS->current == ' ' \|\| LS->current == '\t' \|\| LS->current == '\r')
115	next(LS);
116	}
117		126
		127	#define EXTRABUFF 128
		128	#define checkbuffer(L, n, len) if ((len)+(n) > L->Mbuffsize) \
		129	luaO_openspace(L, (len)+(n)+EXTRABUFF)
118		130
119	static int checkcond (LexState LS, char buff) {	131	#define save(L, c, l) (L->Mbuffer[l++] = (char)c)
120	static char *opts[] = {"nil", "1", NULL};	132	#define save_and_next(L, LS, l) (save(L, LS->current, l), next(LS))
121	int i = luaL_findstring(buff, opts);
122	if (i >= 0) return i;
123	else if (isalpha((unsigned char)buff[0]) \|\| buff[0] == '_')
124	return luaS_globaldefined(buff);
125	else {
126	luaX_syntaxerror(LS, "invalid $if condition", buff);
127	return 0; /* to avoid warnings */
128	}
129	}
130		133
131		134
132	static void readname (LexState LS, char buff) {	135	static const char readname (LexState LS) {
133	int i = 0;	136	lua_State *L = LS->L;
134	skipspace(LS);	137	size_t l = 0;
135	while (isalnum(LS->current) \|\| LS->current == '_') {	138	checkbuffer(L, 10, l);
136	if (i >= PRAGMASIZE) {	139	do {
137	buff[PRAGMASIZE] = 0;	140	checkbuffer(L, 10, l);
138	luaX_syntaxerror(LS, "pragma too long", buff);	141	save_and_next(L, LS, l);
139	}	142	} while (isalnum(LS->current) \|\| LS->current == '_');
140	buff[i++] = (char)LS->current;	143	save(L, '\0', l);
141	next(LS);	144	return L->Mbuffer;
142	}
143	buff[i] = 0;
144	}	145	}
145		146
146		147
147	static void inclinenumber (LexState *LS);	148	/* LUA_NUMBER */
148		149	static void read_number (LexState LS, int comma, SemInfo seminfo) {
149		150	lua_State *L = LS->L;
150	static void ifskip (LexState *LS) {	151	size_t l = 0;
151	while (LS->ifstate[LS->iflevel].skip) {	152	checkbuffer(L, 10, l);
152	if (LS->current == '\n')	153	if (comma) save(L, '.', l);
153	inclinenumber(LS);	154	while (isdigit(LS->current)) {
154	else if (LS->current == EOZ)	155	checkbuffer(L, 10, l);
155	luaX_error(LS, "input ends inside a $if");	156	save_and_next(L, LS, l);
156	else next(LS);
157	}	157	}
158	}	158	if (LS->current == '.') {
159		159	save_and_next(L, LS, l);
160		160	if (LS->current == '.') {
161	static void inclinenumber (LexState *LS) {	161	save_and_next(L, LS, l);
162	static char *pragmas [] =	162	save(L, '\0', l);
163	{"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL};	163	luaX_error(LS, "ambiguous syntax"
164	next(LS); /* skip '\n' */	164	" (decimal point x string concatenation)", TK_NUMBER);
165	++LS->linenumber;
166	if (LS->current == '$') { /* is a pragma? */
167	char buff[PRAGMASIZE+1];
168	int ifnot = 0;
169	int skip = LS->ifstate[LS->iflevel].skip;
170	next(LS); /* skip $ */
171	readname(LS, buff);
172	switch (luaL_findstring(buff, pragmas)) {
173	case 0: /* debug */
174	if (!skip) L->debug = 1;
175	break;
176	case 1: /* nodebug */
177	if (!skip) L->debug = 0;
178	break;
179	case 2: /* endinput */
180	if (!skip) {
181	LS->current = EOZ;
182	LS->iflevel = 0; /* to allow $endinput inside a $if */
183	}
184	break;
185	case 3: /* end */
186	if (LS->iflevel-- == 0)
187	luaX_syntaxerror(LS, "unmatched $end", "$end");
188	break;
189	case 4: /* ifnot */
190	ifnot = 1;
191	/* go through */
192	case 5: /* if */
193	if (LS->iflevel == MAX_IFS-1)
194	luaX_syntaxerror(LS, "too many nested $ifs", "$if");
195	readname(LS, buff);
196	LS->iflevel++;
197	LS->ifstate[LS->iflevel].elsepart = 0;
198	LS->ifstate[LS->iflevel].condition = checkcond(LS, buff) ? !ifnot : ifnot;
199	LS->ifstate[LS->iflevel].skip = skip \|\| !LS->ifstate[LS->iflevel].condition;
200	break;
201	case 6: /* else */
202	if (LS->ifstate[LS->iflevel].elsepart)
203	luaX_syntaxerror(LS, "unmatched $else", "$else");
204	LS->ifstate[LS->iflevel].elsepart = 1;
205	LS->ifstate[LS->iflevel].skip = LS->ifstate[LS->iflevel-1].skip \|\|
206	LS->ifstate[LS->iflevel].condition;
207	break;
208	default:
209	luaX_syntaxerror(LS, "unknown pragma", buff);
210	}	165	}
211	skipspace(LS);
212	if (LS->current == '\n') /* pragma must end with a '\n' ... */
213	inclinenumber(LS);
214	else if (LS->current != EOZ) /* or eof */
215	luaX_syntaxerror(LS, "invalid pragma format", buff);
216	ifskip(LS);
217	}	166	}
		167	while (isdigit(LS->current)) {
		168	checkbuffer(L, 10, l);
		169	save_and_next(L, LS, l);
		170	}
		171	if (LS->current == 'e' \|\| LS->current == 'E') {
		172	save_and_next(L, LS, l); /* read 'E' */
		173	if (LS->current == '+' \|\| LS->current == '-')
		174	save_and_next(L, LS, l); /* optional exponent sign */
		175	while (isdigit(LS->current)) {
		176	checkbuffer(L, 10, l);
		177	save_and_next(L, LS, l);
		178	}
		179	}
		180	save(L, '\0', l);
		181	if (!luaO_str2d(L->Mbuffer, &seminfo->r))
		182	luaX_error(LS, "malformed number", TK_NUMBER);
218	}	183	}
219		184
220		185
221		186	static void read_long_string (LexState LS, SemInfo seminfo) {
222	/*	187	lua_State *L = LS->L;
223	** =======================================================
224	** LEXICAL ANALIZER
225	** =======================================================
226	*/
227
228
229
230	static int read_long_string (LexState *LS) {
231	int cont = 0;	188	int cont = 0;
		189	size_t l = 0;
		190	checkbuffer(L, 10, l);
		191	save(L, '[', l); /* save first '[' */
		192	save_and_next(L, LS, l); /* pass the second '[' */
232	for (;;) {	193	for (;;) {
		194	checkbuffer(L, 10, l);
233	switch (LS->current) {	195	switch (LS->current) {
234	case EOZ:	196	case EOZ:
235	luaX_error(LS, "unfinished long string");	197	save(L, '\0', l);
236	return EOS; /* to avoid warnings */	198	luaX_error(LS, "unfinished long string", TK_STRING);
		199	break; /* to avoid warnings */
237	case '[':	200	case '[':
238	save_and_next(LS);	201	save_and_next(L, LS, l);
239	if (LS->current == '[') {	202	if (LS->current == '[') {
240	cont++;	203	cont++;
241	save_and_next(LS);	204	save_and_next(L, LS, l);
242	}	205	}
243	continue;	206	continue;
244	case ']':	207	case ']':
245	save_and_next(LS);	208	save_and_next(L, LS, l);
246	if (LS->current == ']') {	209	if (LS->current == ']') {
247	if (cont == 0) goto endloop;	210	if (cont == 0) goto endloop;
248	cont--;	211	cont--;
249	save_and_next(LS);	212	save_and_next(L, LS, l);
250	}	213	}
251	continue;	214	continue;
252	case '\n':	215	case '\n':
253	save('\n');	216	save(L, '\n', l);
254	inclinenumber(LS);	217	inclinenumber(LS);
255	continue;	218	continue;
256	default:	219	default:
257	save_and_next(LS);	220	save_and_next(L, LS, l);
258	}	221	}
259	} endloop:	222	} endloop:
260	save_and_next(LS); /* skip the second ']' */	223	save_and_next(L, LS, l); /* skip the second ']' */
261	LS->seminfo.ts = luaS_newlstr(L->Mbuffer+(L->Mbuffbase+2),	224	save(L, '\0', l);
262	L->Mbuffnext-L->Mbuffbase-4);	225	seminfo->ts = luaS_newlstr(L, L->Mbuffer+2, l-5);
263	return STRING;
264	}	226	}
265		227
266		228
267	int luaX_lex (LexState *LS) {	229	static void read_string (LexState LS, int del, SemInfo seminfo) {
268	luaL_resetbuffer();	230	lua_State *L = LS->L;
		231	size_t l = 0;
		232	checkbuffer(L, 10, l);
		233	save_and_next(L, LS, l);
		234	while (LS->current != del) {
		235	checkbuffer(L, 10, l);
		236	switch (LS->current) {
		237	case EOZ: case '\n':
		238	save(L, '\0', l);
		239	luaX_error(LS, "unfinished string", TK_STRING);
		240	break; /* to avoid warnings */
		241	case '\\':
		242	next(LS); /* do not save the '\' */
		243	switch (LS->current) {
		244	case 'a': save(L, '\a', l); next(LS); break;
		245	case 'b': save(L, '\b', l); next(LS); break;
		246	case 'f': save(L, '\f', l); next(LS); break;
		247	case 'n': save(L, '\n', l); next(LS); break;
		248	case 'r': save(L, '\r', l); next(LS); break;
		249	case 't': save(L, '\t', l); next(LS); break;
		250	case 'v': save(L, '\v', l); next(LS); break;
		251	case '\n': save(L, '\n', l); inclinenumber(LS); break;
		252	case '0': case '1': case '2': case '3': case '4':
		253	case '5': case '6': case '7': case '8': case '9': {
		254	int c = 0;
		255	int i = 0;
		256	do {
		257	c = 10*c + (LS->current-'0');
		258	next(LS);
		259	} while (++i<3 && isdigit(LS->current));
		260	if (c != (unsigned char)c) {
		261	save(L, '\0', l);
		262	luaX_error(LS, "escape sequence too large", TK_STRING);
		263	}
		264	save(L, c, l);
		265	break;
		266	}
		267	default: /* handles \\, \", \', and \? */
		268	save_and_next(L, LS, l);
		269	}
		270	break;
		271	default:
		272	save_and_next(L, LS, l);
		273	}
		274	}
		275	save_and_next(L, LS, l); /* skip delimiter */
		276	save(L, '\0', l);
		277	seminfo->ts = luaS_newlstr(L, L->Mbuffer+1, l-3);
		278	}
		279
		280
		281	int luaX_lex (LexState LS, SemInfo seminfo) {
269	for (;;) {	282	for (;;) {
270	switch (LS->current) {	283	switch (LS->current) {
271		284
272	case ' ': case '\t': case '\r': /* CR: to avoid problems with DOS */	285	case ' ': case '\t': case '\r': /* `\r' to avoid problems with DOS */
273	next(LS);	286	next(LS);
274	continue;	287	continue;
275		288
@@ -277,159 +290,89 @@ int luaX_lex (LexState *LS) { · 1 unmodified line
277	inclinenumber(LS);	290	inclinenumber(LS);
278	continue;	291	continue;
279		292
		293	case '$':
		294	luaX_error(LS, "unexpected `$' (pragmas are no longer supported)", '$');
		295	break;
		296
280	case '-':	297	case '-':
281	save_and_next(LS);	298	next(LS);
282	if (LS->current != '-') return '-';	299	if (LS->current != '-') return '-';
283	do { next(LS); } while (LS->current != '\n' && LS->current != EOZ);	300	do { next(LS); } while (LS->current != '\n' && LS->current != EOZ);
284	luaL_resetbuffer();
285	continue;	301	continue;
286		302
287	case '[':	303	case '[':
288	save_and_next(LS);	304	next(LS);
289	if (LS->current != '[') return '[';	305	if (LS->current != '[') return '[';
290	else {	306	else {
291	save_and_next(LS); /* pass the second '[' */	307	read_long_string(LS, seminfo);
292	return read_long_string(LS);	308	return TK_STRING;
293	}	309	}
294		310
295	case '=':	311	case '=':
296	save_and_next(LS);	312	next(LS);
297	if (LS->current != '=') return '=';	313	if (LS->current != '=') return '=';
298	else { save_and_next(LS); return EQ; }	314	else { next(LS); return TK_EQ; }
299		315
300	case '<':	316	case '<':
301	save_and_next(LS);	317	next(LS);
302	if (LS->current != '=') return '<';	318	if (LS->current != '=') return '<';
303	else { save_and_next(LS); return LE; }	319	else { next(LS); return TK_LE; }
304		320
305	case '>':	321	case '>':
306	save_and_next(LS);	322	next(LS);
307	if (LS->current != '=') return '>';	323	if (LS->current != '=') return '>';
308	else { save_and_next(LS); return GE; }	324	else { next(LS); return TK_GE; }
309		325
310	case '~':	326	case '~':
311	save_and_next(LS);	327	next(LS);
312	if (LS->current != '=') return '~';	328	if (LS->current != '=') return '~';
313	else { save_and_next(LS); return NE; }	329	else { next(LS); return TK_NE; }
314		330
315	case '"':	331	case '"':
316	case '\'': {	332	case '\'':
317	int del = LS->current;	333	read_string(LS, LS->current, seminfo);
318	save_and_next(LS);	334	return TK_STRING;
319	while (LS->current != del) {
320	switch (LS->current) {
321	case EOZ:
322	case '\n':
323	luaX_error(LS, "unfinished string");
324	return EOS; /* to avoid warnings */
325	case '\\':
326	next(LS); /* do not save the '\' */
327	switch (LS->current) {
328	case 'a': save('\a'); next(LS); break;
329	case 'b': save('\b'); next(LS); break;
330	case 'f': save('\f'); next(LS); break;
331	case 'n': save('\n'); next(LS); break;
332	case 'r': save('\r'); next(LS); break;
333	case 't': save('\t'); next(LS); break;
334	case 'v': save('\v'); next(LS); break;
335	case '\n': save('\n'); inclinenumber(LS); break;
336	default : {
337	if (isdigit(LS->current)) {
338	int c = 0;
339	int i = 0;
340	do {
341	c = 10*c + (LS->current-'0');
342	next(LS);
343	} while (++i<3 && isdigit(LS->current));
344	if (c != (unsigned char)c)
345	luaX_error(LS, "escape sequence too large");
346	save(c);
347	}
348	else { /* handles \, ", ', and ? */
349	save(LS->current);
350	next(LS);
351	}
352	break;
353	}
354	}
355	break;
356	default:
357	save_and_next(LS);
358	}
359	}
360	save_and_next(LS); /* skip delimiter */
361	LS->seminfo.ts = luaS_newlstr(L->Mbuffer+(L->Mbuffbase+1),
362	L->Mbuffnext-L->Mbuffbase-2);
363	return STRING;
364	}
365		335
366	case '.':	336	case '.':
367	save_and_next(LS);	337	next(LS);
368	if (LS->current == '.')	338	if (LS->current == '.') {
369	{	339	next(LS);
370	save_and_next(LS);	340	if (LS->current == '.') {
371	if (LS->current == '.')	341	next(LS);
372	{	342	return TK_DOTS; /* ... */
373	save_and_next(LS);
374	return DOTS; /* ... */
375	}	343	}
376	else return CONC; /* .. */	344	else return TK_CONCAT; /* .. */
377	}	345	}
378	else if (!isdigit(LS->current)) return '.';	346	else if (!isdigit(LS->current)) return '.';
379	goto fraction; /* LS->current is a digit: goes through to number */	347	else {
		348	read_number(LS, 1, seminfo);
		349	return TK_NUMBER;
		350	}
380		351
381	case '0': case '1': case '2': case '3': case '4':	352	case '0': case '1': case '2': case '3': case '4':
382	case '5': case '6': case '7': case '8': case '9':	353	case '5': case '6': case '7': case '8': case '9':
383	do {	354	read_number(LS, 0, seminfo);
384	save_and_next(LS);	355	return TK_NUMBER;
385	} while (isdigit(LS->current));
386	if (LS->current == '.') {
387	save_and_next(LS);
388	if (LS->current == '.') {
389	save('.');
390	luaX_error(LS,
391	"ambiguous syntax (decimal point x string concatenation)");
392	}
393	}
394	fraction:
395	while (isdigit(LS->current))
396	save_and_next(LS);
397	if (toupper(LS->current) == 'E') {
398	save_and_next(LS); /* read 'E' */
399	save_and_next(LS); /* read '+', '-' or first digit */
400	while (isdigit(LS->current))
401	save_and_next(LS);
402	}
403	save('\0');
404	LS->seminfo.r = luaO_str2d(L->Mbuffer+L->Mbuffbase);
405	if (LS->seminfo.r < 0)
406	luaX_error(LS, "invalid numeric format");
407	return NUMBER;
408		356
409	case EOZ:	357	case EOZ:
410	if (LS->iflevel > 0)	358	return TK_EOS;
411	luaX_error(LS, "input ends inside a $if");	359
412	return EOS;	360	case '_': goto tname;
413		361
414	default:	362	default:
415	if (LS->current != '_' && !isalpha(LS->current)) {	363	if (!isalpha(LS->current)) {
416	int c = LS->current;	364	int c = LS->current;
417	if (iscntrl(c))	365	if (iscntrl(c))
418	luaX_invalidchar(LS, c);	366	luaX_invalidchar(LS, c);
419	save_and_next(LS);	367	next(LS);
420	return c;	368	return c;
421	}	369	}
422	else { /* identifier or reserved word */	370	tname: { /* identifier or reserved word */
423	TaggedString *ts;	371	TString *ts = luaS_new(LS->L, readname(LS));
424	do {	372	if (ts->marked >= RESERVEDMARK) /* reserved word? */
425	save_and_next(LS);	373	return ts->marked-RESERVEDMARK+FIRST_RESERVED;
426	} while (isalnum(LS->current) \|\| LS->current == '_');	374	seminfo->ts = ts;
427	save('\0');	375	return TK_NAME;
428	ts = luaS_new(L->Mbuffer+L->Mbuffbase);
429	if (ts->head.marked >= FIRST_RESERVED)
430	return ts->head.marked; /* reserved word */
431	LS->seminfo.ts = ts;
432	return NAME;
433	}	376	}
434	}	377	}
435	}	378	}

src/llex.h+39−31

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: llex.h,v 1.12 1999/06/17 17:04:03 roberto Exp $	2	** $Id: llex.h,v 1.31 2000/09/27 17:41:58 roberto Exp $
3	** Lexical Analyzer	3	** Lexical Analyzer
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -11,53 +11,61 @@ · 5 unmodified lines
11	#include "lzio.h"	11	#include "lzio.h"
12		12
13		13
14	#define FIRST_RESERVED 260	14	#define FIRST_RESERVED 257
15		15
16	/* maximum length of a reserved word (+1 for terminal 0) */	16	/* maximum length of a reserved word (+1 for final 0) */
17	#define TOKEN_LEN 15	17	#define TOKEN_LEN 15
18		18
		19
		20	/*
		21	* WARNING: if you change the order of this enumeration,
		22	* grep "ORDER RESERVED"
		23	*/
19	enum RESERVED {	24	enum RESERVED {
20	/* terminal symbols denoted by reserved words */	25	/* terminal symbols denoted by reserved words */
21	AND = FIRST_RESERVED,	26	TK_AND = FIRST_RESERVED, TK_BREAK,
22	DO, ELSE, ELSEIF, END, FUNCTION, IF, LOCAL, NIL, NOT, OR,	27	TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FOR, TK_FUNCTION, TK_IF, TK_LOCAL,
23	REPEAT, RETURN, THEN, UNTIL, WHILE,	28	TK_NIL, TK_NOT, TK_OR, TK_REPEAT, TK_RETURN, TK_THEN, TK_UNTIL, TK_WHILE,
24	/* other terminal symbols */	29	/* other terminal symbols */
25	NAME, CONC, DOTS, EQ, GE, LE, NE, NUMBER, STRING, EOS};	30	TK_NAME, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_NUMBER,
		31	TK_STRING, TK_EOS
		32	};
26		33
		34	/* number of reserved words */
		35	#define NUM_RESERVED ((int)(TK_WHILE-FIRST_RESERVED+1))
27		36
28	#ifndef MAX_IFS
29	#define MAX_IFS 5 /* arbitrary limit */
30	#endif
31		37
32	/* "ifstate" keeps the state of each nested $if the lexical is dealing with. */	38	typedef union {
		39	Number r;
		40	TString *ts;
		41	} SemInfo; /* semantics information */
33		42
34	struct ifState {	43
35	int elsepart; /* true if it's in the $else part */	44	typedef struct Token {
36	int condition; /* true if $if condition is true */	45	int token;
37	int skip; /* true if part must be skipped */	46	SemInfo seminfo;
38	};	47	} Token;
39		48
40		49
41	typedef struct LexState {	50	typedef struct LexState {
42	int current; /* look ahead character */	51	int current; /* current character */
43	int token; /* look ahead token */	52	Token t; /* current token */
44	struct FuncState fs; / 'FuncState' is private for the parser */	53	Token lookahead; /* look ahead token */
45	union {	54	struct FuncState fs; / `FuncState' is private to the parser */
46	real r;	55	struct lua_State *L;
47	TaggedString *ts;	56	struct zio z; / input stream */
48	} seminfo; /* semantics information */
49	struct zio lex_z; / input stream */
50	int linenumber; /* input line counter */	57	int linenumber; /* input line counter */
51	int iflevel; /* level of nested $if's (for lexical analysis) */	58	int lastline; /* line of last token `consumed' */
52	struct ifState ifstate[MAX_IFS];	59	TString source; / current source name */
53	} LexState;	60	} LexState;
54		61
55		62
56	void luaX_init (void);	63	void luaX_init (lua_State *L);
57	void luaX_setinput (LexState LS, ZIO z);	64	void luaX_setinput (lua_State L, LexState LS, ZIO z, TString source);
58	int luaX_lex (LexState *LS);	65	int luaX_lex (LexState LS, SemInfo seminfo);
59	void luaX_syntaxerror (LexState ls, char s, char *token);	66	void luaX_checklimit (LexState ls, int val, int limit, const char msg);
60	void luaX_error (LexState ls, char s);	67	void luaX_syntaxerror (LexState ls, const char s, const char *token);
		68	void luaX_error (LexState ls, const char s, int token);
61	void luaX_token2str (int token, char *s);	69	void luaX_token2str (int token, char *s);
62		70
63		71

src/llimits.h+204−0

@@ -0,0 +1,204 @@
	1	/*
	2	** $Id: llimits.h,v 1.19 2000/10/26 12:47:05 roberto Exp $
	3	** Limits, basic types, and some other "installation-dependent" definitions
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7	#ifndef llimits_h
	8	#define llimits_h
	9
	10
	11	#include <limits.h>
	12	#include <stddef.h>
	13
	14
	15
	16	/*
	17	** try to find number of bits in an integer
	18	*/
	19	#ifndef BITS_INT
	20	/* avoid overflows in comparison */
	21	#if INT_MAX-20 < 32760
	22	#define BITS_INT 16
	23	#else
	24	#if INT_MAX > 2147483640L
	25	/* machine has at least 32 bits */
	26	#define BITS_INT 32
	27	#else
	28	#error "you must define BITS_INT with number of bits in an integer"
	29	#endif
	30	#endif
	31	#endif
	32
	33
	34	/*
	35	** Define the type `number' of Lua
	36	** GREP LUA_NUMBER to change that
	37	*/
	38	#ifndef LUA_NUM_TYPE
	39	#define LUA_NUM_TYPE double
	40	#endif
	41
	42	typedef LUA_NUM_TYPE Number;
	43
	44	/* function to convert a Number to a string */
	45	#define NUMBER_FMT "%.16g" /* LUA_NUMBER */
	46	#define lua_number2str(s,n) sprintf((s), NUMBER_FMT, (n))
	47
	48	/* function to convert a string to a Number */
	49	#define lua_str2number(s,p) strtod((s), (p))
	50
	51
	52
	53	typedef unsigned long lint32; /* unsigned int with at least 32 bits */
	54
	55
	56	#define MAX_SIZET ((size_t)(~(size_t)0)-2)
	57
	58
	59	#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
	60
	61	/*
	62	** conversion of pointer to int (for hashing only)
	63	** (the shift removes bits that are usually 0 because of alignment)
	64	*/
	65	#define IntPoint(p) (((unsigned long)(p)) >> 3)
	66
	67
	68
	69	#define MINPOWER2 4 /* minimum size for "growing" vectors */
	70
	71
	72
	73	#ifndef DEFAULT_STACK_SIZE
	74	#define DEFAULT_STACK_SIZE 1024
	75	#endif
	76
	77
	78
	79	/* type to ensure maximum alignment */
	80	union L_Umaxalign { double d; char *s; long l; };
	81
	82
	83
	84	/*
	85	** type for virtual-machine instructions
	86	** 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	*/
	90	typedef unsigned long Instruction;
	91
	92
	93	/*
	94	** size and position of opcode arguments.
	95	** For an instruction with 2 bytes, size is 16, and size_b can be 5
	96	** (accordingly, size_u will be 10, and size_a will be 5)
	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
	108
	109	/*
	110	** limits for opcode arguments.
	111	** we use (signed) int to manipulate most arguments,
	112	** so they must fit in BITS_INT-1 bits (-1 for sign)
	113	*/
	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
	122	#if SIZE_A < BITS_INT-1
	123	#define MAXARG_A ((1<<SIZE_A)-1)
	124	#else
	125	#define MAXARG_A MAX_INT
	126	#endif
	127
	128	#if SIZE_B < BITS_INT-1
	129	#define MAXARG_B ((1<<SIZE_B)-1)
	130	#else
	131	#define MAXARG_B MAX_INT
	132	#endif
	133
	134
	135	/* maximum stack size in a function */
	136	#ifndef MAXSTACK
	137	#define MAXSTACK 250
	138	#endif
	139
	140	#if MAXSTACK > MAXARG_B
	141	#undef MAXSTACK
	142	#define MAXSTACK MAXARG_B
	143	#endif
	144
	145
	146	/* maximum number of local variables */
	147	#ifndef MAXLOCALS
	148	#define MAXLOCALS 200 /* arbitrary limit (<MAXSTACK) */
	149	#endif
	150	#if MAXLOCALS>=MAXSTACK
	151	#undef MAXLOCALS
	152	#define MAXLOCALS (MAXSTACK-1)
	153	#endif
	154
	155
	156	/* maximum number of upvalues */
	157	#ifndef MAXUPVALUES
	158	#define MAXUPVALUES 32 /* arbitrary limit (<=MAXARG_B) */
	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
	174
	175
	176	/* maximum number of parameters in a function */
	177	#ifndef MAXPARAMS
	178	#define MAXPARAMS 100 /* arbitrary limit (<MAXLOCALS) */
	179	#endif
	180	#if MAXPARAMS>=MAXLOCALS
	181	#undef MAXPARAMS
	182	#define MAXPARAMS (MAXLOCALS-1)
	183	#endif
	184
	185
	186	/* number of list items to accumulate before a SETLIST instruction */
	187	#define LFIELDS_PER_FLUSH 64
	188	#if LFIELDS_PER_FLUSH>(MAXSTACK/4)
	189	#undef LFIELDS_PER_FLUSH
	190	#define LFIELDS_PER_FLUSH (MAXSTACK/4)
	191	#endif
	192
	193	/* number of record items to accumulate before a SETMAP instruction */
	194	/* (each item counts 2 elements on the stack: an index and a value) */
	195	#define RFIELDS_PER_FLUSH (LFIELDS_PER_FLUSH/2)
	196
	197
	198	/* maximum lookback to find a real constant (for code generation) */
	199	#ifndef LOOKBACKNUMS
	200	#define LOOKBACKNUMS 20 /* arbitrary constant */
	201	#endif
	202
	203
	204	#endif

src/lmem.c+94−84

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

src/lmem.h+23−22

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lmem.h,v 1.8 1999/02/26 15:48:55 roberto Exp $	2	** $Id: lmem.h,v 1.16 2000/10/30 16:29:59 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	*/
@@ -8,32 +8,33 @@ · 2 unmodified lines
8	#define lmem_h	8	#define lmem_h
9		9
10		10
11	#include <stdlib.h>	11	#include <stddef.h>
12		12
13	/* memory error messages */	13	#include "llimits.h"
14	#define codeEM "code size overflow"	14	#include "lua.h"
15	#define constantEM "constant table overflow"
16	#define refEM "reference table overflow"
17	#define tableEM "table overflow"
18	#define memEM "not enough memory"
19	#define arrEM "internal array bigger than `int' limit"
20		15
21	void luaM_realloc (void oldblock, unsigned long size);	16	void luaM_realloc (lua_State L, void *oldblock, lint32 size);
22	void luaM_growaux (void block, unsigned long nelems, int inc, int size,	17	void luaM_growaux (lua_State L, void *block, size_t nelems,
23	char *errormsg, unsigned long limit);	18	int inc, size_t size, const char *errormsg,
		19	size_t limit);
24		20
25	#define luaM_free(b) luaM_realloc((b), 0)	21	#define luaM_free(L, b) luaM_realloc(L, (b), 0)
26	#define luaM_malloc(t) luaM_realloc(NULL, (t))	22	#define luaM_malloc(L, t) luaM_realloc(L, NULL, (t))
27	#define luaM_new(t) ((t *)luaM_malloc(sizeof(t)))	23	#define luaM_new(L, t) ((t *)luaM_malloc(L, sizeof(t)))
28	#define luaM_newvector(n,t) ((t )luaM_malloc((n)sizeof(t)))	24	#define luaM_newvector(L, n,t) ((t )luaM_malloc(L, (n)(lint32)sizeof(t)))
29	#define luaM_growvector(v,nelems,inc,t,e,l) \
30	((v)=(t *)luaM_growaux(v,nelems,inc,sizeof(t),e,l))
31	#define luaM_reallocvector(v,n,t) ((v)=(t )luaM_realloc(v,(n)sizeof(t)))
32		25
		26	#define luaM_growvector(L, v,nelems,inc,t,e,l) \
		27	((v)=(t *)luaM_growaux(L, v,nelems,inc,sizeof(t),e,l))
33		28
34	#ifdef DEBUG	29	#define luaM_reallocvector(L, v,n,t) \
35	extern unsigned long numblocks;	30	((v)=(t )luaM_realloc(L, v,(n)(lint32)sizeof(t)))
36	extern unsigned long totalmem;	31
		32
		33	#ifdef LUA_DEBUG
		34	extern unsigned long memdebug_numblocks;
		35	extern unsigned long memdebug_total;
		36	extern unsigned long memdebug_maxmem;
		37	extern unsigned long memdebug_memlimit;
37	#endif	38	#endif
38		39
39		40

src/lobject.c+83−87

@@ -1,129 +1,125 @@
1	/*	1	/*
2	** $Id: lobject.c,v 1.19 1999/04/13 19:28:49 roberto Exp $	2	** $Id: lobject.c,v 1.55 2000/10/20 16:36:32 roberto Exp $
3	** Some generic functions over Lua objects	3	** Some generic functions over Lua objects
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7	#include <ctype.h>	7	#include <ctype.h>
		8	#include <stdarg.h>
		9	#include <stdio.h>
8	#include <stdlib.h>	10	#include <stdlib.h>
		11	#include <string.h>
9		12
10	#include "lobject.h"
11	#include "lua.h"	13	#include "lua.h"
12		14
		15	#include "lmem.h"
		16	#include "lobject.h"
		17	#include "lstate.h"
13		18
14	char luaO_typenames[] = { / ORDER LUA_T */
15	"userdata", "number", "string", "table", "function", "function",
16	"nil", "function", "mark", "mark", "mark", "line", NULL
17	};
18		19
19		20
20	TObject luaO_nilobject = {LUA_T_NIL, {NULL}};	21	const TObject luaO_nilobject = {LUA_TNIL, {NULL}};
21		22
22		23
		24	const char *const luaO_typenames[] = {
		25	"userdata", "nil", "number", "string", "table", "function"
		26	};
23		27
24	/* hash dimensions values */
25	static long dimensions[] =
26	{5L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L,
27	12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L,
28	1644817L, 3289613L, 6579211L, 13158023L, MAX_INT};
29		28
30		29
31	int luaO_redimension (int oldsize)	30	/*
32	{	31	** returns smaller power of 2 larger than `n' (minimum is MINPOWER2)
33	int i;	32	*/
34	for (i=0; dimensions[i]<MAX_INT; i++) {	33	lint32 luaO_power2 (lint32 n) {
35	if (dimensions[i] > oldsize)	34	lint32 p = MINPOWER2;
36	return dimensions[i];	35	while (p<=n) p<<=1;
37	}	36	return p;
38	lua_error("tableEM");
39	return 0; /* to avoid warnings */
40	}	37	}
41		38
42		39
43	int luaO_equalval (TObject t1, TObject t2) {	40	int luaO_equalObj (const TObject t1, const TObject t2) {
		41	if (ttype(t1) != ttype(t2)) return 0;
44	switch (ttype(t1)) {	42	switch (ttype(t1)) {
45	case LUA_T_NIL: return 1;	43	case LUA_TNUMBER:
46	case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);	44	return nvalue(t1) == nvalue(t2);
47	case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2);	45	case LUA_TSTRING: case LUA_TUSERDATA:
48	case LUA_T_ARRAY: return avalue(t1) == avalue(t2);	46	return tsvalue(t1) == tsvalue(t2);
49	case LUA_T_PROTO: return tfvalue(t1) == tfvalue(t2);	47	case LUA_TTABLE:
50	case LUA_T_CPROTO: return fvalue(t1) == fvalue(t2);	48	return hvalue(t1) == hvalue(t2);
51	case LUA_T_CLOSURE: return t1->value.cl == t2->value.cl;	49	case LUA_TFUNCTION:
		50	return clvalue(t1) == clvalue(t2);
52	default:	51	default:
53	LUA_INTERNALERROR("invalid type");	52	LUA_ASSERT(ttype(t1) == LUA_TNIL, "invalid type");
54	return 0; /* UNREACHABLE */	53	return 1; /* LUA_TNIL */
55	}	54	}
56	}	55	}
57		56
58		57
59	void luaO_insertlist (GCnode root, GCnode node)	58	char luaO_openspace (lua_State L, size_t n) {
60	{	59	if (n > L->Mbuffsize) {
61	node->next = root->next;	60	luaM_reallocvector(L, L->Mbuffer, n, char);
62	root->next = node;	61	L->nblocks += (n - L->Mbuffsize)*sizeof(char);
63	node->marked = 0;	62	L->Mbuffsize = n;
		63	}
		64	return L->Mbuffer;
64	}	65	}
65		66
66		67
67	#ifdef OLD_ANSI	68	int luaO_str2d (const char s, Number result) { /* LUA_NUMBER */
68	void luaO_memup (void dest, void src, int size) {	69	char *endptr;
69	while (size--)	70	Number res = lua_str2number(s, &endptr);
70	((char )dest)[size]=((char )src)[size];	71	if (endptr == s) return 0; /* no conversion */
71	}	72	while (isspace((unsigned char)*endptr)) endptr++;
72		73	if (endptr != '\0') return 0; / invalid trailing characters? */
73	void luaO_memdown (void dest, void src, int size) {	74	*result = res;
74	int i;	75	return 1;
75	for (i=0; i<size; i++)
76	((char )dest)[i]=((char )src)[i];
77	}	76	}
78	#endif
79		77
80		78
		79	/* maximum length of a string format for `luaO_verror' */
		80	#define MAX_VERROR 280
81		81
82	static double expten (unsigned int e) {	82	/* this function needs to handle only '%d' and '%.XXs' formats */
83	double exp = 10.0;	83	void luaO_verror (lua_State L, const char fmt, ...) {
84	double res = 1.0;	84	va_list argp;
85	for (; e; e>>=1) {	85	char buff[MAX_VERROR]; /* to hold formatted message */
86	if (e & 1) res *= exp;	86	va_start(argp, fmt);
87	exp *= exp;	87	vsprintf(buff, fmt, argp);
88	}	88	va_end(argp);
89	return res;	89	lua_error(L, buff);
90	}	90	}
91		91
92		92
93	double luaO_str2d (char s) { / LUA_NUMBER */	93	void luaO_chunkid (char out, const char source, int bufflen) {
94	double a = 0.0;	94	if (*source == '=') {
95	int point = 0;	95	strncpy(out, source+1, bufflen); /* remove first char */
96	while (isdigit((unsigned char)*s)) {	96	out[bufflen-1] = '\0'; /* ensures null termination */
97	a = 10.0a + ((s++)-'0');
98	}	97	}
99	if (*s == '.') {	98	else {
100	s++;	99	if (*source == '@') {
101	while (isdigit((unsigned char)*s)) {	100	int l;
102	a = 10.0a + ((s++)-'0');	101	source++; /* skip the `@' */
103	point++;	102	bufflen -= sizeof("file `...%s'");
		103	l = strlen(source);
		104	if (l>bufflen) {
		105	source += (l-bufflen); /* get last part of file name */
		106	sprintf(out, "file `...%.99s'", source);
		107	}
		108	else
		109	sprintf(out, "file `%.99s'", source);
104	}	110	}
105	}	111	else {
106	if (toupper((unsigned char)*s) == 'E') {	112	int len = strcspn(source, "\n"); /* stop at first newline */
107	int e = 0;	113	bufflen -= sizeof("string \"%.*s...\"");
108	int sig = 1;	114	if (len > bufflen) len = bufflen;
109	s++;	115	if (source[len] != '\0') { /* must truncate? */
110	if (*s == '-') {	116	strcpy(out, "string \"");
111	s++;	117	out += strlen(out);
112	sig = -1;	118	strncpy(out, source, len);
		119	strcpy(out+len, "...\"");
		120	}
		121	else
		122	sprintf(out, "string \"%.99s\"", source);
113	}	123	}
114	else if (*s == '+') s++;
115	if (!isdigit((unsigned char)s)) return -1; / no digit in the exponent? */
116	do {
117	e = 10e + ((s++)-'0');
118	} while (isdigit((unsigned char)*s));
119	point -= sig*e;
120	}	124	}
121	while (isspace((unsigned char)*s)) s++;
122	if (s != '\0') return -1; / invalid trailing characters? */
123	if (point > 0)
124	a /= expten(point);
125	else if (point < 0)
126	a *= expten(-point);
127	return a;
128	}	125	}
129

src/lobject.h+125−125

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lobject.h,v 1.28 1999/03/16 16:43:27 roberto Exp $	2	** $Id: lobject.h,v 1.82 2000/10/30 17:49:19 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	*/
@@ -8,197 +8,197 @@ · 2 unmodified lines
8	#define lobject_h	8	#define lobject_h
9		9
10		10
11	#include <limits.h>	11	#include "llimits.h"
12
13	#include "lua.h"	12	#include "lua.h"
14		13
15		14
16	#ifdef DEBUG	15	#ifdef LUA_DEBUG
17	#include "lauxlib.h"	16	#undef NDEBUG
18	#define LUA_INTERNALERROR(s) \	17	#include <assert.h>
19	luaL_verror("INTERNAL ERROR - %s [%s:%d]",(s),__FILE__,__LINE__)	18	#define LUA_INTERNALERROR(s) assert(((void)s,0))
20	#define LUA_ASSERT(c,s) { if (!(c)) LUA_INTERNALERROR(s); }	19	#define LUA_ASSERT(c,s) assert(((void)s,(c)))
21	#else	20	#else
22	#define LUA_INTERNALERROR(s) /* empty */	21	#define LUA_INTERNALERROR(s) /* empty */
23	#define LUA_ASSERT(c,s) /* empty */	22	#define LUA_ASSERT(c,s) /* empty */
24	#endif	23	#endif
25		24
26		25
27	/*	26	#ifdef LUA_DEBUG
28	** "real" is the type "number" of Lua	27	/* to avoid warnings, and make sure value is really unused */
29	** GREP LUA_NUMBER to change that	28	#define UNUSED(x) (x=0, (void)(x))
30	*/	29	#else
31	#ifndef LUA_NUM_TYPE	30	#define UNUSED(x) ((void)(x)) /* to avoid warnings */
32	#define LUA_NUM_TYPE double
33	#endif	31	#endif
34		32
35		33
36	typedef LUA_NUM_TYPE real;	34	/* mark for closures active in the stack */
37		35	#define LUA_TMARK 6
38	#define Byte lua_Byte /* some systems have Byte as a predefined type */
39	typedef unsigned char Byte; /* unsigned 8 bits */
40
41		36
42	#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
43		37
44	typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */	38	/* tags for values visible from Lua == first user-created tag */
		39	#define NUM_TAGS 6
45		40
46		41
47	/*	42	/* check whether `t' is a mark */
48	** Lua TYPES	43	#define is_T_MARK(t) ((t) == LUA_TMARK)
49	** WARNING: if you change the order of this enumeration,
50	** grep "ORDER LUA_T"
51	*/
52	typedef enum {
53	LUA_T_USERDATA = 0, /* tag default for userdata */
54	LUA_T_NUMBER = -1, /* fixed tag for numbers */
55	LUA_T_STRING = -2, /* fixed tag for strings */
56	LUA_T_ARRAY = -3, /* tag default for tables (or arrays) */
57	LUA_T_PROTO = -4, /* fixed tag for functions */
58	LUA_T_CPROTO = -5, /* fixed tag for Cfunctions */
59	LUA_T_NIL = -6, /* last "pre-defined" tag */
60	LUA_T_CLOSURE = -7,
61	LUA_T_CLMARK = -8, /* mark for closures */
62	LUA_T_PMARK = -9, /* mark for Lua prototypes */
63	LUA_T_CMARK = -10, /* mark for C prototypes */
64	LUA_T_LINE = -11
65	} lua_Type;
66
67	#define NUM_TAGS 7
68		44
69		45
70	typedef union {	46	typedef union {
71	lua_CFunction f; /* LUA_T_CPROTO, LUA_T_CMARK */	47	struct TString ts; / LUA_TSTRING, LUA_TUSERDATA */
72	real n; /* LUA_T_NUMBER */	48	struct Closure cl; / LUA_TFUNCTION */
73	struct TaggedString ts; / LUA_T_STRING, LUA_T_USERDATA */	49	struct Hash a; / LUA_TTABLE */
74	struct TProtoFunc tf; / LUA_T_PROTO, LUA_T_PMARK */	50	struct CallInfo i; / LUA_TLMARK */
75	struct Closure cl; / LUA_T_CLOSURE, LUA_T_CLMARK */	51	Number n; /* LUA_TNUMBER */
76	struct Hash a; / LUA_T_ARRAY */
77	int i; /* LUA_T_LINE */
78	} Value;	52	} Value;
79		53
80		54
81	typedef struct TObject {	55	/* Macros to access values */
82	lua_Type ttype;	56	#define ttype(o) ((o)->ttype)
		57	#define nvalue(o) ((o)->value.n)
		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 {
		66	int ttype;
83	Value value;	67	Value value;
84	} TObject;	68	} TObject;
85		69
86		70
87
88	/*	71	/*
89	** generic header for garbage collector lists	72	** String headers for string table
90	*/	73	*/
91	typedef struct GCnode {
92	struct GCnode *next;
93	int marked;
94	} GCnode;
95
96		74
97	/*	75	/*
98	** String headers for string table	76	** most `malloc' libraries allocate memory in blocks of 8 bytes. TSPACK
		77	** tries to make sizeof(TString) a multiple of this granularity, to reduce
		78	** waste of space.
99	*/	79	*/
		80	#define TSPACK ((int)sizeof(int))
100		81
101	typedef struct TaggedString {	82	typedef struct TString {
102	GCnode head;
103	unsigned long hash;
104	int constindex; /* hint to reuse constants (= -1 if this is a userdata) */
105	union {	83	union {
106	struct {	84	struct { /* for strings */
107	TObject globalval;	85	unsigned long hash;
108	long len; /* if this is a string, here is its length */	86	int constindex; /* hint to reuse constants */
109	} s;	87	} s;
110	struct {	88	struct { /* for userdata */
111	int tag;	89	int tag;
112	void v; / if this is a userdata, here is its value */	90	void *value;
113	} d;	91	} d;
114	} u;	92	} u;
115	char str[1]; /* \0 byte already reserved */	93	size_t len;
116	} TaggedString;	94	struct TString nexthash; / chain for hash table */
117		95	int marked;
118		96	char str[TSPACK]; /* variable length string!! must be the last field! */
		97	} TString;
119		98
120		99
121	/*	100	/*
122	** Function Prototypes	101	** Function Prototypes
123	*/	102	*/
124	typedef struct TProtoFunc {	103	typedef struct Proto {
125	GCnode head;	104	Number knum; / Number numbers used by the function */
126	struct TObject *consts;	105	int nknum; /* size of `knum' */
127	int nconsts;	106	struct TString *kstr; / strings used by the function */
128	Byte code; / ends with opcode ENDCODE */	107	int nkstr; /* size of `kstr' */
		108	struct Proto *kproto; / functions defined inside the function */
		109	int nkproto; /* size of `kproto' */
		110	Instruction *code;
		111	int ncode; /* size of `code'; when 0 means an incomplete `Proto' */
		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 */
		119	int nlineinfo; /* size of `lineinfo' */
		120	int nlocvars;
		121	struct LocVar locvars; / information about local variables */
129	int lineDefined;	122	int lineDefined;
130	TaggedString *source;	123	TString *source;
131	struct LocVar locvars; / ends with line = -1 */	124	} Proto;
132	} TProtoFunc;	125
133		126
134	typedef struct LocVar {	127	typedef struct LocVar {
135	TaggedString varname; / NULL signals end of scope */	128	TString *varname;
136	int line;	129	int startpc; /* first point where variable is active */
		130	int endpc; /* first point where variable is dead */
137	} LocVar;	131	} LocVar;
138		132
139		133
140
141
142
143	/* Macros to access structure members */
144	#define ttype(o) ((o)->ttype)
145	#define nvalue(o) ((o)->value.n)
146	#define svalue(o) ((o)->value.ts->str)
147	#define tsvalue(o) ((o)->value.ts)
148	#define clvalue(o) ((o)->value.cl)
149	#define avalue(o) ((o)->value.a)
150	#define fvalue(o) ((o)->value.f)
151	#define tfvalue(o) ((o)->value.tf)
152
153	#define protovalue(o) ((o)->value.cl->consts)
154
155
156	/*	134	/*
157	** Closures	135	** Closures
158	*/	136	*/
159	typedef struct Closure {	137	typedef struct Closure {
160	GCnode head;	138	union {
161	int nelems; /* not included the first one (always the prototype) */	139	lua_CFunction c; /* C functions */
162	TObject consts[1]; /* at least one for prototype */	140	struct Proto l; / Lua functions */
		141	} f;
		142	struct Closure *next;
		143	struct Closure mark; / marked closures (point to itself when not marked) */
		144	short isC; /* 0 for Lua functions, 1 for C functions */
		145	short nupvalues;
		146	TObject upvalue[1];
163	} Closure;	147	} Closure;
164		148
165		149
		150	#define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->isC)
		151
166		152
167	typedef struct node {	153	typedef struct Node {
168	TObject ref;	154	TObject key;
169	TObject val;	155	TObject val;
		156	struct Node next; / for chaining */
170	} Node;	157	} Node;
171		158
172	typedef struct Hash {	159	typedef struct Hash {
173	GCnode head;
174	Node *node;	160	Node *node;
175	int nhash;
176	int nuse;
177	int htag;	161	int htag;
		162	int size;
		163	Node firstfree; / this position is free; all positions after it are full */
		164	struct Hash *next;
		165	struct Hash mark; / marked tables (point to itself when not marked) */
178	} Hash;	166	} Hash;
179		167
180		168
181	extern char *luaO_typenames[];	169	/* unmarked tables and closures are represented by pointing `mark' to
		170	** themselves
		171	*/
		172	#define ismarked(x) ((x)->mark != (x))
		173
182		174
183	#define luaO_typename(o) luaO_typenames[-ttype(o)]	175	/*
		176	** informations about a call (for debugging)
		177	*/
		178	typedef struct CallInfo {
		179	struct Closure func; / function being called */
		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;
184		185
185		186
186	extern TObject luaO_nilobject;	187	extern const TObject luaO_nilobject;
		188	extern const char *const luaO_typenames[];
187		189
188	#define luaO_equalObj(t1,t2) ((ttype(t1) != ttype(t2)) ? 0 \
189	: luaO_equalval(t1,t2))
190	int luaO_equalval (TObject t1, TObject t2);
191	int luaO_redimension (int oldsize);
192	void luaO_insertlist (GCnode root, GCnode node);
193	double luaO_str2d (char *s);
194		190
195	#ifdef OLD_ANSI	191	#define luaO_typename(o) (luaO_typenames[ttype(o)])
196	void luaO_memup (void dest, void src, int size);	192
197	void luaO_memdown (void dest, void src, int size);	193
198	#else	194	lint32 luaO_power2 (lint32 n);
199	#include <string.h>	195	char luaO_openspace (lua_State L, size_t n);
200	#define luaO_memup(d,s,n) memmove(d,s,n)	196
201	#define luaO_memdown(d,s,n) memmove(d,s,n)	197	int luaO_equalObj (const TObject t1, const TObject t2);
202	#endif	198	int luaO_str2d (const char s, Number result);
		199
		200	void luaO_verror (lua_State L, const char fmt, ...);
		201	void luaO_chunkid (char out, const char source, int len);
		202
203		203
204	#endif	204	#endif

src/lopcodes.h+120−90

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lopcodes.h,v 1.33 1999/06/17 17:04:03 roberto Exp $	2	** $Id: lopcodes.h,v 1.68 2000/10/24 16:05:59 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	*/
@@ -7,132 +7,162 @@ · 1 unmodified line
7	#ifndef lopcodes_h	7	#ifndef lopcodes_h
8	#define lopcodes_h	8	#define lopcodes_h
9		9
		10	#include "llimits.h"
10		11
11	/*
12	** NOTICE: variants of the same opcode must be consecutive: First, those
13	** with word parameter, then with byte parameter.
14	*/
15		12
		13	/*===========================================================================
		14	We assume that instructions are unsigned numbers.
		15	All instructions have an opcode in the first 6 bits. Moreover,
		16	an instruction can have 0, 1, or 2 arguments. Instructions can
		17	have the following types:
		18	type 0: no arguments
		19	type 1: 1 unsigned argument in the higher bits (called `U')
		20	type 2: 1 signed argument in the higher bits (`S')
		21	type 3: 1st unsigned argument in the higher bits (`A')
		22	2nd unsigned argument in the middle bits (`B')
16		23
17	typedef enum {	24	A signed argument is represented in excess K; that is, the number
18	/* name parm before after side effect	25	value is the unsigned value minus K. K is exactly the maximum value
19	-----------------------------------------------------------------------------*/	26	for that argument (so that -max is represented by 0, and +max is
20	ENDCODE,/* - - (return) */	27	represented by 2*max), which is half the maximum for the corresponding
21	RETCODE,/* b - (return) */	28	unsigned argument.
22		29
23	CALL,/* b c v_c...v_1 f r_b...r_1 f(v1,...,v_c) */	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	===========================================================================*/
24		36
25	TAILCALL,/* b c v_c...v_1 f (return) f(v1,...,v_c) */
26		37
27	PUSHNIL,/* b - nil_0...nil_b */
28	POP,/* b a_b...a_1 - */
29		38
30	PUSHNUMBERW,/* w - (float)w */
31	PUSHNUMBER,/* b - (float)b */
32		39
33	PUSHNUMBERNEGW,/* w - (float)-w */	40	/* creates a mask with `n' 1 bits at position `p' */
34	PUSHNUMBERNEG,/* b - (float)-b */	41	#define MASK1(n,p) ((~((~(Instruction)0)<<n))<<p)
35		42
36	PUSHCONSTANTW,/w - CNST[w] /	43	/* creates a mask with `n' 0 bits at position `p' */
37	PUSHCONSTANT,/* b - CNST[b] */	44	#define MASK0(n,p) (~MASK1(n,p))
38		45
39	PUSHUPVALUE,/* b - Closure[b] */	46	/*
		47	** the following macros help to manipulate instructions
		48	*/
40		49
41	PUSHLOCAL,/* b - LOC[b] */	50	#define CREATE_0(o) ((Instruction)(o))
		51	#define GET_OPCODE(i) ((OpCode)((i)&MASK1(SIZE_OP,0)))
		52	#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) \| (Instruction)(o)))
42		53
43	GETGLOBALW,/* w - VAR[CNST[w]] */	54	#define CREATE_U(o,u) ((Instruction)(o) \| ((Instruction)(u)<<POS_U))
44	GETGLOBAL,/* b - VAR[CNST[b]] */	55	#define GETARG_U(i) ((int)((i)>>POS_U))
		56	#define SETARG_U(i,u) ((i) = (((i)&MASK0(SIZE_U,POS_U)) \| \
		57	((Instruction)(u)<<POS_U)))
45		58
46	GETTABLE,/* - i t t[i] */	59	#define CREATE_S(o,s) CREATE_U((o),(s)+MAXARG_S)
		60	#define GETARG_S(i) (GETARG_U(i)-MAXARG_S)
		61	#define SETARG_S(i,s) SETARG_U((i),(s)+MAXARG_S)
47		62
48	GETDOTTEDW,/* w t t[CNST[w]] */
49	GETDOTTED,/* b t t[CNST[b]] */
50		63
51	PUSHSELFW,/* w t t t[CNST[w]] */	64	#define CREATE_AB(o,a,b) ((Instruction)(o) \| ((Instruction)(a)<<POS_A) \
52	PUSHSELF,/* b t t t[CNST[b]] */	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)))
53		72
54	CREATEARRAYW,/* w - newarray(size = w) */
55	CREATEARRAY,/* b - newarray(size = b) */
56		73
57	SETLOCAL,/* b x - LOC[b]=x */	74	/*
		75	** K = U argument used as index to `kstr'
		76	** J = S argument used as jump offset (relative to pc of next instruction)
		77	** L = unsigned argument used as index of local variable
		78	** N = U argument used as index to `knum'
		79	*/
58		80
59	SETGLOBALW,/* w x - VAR[CNST[w]]=x */	81	typedef enum {
60	SETGLOBAL,/* b x - VAR[CNST[b]]=x */	82	/*----------------------------------------------------------------------
		83	name args stack before stack after side effects
		84	------------------------------------------------------------------------*/
		85	OP_END,/* - - (return) no results */
		86	OP_RETURN,/* U v_n-v_x(at u) (return) returns v_x-v_n */
61		87
62	SETTABLEPOP,/* - v i t - t[i]=v */	88	OP_CALL,/* A B v_n-v_1 f(at a) r_b-r_1 f(v1,...,v_n) */
		89	OP_TAILCALL,/* A B v_n-v_1 f(at a) (return) f(v1,...,v_n) */
63		90
64	SETTABLE,/* b v a_b...a_1 i t a_b...a_1 i t t[i]=v */	91	OP_PUSHNIL,/* U - nil_1-nil_u */
		92	OP_POP,/* U a_u-a_1 - */
65		93
66	SETLISTW,/* w c v_c...v_1 t t t[i+wFPF]=v_i /	94	OP_PUSHINT,/* S - (Number)s */
67	SETLIST,/* b c v_c...v_1 t t t[i+bFPF]=v_i /	95	OP_PUSHSTRING,/* K - KSTR[k] */
		96	OP_PUSHNUM,/* N - KNUM[n] */
		97	OP_PUSHNEGNUM,/* N - -KNUM[n] */
68		98
69	SETMAP,/* b v_b k_b ...v_0 k_0 t t t[k_i]=v_i */	99	OP_PUSHUPVALUE,/* U - Closure[u] */
70		100
71	NEQOP,/* - y x (x~=y)? 1 : nil */	101	OP_GETLOCAL,/* L - LOC[l] */
72	EQOP,/* - y x (x==y)? 1 : nil */	102	OP_GETGLOBAL,/* K - VAR[KSTR[k]] */
73	LTOP,/* - y x (x<y)? 1 : nil */
74	LEOP,/* - y x (x<y)? 1 : nil */
75	GTOP,/* - y x (x>y)? 1 : nil */
76	GEOP,/* - y x (x>=y)? 1 : nil */
77	ADDOP,/* - y x x+y */
78	SUBOP,/* - y x x-y */
79	MULTOP,/* - y x xy /
80	DIVOP,/* - y x x/y */
81	POWOP,/* - y x x^y */
82	CONCOP,/* - y x x..y */
83	MINUSOP,/* - x -x */
84	NOTOP,/* - x (x==nil)? 1 : nil */
85		103
86	ONTJMPW,/* w x (x!=nil)? x : - (x!=nil)? PC+=w */	104	OP_GETTABLE,/* - i t t[i] */
87	ONTJMP,/* b x (x!=nil)? x : - (x!=nil)? PC+=b */	105	OP_GETDOTTED,/* K t t[KSTR[k]] */
88	ONFJMPW,/* w x (x==nil)? x : - (x==nil)? PC+=w */	106	OP_GETINDEXED,/* L t t[LOC[l]] */
89	ONFJMP,/* b x (x==nil)? x : - (x==nil)? PC+=b */	107	OP_PUSHSELF,/* K t t t[KSTR[k]] */
90	JMPW,/* w - - PC+=w */
91	JMP,/* b - - PC+=b */
92	IFFJMPW,/* w x - (x==nil)? PC+=w */
93	IFFJMP,/* b x - (x==nil)? PC+=b */
94	IFTUPJMPW,/* w x - (x!=nil)? PC-=w */
95	IFTUPJMP,/* b x - (x!=nil)? PC-=b */
96	IFFUPJMPW,/* w x - (x==nil)? PC-=w */
97	IFFUPJMP,/* b x - (x==nil)? PC-=b */
98		108
99	CLOSUREW,/* w c v_c...v_1 closure(CNST[w], v_c...v_1) */	109	OP_CREATETABLE,/* U - newarray(size = u) */
100	CLOSURE,/* b c v_c...v_1 closure(CNST[b], v_c...v_1) */
101		110
102	SETLINEW,/* w - - LINE=w */	111	OP_SETLOCAL,/* L x - LOC[l]=x */
103	SETLINE,/* b - - LINE=b */	112	OP_SETGLOBAL,/* K x - VAR[KSTR[k]]=x */
		113	OP_SETTABLE,/* A B v a_a-a_1 i t (pops b values) t[i]=v */
104		114
105	LONGARGW,/* w (add w(1<<16) to arg of next instruction) /	115	OP_SETLIST,/* A B v_b-v_1 t t t[i+aFPF]=v_i /
106	LONGARG,/* b (add b(1<<16) to arg of next instruction) /	116	OP_SETMAP,/* U v_u k_u - v_1 k_1 t t t[k_i]=v_i */
107		117
108	CHECKSTACK /* b (assert #temporaries == b; only for internal debuging!) */	118	OP_ADD,/* - y x x+y */
		119	OP_ADDI,/* S x x+s */
		120	OP_SUB,/* - y x x-y */
		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 */
109		127
110	} OpCode;	128	OP_JMPNE,/* J y x - (x~=y)? PC+=s */
		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 */
111		134
		135	OP_JMPT,/* J x - (x~=nil)? PC+=s */
		136	OP_JMPF,/* J x - (x==nil)? PC+=s */
		137	OP_JMPONT,/* J x (x~=nil)? x : - (x~=nil)? PC+=s */
		138	OP_JMPONF,/* J x (x==nil)? x : - (x==nil)? PC+=s */
		139	OP_JMP,/* J - - PC+=s */
112		140
113	#define RFIELDS_PER_FLUSH 32 /* records (SETMAP) */	141	OP_PUSHNILJMP,/* - - nil PC++; */
114	#define LFIELDS_PER_FLUSH 64 /* FPF - lists (SETLIST) */
115		142
116	#define ZEROVARARG 128	143	OP_FORPREP,/* J */
		144	OP_FORLOOP,/* J */
117		145
		146	OP_LFORPREP,/* J */
		147	OP_LFORLOOP,/* J */
118		148
119	/* maximum value of an arg of 3 bytes; must fit in an "int" */	149	OP_CLOSURE/* A B v_b-v_1 closure(KPROTO[a], v_1-v_b) */
120	#if MAX_INT < (1<<24)
121	#define MAX_ARG MAX_INT
122	#else
123	#define MAX_ARG ((1<<24)-1)
124	#endif
125		150
126	/* maximum value of a word of 2 bytes; cannot be bigger than MAX_ARG */	151	} OpCode;
127	#if MAX_ARG < (1<<16)	152
128	#define MAX_WORD MAX_ARG	153	#define NUM_OPCODES ((int)OP_CLOSURE+1)
129	#else
130	#define MAX_WORD ((1<<16)-1)
131	#endif
132		154
133		155
134	/* maximum value of a byte */	156	#define ISJUMP(o) (OP_JMPNE <= (o) && (o) <= OP_JMP)
135	#define MAX_BYTE ((1<<8)-1)	157
		158
		159
		160	/* special code to fit a LUA_MULTRET inside an argB */
		161	#define MULT_RET 255 /* (<=MAXARG_B) */
		162	#if MULT_RET>MAXARG_B
		163	#undef MULT_RET
		164	#define MULT_RET MAXARG_B
		165	#endif
136		166
137		167
138	#endif	168	#endif

src/lparser.c+822−1090

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lparser.c,v 1.37a 1999/06/17 17:04:03 roberto Exp $	2	** $Id: lparser.c,v 1.116 2000/10/27 11:39:52 roberto Exp $
3	** LL(1) Parser and code generator for Lua	3	** LL(1) Parser and code generator for Lua
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -8,1385 +8,1117 @@ · 2 unmodified lines
8	#include <stdio.h>	8	#include <stdio.h>
9	#include <string.h>	9	#include <string.h>
10		10
11	#include "lauxlib.h"	11	#include "lua.h"
12	#include "ldo.h"	12
		13	#include "lcode.h"
13	#include "lfunc.h"	14	#include "lfunc.h"
14	#include "llex.h"	15	#include "llex.h"
15	#include "lmem.h"	16	#include "lmem.h"
		17	#include "lobject.h"
16	#include "lopcodes.h"	18	#include "lopcodes.h"
17	#include "lparser.h"	19	#include "lparser.h"
18	#include "lstate.h"	20	#include "lstate.h"
19	#include "lstring.h"	21	#include "lstring.h"
20	#include "lua.h"
21	#include "luadebug.h"
22	#include "lzio.h"
23
24
25
26	/* size of a "normal" jump instruction: OpCode + 1 byte */
27	#define JMPSIZE 2
28
29	/* maximum number of local variables */
30	#ifndef MAXLOCALS
31	#define MAXLOCALS 200 /* arbitrary limit (<256) */
32	#endif
33
34
35	/* maximum number of upvalues */
36	#ifndef MAXUPVALUES
37	#define MAXUPVALUES 32 /* arbitrary limit (<256) */
38	#endif
39
40
41	/* maximum number of variables in the left side of an assignment */
42	#ifndef MAXVARSLH
43	#define MAXVARSLH 100 /* arbitrary limit (<255) */
44	#endif
45
46
47	/* maximum number of parameters in a function */
48	#ifndef MAXPARAMS
49	#define MAXPARAMS 100 /* arbitrary limit (<ZEROVARARG) */
50	#endif
51
52
53	/*
54	** Variable descriptor:
55	** must include an "exp" option because LL(1) cannot distinguish
56	** between variables, upvalues and function calls on first sight.
57	*/
58	typedef enum {
59	VGLOBAL, /* info is constant index of global name */
60	VLOCAL, /* info is stack index */
61	VDOT, /* info is constant index of index name */
62	VINDEXED, /* no info (table and index are on the stack) */
63	VEXP /* info is pc index of "nparam" of a call (or 0 if exp is closed) */
64	} varkind;
65
66	typedef struct vardesc {
67	varkind k;
68	int info;
69	} vardesc;
70
71
72	/*
73	** Expression List descriptor:
74	** tells number of expressions in the list,
75	** and, if last expression is open (a function call),
76	** where is its pc index of "nparam"
77	*/
78	typedef struct listdesc {
79	int n;
80	int pc; /* 0 if last expression is closed */
81	} listdesc;
82		22
83		23
84	/*	24	/*
85	** Constructors descriptor:	25	** Constructors descriptor:
86	** "n" indicates number of elements, and "k" signals whether	26	** `n' indicates number of elements, and `k' signals whether
87	** it is a list constructor (k = 0) or a record constructor (k = 1)	27	** it is a list constructor (k = 0) or a record constructor (k = 1)
88	** or empty (k = ';' or '}')	28	** or empty (k = ';' or '}')
89	*/	29	*/
90	typedef struct constdesc {	30	typedef struct Constdesc {
91	int n;	31	int n;
92	int k;	32	int k;
93	} constdesc;	33	} Constdesc;
		34
		35
		36	typedef struct Breaklabel {
		37	struct Breaklabel previous; / chain */
		38	int breaklist;
		39	int stacklevel;
		40	} Breaklabel;
94		41
95		42
96	/* state needed to generate code for a given function */
97	typedef struct FuncState {
98	TProtoFunc f; / current function header */
99	struct FuncState prev; / enclosuring function */
100	int pc; /* next position to code */
101	int stacksize; /* number of values on activation register */
102	int maxstacksize; /* maximum number of values on activation register */
103	int nlocalvar; /* number of active local variables */
104	int nupvalues; /* number of upvalues */
105	int nvars; /* number of entries in f->locvars (-1 if no debug information) */
106	int lastsetline; /* line where last SETLINE was issued */
107	vardesc upvalues[MAXUPVALUES]; /* upvalues */
108	TaggedString localvar[MAXLOCALS]; / store local variable names */
109	} FuncState;
110		43
111		44
112	/*	45	/*
113	** prototypes for non-terminal functions	46	** prototypes for recursive non-terminal functions
114	*/	47	*/
115	static int assignment (LexState ls, vardesc v, int nvars);
116	static int cond (LexState *ls);
117	static int funcname (LexState ls, vardesc v);
118	static int funcparams (LexState *ls, int slf);
119	static int listfields (LexState *ls);
120	static int localnamelist (LexState *ls);
121	static int optional (LexState *ls, int c);
122	static int recfields (LexState *ls);
123	static int stat (LexState *ls);
124	static void block (LexState *ls);
125	static void body (LexState *ls, int needself, int line);	48	static void body (LexState *ls, int needself, int line);
126	static void chunk (LexState *ls);	49	static void chunk (LexState *ls);
127	static void constructor (LexState *ls);	50	static void constructor (LexState *ls);
128	static void decinit (LexState ls, listdesc d);	51	static void expr (LexState ls, expdesc v);
129	static void exp0 (LexState ls, vardesc v);
130	static void exp1 (LexState *ls);	52	static void exp1 (LexState *ls);
131	static void exp2 (LexState ls, vardesc v);
132	static void explist (LexState ls, listdesc e);
133	static void explist1 (LexState ls, listdesc e);
134	static void ifpart (LexState *ls, int line);
135	static void parlist (LexState *ls);
136	static void part (LexState ls, constdesc cd);
137	static void recfield (LexState *ls);
138	static void ret (LexState *ls);
139	static void statlist (LexState *ls);
140	static void var_or_func (LexState ls, vardesc v);
141	static void var_or_func_tail (LexState ls, vardesc v);
142
143
144
145	static void checklimit (LexState ls, int val, int limit, char msg) {
146	if (val > limit) {
147	char buff[100];
148	sprintf(buff, "too many %s (limit=%d)", msg, limit);
149	luaX_error(ls, buff);
150	}
151	}
152
153		53
154	static void check_pc (FuncState *fs, int n) {
155	luaM_growvector(fs->f->code, fs->pc, n, Byte, codeEM, MAX_INT);
156	}
157
158
159	static void code_byte (FuncState *fs, Byte c) {
160	check_pc(fs, 1);
161	fs->f->code[fs->pc++] = c;
162	}
163
164
165	static void deltastack (LexState *ls, int delta) {
166	FuncState *fs = ls->fs;
167	fs->stacksize += delta;
168	if (fs->stacksize > fs->maxstacksize) {
169	if (fs->stacksize > MAX_BYTE)
170	luaX_error(ls, "function/expression too complex");
171	fs->maxstacksize = fs->stacksize;
172	}
173	}
174		54
175		55
176	static void code_oparg_at (LexState *ls, int pc, OpCode op,	56	static void next (LexState *ls) {
177	int arg, int delta) {	57	ls->lastline = ls->linenumber;
178	Byte *code = ls->fs->f->code;	58	if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */
179	deltastack(ls, delta);	59	ls->t = ls->lookahead; /* use this one */
180	if (arg <= MAX_BYTE) {	60	ls->lookahead.token = TK_EOS; /* and discharge it */
181	code[pc] = (Byte)op;
182	code[pc+1] = (Byte)arg;
183	}
184	else if (arg > MAX_ARG)
185	luaX_error(ls, "code too long");
186	else { /* MAX_BYTE < arg < MAX_ARG */
187	if (arg > MAX_WORD) {
188	code[pc] = (Byte)LONGARG;
189	code[pc+1] = (Byte)(arg>>16);
190	pc += 2;
191	}
192	code[pc] = (Byte)(op-1); /* opcode for word argument */
193	code[pc+1] = (Byte)((arg&0xFFFF)>>8);
194	code[pc+2] = (Byte)(arg&0xFF);
195	}	61	}
		62	else
		63	ls->t.token = luaX_lex(ls, &ls->t.seminfo); /* read next token */
196	}	64	}
197		65
198		66
199	static int codesize (int arg) {	67	static void lookahead (LexState *ls) {
200	if (arg <= MAX_BYTE) return 2; /* opcode + 1 byte */	68	LUA_ASSERT(ls->lookahead.token == TK_EOS, "two look-aheads");
201	else if (arg <= MAX_WORD) return 3; /* opcode + 1 word (2 bytes) */	69	ls->lookahead.token = luaX_lex(ls, &ls->lookahead.seminfo);
202	else return 5; /* LONGARG + 1 byte + opcode + 1 word (2 bytes) */
203	}	70	}
204		71
205		72
206	static int fix_opcode (LexState *ls, int pc, OpCode op, int arg) {	73	static void error_expected (LexState *ls, int token) {
207	int tomove = codesize(arg)-2;	74	char buff[100], t[TOKEN_LEN];
208	if (tomove > 0) { /* need to open space? */	75	luaX_token2str(token, t);
209	FuncState *fs = ls->fs;	76	sprintf(buff, "`%.20s' expected", t);
210	TProtoFunc *f = fs->f;	77	luaK_error(ls, buff);
211	check_pc(fs, tomove);
212	luaO_memup(f->code+pc+tomove, f->code+pc, fs->pc-pc);
213	fs->pc += tomove;
214	}
215	code_oparg_at(ls, pc, op, arg, 0);
216	return tomove;
217	}	78	}
218		79
219		80
220	static void code_oparg (LexState *ls, OpCode op, int arg, int delta) {	81	static void check (LexState *ls, int c) {
221	int size = codesize(arg);	82	if (ls->t.token != c)
222	check_pc(ls->fs, size);	83	error_expected(ls, c);
223	code_oparg_at(ls, ls->fs->pc, op, arg, delta);	84	next(ls);
224	ls->fs->pc += size;
225	}	85	}
226		86
227		87
228	static void code_opcode (LexState *ls, OpCode op, int delta) {	88	static void check_condition (LexState ls, int c, const char msg) {
229	deltastack(ls, delta);	89	if (!c) luaK_error(ls, msg);
230	code_byte(ls->fs, (Byte)op);
231	}	90	}
232		91
233		92
234	static void code_constant (LexState *ls, int c) {	93	static int optional (LexState *ls, int c) {
235	code_oparg(ls, PUSHCONSTANT, c, 1);	94	if (ls->t.token == c) {
		95	next(ls);
		96	return 1;
		97	}
		98	else return 0;
236	}	99	}
237		100
238		101
239	static int next_constant (FuncState *fs) {	102	static void check_match (LexState *ls, int what, int who, int where) {
240	TProtoFunc *f = fs->f;	103	if (ls->t.token != what) {
241	luaM_growvector(f->consts, f->nconsts, 1, TObject, constantEM, MAX_ARG);	104	if (where == ls->linenumber)
242	return f->nconsts++;	105	error_expected(ls, what);
		106	else {
		107	char buff[100];
		108	char t_what[TOKEN_LEN], t_who[TOKEN_LEN];
		109	luaX_token2str(what, t_what);
		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	}
		115	}
		116	next(ls);
243	}	117	}
244		118
245		119
246	static int string_constant (FuncState fs, TaggedString s) {	120	static int string_constant (FuncState fs, TString s) {
247	TProtoFunc *f = fs->f;	121	Proto *f = fs->f;
248	int c = s->constindex;	122	int c = s->u.s.constindex;
249	if (!(c < f->nconsts &&	123	if (c >= f->nkstr \|\| f->kstr[c] != s) {
250	ttype(&f->consts[c]) == LUA_T_STRING && tsvalue(&f->consts[c]) == s)) {	124	luaM_growvector(fs->L, f->kstr, f->nkstr, 1, TString *,
251	c = next_constant(fs);	125	"constant table overflow", MAXARG_U);
252	ttype(&f->consts[c]) = LUA_T_STRING;	126	c = f->nkstr++;
253	tsvalue(&f->consts[c]) = s;	127	f->kstr[c] = s;
254	s->constindex = c; /* hint for next time */	128	s->u.s.constindex = c; /* hint for next time */
255	}	129	}
256	return c;	130	return c;
257	}	131	}
258		132
259		133
260	static void code_string (LexState ls, TaggedString s) {	134	static void code_string (LexState ls, TString s) {
261	code_constant(ls, string_constant(ls->fs, s));	135	luaK_kstr(ls, string_constant(ls->fs, s));
262	}
263
264
265	#define LIM 20
266	static int real_constant (FuncState *fs, real r) {
267	/* check whether 'r' has appeared within the last LIM entries */
268	TObject *cnt = fs->f->consts;
269	int c = fs->f->nconsts;
270	int lim = c < LIM ? 0 : c-LIM;
271	while (--c >= lim) {
272	if (ttype(&cnt[c]) == LUA_T_NUMBER && nvalue(&cnt[c]) == r)
273	return c;
274	}
275	/* not found; create a new entry */
276	c = next_constant(fs);
277	cnt = fs->f->consts; /* 'next_constant' may have reallocated this vector */
278	ttype(&cnt[c]) = LUA_T_NUMBER;
279	nvalue(&cnt[c]) = r;
280	return c;
281	}	136	}
282		137
283		138
284	static void code_number (LexState *ls, real f) {	139	static TString str_checkname (LexState ls) {
285	real af = (f<0) ? -f : f;	140	TString *ts;
286	if (0 <= af && af <= (real)MAX_WORD && (int)af == af) {	141	check_condition(ls, (ls->t.token == TK_NAME), "<name> expected");
287	/* abs(f) has a short integer value */	142	ts = ls->t.seminfo.ts;
288	code_oparg(ls, (f<0) ? PUSHNUMBERNEG : PUSHNUMBER, (int)af, 1);	143	next(ls);
289	}	144	return ts;
290	else
291	code_constant(ls, real_constant(ls->fs, f));
292	}	145	}
293		146
294		147
295	static void flush_record (LexState *ls, int n) {	148	static int checkname (LexState *ls) {
296	if (n > 0)	149	return string_constant(ls->fs, str_checkname(ls));
297	code_oparg(ls, SETMAP, n-1, -2*n);
298	}	150	}
299		151
300		152
301	static void flush_list (LexState *ls, int m, int n) {	153	static int luaI_registerlocalvar (LexState ls, TString varname) {
302	if (n > 0) {	154	Proto *f = ls->fs->f;
303	code_oparg(ls, SETLIST, m, -n);	155	luaM_growvector(ls->L, f->locvars, f->nlocvars, 1, LocVar, "", MAX_INT);
304	code_byte(ls->fs, (Byte)n);	156	f->locvars[f->nlocvars].varname = varname;
305	}	157	return f->nlocvars++;
306	}	158	}
307		159
308		160
309	static void luaI_registerlocalvar (FuncState fs, TaggedString varname,	161	static void new_localvar (LexState ls, TString name, int n) {
310	int line) {	162	FuncState *fs = ls->fs;
311	if (fs->nvars != -1) { /* debug information? */	163	luaX_checklimit(ls, fs->nactloc+n+1, MAXLOCALS, "local variables");
312	TProtoFunc *f = fs->f;	164	fs->actloc[fs->nactloc+n] = luaI_registerlocalvar(ls, name);
313	luaM_growvector(f->locvars, fs->nvars, 1, LocVar, "", MAX_INT);
314	f->locvars[fs->nvars].varname = varname;
315	f->locvars[fs->nvars].line = line;
316	fs->nvars++;
317	}
318	}	165	}
319		166
320		167
321	static void luaI_unregisterlocalvar (FuncState *fs, int line) {	168	static void adjustlocalvars (LexState *ls, int nvars) {
322	luaI_registerlocalvar(fs, NULL, line);	169	FuncState *fs = ls->fs;
		170	while (nvars--)
		171	fs->f->locvars[fs->actloc[fs->nactloc++]].startpc = fs->pc;
323	}	172	}
324		173
325		174
326	static void store_localvar (LexState ls, TaggedString name, int n) {	175	static void removelocalvars (LexState *ls, int nvars) {
327	FuncState *fs = ls->fs;	176	FuncState *fs = ls->fs;
328	checklimit(ls, fs->nlocalvar+n+1, MAXLOCALS, "local variables");	177	while (nvars--)
329	fs->localvar[fs->nlocalvar+n] = name;	178	fs->f->locvars[fs->actloc[--fs->nactloc]].endpc = fs->pc;
330	luaI_registerlocalvar(fs, name, ls->linenumber);
331	}	179	}
332		180
333		181
334	static void add_localvar (LexState ls, TaggedString name) {	182	static void new_localvarstr (LexState ls, const char name, int n) {
335	store_localvar(ls, name, 0);	183	new_localvar(ls, luaS_newfixed(ls->L, name), n);
336	ls->fs->nlocalvar++;
337	}	184	}
338		185
339		186
340	static void correctvarlines (LexState *ls, int nvars) {	187	static int search_local (LexState ls, TString n, expdesc *var) {
341	FuncState *fs = ls->fs;	188	FuncState *fs;
342	if (fs->nvars != -1) { /* debug information? */	189	int level = 0;
343	for (; nvars; nvars--) { /* correct line information */	190	for (fs=ls->fs; fs; fs=fs->prev) {
344	fs->f->locvars[fs->nvars-nvars].line = fs->lastsetline;	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	}
345	}	198	}
		199	level++; /* `var' not found; check outer level */
346	}	200	}
		201	var->k = VGLOBAL; /* not found in any level; must be global */
		202	return -1;
347	}	203	}
348		204
349		205
350	static int aux_localname (FuncState fs, TaggedString n) {	206	static void singlevar (LexState ls, TString n, expdesc *var) {
351	int i;	207	int level = search_local(ls, n, var);
352	for (i=fs->nlocalvar-1; i >= 0; i--)	208	if (level >= 1) /* neither local (0) nor global (-1)? */
353	if (n == fs->localvar[i]) return i; /* local var index */	209	luaX_syntaxerror(ls, "cannot access a variable in outer scope", n->str);
354	return -1; /* not found */	210	else if (level == -1) /* global? */
355	}	211	var->u.index = string_constant(ls->fs, n);
356
357
358	static void singlevar (LexState ls, TaggedString n, vardesc *var, int prev) {
359	FuncState *fs = prev ? ls->fs->prev : ls->fs;
360	int i = aux_localname(fs, n);
361	if (i >= 0) { /* local value? */
362	var->k = VLOCAL;
363	var->info = i;
364	}
365	else {
366	FuncState *level = fs;
367	while ((level = level->prev) != NULL) /* check shadowing */
368	if (aux_localname(level, n) >= 0)
369	luaX_syntaxerror(ls, "cannot access a variable in outer scope", n->str);
370	var->k = VGLOBAL;
371	var->info = string_constant(fs, n);
372	}
373	}	212	}
374		213
375		214
376	static int indexupvalue (LexState ls, TaggedString n) {	215	static int indexupvalue (LexState ls, expdesc v) {
377	FuncState *fs = ls->fs;	216	FuncState *fs = ls->fs;
378	vardesc v;
379	int i;	217	int i;
380	singlevar(ls, n, &v, 1);
381	for (i=0; i<fs->nupvalues; i++) {	218	for (i=0; i<fs->nupvalues; i++) {
382	if (fs->upvalues[i].k == v.k && fs->upvalues[i].info == v.info)	219	if (fs->upvalues[i].k == v->k && fs->upvalues[i].u.index == v->u.index)
383	return i;	220	return i;
384	}	221	}
385	/* new one */	222	/* new one */
386	++(fs->nupvalues);	223	luaX_checklimit(ls, fs->nupvalues+1, MAXUPVALUES, "upvalues");
387	checklimit(ls, fs->nupvalues, MAXUPVALUES, "upvalues");	224	fs->upvalues[fs->nupvalues] = *v;
388	fs->upvalues[i] = v; /* i = fs->nupvalues - 1 */	225	return fs->nupvalues++;
389	return i;
390	}
391
392
393	static void pushupvalue (LexState ls, TaggedString n) {
394	if (ls->fs->prev == NULL)
395	luaX_syntaxerror(ls, "cannot access upvalue in main", n->str);
396	if (aux_localname(ls->fs, n) >= 0)
397	luaX_syntaxerror(ls, "cannot access an upvalue in current scope", n->str);
398	code_oparg(ls, PUSHUPVALUE, indexupvalue(ls, n), 1);
399	}
400
401
402
403	static void check_debugline (LexState *ls) {
404	if (L->debug && ls->linenumber != ls->fs->lastsetline) {
405	code_oparg(ls, SETLINE, ls->linenumber, 0);
406	ls->fs->lastsetline = ls->linenumber;
407	}
408	}
409
410
411	static void adjuststack (LexState *ls, int n) {
412	if (n > 0)
413	code_oparg(ls, POP, n, -n);
414	else if (n < 0)
415	code_oparg(ls, PUSHNIL, (-n)-1, -n);
416	}	226	}
417		227
418		228
419	static void close_exp (LexState *ls, int pc, int nresults) {	229	static void pushupvalue (LexState ls, TString n) {
420	if (pc > 0) { /* expression is an open function call? */	230	FuncState *fs = ls->fs;
421	Byte *code = ls->fs->f->code;	231	expdesc v;
422	code[pc-1] = (Byte)nresults; /* set nresults */	232	int level = search_local(ls, n, &v);
423	/* push results, pop params (at code[pc]) and function */	233	if (level == -1) { /* global? */
424	deltastack(ls, nresults-(code[pc]+1));	234	if (fs->prev == NULL)
		235	luaX_syntaxerror(ls, "cannot access upvalue in main", n->str);
		236	v.u.index = string_constant(fs->prev, n);
425	}	237	}
426	#ifdef DEBUG	238	else if (level != 1)
427	code_oparg(ls, CHECKSTACK, ls->fs->stacksize, 0);	239	luaX_syntaxerror(ls,
428	#endif	240	"upvalue must be global or local to immediately outer scope", n->str);
		241	luaK_code1(fs, OP_PUSHUPVALUE, indexupvalue(ls, &v));
429	}	242	}
430		243
431		244
432	static void adjust_mult_assign (LexState ls, int nvars, listdesc d) {	245	static void adjust_mult_assign (LexState *ls, int nvars, int nexps) {
433	int diff = d->n - nvars;	246	FuncState *fs = ls->fs;
434	if (d->pc == 0) { /* list is closed */	247	int diff = nexps - nvars;
435	/* push or pop eventual difference between list lengths */	248	if (nexps > 0 && luaK_lastisopen(fs)) { /* list ends in a function call */
436	adjuststack(ls, diff);
437	}
438	else { /* must correct function call */
439	diff--; /* do not count function call itself */	249	diff--; /* do not count function call itself */
440	if (diff <= 0) { /* more variables than values? */	250	if (diff <= 0) { /* more variables than values? */
441	/* function call must provide extra values */	251	luaK_setcallreturns(fs, -diff); /* function call provide extra values */
442	close_exp(ls, d->pc, -diff);	252	diff = 0; /* no more difference */
443	}
444	else { /* more values than variables */
445	close_exp(ls, d->pc, 0); /* call should provide no value */
446	adjuststack(ls, diff); /* pop eventual extra values */
447	}	253	}
		254	else /* more values than variables */
		255	luaK_setcallreturns(fs, 0); /* call should provide no value */
448	}	256	}
		257	/* push or pop eventual difference between list lengths */
		258	luaK_adjuststack(fs, diff);
449	}	259	}
450		260
451		261
452	static void code_args (LexState *ls, int nparams, int dots) {	262	static void code_params (LexState *ls, int nparams, int dots) {
453	FuncState *fs = ls->fs;	263	FuncState *fs = ls->fs;
454	fs->nlocalvar += nparams; /* "self" may already be there */	264	adjustlocalvars(ls, nparams);
455	checklimit(ls, fs->nlocalvar, MAXPARAMS, "parameters");	265	luaX_checklimit(ls, fs->nactloc, MAXPARAMS, "parameters");
456	nparams = fs->nlocalvar;	266	fs->f->numparams = fs->nactloc; /* `self' could be there already */
457	if (!dots) {	267	fs->f->is_vararg = dots;
458	fs->f->code[1] = (Byte)nparams; /* fill-in arg information */	268	if (dots) {
459	deltastack(ls, nparams);	269	new_localvarstr(ls, "arg", 0);
460	}	270	adjustlocalvars(ls, 1);
461	else {
462	fs->f->code[1] = (Byte)(nparams+ZEROVARARG);
463	deltastack(ls, nparams+1);
464	add_localvar(ls, luaS_new("arg"));
465	}
466	}
467
468
469	static void unloaddot (LexState ls, vardesc v) {
470	/* dotted variables <a.x> must be stored like regular indexed vars <a["x"]> */
471	if (v->k == VDOT) {
472	code_constant(ls, v->info);
473	v->k = VINDEXED;
474	}
475	}
476
477
478	static void lua_pushvar (LexState ls, vardesc var) {
479	switch (var->k) {
480	case VLOCAL:
481	code_oparg(ls, PUSHLOCAL, var->info, 1);
482	break;
483	case VGLOBAL:
484	code_oparg(ls, GETGLOBAL, var->info, 1);
485	break;
486	case VDOT:
487	code_oparg(ls, GETDOTTED, var->info, 0);
488	break;
489	case VINDEXED:
490	code_opcode(ls, GETTABLE, -1);
491	break;
492	case VEXP:
493	close_exp(ls, var->info, 1); /* function must return 1 value */
494	break;
495	}
496	var->k = VEXP;
497	var->info = 0; /* now this is a closed expression */
498	}
499
500
501	static void storevar (LexState ls, vardesc var) {
502	switch (var->k) {
503	case VLOCAL:
504	code_oparg(ls, SETLOCAL, var->info, -1);
505	break;
506	case VGLOBAL:
507	code_oparg(ls, SETGLOBAL, var->info, -1);
508	break;
509	case VINDEXED:
510	code_opcode(ls, SETTABLEPOP, -3);
511	break;
512	default:
513	LUA_INTERNALERROR("invalid var kind to store");
514	}	271	}
		272	luaK_deltastack(fs, fs->nactloc); /* count parameters in the stack */
515	}	273	}
516		274
517		275
518	static int fix_jump (LexState *ls, int pc, OpCode op, int n) {	276	static void enterbreak (FuncState fs, Breaklabel bl) {
519	/* jump is relative to position following jump instruction */	277	bl->stacklevel = fs->stacklevel;
520	return fix_opcode(ls, pc, op, n-(pc+JMPSIZE));	278	bl->breaklist = NO_JUMP;
521	}	279	bl->previous = fs->bl;
522		280	fs->bl = bl;
523
524	static void fix_upjmp (LexState *ls, OpCode op, int pos) {
525	int delta = ls->fs->pc+JMPSIZE - pos; /* jump is relative */
526	code_oparg(ls, op, delta+(codesize(delta)-2), 0);
527	}	281	}
528		282
529		283
530	static void codeIf (LexState *ls, int thenAdd, int elseAdd) {	284	static void leavebreak (FuncState fs, Breaklabel bl) {
531	FuncState *fs = ls->fs;	285	fs->bl = bl->previous;
532	int elseinit = elseAdd+JMPSIZE;	286	LUA_ASSERT(bl->stacklevel == fs->stacklevel, "wrong levels");
533	if (fs->pc == elseinit) { /* no else part? */	287	luaK_patchlist(fs, bl->breaklist, luaK_getlabel(fs));
534	fs->pc -= JMPSIZE;
535	elseinit = fs->pc;
536	}
537	else
538	elseinit += fix_jump(ls, elseAdd, JMP, fs->pc);
539	fix_jump(ls, thenAdd, IFFJMP, elseinit);
540	}	288	}
541		289
542		290
543	static void func_onstack (LexState ls, FuncState func) {	291	static void pushclosure (LexState ls, FuncState func) {
544	FuncState *fs = ls->fs;	292	FuncState *fs = ls->fs;
		293	Proto *f = fs->f;
545	int i;	294	int i;
546	int c = next_constant(fs);	295	for (i=0; i<func->nupvalues; i++)
547	ttype(&fs->f->consts[c]) = LUA_T_PROTO;	296	luaK_tostack(ls, &func->upvalues[i], 1);
548	fs->f->consts[c].value.tf = func->f;	297	luaM_growvector(ls->L, f->kproto, f->nkproto, 1, Proto *,
549	if (func->nupvalues == 0)	298	"constant table overflow", MAXARG_A);
550	code_constant(ls, c);	299	f->kproto[f->nkproto++] = func->f;
551	else {	300	luaK_code2(fs, OP_CLOSURE, f->nkproto-1, func->nupvalues);
552	for (i=0; i<func->nupvalues; i++)
553	lua_pushvar(ls, &func->upvalues[i]);
554	deltastack(ls, 1); /* CLOSURE puts one extra element (before poping) */
555	code_oparg(ls, CLOSURE, c, -func->nupvalues);
556	code_byte(fs, (Byte)func->nupvalues);
557	}
558	}	301	}
559		302
560		303
561	static void init_state (LexState ls, FuncState fs, TaggedString *source) {	304	static void open_func (LexState ls, FuncState fs) {
562	TProtoFunc *f = luaF_newproto();	305	Proto *f = luaF_newproto(ls->L);
563	fs->prev = ls->fs; /* linked list of funcstates */	306	fs->prev = ls->fs; /* linked list of funcstates */
		307	fs->ls = ls;
		308	fs->L = ls->L;
564	ls->fs = fs;	309	ls->fs = fs;
565	fs->stacksize = 0;	310	fs->stacklevel = 0;
566	fs->maxstacksize = 0;	311	fs->nactloc = 0;
567	fs->nlocalvar = 0;
568	fs->nupvalues = 0;	312	fs->nupvalues = 0;
569	fs->lastsetline = 0;	313	fs->bl = NULL;
570	fs->f = f;	314	fs->f = f;
571	f->source = source;	315	f->source = ls->source;
572	fs->pc = 0;	316	fs->pc = 0;
		317	fs->lasttarget = 0;
		318	fs->lastline = 0;
		319	fs->jlt = NO_JUMP;
573	f->code = NULL;	320	f->code = NULL;
574	fs->nvars = (L->debug) ? 0 : -1; /* flag no debug information? */	321	f->maxstacksize = 0;
575	code_byte(fs, 0); /* to be filled with maxstacksize */	322	f->numparams = 0; /* default for main chunk */
576	code_byte(fs, 0); /* to be filled with arg information */	323	f->is_vararg = 0; /* default for main chunk */
577	/* push function (to avoid GC) */
578	tfvalue(L->stack.top) = f; ttype(L->stack.top) = LUA_T_PROTO;
579	incr_top;
580	}	324	}
581		325
582		326
583	static void close_func (LexState *ls) {	327	static void close_func (LexState *ls) {
		328	lua_State *L = ls->L;
584	FuncState *fs = ls->fs;	329	FuncState *fs = ls->fs;
585	TProtoFunc *f = fs->f;	330	Proto *f = fs->f;
586	code_opcode(ls, ENDCODE, 0);	331	luaK_code0(fs, OP_END);
587	f->code[0] = (Byte)fs->maxstacksize;	332	luaK_getlabel(fs); /* close eventual list of pending jumps */
588	luaM_reallocvector(f->code, fs->pc, Byte);	333	luaM_reallocvector(L, f->code, fs->pc, Instruction);
589	luaM_reallocvector(f->consts, f->nconsts, TObject);	334	luaM_reallocvector(L, f->kstr, f->nkstr, TString *);
590	if (fs->nvars != -1) { /* debug information? */	335	luaM_reallocvector(L, f->knum, f->nknum, Number);
591	luaI_registerlocalvar(fs, NULL, -1); /* flag end of vector */	336	luaM_reallocvector(L, f->kproto, f->nkproto, Proto *);
592	luaM_reallocvector(f->locvars, fs->nvars, LocVar);	337	removelocalvars(ls, fs->nactloc);
593	}	338	luaM_reallocvector(L, f->locvars, f->nlocvars, LocVar);
		339	luaM_reallocvector(L, f->lineinfo, f->nlineinfo+1, int);
		340	f->lineinfo[f->nlineinfo++] = MAX_INT; /* end flag */
		341	luaF_protook(L, f, fs->pc); /* proto is ok now */
594	ls->fs = fs->prev;	342	ls->fs = fs->prev;
595	L->stack.top--; /* pop function */	343	LUA_ASSERT(fs->bl == NULL, "wrong list end");
596	}
597
598
599
600	static int expfollow [] = {ELSE, ELSEIF, THEN, IF, WHILE, REPEAT, DO, NAME,
601	LOCAL, FUNCTION, END, UNTIL, RETURN, ')', ']', '}', ';', EOS, ',', 0};
602
603
604	static int is_in (int tok, int *toks) {
605	int *t;
606	for (t=toks; *t; t++)
607	if (*t == tok) return t-toks;
608	return -1;
609	}
610
611
612	static void next (LexState *ls) {
613	ls->token = luaX_lex(ls);
614	}
615
616
617	static void error_expected (LexState *ls, int token) {
618	char buff[100], t[TOKEN_LEN];
619	luaX_token2str(token, t);
620	sprintf(buff, "`%s' expected", t);
621	luaX_error(ls, buff);
622	}
623
624
625	static void error_unexpected (LexState *ls) {
626	luaX_error(ls, "unexpected token");
627	}
628
629
630	static void error_unmatched (LexState *ls, int what, int who, int where) {
631	if (where == ls->linenumber)
632	error_expected(ls, what);
633	else {
634	char buff[100];
635	char t_what[TOKEN_LEN], t_who[TOKEN_LEN];
636	luaX_token2str(what, t_what);
637	luaX_token2str(who, t_who);
638	sprintf(buff, "`%s' expected (to close `%s' at line %d)",
639	t_what, t_who, where);
640	luaX_error(ls, buff);
641	}
642	}
643
644	static void check (LexState *ls, int c) {
645	if (ls->token != c)
646	error_expected(ls, c);
647	next(ls);
648	}
649
650	static void check_match (LexState *ls, int what, int who, int where) {
651	if (ls->token != what)
652	error_unmatched(ls, what, who, where);
653	check_debugline(ls); /* to 'mark' the 'what' */
654	next(ls);
655	}
656
657	static int checkname (LexState *ls) {
658	int sc;
659	if (ls->token != NAME)
660	luaX_error(ls, "`NAME' expected");
661	sc = string_constant(ls->fs, ls->seminfo.ts);
662	next(ls);
663	return sc;
664	}
665
666
667	static TaggedString str_checkname (LexState ls) {
668	int i = checkname(ls); /* this call may realloc `f->consts' */
669	return tsvalue(&ls->fs->f->consts[i]);
670	}
671
672
673	static int optional (LexState *ls, int c) {
674	if (ls->token == c) {
675	next(ls);
676	return 1;
677	}
678	else return 0;
679	}	344	}
680		345
681		346
682	TProtoFunc luaY_parser (ZIO z) {	347	Proto luaY_parser (lua_State L, ZIO *z) {
683	struct LexState lexstate;	348	struct LexState lexstate;
684	struct FuncState funcstate;	349	struct FuncState funcstate;
685	luaX_setinput(&lexstate, z);	350	luaX_setinput(L, &lexstate, z, luaS_new(L, zname(z)));
686	init_state(&lexstate, &funcstate, luaS_new(zname(z)));	351	open_func(&lexstate, &funcstate);
687	next(&lexstate); /* read first token */	352	next(&lexstate); /* read first token */
688	chunk(&lexstate);	353	chunk(&lexstate);
689	if (lexstate.token != EOS)	354	check_condition(&lexstate, (lexstate.t.token == TK_EOS), "<eof> expected");
690	luaX_error(&lexstate, "<eof> expected");
691	close_func(&lexstate);	355	close_func(&lexstate);
		356	LUA_ASSERT(funcstate.prev == NULL, "wrong list end");
		357	LUA_ASSERT(funcstate.nupvalues == 0, "no upvalues in main");
692	return funcstate.f;	358	return funcstate.f;
693	}	359	}
694		360
695		361
696		362
697	/============================================================/	363	/============================================================/
698	/* GRAMAR RULES */	364	/* GRAMMAR RULES */
699	/============================================================/	365	/============================================================/
700		366
701	static void chunk (LexState *ls) {
702	/* chunk -> statlist ret */
703	statlist(ls);
704	ret(ls);
705	}
706		367
707	static void statlist (LexState *ls) {	368	static int explist1 (LexState *ls) {
708	/* statlist -> { stat [;] } */	369	/* explist1 -> expr { ',' expr } */
709	while (stat(ls)) {	370	int n = 1; /* at least one expression */
710	LUA_ASSERT(ls->fs->stacksize == ls->fs->nlocalvar,	371	expdesc v;
711	"stack size != # local vars");	372	expr(ls, &v);
712	optional(ls, ';');	373	while (ls->t.token == ',') {
		374	luaK_tostack(ls, &v, 1); /* gets only 1 value from previous expression */
		375	next(ls); /* skip comma */
		376	expr(ls, &v);
		377	n++;
713	}	378	}
		379	luaK_tostack(ls, &v, 0); /* keep open number of values of last expression */
		380	return n;
714	}	381	}
715		382
716	static int stat (LexState *ls) {
717	int line = ls->linenumber; /* may be needed for error messages */
718	FuncState *fs = ls->fs;
719	switch (ls->token) {
720	case IF: /* stat -> IF ifpart END */
721	ifpart(ls, line);
722	return 1;
723		383
724	case WHILE: { /* stat -> WHILE cond DO block END */	384	static void funcargs (LexState *ls, int slf) {
725	TProtoFunc *f = fs->f;	385	FuncState *fs = ls->fs;
726	int while_init = fs->pc;	386	int slevel = fs->stacklevel - slf - 1; /* where is func in the stack */
727	int cond_end, cond_size;	387	switch (ls->t.token) {
		388	case '(': { /* funcargs -> '(' [ explist1 ] ')' */
		389	int line = ls->linenumber;
		390	int nargs = 0;
728	next(ls);	391	next(ls);
729	cond_end = cond(ls);	392	if (ls->t.token != ')') /* arg list not empty? */
730	check(ls, DO);	393	nargs = explist1(ls);
731	block(ls);	394	check_match(ls, ')', '(', line);
732	check_match(ls, END, WHILE, line);	395	#ifdef LUA_COMPAT_ARGRET
733	cond_size = cond_end-while_init;	396	if (nargs > 0) /* arg list is not empty? */
734	check_pc(fs, cond_size);	397	luaK_setcallreturns(fs, 1); /* last call returns only 1 value */
735	memcpy(f->code+fs->pc, f->code+while_init, cond_size);	398	#else
736	luaO_memdown(f->code+while_init, f->code+cond_end, fs->pc-while_init);	399	UNUSED(nargs); /* to avoid warnings */
737	while_init += JMPSIZE + fix_jump(ls, while_init, JMP, fs->pc-cond_size);	400	#endif
738	fix_upjmp(ls, IFTUPJMP, while_init);	401	break;
739	return 1;
740	}	402	}
741		403	case '{': { /* funcargs -> constructor */
742	case DO: { /* stat -> DO block END */	404	constructor(ls);
743	next(ls);	405	break;
744	block(ls);
745	check_match(ls, END, DO, line);
746	return 1;
747	}	406	}
748		407	case TK_STRING: { /* funcargs -> STRING */
749	case REPEAT: { /* stat -> REPEAT block UNTIL exp1 */	408	code_string(ls, ls->t.seminfo.ts); /* must use `seminfo' before `next' */
750	int repeat_init = fs->pc;
751	next(ls);	409	next(ls);
752	block(ls);	410	break;
753	check_match(ls, UNTIL, REPEAT, line);
754	exp1(ls);
755	fix_upjmp(ls, IFFUPJMP, repeat_init);
756	deltastack(ls, -1); /* pops condition */
757	return 1;
758	}	411	}
759		412	default: {
760	case FUNCTION: { /* stat -> FUNCTION funcname body */	413	luaK_error(ls, "function arguments expected");
761	int needself;	414	break;
762	vardesc v;
763	if (ls->fs->prev) /* inside other function? */
764	return 0;
765	check_debugline(ls);
766	next(ls);
767	needself = funcname(ls, &v);
768	body(ls, needself, line);
769	storevar(ls, &v);
770	return 1;
771	}	415	}
		416	}
		417	fs->stacklevel = slevel; /* call will remove function and arguments */
		418	luaK_code2(fs, OP_CALL, slevel, MULT_RET);
		419	}
772		420
773	case LOCAL: { /* stat -> LOCAL localnamelist decinit */
774	listdesc d;
775	int nvars;
776	check_debugline(ls);
777	next(ls);
778	nvars = localnamelist(ls);
779	decinit(ls, &d);
780	fs->nlocalvar += nvars;
781	correctvarlines(ls, nvars); /* vars will be alive only after decinit */
782	adjust_mult_assign(ls, nvars, &d);
783	return 1;
784	}
785		421
786	case NAME: case '%': { /* stat -> func \| ['%'] NAME assignment */	422	static void var_or_func_tail (LexState ls, expdesc v) {
787	vardesc v;	423	for (;;) {
788	check_debugline(ls);	424	switch (ls->t.token) {
789	var_or_func(ls, &v);	425	case '.': { /* var_or_func_tail -> '.' NAME */
790	if (v.k == VEXP) { /* stat -> func */	426	next(ls);
791	if (v.info == 0) /* is just an upper value? */	427	luaK_tostack(ls, v, 1); /* `v' must be on stack */
792	luaX_error(ls, "syntax error");	428	luaK_kstr(ls, checkname(ls));
793	close_exp(ls, v.info, 0);	429	v->k = VINDEXED;
		430	break;
794	}	431	}
795	else { /* stat -> ['%'] NAME assignment */	432	case '[': { /* var_or_func_tail -> '[' exp1 ']' */
796	int left = assignment(ls, &v, 1);	433	next(ls);
797	adjuststack(ls, left); /* remove eventual 'garbage' left on stack */	434	luaK_tostack(ls, v, 1); /* `v' must be on stack */
		435	v->k = VINDEXED;
		436	exp1(ls);
		437	check(ls, ']');
		438	break;
798	}	439	}
799	return 1;	440	case ':': { /* var_or_func_tail -> ':' NAME funcargs */
		441	int name;
		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;
		450	}
		451	case '(': case TK_STRING: case '{': { /* var_or_func_tail -> funcargs */
		452	luaK_tostack(ls, v, 1); /* `v' must be on stack */
		453	funcargs(ls, 0);
		454	v->k = VEXP;
		455	v->u.l.t = v->u.l.f = NO_JUMP;
		456	break;
		457	}
		458	default: return; /* should be follow... */
800	}	459	}
		460	}
		461	}
801		462
802	case RETURN: case ';': case ELSE: case ELSEIF:
803	case END: case UNTIL: case EOS: /* 'stat' follow */
804	return 0;
805		463
806	default:	464	static void var_or_func (LexState ls, expdesc v) {
807	error_unexpected(ls);	465	/* var_or_func -> ['%'] NAME var_or_func_tail */
808	return 0; /* to avoid warnings */	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;
809	}	470	}
		471	else /* variable name */
		472	singlevar(ls, str_checkname(ls), v);
		473	var_or_func_tail(ls, v);
810	}	474	}
811		475
812	static int SaveWord (LexState *ls) {
813	int res = ls->fs->pc;
814	check_pc(ls->fs, JMPSIZE);
815	ls->fs->pc += JMPSIZE; /* open space */
816	return res;
817	}
818		476
819	static int SaveWordPop (LexState *ls) {
820	deltastack(ls, -1); /* pop condition */
821	return SaveWord(ls);
822	}
823		477
824	static int cond (LexState *ls) {	478	/*
825	/* cond -> exp1 */	479	** {======================================================================
826	exp1(ls);	480	** Rules for Constructors
827	return SaveWordPop(ls);	481	** =======================================================================
828	}	482	*/
829		483
830	static void block (LexState *ls) {
831	/* block -> chunk */
832	FuncState *fs = ls->fs;
833	int nlocalvar = fs->nlocalvar;
834	chunk(ls);
835	adjuststack(ls, fs->nlocalvar - nlocalvar);
836	for (; fs->nlocalvar > nlocalvar; fs->nlocalvar--)
837	luaI_unregisterlocalvar(fs, fs->lastsetline);
838	}
839		484
840	static int funcname (LexState ls, vardesc v) {	485	static void recfield (LexState *ls) {
841	/* funcname -> NAME [':' NAME \| '.' NAME] */	486	/* recfield -> (NAME \| '['exp1']') = exp1 */
842	int needself = 0;	487	switch (ls->t.token) {
843	singlevar(ls, str_checkname(ls), v, 0);	488	case TK_NAME: {
844	if (ls->token == ':' \|\| ls->token == '.') {	489	luaK_kstr(ls, checkname(ls));
845	needself = (ls->token == ':');	490	break;
846	next(ls);	491	}
847	lua_pushvar(ls, v);	492	case '[': {
848	code_constant(ls, checkname(ls));	493	next(ls);
849	v->k = VINDEXED;	494	exp1(ls);
		495	check(ls, ']');
		496	break;
		497	}
		498	default: luaK_error(ls, "<name> or `[' expected");
850	}	499	}
851	return needself;	500	check(ls, '=');
852	}	501	exp1(ls);
853
854	static void body (LexState *ls, int needself, int line) {
855	/* body -> '(' parlist ')' chunk END */
856	FuncState newfs;
857	init_state(ls, &newfs, ls->fs->f->source);
858	newfs.f->lineDefined = line;
859	check(ls, '(');
860	if (needself)
861	add_localvar(ls, luaS_new("self"));
862	parlist(ls);
863	check(ls, ')');
864	chunk(ls);
865	check_match(ls, END, FUNCTION, line);
866	close_func(ls);
867	func_onstack(ls, &newfs);
868	}	502	}
869		503
870		504
871	static void ifpart (LexState *ls, int line) {	505	static int recfields (LexState *ls) {
872	/* ifpart -> cond THEN block [ELSE block \| ELSEIF ifpart] */	506	/* recfields -> recfield { ',' recfield } [','] */
873	int c;	507	FuncState *fs = ls->fs;
874	int e;	508	int n = 1; /* at least one element */
875	next(ls); /* skip IF or ELSEIF */	509	recfield(ls);
876	c = cond(ls);	510	while (ls->t.token == ',') {
877	check(ls, THEN);	511	next(ls);
878	block(ls);	512	if (ls->t.token == ';' \|\| ls->t.token == '}')
879	e = SaveWord(ls);	513	break;
880	if (ls->token == ELSEIF)	514	recfield(ls);
881	ifpart(ls, line);	515	n++;
882	else {	516	if (n%RFIELDS_PER_FLUSH == 0)
883	if (optional(ls, ELSE))	517	luaK_code1(fs, OP_SETMAP, RFIELDS_PER_FLUSH);
884	block(ls);
885	check_match(ls, END, IF, line);
886	}	518	}
887	codeIf(ls, c, e);	519	luaK_code1(fs, OP_SETMAP, n%RFIELDS_PER_FLUSH);
		520	return n;
888	}	521	}
889		522
890		523
891	static void ret (LexState *ls) {	524	static int listfields (LexState *ls) {
892	/* ret -> [RETURN explist sc] */	525	/* listfields -> exp1 { ',' exp1 } [','] */
893	if (optional(ls, RETURN)) {	526	FuncState *fs = ls->fs;
894	listdesc e;	527	int n = 1; /* at least one element */
895	check_debugline(ls);	528	exp1(ls);
896	explist(ls, &e);	529	while (ls->t.token == ',') {
897	if (e.pc > 0) { /* expression is an open function call? */	530	next(ls);
898	Byte *code = ls->fs->f->code;	531	if (ls->t.token == ';' \|\| ls->t.token == '}')
899	code[e.pc-2] = TAILCALL; /* instead of a conventional CALL */	532	break;
900	code[e.pc-1] = (Byte)ls->fs->nlocalvar;	533	exp1(ls);
901	}	534	n++;
902	else	535	luaX_checklimit(ls, n/LFIELDS_PER_FLUSH, MAXARG_A,
903	code_oparg(ls, RETCODE, ls->fs->nlocalvar, 0);	536	"`item groups' in a list initializer");
904	ls->fs->stacksize = ls->fs->nlocalvar; /* removes all temp values */	537	if (n%LFIELDS_PER_FLUSH == 0)
905	optional(ls, ';');	538	luaK_code2(fs, OP_SETLIST, n/LFIELDS_PER_FLUSH - 1, LFIELDS_PER_FLUSH);
906	}	539	}
		540	luaK_code2(fs, OP_SETLIST, n/LFIELDS_PER_FLUSH, n%LFIELDS_PER_FLUSH);
		541	return n;
907	}	542	}
908		543
909		544
910	/*
911	** For parsing expressions, we use a classic stack with priorities.
912	** Each binary operator is represented by its index in "binop" + FIRSTBIN
913	** (EQ=2, NE=3, ... '^'=13). The unary NOT is 0 and UNMINUS is 1.
914	*/
915
916	#define INDNOT 0
917	#define INDMINUS 1
918
919	/* code of first binary operator */
920	#define FIRSTBIN 2
921
922	/* code for power operator (last operator)
923	** '^' needs special treatment because it is right associative
924	*/
925	#define POW 13
926
927	static int binop [] = {EQ, NE, '>', '<', LE, GE, CONC,
928	'+', '-', '*', '/', '^', 0};
929
930	static int priority [POW+1] = {5, 5, 1, 1, 1, 1, 1, 1, 2, 3, 3, 4, 4, 6};
931
932	static OpCode opcodes [POW+1] = {NOTOP, MINUSOP, EQOP, NEQOP, GTOP, LTOP,
933	LEOP, GEOP, CONCOP, ADDOP, SUBOP, MULTOP, DIVOP, POWOP};
934
935	#define MAXOPS 20 /* op's stack size (arbitrary limit) */
936		545
937	typedef struct stack_op {	546	static void constructor_part (LexState ls, Constdesc cd) {
938	int ops[MAXOPS];	547	switch (ls->t.token) {
939	int top;	548	case ';': case '}': { /* constructor_part -> empty */
940	} stack_op;	549	cd->n = 0;
941		550	cd->k = ls->t.token;
942		551	break;
943	static void exp1 (LexState *ls) {	552	}
944	vardesc v;	553	case TK_NAME: { /* may be listfields or recfields */
945	exp0(ls, &v);	554	lookahead(ls);
946	lua_pushvar(ls, &v);	555	if (ls->lookahead.token != '=') /* expression? */
947	if (is_in(ls->token, expfollow) < 0)	556	goto case_default;
948	luaX_error(ls, "ill-formed expression");	557	/* else go through to recfields */
		558	}
		559	case '[': { /* constructor_part -> recfields */
		560	cd->n = recfields(ls);
		561	cd->k = 1; /* record */
		562	break;
		563	}
		564	default: { /* constructor_part -> listfields */
		565	case_default:
		566	cd->n = listfields(ls);
		567	cd->k = 0; /* list */
		568	break;
		569	}
		570	}
949	}	571	}
950		572
951		573
952	static void exp0 (LexState ls, vardesc v) {	574	static void constructor (LexState *ls) {
953	/* exp0 -> exp2 {(AND \| OR) exp2} */	575	/* constructor -> '{' constructor_part [';' constructor_part] '}' */
954	exp2(ls, v);	576	FuncState *fs = ls->fs;
955	while (ls->token == AND \|\| ls->token == OR) {	577	int line = ls->linenumber;
956	int op = (ls->token == AND) ? ONFJMP : ONTJMP;	578	int pc = luaK_code1(fs, OP_CREATETABLE, 0);
957	int pc;	579	int nelems;
958	lua_pushvar(ls, v);	580	Constdesc cd;
959	next(ls);	581	check(ls, '{');
960	pc = SaveWordPop(ls);	582	constructor_part(ls, &cd);
961	exp2(ls, v);	583	nelems = cd.n;
962	lua_pushvar(ls, v);	584	if (optional(ls, ';')) {
963	fix_jump(ls, pc, op, ls->fs->pc);	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;
964	}	589	}
		590	check_match(ls, '}', '{', line);
		591	luaX_checklimit(ls, nelems, MAXARG_U, "elements in a table constructor");
		592	SETARG_U(fs->f->code[pc], nelems); /* set initial table size */
965	}	593	}
966		594
		595	/* }====================================================================== */
967		596
968	static void push (LexState ls, stack_op s, int op) {
969	if (s->top >= MAXOPS)
970	luaX_error(ls, "expression too complex");
971	s->ops[s->top++] = op;
972	}
973		597
974		598
975	static void pop_to (LexState ls, stack_op s, int prio) {
976	int op;
977	while (s->top > 0 && priority[(op=s->ops[s->top-1])] >= prio) {
978	code_opcode(ls, opcodes[op], op<FIRSTBIN?0:-1);
979	s->top--;
980	}
981	}
982		599
983	static void simpleexp (LexState ls, vardesc v, stack_op *s) {	600	/*
984	check_debugline(ls);	601	** {======================================================================
985	switch (ls->token) {	602	** Expression parsing
986	case NUMBER: { /* simpleexp -> NUMBER */	603	** =======================================================================
987	real r = ls->seminfo.r;	604	*/
		605
		606
		607	static void simpleexp (LexState ls, expdesc v) {
		608	FuncState *fs = ls->fs;
		609	switch (ls->t.token) {
		610	case TK_NUMBER: { /* simpleexp -> NUMBER */
		611	Number r = ls->t.seminfo.r;
988	next(ls);	612	next(ls);
989	/* dirty trick: check whether it is a -NUMBER not followed by '^' */	613	luaK_number(fs, r);
990	/* (because the priority of '^' is closer than '-'...) */
991	if (s->top > 0 && s->ops[s->top-1] == INDMINUS && ls->token != '^') {
992	s->top--; /* remove '-' from stack */
993	r = -r;
994	}
995	code_number(ls, r);
996	break;	614	break;
997	}	615	}
998		616	case TK_STRING: { /* simpleexp -> STRING */
999	case STRING: /* simpleexp -> STRING */	617	code_string(ls, ls->t.seminfo.ts); /* must use `seminfo' before `next' */
1000	code_string(ls, ls->seminfo.ts); /* must use 'seminfo' before "next" */
1001	next(ls);	618	next(ls);
1002	break;	619	break;
1003		620	}
1004	case NIL: /* simpleexp -> NIL */	621	case TK_NIL: { /* simpleexp -> NIL */
1005	adjuststack(ls, -1);	622	luaK_adjuststack(fs, -1);
1006	next(ls);	623	next(ls);
1007	break;	624	break;
1008		625	}
1009	case '{': /* simpleexp -> constructor */	626	case '{': { /* simpleexp -> constructor */
1010	constructor(ls);	627	constructor(ls);
1011	break;	628	break;
1012		629	}
1013	case FUNCTION: /* simpleexp -> FUNCTION body */	630	case TK_FUNCTION: { /* simpleexp -> FUNCTION body */
1014	next(ls);	631	next(ls);
1015	body(ls, 0, ls->linenumber);	632	body(ls, 0, ls->linenumber);
1016	break;	633	break;
1017		634	}
1018	case '(': /* simpleexp -> '(' exp0 ')' */	635	case '(': { /* simpleexp -> '(' expr ')' */
1019	next(ls);	636	next(ls);
1020	exp0(ls, v);	637	expr(ls, v);
1021	check(ls, ')');	638	check(ls, ')');
1022	return;	639	return;
1023		640	}
1024	case NAME: case '%':	641	case TK_NAME: case '%': {
1025	var_or_func(ls, v);	642	var_or_func(ls, v);
1026	return;	643	return;
1027		644	}
1028	default:	645	default: {
1029	luaX_error(ls, "<expression> expected");	646	luaK_error(ls, "<expression> expected");
1030	return;	647	return;
		648	}
1031	}	649	}
1032	v->k = VEXP; v->info = 0;	650	v->k = VEXP;
		651	v->u.l.t = v->u.l.f = NO_JUMP;
1033	}	652	}
1034		653
1035		654
1036	static void prefixexp (LexState ls, vardesc v, stack_op *s) {	655	static void exp1 (LexState *ls) {
1037	/* prefixexp -> {NOT \| '-'} simpleexp */	656	expdesc v;
1038	while (ls->token == NOT \|\| ls->token == '-') {	657	expr(ls, &v);
1039	push(ls, s, (ls->token==NOT)?INDNOT:INDMINUS);	658	luaK_tostack(ls, &v, 1);
1040	next(ls);
1041	}
1042	simpleexp(ls, v, s);
1043	}	659	}
1044		660
1045		661
1046	static void exp2 (LexState ls, vardesc v) {	662	static UnOpr getunopr (int op) {
1047	stack_op s;	663	switch (op) {
1048	int op;	664	case TK_NOT: return OPR_NOT;
1049	s.top = 0;	665	case '-': return OPR_MINUS;
1050	prefixexp(ls, v, &s);	666	default: return OPR_NOUNOPR;
1051	while ((op = is_in(ls->token, binop)) >= 0) {
1052	op += FIRSTBIN;
1053	lua_pushvar(ls, v);
1054	/* '^' is right associative, so must 'simulate' a higher priority */
1055	pop_to(ls, &s, (op == POW)?priority[op]+1:priority[op]);
1056	push(ls, &s, op);
1057	next(ls);
1058	prefixexp(ls, v, &s);
1059	lua_pushvar(ls, v);
1060	}
1061	if (s.top > 0) {
1062	lua_pushvar(ls, v);
1063	pop_to(ls, &s, 0);
1064	}	667	}
1065	}	668	}
1066		669
1067		670
1068	static void var_or_func (LexState ls, vardesc v) {	671	static BinOpr getbinopr (int op) {
1069	/* var_or_func -> ['%'] NAME var_or_func_tail */	672	switch (op) {
1070	if (optional(ls, '%')) { /* upvalue? */	673	case '+': return OPR_ADD;
1071	pushupvalue(ls, str_checkname(ls));	674	case '-': return OPR_SUB;
1072	v->k = VEXP;	675	case '*': return OPR_MULT;
1073	v->info = 0; /* closed expression */	676	case '/': return OPR_DIV;
		677	case '^': return OPR_POW;
		678	case TK_CONCAT: return OPR_CONCAT;
		679	case TK_NE: return OPR_NE;
		680	case TK_EQ: return OPR_EQ;
		681	case '<': return OPR_LT;
		682	case TK_LE: return OPR_LE;
		683	case '>': return OPR_GT;
		684	case TK_GE: return OPR_GE;
		685	case TK_AND: return OPR_AND;
		686	case TK_OR: return OPR_OR;
		687	default: return OPR_NOBINOPR;
1074	}	688	}
1075	else /* variable name */
1076	singlevar(ls, str_checkname(ls), v, 0);
1077	var_or_func_tail(ls, v);
1078	}	689	}
1079		690
1080		691
1081	static void var_or_func_tail (LexState ls, vardesc v) {	692	static const struct {
1082	for (;;) {	693	char left; /* left priority for each binary operator */
1083	switch (ls->token) {	694	char right; /* right priority */
1084	case '.': /* var_or_func_tail -> '.' NAME */	695	} priority[] = { /* ORDER OPR */
1085	next(ls);	696	{5, 5}, {5, 5}, {6, 6}, {6, 6}, /* arithmetic */
1086	lua_pushvar(ls, v); /* 'v' must be on stack */	697	{9, 8}, {4, 3}, /* power and concat (right associative) */
1087	v->k = VDOT;	698	{2, 2}, {2, 2}, /* equality */
1088	v->info = checkname(ls);	699	{2, 2}, {2, 2}, {2, 2}, {2, 2}, /* order */
1089	break;	700	{1, 1}, {1, 1} /* logical */
1090		701	};
1091	case '[': /* var_or_func_tail -> '[' exp1 ']' */
1092	next(ls);
1093	lua_pushvar(ls, v); /* 'v' must be on stack */
1094	exp1(ls);
1095	check(ls, ']');
1096	v->k = VINDEXED;
1097	break;
1098		702
1099	case ':': /* var_or_func_tail -> ':' NAME funcparams */	703	#define UNARY_PRIORITY 7 /* priority for unary operators */
1100	next(ls);
1101	lua_pushvar(ls, v); /* 'v' must be on stack */
1102	code_oparg(ls, PUSHSELF, checkname(ls), 1);
1103	v->k = VEXP;
1104	v->info = funcparams(ls, 1);
1105	break;
1106		704
1107	case '(': case STRING: case '{': /* var_or_func_tail -> funcparams */
1108	lua_pushvar(ls, v); /* 'v' must be on stack */
1109	v->k = VEXP;
1110	v->info = funcparams(ls, 0);
1111	break;
1112		705
1113	default: return; /* should be follow... */	706	/*
1114	}	707	** subexpr -> (simplexep \| unop subexpr) { binop subexpr }
		708	** where `binop' is any binary operator with a priority higher than `limit'
		709	*/
		710	static BinOpr subexpr (LexState ls, expdesc v, int limit) {
		711	BinOpr op;
		712	UnOpr uop = getunopr(ls->t.token);
		713	if (uop != OPR_NOUNOPR) {
		714	next(ls);
		715	subexpr(ls, v, UNARY_PRIORITY);
		716	luaK_prefix(ls, uop, v);
1115	}	717	}
		718	else simpleexp(ls, v);
		719	/* expand while operators have priorities higher than `limit' */
		720	op = getbinopr(ls->t.token);
		721	while (op != OPR_NOBINOPR && priority[op].left > limit) {
		722	expdesc v2;
		723	BinOpr nextop;
		724	next(ls);
		725	luaK_infix(ls, op, v);
		726	/* read sub-expression with higher priority */
		727	nextop = subexpr(ls, &v2, priority[op].right);
		728	luaK_posfix(ls, op, v, &v2);
		729	op = nextop;
		730	}
		731	return op; /* return first untreated operator */
1116	}	732	}
1117		733
1118	static int funcparams (LexState *ls, int slf) {
1119	FuncState *fs = ls->fs;
1120	int nparams = 1; /* in cases STRING and constructor */
1121	switch (ls->token) {
1122	case '(': { /* funcparams -> '(' explist ')' */
1123	int line = ls->linenumber;
1124	listdesc e;
1125	next(ls);
1126	explist(ls, &e);
1127	check_match(ls, ')', '(', line);
1128	close_exp(ls, e.pc, 1);
1129	nparams = e.n;
1130	break;
1131	}
1132		734
1133	case '{': /* funcparams -> constructor */	735	static void expr (LexState ls, expdesc v) {
1134	constructor(ls);	736	subexpr(ls, v, -1);
1135	break;	737	}
1136		738
1137	case STRING: /* funcparams -> STRING */	739	/* }==================================================================== */
1138	code_string(ls, ls->seminfo.ts); /* must use 'seminfo' before "next" */	740
1139	next(ls);	741
1140	break;	742	/*
		743	** {======================================================================
		744	** Rules for Statements
		745	** =======================================================================
		746	*/
1141		747
1142	default:
1143	luaX_error(ls, "function arguments expected");
1144	break;
1145	}
1146	code_byte(fs, CALL);
1147	code_byte(fs, 0); /* save space for nresult */
1148	code_byte(fs, (Byte)(nparams+slf));
1149	return fs->pc-1;
1150	}
1151
1152	static void explist (LexState ls, listdesc d) {
1153	switch (ls->token) {
1154	case ELSE: case ELSEIF: case END: case UNTIL:
1155	case EOS: case ';': case ')':
1156	d->pc = 0;
1157	d->n = 0;
1158	break;
1159		748
1160	default:	749	static int block_follow (int token) {
1161	explist1(ls, d);	750	switch (token) {
		751	case TK_ELSE: case TK_ELSEIF: case TK_END:
		752	case TK_UNTIL: case TK_EOS:
		753	return 1;
		754	default: return 0;
1162	}	755	}
1163	}	756	}
1164		757
1165	static void explist1 (LexState ls, listdesc d) {	758
1166	vardesc v;	759	static void block (LexState *ls) {
1167	exp0(ls, &v);	760	/* block -> chunk */
1168	d->n = 1;	761	FuncState *fs = ls->fs;
1169	while (ls->token == ',') {	762	int nactloc = fs->nactloc;
1170	d->n++;	763	chunk(ls);
1171	lua_pushvar(ls, &v);	764	luaK_adjuststack(fs, fs->nactloc - nactloc); /* remove local variables */
		765	removelocalvars(ls, fs->nactloc - nactloc);
		766	}
		767
		768
		769	static int assignment (LexState ls, expdesc v, int nvars) {
		770	int left = 0; /* number of values left in the stack after assignment */
		771	luaX_checklimit(ls, nvars, MAXVARSLH, "variables in a multiple assignment");
		772	if (ls->t.token == ',') { /* assignment -> ',' NAME assignment */
		773	expdesc nv;
1172	next(ls);	774	next(ls);
1173	exp0(ls, &v);	775	var_or_func(ls, &nv);
		776	check_condition(ls, (nv.k != VEXP), "syntax error");
		777	left = assignment(ls, &nv, nvars+1);
		778	}
		779	else { /* assignment -> '=' explist1 */
		780	int nexps;
		781	check(ls, '=');
		782	nexps = explist1(ls);
		783	adjust_mult_assign(ls, nvars, nexps);
1174	}	784	}
1175	if (v.k == VEXP)	785	if (v->k != VINDEXED)
1176	d->pc = v.info;	786	luaK_storevar(ls, v);
1177	else {	787	else { /* there may be garbage between table-index and value */
1178	lua_pushvar(ls, &v);	788	luaK_code2(ls->fs, OP_SETTABLE, left+nvars+2, 1);
1179	d->pc = 0;	789	left += 2;
1180	}	790	}
		791	return left;
1181	}	792	}
1182		793
1183	static void parlist (LexState *ls) {
1184	int nparams = 0;
1185	int dots = 0;
1186	switch (ls->token) {
1187	case DOTS: /* parlist -> DOTS */
1188	next(ls);
1189	dots = 1;
1190	break;
1191		794
1192	case NAME: /* parlist, tailparlist -> NAME [',' tailparlist] */	795	static void cond (LexState ls, expdesc v) {
1193	init:	796	/* cond -> exp */
1194	store_localvar(ls, str_checkname(ls), nparams++);	797	expr(ls, v); /* read condition */
1195	if (ls->token == ',') {	798	luaK_goiftrue(ls->fs, v, 0);
1196	next(ls);	799	}
1197	switch (ls->token) {
1198	case DOTS: /* tailparlist -> DOTS */
1199	next(ls);
1200	dots = 1;
1201	break;
1202		800
1203	case NAME: /* tailparlist -> NAME [',' tailparlist] */
1204	goto init;
1205		801
1206	default: luaX_error(ls, "NAME or `...' expected");	802	static void whilestat (LexState *ls, int line) {
1207	}	803	/* whilestat -> WHILE cond DO block END */
1208	}	804	FuncState *fs = ls->fs;
1209	break;	805	int while_init = luaK_getlabel(fs);
		806	expdesc v;
		807	Breaklabel bl;
		808	enterbreak(fs, &bl);
		809	next(ls);
		810	cond(ls, &v);
		811	check(ls, TK_DO);
		812	block(ls);
		813	luaK_patchlist(fs, luaK_jump(fs), while_init);
		814	luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs));
		815	check_match(ls, TK_END, TK_WHILE, line);
		816	leavebreak(fs, &bl);
		817	}
1210		818
1211	case ')': break; /* parlist -> empty */
1212		819
1213	default: luaX_error(ls, "NAME or `...' expected");	820	static void repeatstat (LexState *ls, int line) {
1214	}	821	/* repeatstat -> REPEAT block UNTIL cond */
1215	code_args(ls, nparams, dots);	822	FuncState *fs = ls->fs;
		823	int repeat_init = luaK_getlabel(fs);
		824	expdesc v;
		825	Breaklabel bl;
		826	enterbreak(fs, &bl);
		827	next(ls);
		828	block(ls);
		829	check_match(ls, TK_UNTIL, TK_REPEAT, line);
		830	cond(ls, &v);
		831	luaK_patchlist(fs, v.u.l.f, repeat_init);
		832	leavebreak(fs, &bl);
1216	}	833	}
1217		834
1218	static int localnamelist (LexState *ls) {	835
1219	/* localnamelist -> NAME {',' NAME} */	836	static void forbody (LexState *ls, int nvar, OpCode prepfor, OpCode loopfor) {
1220	int i = 1;	837	/* forbody -> DO block END */
1221	store_localvar(ls, str_checkname(ls), 0);	838	FuncState *fs = ls->fs;
1222	while (ls->token == ',') {	839	int prep = luaK_code1(fs, prepfor, NO_JUMP);
1223	next(ls);	840	int blockinit = luaK_getlabel(fs);
1224	store_localvar(ls, str_checkname(ls), i++);	841	check(ls, TK_DO);
		842	adjustlocalvars(ls, nvar); /* scope for control variables */
		843	block(ls);
		844	luaK_patchlist(fs, luaK_code1(fs, loopfor, NO_JUMP), blockinit);
		845	luaK_patchlist(fs, prep, luaK_getlabel(fs));
		846	removelocalvars(ls, nvar);
		847	}
		848
		849
		850	static void fornum (LexState ls, TString varname) {
		851	/* fornum -> NAME = exp1,exp1[,exp1] forbody */
		852	FuncState *fs = ls->fs;
		853	check(ls, '=');
		854	exp1(ls); /* initial value */
		855	check(ls, ',');
		856	exp1(ls); /* limit */
		857	if (optional(ls, ','))
		858	exp1(ls); /* optional step */
		859	else
		860	luaK_code1(fs, OP_PUSHINT, 1); /* default step */
		861	new_localvar(ls, varname, 0);
		862	new_localvarstr(ls, "(limit)", 1);
		863	new_localvarstr(ls, "(step)", 2);
		864	forbody(ls, 3, OP_FORPREP, OP_FORLOOP);
		865	}
		866
		867
		868	static void forlist (LexState ls, TString indexname) {
		869	/* forlist -> NAME,NAME IN exp1 forbody */
		870	TString *valname;
		871	check(ls, ',');
		872	valname = str_checkname(ls);
		873	/* next test is dirty, but avoids `in' being a reserved word */
		874	check_condition(ls,
		875	(ls->t.token == TK_NAME && ls->t.seminfo.ts == luaS_new(ls->L, "in")),
		876	"`in' expected");
		877	next(ls); /* skip `in' */
		878	exp1(ls); /* table */
		879	new_localvarstr(ls, "(table)", 0);
		880	new_localvar(ls, indexname, 1);
		881	new_localvar(ls, valname, 2);
		882	forbody(ls, 3, OP_LFORPREP, OP_LFORLOOP);
		883	}
		884
		885
		886	static void forstat (LexState *ls, int line) {
		887	/* forstat -> fornum \| forlist */
		888	FuncState *fs = ls->fs;
		889	TString *varname;
		890	Breaklabel bl;
		891	enterbreak(fs, &bl);
		892	next(ls); /* skip `for' */
		893	varname = str_checkname(ls); /* first variable name */
		894	switch (ls->t.token) {
		895	case '=': fornum(ls, varname); break;
		896	case ',': forlist(ls, varname); break;
		897	default: luaK_error(ls, "`=' or `,' expected");
1225	}	898	}
1226	return i;	899	check_match(ls, TK_END, TK_FOR, line);
		900	leavebreak(fs, &bl);
1227	}	901	}
1228		902
1229	static void decinit (LexState ls, listdesc d) {	903
1230	/* decinit -> ['=' explist1] */	904	static void test_then_block (LexState ls, expdesc v) {
1231	if (ls->token == '=') {	905	/* test_then_block -> [IF \| ELSEIF] cond THEN block */
1232	next(ls);	906	next(ls); /* skip IF or ELSEIF */
1233	explist1(ls, d);	907	cond(ls, v);
		908	check(ls, TK_THEN);
		909	block(ls); /* `then' part */
		910	}
		911
		912
		913	static void ifstat (LexState *ls, int line) {
		914	/* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */
		915	FuncState *fs = ls->fs;
		916	expdesc v;
		917	int escapelist = NO_JUMP;
		918	test_then_block(ls, &v); /* IF cond THEN block */
		919	while (ls->t.token == TK_ELSEIF) {
		920	luaK_concat(fs, &escapelist, luaK_jump(fs));
		921	luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs));
		922	test_then_block(ls, &v); /* ELSEIF cond THEN block */
1234	}	923	}
1235	else {	924	if (ls->t.token == TK_ELSE) {
1236	d->n = 0;	925	luaK_concat(fs, &escapelist, luaK_jump(fs));
1237	d->pc = 0;	926	luaK_patchlist(fs, v.u.l.f, luaK_getlabel(fs));
		927	next(ls); /* skip ELSE */
		928	block(ls); /* `else' part */
1238	}	929	}
		930	else
		931	luaK_concat(fs, &escapelist, v.u.l.f);
		932	luaK_patchlist(fs, escapelist, luaK_getlabel(fs));
		933	check_match(ls, TK_END, TK_IF, line);
		934	}
		935
		936
		937	static void localstat (LexState *ls) {
		938	/* stat -> LOCAL NAME {',' NAME} ['=' explist1] */
		939	int nvars = 0;
		940	int nexps;
		941	do {
		942	next(ls); /* skip LOCAL or ',' */
		943	new_localvar(ls, str_checkname(ls), nvars++);
		944	} while (ls->t.token == ',');
		945	if (optional(ls, '='))
		946	nexps = explist1(ls);
		947	else
		948	nexps = 0;
		949	adjust_mult_assign(ls, nvars, nexps);
		950	adjustlocalvars(ls, nvars);
1239	}	951	}
1240		952
1241		953
1242	static int assignment (LexState ls, vardesc v, int nvars) {	954	static int funcname (LexState ls, expdesc v) {
1243	int left = 0;	955	/* funcname -> NAME [':' NAME \| '.' NAME] */
1244	checklimit(ls, nvars, MAXVARSLH, "variables in a multiple assignment");	956	int needself = 0;
1245	unloaddot(ls, v);	957	singlevar(ls, str_checkname(ls), v);
1246	if (ls->token == ',') { /* assignment -> ',' NAME assignment */	958	if (ls->t.token == ':' \|\| ls->t.token == '.') {
1247	vardesc nv;	959	needself = (ls->t.token == ':');
1248	next(ls);	960	next(ls);
1249	var_or_func(ls, &nv);	961	luaK_tostack(ls, v, 1);
1250	if (nv.k == VEXP)	962	luaK_kstr(ls, checkname(ls));
1251	luaX_error(ls, "syntax error");	963	v->k = VINDEXED;
1252	left = assignment(ls, &nv, nvars+1);
1253	}
1254	else { /* assignment -> '=' explist1 */
1255	listdesc d;
1256	check(ls, '=');
1257	explist1(ls, &d);
1258	adjust_mult_assign(ls, nvars, &d);
1259	}	964	}
1260	if (v->k != VINDEXED \|\| left+(nvars-1) == 0) {	965	return needself;
1261	/* global/local var or indexed var without values in between */	966	}
1262	storevar(ls, v);	967
		968
		969	static void funcstat (LexState *ls, int line) {
		970	/* funcstat -> FUNCTION funcname body */
		971	int needself;
		972	expdesc v;
		973	next(ls); /* skip FUNCTION */
		974	needself = funcname(ls, &v);
		975	body(ls, needself, line);
		976	luaK_storevar(ls, &v);
		977	}
		978
		979
		980	static void namestat (LexState *ls) {
		981	/* stat -> func \| ['%'] NAME assignment */
		982	FuncState *fs = ls->fs;
		983	expdesc v;
		984	var_or_func(ls, &v);
		985	if (v.k == VEXP) { /* stat -> func */
		986	check_condition(ls, luaK_lastisopen(fs), "syntax error"); /* an upvalue? */
		987	luaK_setcallreturns(fs, 0); /* call statement uses no results */
1263	}	988	}
1264	else { /* indexed var with values in between*/	989	else { /* stat -> ['%'] NAME assignment */
1265	code_oparg(ls, SETTABLE, left+(nvars-1), -1);	990	int left = assignment(ls, &v, 1);
1266	left += 2; /* table&index are not popped, because they aren't on top */	991	luaK_adjuststack(fs, left); /* remove eventual garbage left on stack */
1267	}	992	}
1268	return left;
1269	}	993	}
1270		994
1271		995
1272	static void constructor (LexState *ls) {	996	static void retstat (LexState *ls) {
1273	/* constructor -> '{' part [';' part] '}' */	997	/* stat -> RETURN explist */
1274	int line = ls->linenumber;	998	FuncState *fs = ls->fs;
1275	int pc = SaveWord(ls);	999	next(ls); /* skip RETURN */
1276	int nelems;	1000	if (!block_follow(ls->t.token))
1277	constdesc cd;	1001	explist1(ls); /* optional return values */
1278	deltastack(ls, 1);	1002	luaK_code1(fs, OP_RETURN, ls->fs->nactloc);
1279	check(ls, '{');	1003	fs->stacklevel = fs->nactloc; /* removes all temp values */
1280	part(ls, &cd);
1281	nelems = cd.n;
1282	if (ls->token == ';') {
1283	constdesc other_cd;
1284	next(ls);
1285	part(ls, &other_cd);
1286	if (cd.k == other_cd.k) /* repeated parts? */
1287	luaX_error(ls, "invalid constructor syntax");
1288	nelems += other_cd.n;
1289	}
1290	check_match(ls, '}', '{', line);
1291	fix_opcode(ls, pc, CREATEARRAY, nelems);
1292	}	1004	}
1293		1005
1294	static void part (LexState ls, constdesc cd) {
1295	switch (ls->token) {
1296	case ';': case '}': /* part -> empty */
1297	cd->n = 0;
1298	cd->k = ls->token;
1299	return;
1300		1006
1301	case NAME: {	1007	static void breakstat (LexState *ls) {
1302	vardesc v;	1008	/* stat -> BREAK [NAME] */
1303	exp0(ls, &v);	1009	FuncState *fs = ls->fs;
1304	if (ls->token == '=') {	1010	int currentlevel = fs->stacklevel;
1305	switch (v.k) {	1011	Breaklabel *bl = fs->bl;
1306	case VGLOBAL:	1012	if (!bl)
1307	code_constant(ls, v.info);	1013	luaK_error(ls, "no loop to break");
1308	break;	1014	next(ls); /* skip BREAK */
1309	case VLOCAL:	1015	luaK_adjuststack(fs, currentlevel - bl->stacklevel);
1310	code_string(ls, ls->fs->localvar[v.info]);	1016	luaK_concat(fs, &bl->breaklist, luaK_jump(fs));
1311	break;	1017	/* correct stack for compiler and symbolic execution */
1312	default:	1018	luaK_adjuststack(fs, bl->stacklevel - currentlevel);
1313	error_unexpected(ls);	1019	}
1314	}
1315	next(ls);
1316	exp1(ls);
1317	cd->n = recfields(ls);
1318	cd->k = 1; /* record */
1319	}
1320	else {
1321	lua_pushvar(ls, &v);
1322	cd->n = listfields(ls);
1323	cd->k = 0; /* list */
1324	}
1325	break;
1326	}
1327		1020
1328	case '[': /* part -> recfield recfields */
1329	recfield(ls);
1330	cd->n = recfields(ls);
1331	cd->k = 1; /* record */
1332	break;
1333		1021
1334	default: /* part -> exp1 listfields */	1022	static int stat (LexState *ls) {
1335	exp1(ls);	1023	int line = ls->linenumber; /* may be needed for error messages */
1336	cd->n = listfields(ls);	1024	switch (ls->t.token) {
1337	cd->k = 0; /* list */	1025	case TK_IF: { /* stat -> ifstat */
1338	break;	1026	ifstat(ls, line);
		1027	return 0;
		1028	}
		1029	case TK_WHILE: { /* stat -> whilestat */
		1030	whilestat(ls, line);
		1031	return 0;
		1032	}
		1033	case TK_DO: { /* stat -> DO block END */
		1034	next(ls); /* skip DO */
		1035	block(ls);
		1036	check_match(ls, TK_END, TK_DO, line);
		1037	return 0;
		1038	}
		1039	case TK_FOR: { /* stat -> forstat */
		1040	forstat(ls, line);
		1041	return 0;
		1042	}
		1043	case TK_REPEAT: { /* stat -> repeatstat */
		1044	repeatstat(ls, line);
		1045	return 0;
		1046	}
		1047	case TK_FUNCTION: { /* stat -> funcstat */
		1048	funcstat(ls, line);
		1049	return 0;
		1050	}
		1051	case TK_LOCAL: { /* stat -> localstat */
		1052	localstat(ls);
		1053	return 0;
		1054	}
		1055	case TK_NAME: case '%': { /* stat -> namestat */
		1056	namestat(ls);
		1057	return 0;
		1058	}
		1059	case TK_RETURN: { /* stat -> retstat */
		1060	retstat(ls);
		1061	return 1; /* must be last statement */
		1062	}
		1063	case TK_BREAK: { /* stat -> breakstat */
		1064	breakstat(ls);
		1065	return 1; /* must be last statement */
		1066	}
		1067	default: {
		1068	luaK_error(ls, "<statement> expected");
		1069	return 0; /* to avoid warnings */
		1070	}
1339	}	1071	}
1340	}	1072	}
1341		1073
1342	static int recfields (LexState *ls) {	1074
1343	/* recfields -> { ',' recfield } [','] */	1075	static void parlist (LexState *ls) {
1344	int n = 1; /* one has been read before */	1076	/* parlist -> [ param { ',' param } ] */
1345	while (ls->token == ',') {	1077	int nparams = 0;
1346	next(ls);	1078	int dots = 0;
1347	if (ls->token == ';' \|\| ls->token == '}')	1079	if (ls->t.token != ')') { /* is `parlist' not empty? */
1348	break;	1080	do {
1349	recfield(ls);	1081	switch (ls->t.token) {
1350	n++;	1082	case TK_DOTS: next(ls); dots = 1; break;
1351	if (n%RFIELDS_PER_FLUSH == 0)	1083	case TK_NAME: new_localvar(ls, str_checkname(ls), nparams++); break;
1352	flush_record(ls, RFIELDS_PER_FLUSH);	1084	default: luaK_error(ls, "<name> or `...' expected");
		1085	}
		1086	} while (!dots && optional(ls, ','));
1353	}	1087	}
1354	flush_record(ls, n%RFIELDS_PER_FLUSH);	1088	code_params(ls, nparams, dots);
1355	return n;
1356	}	1089	}
1357		1090
1358	static int listfields (LexState *ls) {	1091
1359	/* listfields -> { ',' exp1 } [','] */	1092	static void body (LexState *ls, int needself, int line) {
1360	int n = 1; /* one has been read before */	1093	/* body -> '(' parlist ')' chunk END */
1361	while (ls->token == ',') {	1094	FuncState new_fs;
1362	next(ls);	1095	open_func(ls, &new_fs);
1363	if (ls->token == ';' \|\| ls->token == '}')	1096	new_fs.f->lineDefined = line;
1364	break;	1097	check(ls, '(');
1365	exp1(ls);	1098	if (needself) {
1366	n++;	1099	new_localvarstr(ls, "self", 0);
1367	if (n%LFIELDS_PER_FLUSH == 0)	1100	adjustlocalvars(ls, 1);
1368	flush_list(ls, n/LFIELDS_PER_FLUSH - 1, LFIELDS_PER_FLUSH);
1369	}	1101	}
1370	flush_list(ls, n/LFIELDS_PER_FLUSH, n%LFIELDS_PER_FLUSH);	1102	parlist(ls);
1371	return n;	1103	check(ls, ')');
		1104	chunk(ls);
		1105	check_match(ls, TK_END, TK_FUNCTION, line);
		1106	close_func(ls);
		1107	pushclosure(ls, &new_fs);
1372	}	1108	}
1373		1109
1374	static void recfield (LexState *ls) {
1375	/* recfield -> (NAME \| '['exp1']') = exp1 */
1376	switch (ls->token) {
1377	case NAME:
1378	code_constant(ls, checkname(ls));
1379	break;
1380		1110
1381	case '[':	1111	/* }====================================================================== */
1382	next(ls);
1383	exp1(ls);
1384	check(ls, ']');
1385	break;
1386		1112
1387	default: luaX_error(ls, "NAME or `[' expected");	1113
		1114	static void chunk (LexState *ls) {
		1115	/* chunk -> { stat [';'] } */
		1116	int islast = 0;
		1117	while (!islast && !block_follow(ls->t.token)) {
		1118	islast = stat(ls);
		1119	optional(ls, ';');
		1120	LUA_ASSERT(ls->fs->stacklevel == ls->fs->nactloc,
		1121	"stack size != # local vars");
1388	}	1122	}
1389	check(ls, '=');
1390	exp1(ls);
1391	}	1123	}
1392		1124

src/lparser.h+45−5

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lparser.h,v 1.3 1999/02/25 19:13:56 roberto Exp $	2	** $Id: lparser.h,v 1.26 2000/10/09 13:47:46 roberto Exp $
3	** LL(1) Parser and code generator for Lua	3	** LL(1) Parser and code generator for Lua
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -11,10 +11,50 @@ · 5 unmodified lines
11	#include "lzio.h"	11	#include "lzio.h"
12		12
13		13
14	void luaY_codedebugline (int line);	14	/*
15	TProtoFunc luaY_parser (ZIO z);	15	** Expression descriptor
16	void luaY_error (char *s);	16	*/
17	void luaY_syntaxerror (char s, char token);	17
		18	typedef enum {
		19	VGLOBAL,
		20	VLOCAL,
		21	VINDEXED,
		22	VEXP
		23	} expkind;
		24
		25	typedef struct expdesc {
		26	expkind k;
		27	union {
		28	int index; /* VGLOBAL: `kstr' index of global name; VLOCAL: stack index */
		29	struct {
		30	int t; /* patch list of `exit when true' */
		31	int f; /* patch list of `exit when false' */
		32	} l;
		33	} u;
		34	} expdesc;
		35
		36
		37
		38	/* state needed to generate code for a given function */
		39	typedef struct FuncState {
		40	Proto f; / current function header */
		41	struct FuncState prev; / enclosing function */
		42	struct LexState ls; / lexical state */
		43	struct lua_State L; / copy of the Lua state */
		44	int pc; /* next position to code */
		45	int lasttarget; /* `pc' of last `jump target' */
		46	int jlt; /* list of jumps to `lasttarget' */
		47	short stacklevel; /* number of values on activation register */
		48	short nactloc; /* number of active local variables */
		49	short nupvalues; /* number of upvalues */
		50	int lastline; /* line where last `lineinfo' was generated */
		51	struct Breaklabel bl; / chain of breakable blocks */
		52	expdesc upvalues[MAXUPVALUES]; /* upvalues */
		53	int actloc[MAXLOCALS]; /* local-variable stack (indices to locvars) */
		54	} FuncState;
		55
		56
		57	Proto luaY_parser (lua_State L, ZIO *z);
18		58
19		59
20	#endif	60	#endif

src/lstate.c+94−59

 /*
-** $Id: lstate.c,v 1.12 1999/05/11 20:08:20 roberto Exp $
+** $Id: lstate.c,v 1.48 2000/10/30 16:29:59 roberto Exp $
 ** Global State
 ** See Copyright Notice in lua.h
 */
-#include "lbuiltin.h"
+#include <stdio.h>
+#include "lua.h"
 #include "ldo.h"
-#include "lfunc.h"
 #include "lgc.h"
 #include "llex.h"
 #include "lmem.h"
 #include "ltm.h"
-lua_State *lua_state = NULL;
+#ifdef LUA_DEBUG
+static lua_State *lua_state = NULL;
+void luaB_opentests (lua_State *L);
+#endif
-void lua_open (void)
+/*
-{
+** built-in implementation for ERRORMESSAGE. In a "correct" environment
-  if (lua_state) return;
+** ERRORMESSAGE should have an external definition, and so this function
-  lua_state = luaM_new(lua_State);
+** would not be used.
-  L->Cstack.base = 0;
+*/
-  L->Cstack.lua2C = 0;
+static int errormessage (lua_State *L) {
-  L->Cstack.num = 0;
+  const char *s = lua_tostring(L, 1);
-  L->errorJmp = NULL;
+  if (s == NULL) s = "(no message)";
+  fprintf(stderr, "error: %s\n", s);
+  return 0;
+}
+/*
+** open parts that may cause memory-allocation errors
+*/
+static void f_luaopen (lua_State *L, void *ud) {
+  int stacksize = *(int *)ud;
+  if (stacksize == 0)
+    stacksize = DEFAULT_STACK_SIZE;
+  else
+    stacksize += LUA_MINSTACK;
+  L->gt = luaH_new(L, 10);  /* table of globals */
+  luaD_init(L, stacksize);
+  luaS_init(L);
+  luaX_init(L);
+  luaT_init(L);
+  lua_newtable(L);
+  lua_ref(L, 1);  /* create registry */
+  lua_register(L, LUA_ERRORMESSAGE, errormessage);
+#ifdef LUA_DEBUG
+  luaB_opentests(L);
+  if (lua_state == NULL) lua_state = L;  /* keep first state to be opened */
+#endif
+  LUA_ASSERT(lua_gettop(L) == 0, "wrong API stack");
+}
+LUA_API lua_State *lua_open (int stacksize) {
+  lua_State *L = luaM_new(NULL, lua_State);
+  if (L == NULL) return NULL;  /* memory allocation error */
+  L->stack = NULL;
+  L->strt.size = L->udt.size = 0;
+  L->strt.nuse = L->udt.nuse = 0;
+  L->strt.hash = NULL;
+  L->udt.hash = NULL;
   L->Mbuffer = NULL;
-  L->Mbuffbase = 0;
   L->Mbuffsize = 0;
-  L->Mbuffnext = 0;
+  L->rootproto = NULL;
-  L->Cblocks = NULL;
+  L->rootcl = NULL;
-  L->numCblocks = 0;
+  L->roottable = NULL;
-  L->debug = 0;
+  L->TMtable = NULL;
-  L->callhook = NULL;
+  L->last_tag = -1;
-  L->linehook = NULL;
-  L->rootproto.next = NULL;
-  L->rootproto.marked = 0;
-  L->rootcl.next = NULL;
-  L->rootcl.marked = 0;
-  L->rootglobal.next = NULL;
-  L->rootglobal.marked = 0;
-  L->roottable.next = NULL;
-  L->roottable.marked = 0;
-  L->IMtable = NULL;
   L->refArray = NULL;
   L->refSize = 0;
-  L->GCthreshold = GARBAGE_BLOCK;
+  L->refFree = NONEXT;
-  L->nblocks = 0;
+  L->nblocks = sizeof(lua_State);
-  luaD_init();
+  L->GCthreshold = MAX_INT;  /* to avoid GC during pre-definitions */
-  luaS_init();
+  L->callhook = NULL;
-  luaX_init();
+  L->linehook = NULL;
-  luaT_init();
+  L->allowhooks = 1;
-  luaB_predefine();
+  L->errorJmp = NULL;
+  if (luaD_runprotected(L, f_luaopen, &stacksize) != 0) {
+    /* memory allocation error: free partial state */
+    lua_close(L);
+    return NULL;
+  }
+  L->GCthreshold = 2*L->nblocks;
+  return L;
 }
-void lua_close (void)
+LUA_API void lua_close (lua_State *L) {
-{
+  LUA_ASSERT(L != lua_state || lua_gettop(L) == 0, "garbage in C stack");
-  TaggedString *alludata = luaS_collectudata();
+  luaC_collect(L, 1);  /* collect all elements */
-  L->GCthreshold = MAX_INT;  /* to avoid GC during GC */
+  LUA_ASSERT(L->rootproto == NULL, "list should be empty");
-  luaC_hashcallIM((Hash *)L->roottable.next);  /* GC t.methods for tables */
+  LUA_ASSERT(L->rootcl == NULL, "list should be empty");
-  luaC_strcallIM(alludata);  /* GC tag methods for userdata */
+  LUA_ASSERT(L->roottable == NULL, "list should be empty");
-  luaD_gcIM(&luaO_nilobject);  /* GC tag method for nil (signal end of GC) */
+  luaS_freeall(L);
-  luaH_free((Hash *)L->roottable.next);
+  if (L->stack)
-  luaF_freeproto((TProtoFunc *)L->rootproto.next);
+    L->nblocks -= (L->stack_last - L->stack + 1)*sizeof(TObject);
-  luaF_freeclosure((Closure *)L->rootcl.next);
+  luaM_free(L, L->stack);
-  luaS_free(alludata);
+  L->nblocks -= (L->last_tag+1)*sizeof(struct TM);
-  luaS_freeall();
+  luaM_free(L, L->TMtable);
-  luaM_free(L->stack.stack);
+  L->nblocks -= (L->refSize)*sizeof(struct Ref);
-  luaM_free(L->IMtable);
+  luaM_free(L, L->refArray);
-  luaM_free(L->refArray);
+  L->nblocks -= (L->Mbuffsize)*sizeof(char);
-  luaM_free(L->Mbuffer);
+  luaM_free(L, L->Mbuffer);
-  luaM_free(L->Cblocks);
+  LUA_ASSERT(L->nblocks == sizeof(lua_State), "wrong count for nblocks");
-  luaM_free(L);
+  luaM_free(L, L);
-  L = NULL;
+  LUA_ASSERT(L != lua_state || memdebug_numblocks == 0, "memory leak!");
-#ifdef DEBUG
+  LUA_ASSERT(L != lua_state || memdebug_total == 0,"memory leak!");
-  printf("total de blocos: %ld\n", numblocks);
-  printf("total de memoria: %ld\n", totalmem);
-#endif
 }

src/lstate.h+35−52

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lstate.h,v 1.19 1999/05/11 20:08:20 roberto Exp $	2	** $Id: lstate.h,v 1.41 2000/10/05 13:00:17 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,88 +7,71 @@ · 1 unmodified line
7	#ifndef lstate_h	7	#ifndef lstate_h
8	#define lstate_h	8	#define lstate_h
9		9
10	#include <setjmp.h>
11
12	#include "lobject.h"	10	#include "lobject.h"
13	#include "lua.h"	11	#include "lua.h"
14	#include "luadebug.h"	12	#include "luadebug.h"
15		13
16		14
17	#define GARBAGE_BLOCK 150
18
19		15
20	typedef int StkId; /* index to stack elements */	16	typedef TObject StkId; / index to stack elements */
21		17
22		18
23	/*	19	/*
24	** "jmp_buf" may be an array, so it is better to make sure it has an	20	** marks for Reference array
25	** address (and not that it is an address...)
26	*/	21	*/
27	struct lua_longjmp {	22	#define NONEXT -1 /* to end the free list */
28	jmp_buf b;	23	#define HOLD -2
29	};	24	#define COLLECTED -3
		25	#define LOCK -4
30		26
31		27
32	struct Stack {	28	struct Ref {
33	TObject *top;	29	TObject o;
34	TObject *stack;	30	int st; /* can be LOCK, HOLD, COLLECTED, or next (for free list) */
35	TObject *last;
36	};	31	};
37		32
38	struct C_Lua_Stack {	33
39	StkId base; /* when Lua calls C or C calls Lua, points to */	34	struct lua_longjmp; /* defined in ldo.c */
40	/* the first slot after the last parameter. */	35	struct TM; /* defined in ltm.h */
41	StkId lua2C; /* points to first element of "array" lua2C */
42	int num; /* size of "array" lua2C */
43	};
44		36
45		37
46	typedef struct stringtable {	38	typedef struct stringtable {
47	int size;	39	int size;
48	int nuse; /* number of elements (including EMPTYs) */	40	lint32 nuse; /* number of elements */
49	TaggedString **hash;	41	TString **hash;
50	} stringtable;	42	} stringtable;
51		43
52		44
53	enum Status {LOCK, HOLD, FREE, COLLECTED};
54
55	struct ref {
56	TObject o;
57	enum Status status;
58	};
59
60		45
61	struct lua_State {	46	struct lua_State {
62	/* thread-specific state */	47	/* thread-specific state */
63	struct Stack stack; /* Lua stack */	48	StkId top; /* first free slot in the stack */
64	struct C_Lua_Stack Cstack; /* C2lua struct */	49	StkId stack; /* stack base */
		50	StkId stack_last; /* last free slot in the stack */
		51	int stacksize;
		52	StkId Cbase; /* base for current C function */
65	struct lua_longjmp errorJmp; / current error recover point */	53	struct lua_longjmp errorJmp; / current error recover point */
66	char Mbuffer; / global buffer */	54	char Mbuffer; / global buffer */
67	int Mbuffbase; /* current first position of Mbuffer */	55	size_t Mbuffsize; /* size of Mbuffer */
68	int Mbuffsize; /* size of Mbuffer */
69	int Mbuffnext; /* next position to fill in Mbuffer */
70	struct C_Lua_Stack *Cblocks;
71	int numCblocks; /* number of nested Cblocks */
72	int debug;
73	lua_CHFunction callhook;
74	lua_LHFunction linehook;
75	/* global state */	56	/* global state */
76	GCnode rootproto; /* list of all prototypes */	57	Proto rootproto; / list of all prototypes */
77	GCnode rootcl; /* list of all closures */	58	Closure rootcl; / list of all closures */
78	GCnode roottable; /* list of all tables */	59	Hash roottable; / list of all tables */
79	GCnode rootglobal; /* list of strings with global values */	60	stringtable strt; /* hash table for strings */
80	stringtable string_root; / array of hash tables for strings and udata */	61	stringtable udt; /* hash table for udata */
81	struct IM IMtable; / table for tag methods */	62	Hash gt; / table for globals */
82	int last_tag; /* last used tag in IMtable */	63	struct TM TMtable; / table for tag methods */
83	struct ref refArray; / locked objects */	64	int last_tag; /* last used tag in TMtable */
		65	struct Ref refArray; / locked objects */
84	int refSize; /* size of refArray */	66	int refSize; /* size of refArray */
		67	int refFree; /* list of free positions in refArray */
85	unsigned long GCthreshold;	68	unsigned long GCthreshold;
86	unsigned long nblocks; /* number of 'blocks' currently allocated */	69	unsigned long nblocks; /* number of `bytes' currently allocated */
		70	lua_Hook callhook;
		71	lua_Hook linehook;
		72	int allowhooks;
87	};	73	};
88		74
89		75
90	#define L lua_state
91
92
93	#endif	76	#endif
94		77

src/lstring.c+96−239

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lstring.c,v 1.19 1999/02/26 15:49:53 roberto Exp $	2	** $Id: lstring.c,v 1.45 2000/10/30 17:49:19 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,292 +7,149 @@ · 1 unmodified line
7		7
8	#include <string.h>	8	#include <string.h>
9		9
		10	#include "lua.h"
		11
10	#include "lmem.h"	12	#include "lmem.h"
11	#include "lobject.h"	13	#include "lobject.h"
12	#include "lstate.h"	14	#include "lstate.h"
13	#include "lstring.h"	15	#include "lstring.h"
14	#include "lua.h"
15
16
17	#define NUM_HASHSTR 31
18	#define NUM_HASHUDATA 31
19	#define NUM_HASHS (NUM_HASHSTR+NUM_HASHUDATA)
20		16
21		17
22	#define gcsizestring(l) (1+(l/64)) /* "weight" for a string with length 'l' */	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	};
23		25
24		26
25		27
26	static TaggedString EMPTY = {{NULL, 2}, 0L, 0,	28	void luaS_init (lua_State *L) {
27	{{{LUA_T_NIL, {NULL}}, 0L}}, {0}};	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	}
28		36
29		37
30	void luaS_init (void) {	38	void luaS_freeall (lua_State *L) {
31	int i;	39	LUA_ASSERT(L->strt.nuse==0, "non-empty string table");
32	L->string_root = luaM_newvector(NUM_HASHS, stringtable);	40	L->nblocks -= (L->strt.size + L->udt.size)sizeof(TString );
33	for (i=0; i<NUM_HASHS; i++) {	41	luaM_free(L, L->strt.hash);
34	L->string_root[i].size = 0;	42	LUA_ASSERT(L->udt.nuse==0, "non-empty udata table");
35	L->string_root[i].nuse = 0;	43	luaM_free(L, L->udt.hash);
36	L->string_root[i].hash = NULL;
37	}
38	}	44	}
39		45
40		46
41	static unsigned long hash_s (char *s, long l) {	47	static unsigned long hash_s (const char *s, size_t l) {
42	unsigned long h = 0; /* seed */	48	unsigned long h = l; /* seed */
43	while (l--)	49	size_t step = (l>>5)\|1; /* if string is too long, don't hash all its chars */
44	h = h ^ ((h<<5)+(h>>2)+(unsigned char)*(s++));	50	for (; l>=step; l-=step)
		51	h = h ^ ((h<<5)+(h>>2)+(unsigned char)*(s++));
45	return h;	52	return h;
46	}	53	}
47		54
48	static int newsize (stringtable *tb) {
49	int size = tb->size;
50	int realuse = 0;
51	int i;
52	/* count how many entries are really in use */
53	for (i=0; i<size; i++)
54	if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY)
55	realuse++;
56	return luaO_redimension((realuse+1)2); / +1 is the new element */
57	}
58		55
59		56	void luaS_resize (lua_State L, stringtable tb, int newsize) {
60	static void grow (stringtable *tb) {	57	TString *newhash = luaM_newvector(L, newsize, TString );
61	int ns = newsize(tb);
62	TaggedString *newhash = luaM_newvector(ns, TaggedString );
63	int i;	58	int i;
64	for (i=0; i<ns; i++)	59	for (i=0; i<newsize; i++) newhash[i] = NULL;
65	newhash[i] = NULL;
66	/* rehash */	60	/* rehash */
67	tb->nuse = 0;
68	for (i=0; i<tb->size; i++) {	61	for (i=0; i<tb->size; i++) {
69	if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) {	62	TString *p = tb->hash[i];
70	unsigned long h = tb->hash[i]->hash;	63	while (p) { /* for each node in the list */
71	int h1 = h%ns;	64	TString next = p->nexthash; / save next */
72	while (newhash[h1]) {	65	unsigned long h = (tb == &L->strt) ? p->u.s.hash : IntPoint(p->u.d.value);
73	h1 += (h&(ns-2)) + 1; /* double hashing */	66	int h1 = h&(newsize-1); /* new position */
74	if (h1 >= ns) h1 -= ns;	67	LUA_ASSERT(h%newsize == (h&(newsize-1)),
75	}	68	"a&(x-1) == a%x, for x power of 2");
76	newhash[h1] = tb->hash[i];	69	p->nexthash = newhash[h1]; /* chain it in new position */
77	tb->nuse++;	70	newhash[h1] = p;
		71	p = next;
78	}	72	}
79	}	73	}
80	luaM_free(tb->hash);	74	luaM_free(L, tb->hash);
81	tb->size = ns;	75	L->nblocks += (newsize - tb->size)sizeof(TString );
		76	tb->size = newsize;
82	tb->hash = newhash;	77	tb->hash = newhash;
83	}	78	}
84		79
85		80
86	static TaggedString newone_s (char str, long l, unsigned long h) {	81	static void newentry (lua_State L, stringtable tb, TString *ts, int h) {
87	TaggedString ts = (TaggedString )luaM_malloc(sizeof(TaggedString)+l);	82	ts->nexthash = tb->hash[h]; /* chain new entry */
88	memcpy(ts->str, str, l);	83	tb->hash[h] = ts;
89	ts->str[l] = 0; /* ending 0 */	84	tb->nuse++;
90	ts->u.s.globalval.ttype = LUA_T_NIL; /* initialize global value */	85	if (tb->nuse > (lint32)tb->size && tb->size < MAX_INT/2) /* too crowded? */
91	ts->u.s.len = l;	86	luaS_resize(L, tb, tb->size*2);
92	ts->constindex = 0;
93	L->nblocks += gcsizestring(l);
94	ts->head.marked = 0;
95	ts->head.next = (GCnode )ts; / signal it is in no list */
96	ts->hash = h;
97	return ts;
98	}	87	}
99		88
100	static TaggedString newone_u (char buff, int tag, unsigned long h) {
101	TaggedString *ts = luaM_new(TaggedString);
102	ts->u.d.v = buff;
103	ts->u.d.tag = (tag == LUA_ANYTAG) ? 0 : tag;
104	ts->constindex = -1; /* tag -> this is a userdata */
105	L->nblocks++;
106	ts->head.marked = 0;
107	ts->head.next = (GCnode )ts; / signal it is in no list */
108	ts->hash = h;
109	return ts;
110	}
111		89
112	static TaggedString insert_s (char str, long l, stringtable *tb) {	90
113	TaggedString *ts;	91	TString luaS_newlstr (lua_State L, const char *str, size_t l) {
114	unsigned long h = hash_s(str, l);	92	unsigned long h = hash_s(str, l);
115	int size = tb->size;	93	int h1 = h & (L->strt.size-1);
116	int j = -1;	94	TString *ts;
117	int h1;	95	for (ts = L->strt.hash[h1]; ts; ts = ts->nexthash) {
118	if ((long)tb->nuse3 >= (long)size2) {	96	if (ts->len == l && (memcmp(str, ts->str, l) == 0))
119	grow(tb);
120	size = tb->size;
121	}
122	h1 = h%size;
123	while ((ts = tb->hash[h1]) != NULL) {
124	if (ts == &EMPTY)
125	j = h1;
126	else if (ts->u.s.len == l && (memcmp(str, ts->str, l) == 0))
127	return ts;	97	return ts;
128	h1 += (h&(size-2)) + 1; /* double hashing */
129	if (h1 >= size) h1 -= size;
130	}	98	}
131	/* not found */	99	/* not found */
132	if (j != -1) /* is there an EMPTY space? */	100	ts = (TString *)luaM_malloc(L, sizestring(l));
133	h1 = j;	101	ts->marked = 0;
134	else	102	ts->nexthash = NULL;
135	tb->nuse++;	103	ts->len = l;
136	ts = tb->hash[h1] = newone_s(str, l, h);	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 */
137	return ts;	110	return ts;
138	}	111	}
139		112
140		113
141	static TaggedString insert_u (void buff, int tag, stringtable *tb) {	114	TString luaS_newudata (lua_State L, size_t s, void *udata) {
142	TaggedString *ts;	115	union L_UTString uts = (union L_UTString )luaM_malloc(L,
143	unsigned long h = (unsigned long)buff;	116	(lint32)sizeof(union L_UTString)+s);
144	int size = tb->size;	117	TString *ts = &uts->ts;
145	int j = -1;	118	ts->marked = 0;
146	int h1;	119	ts->nexthash = NULL;
147	if ((long)tb->nuse3 >= (long)size2) {	120	ts->len = s;
148	grow(tb);	121	ts->u.d.tag = 0;
149	size = tb->size;	122	ts->u.d.value = (udata == NULL) ? uts+1 : udata;
150	}	123	L->nblocks += sizestring(s);
151	h1 = h%size;	124	/* insert it on table */
152	while ((ts = tb->hash[h1]) != NULL) {	125	newentry(L, &L->udt, ts, IntPoint(ts->u.d.value) & (L->udt.size-1));
153	if (ts == &EMPTY)
154	j = h1;
155	else if ((tag == ts->u.d.tag \|\| tag == LUA_ANYTAG) && buff == ts->u.d.v)
156	return ts;
157	h1 += (h&(size-2)) + 1; /* double hashing */
158	if (h1 >= size) h1 -= size;
159	}
160	/* not found */
161	if (j != -1) /* is there an EMPTY space? */
162	h1 = j;
163	else
164	tb->nuse++;
165	ts = tb->hash[h1] = newone_u(buff, tag, h);
166	return ts;	126	return ts;
167	}	127	}
168		128
169		129
170	TaggedString luaS_createudata (void udata, int tag) {	130	TString luaS_createudata (lua_State L, void *udata, int tag) {
171	int t = ((unsigned)udata%NUM_HASHUDATA)+NUM_HASHSTR;	131	int h1 = IntPoint(udata) & (L->udt.size-1);
172	return insert_u(udata, tag, &L->string_root[t]);	132	TString *ts;
173	}	133	for (ts = L->udt.hash[h1]; ts; ts = ts->nexthash) {
174		134	if (udata == ts->u.d.value && (tag == ts->u.d.tag \|\| tag == LUA_ANYTAG))
175	TaggedString luaS_newlstr (char str, long l) {	135	return ts;
176	int t = (l==0) ? 0 : ((int)((unsigned char)str[0]*l))%NUM_HASHSTR;
177	return insert_s(str, l, &L->string_root[t]);
178	}
179
180	TaggedString luaS_new (char str) {
181	return luaS_newlstr(str, strlen(str));
182	}
183
184	TaggedString luaS_newfixedstring (char str) {
185	TaggedString *ts = luaS_new(str);
186	if (ts->head.marked == 0)
187	ts->head.marked = 2; /* avoid GC */
188	return ts;
189	}
190
191
192	void luaS_free (TaggedString *l) {
193	while (l) {
194	TaggedString next = (TaggedString )l->head.next;
195	L->nblocks -= (l->constindex == -1) ? 1 : gcsizestring(l->u.s.len);
196	luaM_free(l);
197	l = next;
198	}
199	}
200
201
202	/*
203	** Garbage collection functions.
204	*/
205
206	static void remove_from_list (GCnode *l) {
207	while (l) {
208	GCnode *next = l->next;
209	while (next && !next->marked)
210	next = l->next = next->next;
211	l = next;
212	}
213	}
214
215
216	TaggedString *luaS_collector (void) {
217	TaggedString *frees = NULL;
218	int i;
219	remove_from_list(&(L->rootglobal));
220	for (i=0; i<NUM_HASHS; i++) {
221	stringtable *tb = &L->string_root[i];
222	int j;
223	for (j=0; j<tb->size; j++) {
224	TaggedString *t = tb->hash[j];
225	if (t == NULL) continue;
226	if (t->head.marked == 1)
227	t->head.marked = 0;
228	else if (!t->head.marked) {
229	t->head.next = (GCnode *)frees;
230	frees = t;
231	tb->hash[j] = &EMPTY;
232	}
233	}
234	}
235	return frees;
236	}
237
238
239	TaggedString *luaS_collectudata (void) {
240	TaggedString *frees = NULL;
241	int i;
242	L->rootglobal.next = NULL; /* empty list of globals */
243	for (i=NUM_HASHSTR; i<NUM_HASHS; i++) {
244	stringtable *tb = &L->string_root[i];
245	int j;
246	for (j=0; j<tb->size; j++) {
247	TaggedString *t = tb->hash[j];
248	if (t == NULL \|\| t == &EMPTY)
249	continue;
250	LUA_ASSERT(t->constindex == -1, "must be userdata");
251	t->head.next = (GCnode *)frees;
252	frees = t;
253	tb->hash[j] = &EMPTY;
254	}
255	}
256	return frees;
257	}
258
259
260	void luaS_freeall (void) {
261	int i;
262	for (i=0; i<NUM_HASHS; i++) {
263	stringtable *tb = &L->string_root[i];
264	int j;
265	for (j=0; j<tb->size; j++) {
266	TaggedString *t = tb->hash[j];
267	if (t == &EMPTY) continue;
268	luaM_free(t);
269	}
270	luaM_free(tb->hash);
271	}
272	luaM_free(L->string_root);
273	}
274
275
276	void luaS_rawsetglobal (TaggedString ts, TObject newval) {
277	ts->u.s.globalval = *newval;
278	if (ts->head.next == (GCnode )ts) { / is not in list? */
279	ts->head.next = L->rootglobal.next;
280	L->rootglobal.next = (GCnode *)ts;
281	}	136	}
		137	/* not found */
		138	ts = luaS_newudata(L, 0, udata);
		139	if (tag != LUA_ANYTAG)
		140	ts->u.d.tag = tag;
		141	return ts;
282	}	142	}
283		143
284		144
285	char luaS_travsymbol (int (fn)(TObject *)) {	145	TString luaS_new (lua_State L, const char *str) {
286	TaggedString *g;	146	return luaS_newlstr(L, str, strlen(str));
287	for (g=(TaggedString )L->rootglobal.next; g; g=(TaggedString )g->head.next)
288	if (fn(&g->u.s.globalval))
289	return g->str;
290	return NULL;
291	}	147	}
292		148
293		149
294	int luaS_globaldefined (char *name) {	150	TString luaS_newfixed (lua_State L, const char *str) {
295	TaggedString *ts = luaS_new(name);	151	TString *ts = luaS_new(L, str);
296	return ts->u.s.globalval.ttype != LUA_T_NIL;	152	if (ts->marked == 0) ts->marked = FIXMARK; /* avoid GC */
		153	return ts;
297	}	154	}
298		155

src/lstring.h+22−13

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lstring.h,v 1.7 1998/03/06 16:54:42 roberto Exp $	2	** $Id: lstring.h,v 1.24 2000/10/30 17:49:19 roberto Exp $
3	** String table (keep all strings handled by Lua)	3	** String table (keep all strings handled by Lua)
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -9,20 +9,29 @@ · 3 unmodified lines
9		9
10		10
11	#include "lobject.h"	11	#include "lobject.h"
		12	#include "lstate.h"
12		13
13		14
14	void luaS_init (void);	15	/*
15	TaggedString luaS_createudata (void udata, int tag);	16	** any TString with mark>=FIXMARK is never collected.
16	TaggedString *luaS_collector (void);	17	** Marks>=RESERVEDMARK are used to identify reserved words.
17	void luaS_free (TaggedString *l);	18	*/
18	TaggedString luaS_newlstr (char str, long l);	19	#define FIXMARK 2
19	TaggedString luaS_new (char str);	20	#define RESERVEDMARK 3
20	TaggedString luaS_newfixedstring (char str);	21
21	void luaS_rawsetglobal (TaggedString ts, TObject newval);	22
22	char luaS_travsymbol (int (fn)(TObject *));	23	#define sizestring(l) ((long)sizeof(TString) + \
23	int luaS_globaldefined (char *name);	24	((long)(l+1)-TSPACK)*(long)sizeof(char))
24	TaggedString *luaS_collectudata (void);	25
25	void luaS_freeall (void);	26
		27	void luaS_init (lua_State *L);
		28	void luaS_resize (lua_State L, stringtable tb, int newsize);
		29	TString luaS_newudata (lua_State L, size_t s, void *udata);
		30	TString luaS_createudata (lua_State L, void *udata, int tag);
		31	void luaS_freeall (lua_State *L);
		32	TString luaS_newlstr (lua_State L, const char *str, size_t l);
		33	TString luaS_new (lua_State L, const char *str);
		34	TString luaS_newfixed (lua_State L, const char *str);
26		35
27		36
28	#endif	37	#endif

src/ltable.c+231−105

@@ -1,177 +1,303 @@
1	/*	1	/*
2	** $Id: ltable.c,v 1.22 1999/05/21 19:41:49 roberto Exp $	2	** $Id: ltable.c,v 1.58 2000/10/26 12:47:05 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	#include <stdlib.h>
8		7
9	#include "lauxlib.h"	8	/*
		9	** Implementation of tables (aka arrays, objects, or hash tables);
		10	** 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
		12	** 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.
		14	** In other words, there are collisions only when two elements have the
		15	** same main position (i.e. the same hash values for that table size).
		16	** Because of that, the load factor of these tables can be 100% without
		17	** performance penalties.
		18	*/
		19
		20
		21	#include "lua.h"
		22
10	#include "lmem.h"	23	#include "lmem.h"
11	#include "lobject.h"	24	#include "lobject.h"
12	#include "lstate.h"	25	#include "lstate.h"
		26	#include "lstring.h"
13	#include "ltable.h"	27	#include "ltable.h"
14	#include "lua.h"
15		28
16		29
17	#define gcsize(n) (1+(n/16))	30	#define gcsize(L, n) (sizeof(Hash)+(n)*sizeof(Node))
18		31
19	#define nuse(t) ((t)->nuse)
20	#define nodevector(t) ((t)->node)
21		32
22		33
23	#define TagDefault LUA_T_ARRAY;	34	#define TagDefault LUA_TTABLE
24		35
25		36
26		37
27	static long int hashindex (TObject *ref) {	38	/*
28	long int h;	39	** returns the `main' position of an element in a table (that is, the index
29	switch (ttype(ref)) {	40	** of its hash value)
30	case LUA_T_NUMBER:	41	*/
31	h = (long int)nvalue(ref);	42	Node luaH_mainposition (const Hash t, const TObject *key) {
32	break;	43	unsigned long h;
33	case LUA_T_STRING: case LUA_T_USERDATA:	44	switch (ttype(key)) {
34	h = (IntPoint)tsvalue(ref);	45	case LUA_TNUMBER:
		46	h = (unsigned long)(long)nvalue(key);
35	break;	47	break;
36	case LUA_T_ARRAY:	48	case LUA_TSTRING:
37	h = (IntPoint)avalue(ref);	49	h = tsvalue(key)->u.s.hash;
38	break;	50	break;
39	case LUA_T_PROTO:	51	case LUA_TUSERDATA:
40	h = (IntPoint)tfvalue(ref);	52	h = IntPoint(tsvalue(key));
41	break;	53	break;
42	case LUA_T_CPROTO:	54	case LUA_TTABLE:
43	h = (IntPoint)fvalue(ref);	55	h = IntPoint(hvalue(key));
44	break;	56	break;
45	case LUA_T_CLOSURE:	57	case LUA_TFUNCTION:
46	h = (IntPoint)clvalue(ref);	58	h = IntPoint(clvalue(key));
47	break;	59	break;
48	default:	60	default:
49	lua_error("unexpected type to index table");	61	return NULL; /* invalid key */
50	h = 0; /* to avoid warnings */
51	}	62	}
52	return (h >= 0 ? h : -(h+1));	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	}
		67
		68
		69	static const TObject luaH_getany (lua_State L, const Hash *t,
		70	const TObject *key) {
		71	Node *n = luaH_mainposition(t, key);
		72	if (!n)
		73	lua_error(L, "table index is nil");
		74	else do {
		75	if (luaO_equalObj(key, &n->key))
		76	return &n->val;
		77	n = n->next;
		78	} while (n);
		79	return &luaO_nilobject; /* key not found */
		80	}
		81
		82
		83	/* specialized version for numbers */
		84	const TObject luaH_getnum (const Hash t, Number key) {
		85	Node *n = &t->node[(unsigned long)(long)key&(t->size-1)];
		86	do {
		87	if (ttype(&n->key) == LUA_TNUMBER && nvalue(&n->key) == key)
		88	return &n->val;
		89	n = n->next;
		90	} while (n);
		91	return &luaO_nilobject; /* key not found */
53	}	92	}
54		93
55		94
56	Node luaH_present (Hash t, TObject *key) {	95	/* specialized version for strings */
57	int tsize = nhash(t);	96	const TObject luaH_getstr (const Hash t, TString *key) {
58	long int h = hashindex(key);	97	Node *n = &t->node[key->u.s.hash&(t->size-1)];
59	int h1 = h%tsize;	98	do {
60	Node *n = node(t, h1);	99	if (ttype(&n->key) == LUA_TSTRING && tsvalue(&n->key) == key)
61	/* keep looking until an entry with "ref" equal to key or nil */	100	return &n->val;
62	while ((ttype(ref(n)) == ttype(key)) ? !luaO_equalval(key, ref(n))	101	n = n->next;
63	: ttype(ref(n)) != LUA_T_NIL) {	102	} while (n);
64	h1 += (h&(tsize-2)) + 1; /* double hashing */	103	return &luaO_nilobject; /* key not found */
65	if (h1 >= tsize) h1 -= tsize;	104	}
66	n = node(t, h1);	105
		106
		107	const TObject luaH_get (lua_State L, const Hash t, const TObject key) {
		108	switch (ttype(key)) {
		109	case LUA_TNUMBER: return luaH_getnum(t, nvalue(key));
		110	case LUA_TSTRING: return luaH_getstr(t, tsvalue(key));
		111	default: return luaH_getany(L, t, key);
67	}	112	}
68	return n;
69	}	113	}
70		114
71		115
72	void luaH_free (Hash *frees) {	116	Node luaH_next (lua_State L, const Hash t, const TObject key) {
73	while (frees) {	117	int i;
74	Hash next = (Hash )frees->head.next;	118	if (ttype(key) == LUA_TNIL)
75	L->nblocks -= gcsize(frees->nhash);	119	i = 0; /* first iteration */
76	luaM_free(nodevector(frees));	120	else {
77	luaM_free(frees);	121	const TObject *v = luaH_get(L, t, key);
78	frees = next;	122	if (v == &luaO_nilobject)
		123	lua_error(L, "invalid key for `next'");
		124	i = (int)(((const char *)v -
		125	(const char *)(&t->node[0].val)) / sizeof(Node)) + 1;
		126	}
		127	for (; i<t->size; i++) {
		128	Node *n = node(t, i);
		129	if (ttype(val(n)) != LUA_TNIL)
		130	return n;
79	}	131	}
		132	return NULL; /* no more elements */
80	}	133	}
81		134
82		135
83	static Node *hashnodecreate (int nhash) {	136	/*
84	Node *v = luaM_newvector(nhash, Node);	137	** try to remove a key without value from a table. To avoid problems with
		138	** hash, change `key' for a number with the same hash.
		139	*/
		140	void luaH_remove (Hash t, TObject key) {
		141	if (ttype(key) == LUA_TNUMBER \|\|
		142	(ttype(key) == LUA_TSTRING && tsvalue(key)->len <= 30))
		143	return; /* do not remove numbers nor small strings */
		144	else {
		145	/* try to find a number `n' with the same hash as `key' */
		146	Node *mp = luaH_mainposition(t, key);
		147	int n = mp - &t->node[0];
		148	/* make sure `n' is not in `t' */
		149	while (luaH_getnum(t, n) != &luaO_nilobject) {
		150	if (n >= MAX_INT - t->size)
		151	return; /* give up; (to avoid overflow) */
		152	n += t->size;
		153	}
		154	ttype(key) = LUA_TNUMBER;
		155	nvalue(key) = n;
		156	LUA_ASSERT(luaH_mainposition(t, key) == mp, "cannot change hash");
		157	}
		158	}
		159
		160
		161	static void setnodevector (lua_State L, Hash t, lint32 size) {
85	int i;	162	int i;
86	for (i=0; i<nhash; i++)	163	if (size > MAX_INT)
87	ttype(ref(&v[i])) = ttype(val(&v[i])) = LUA_T_NIL;	164	lua_error(L, "table overflow");
88	return v;	165	t->node = luaM_newvector(L, size, Node);
		166	for (i=0; i<(int)size; i++) {
		167	ttype(&t->node[i].key) = ttype(&t->node[i].val) = LUA_TNIL;
		168	t->node[i].next = NULL;
		169	}
		170	L->nblocks += gcsize(L, size) - gcsize(L, t->size);
		171	t->size = size;
		172	t->firstfree = &t->node[size-1]; /* first free position to be used */
89	}	173	}
90		174
91		175
92	Hash *luaH_new (int nhash) {	176	Hash luaH_new (lua_State L, int size) {
93	Hash *t = luaM_new(Hash);	177	Hash *t = luaM_new(L, Hash);
94	nhash = luaO_redimension(nhash*3/2);
95	nodevector(t) = hashnodecreate(nhash);
96	nhash(t) = nhash;
97	nuse(t) = 0;
98	t->htag = TagDefault;	178	t->htag = TagDefault;
99	luaO_insertlist(&(L->roottable), (GCnode *)t);	179	t->next = L->roottable;
100	L->nblocks += gcsize(nhash);	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));
101	return t;	186	return t;
102	}	187	}
103		188
104		189
105	static int newsize (Hash *t) {	190	void luaH_free (lua_State L, Hash t) {
		191	L->nblocks -= gcsize(L, t->size);
		192	luaM_free(L, t->node);
		193	luaM_free(L, t);
		194	}
		195
		196
		197	static int numuse (const Hash *t) {
106	Node *v = t->node;	198	Node *v = t->node;
107	int size = nhash(t);	199	int size = t->size;
108	int realuse = 0;	200	int realuse = 0;
109	int i;	201	int i;
110	for (i=0; i<size; i++) {	202	for (i=0; i<size; i++) {
111	if (ttype(val(v+i)) != LUA_T_NIL)	203	if (ttype(&v[i].val) != LUA_TNIL)
112	realuse++;	204	realuse++;
113	}	205	}
114	return luaO_redimension((realuse+1)2); / +1 is the new element */	206	return realuse;
115	}	207	}
116		208
117		209
118	static void rehash (Hash *t) {	210	static void rehash (lua_State L, Hash t) {
119	int nold = nhash(t);	211	int oldsize = t->size;
120	Node *vold = nodevector(t);	212	Node *nold = t->node;
121	int nnew = newsize(t);	213	int nelems = numuse(t);
122	int i;	214	int i;
123	nodevector(t) = hashnodecreate(nnew);	215	LUA_ASSERT(nelems<=oldsize, "wrong count");
124	nhash(t) = nnew;	216	if (nelems >= oldsize-oldsize/4) /* using more than 3/4? */
125	nuse(t) = 0;	217	setnodevector(L, t, (lint32)oldsize*2);
126	for (i=0; i<nold; i++) {	218	else if (nelems <= oldsize/4 && /* less than 1/4? */
127	Node *n = vold+i;	219	oldsize > MINPOWER2)
128	if (ttype(val(n)) != LUA_T_NIL) {	220	setnodevector(L, t, oldsize/2);
129	luaH_present(t, ref(n)) = n; /* copy old node to new hash */	221	else
130	nuse(t)++;	222	setnodevector(L, t, oldsize);
131	}	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;
132	}	227	}
133	L->nblocks += gcsize(nnew)-gcsize(nold);	228	luaM_free(L, nold); /* free old array */
134	luaM_free(vold);
135	}	229	}
136		230
137		231
138	void luaH_set (Hash t, TObject ref, TObject *val) {	232	/*
139	Node *n = luaH_present(t, ref);	233	** inserts a key into a hash table; first, check whether key is
140	if (ttype(ref(n)) != LUA_T_NIL)	234	** already present; if not, check whether key's main position is free;
141	val(n) = val;	235	** if not, check whether colliding node is in its main position or not;
142	else {	236	** if it is not, move colliding node to an empty place and put new key
143	TObject buff;	237	** in its main position; otherwise (colliding node is in its main position),
144	buff = val; / rehash may invalidate this address */	238	** new key goes to an empty position.
145	if ((long)nuse(t)3L > (long)nhash(t)2L) {	239	*/
146	rehash(t);	240	TObject luaH_set (lua_State L, Hash t, const TObject key) {
147	n = luaH_present(t, ref);	241	Node *mp = luaH_mainposition(t, key);
		242	Node *n = mp;
		243	if (!mp)
		244	lua_error(L, "table index is nil");
		245	do { /* check whether `key' is somewhere in the chain */
		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 */
		258	while (othern->next != mp) othern = othern->next; /* find previous */
		259	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) */
		261	mp->next = NULL; /* now `mp' is free */
148	}	262	}
149	nuse(t)++;	263	else { /* colliding node is in its own main position */
150	ref(n) = ref;	264	/* new node will go into free position */
151	*val(n) = buff;	265	n->next = mp->next; /* chain new position */
		266	mp->next = n;
		267	mp = n;
		268	}
		269	}
		270	mp->key = *key;
		271	for (;;) { /* correct `firstfree' */
		272	if (ttype(&t->firstfree->key) == LUA_TNIL)
		273	return &mp->val; /* OK; table still has a free place */
		274	else if (t->firstfree == t->node) break; /* cannot decrement from here */
		275	else (t->firstfree)--;
152	}	276	}
		277	rehash(L, t); /* no more free places */
		278	return luaH_set(L, t, key); /* `rehash' invalidates this insertion */
153	}	279	}
154		280
155		281
156	int luaH_pos (Hash t, TObject r) {	282	TObject luaH_setint (lua_State L, Hash *t, int key) {
157	Node *n = luaH_present(t, r);	283	TObject index;
158	luaL_arg_check(ttype(val(n)) != LUA_T_NIL, 2, "key not found");	284	ttype(&index) = LUA_TNUMBER;
159	return n-(t->node);	285	nvalue(&index) = key;
		286	return luaH_set(L, t, &index);
160	}	287	}
161		288
162		289
163	void luaH_setint (Hash t, int ref, TObject val) {	290	void luaH_setstrnum (lua_State L, Hash t, TString *key, Number val) {
164	TObject index;	291	TObject *value, index;
165	ttype(&index) = LUA_T_NUMBER;	292	ttype(&index) = LUA_TSTRING;
166	nvalue(&index) = ref;	293	tsvalue(&index) = key;
167	luaH_set(t, &index, val);	294	value = luaH_set(L, t, &index);
		295	ttype(value) = LUA_TNUMBER;
		296	nvalue(value) = val;
168	}	297	}
169		298
170		299
171	TObject luaH_getint (Hash t, int ref) {	300	const TObject luaH_getglobal (lua_State L, const char *name) {
172	TObject index;	301	return luaH_getstr(L->gt, luaS_new(L, name));
173	ttype(&index) = LUA_T_NUMBER;
174	nvalue(&index) = ref;
175	return luaH_get(t, &index);
176	}	302	}
177		303

src/ltable.h+19−15

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: ltable.h,v 1.11 1999/02/23 14:57:28 roberto Exp $	2	** $Id: ltable.h,v 1.24 2000/08/31 14:08:27 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,21 +10,25 @@ · 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 node(t,i) (&(t)->node[i])
14	#define ref(n) (&(n)->ref)	14	#define key(n) (&(n)->key)
15	#define val(n) (&(n)->val)	15	#define val(n) (&(n)->val)
16	#define nhash(t) ((t)->nhash)	16
17		17	Hash luaH_new (lua_State L, int nhash);
18	#define luaH_get(t,ref) (val(luaH_present((t), (ref))))	18	void luaH_free (lua_State L, Hash t);
19	#define luaH_move(t,from,to) (luaH_setint(t, to, luaH_getint(t, from)))	19	const TObject luaH_get (lua_State L, const Hash t, const TObject key);
20		20	const TObject luaH_getnum (const Hash t, Number key);
21	Hash *luaH_new (int nhash);	21	const TObject luaH_getstr (const Hash t, TString *key);
22	void luaH_free (Hash *frees);	22	void luaH_remove (Hash t, TObject key);
23	Node luaH_present (Hash t, TObject *key);	23	TObject luaH_set (lua_State L, Hash t, const TObject key);
24	void luaH_set (Hash t, TObject ref, TObject *val);	24	Node * luaH_next (lua_State L, const Hash t, const TObject *r);
25	int luaH_pos (Hash t, TObject r);	25	TObject luaH_setint (lua_State L, Hash *t, int key);
26	void luaH_setint (Hash t, int ref, TObject val);	26	void luaH_setstrnum (lua_State L, Hash t, TString *key, Number val);
27	TObject luaH_getint (Hash t, int ref);	27	unsigned long luaH_hash (lua_State L, const TObject key);
		28	const TObject luaH_getglobal (lua_State L, const char *name);
		29
		30	/* exported only for debugging */
		31	Node luaH_mainposition (const Hash t, const TObject *key);
28		32
29		33
30	#endif	34	#endif

src/ltests.c+543−0

@@ -0,0 +1,543 @@
	1	/*
	2	** $Id: ltests.c,v 1.54 2000/10/31 13:10:24 roberto Exp $
	3	** Internal Module for Debugging of the Lua Implementation
	4	** See Copyright Notice in lua.h
	5	*/
	6
	7
	8	#include <ctype.h>
	9	#include <stdio.h>
	10	#include <stdlib.h>
	11	#include <string.h>
	12
	13
	14	#include "lua.h"
	15
	16	#include "lapi.h"
	17	#include "lauxlib.h"
	18	#include "lcode.h"
	19	#include "ldebug.h"
	20	#include "ldo.h"
	21	#include "lfunc.h"
	22	#include "lmem.h"
	23	#include "lopcodes.h"
	24	#include "lstate.h"
	25	#include "lstring.h"
	26	#include "ltable.h"
	27	#include "luadebug.h"
	28	#include "lualib.h"
	29
	30
	31	void luaB_opentests (lua_State *L);
	32
	33
	34	/*
	35	** The whole module only makes sense with LUA_DEBUG on
	36	*/
	37	#ifdef LUA_DEBUG
	38
	39
	40
	41	static void setnameval (lua_State L, const char name, int val) {
	42	lua_pushstring(L, name);
	43	lua_pushnumber(L, val);
	44	lua_settable(L, -3);
	45	}
	46
	47
	48	/*
	49	** {======================================================
	50	** Disassembler
	51	** =======================================================
	52	*/
	53
	54
	55	static const char *const instrname[NUM_OPCODES] = {
	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];
	70	OpCode o = GET_OPCODE(i);
	71	const char *name = instrname[o];
	72	sprintf(buff, "%5d - ", luaG_getline(p->lineinfo, pc, 1, NULL));
	73	switch ((enum Mode)luaK_opproperties[o].mode) {
	74	case iO:
	75	sprintf(buff+8, "%-12s", name);
	76	break;
	77	case iU:
	78	sprintf(buff+8, "%-12s%4u", name, GETARG_U(i));
	79	break;
	80	case iS:
	81	sprintf(buff+8, "%-12s%4d", name, GETARG_S(i));
	82	break;
	83	case iAB:
	84	sprintf(buff+8, "%-12s%4d %4d", name, GETARG_A(i), GETARG_B(i));
	85	break;
	86	}
	87	lua_pushstring(L, buff);
	88	return (o != OP_END);
	89	}
	90
	91
	92	static int listcode (lua_State *L) {
	93	int pc;
	94	Proto *p;
	95	int res;
	96	luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
	97	1, "Lua function expected");
	98	p = clvalue(luaA_index(L, 1))->f.l;
	99	lua_newtable(L);
	100	setnameval(L, "maxstack", p->maxstacksize);
	101	setnameval(L, "numparams", p->numparams);
	102	pc = 0;
	103	do {
	104	lua_pushnumber(L, pc+1);
	105	res = pushop(L, p, pc++);
	106	lua_settable(L, -3);
	107	} while (res);
	108	return 1;
	109	}
	110
	111
	112	static int liststrings (lua_State *L) {
	113	Proto *p;
	114	int i;
	115	luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
	116	1, "Lua function expected");
	117	p = clvalue(luaA_index(L, 1))->f.l;
	118	lua_newtable(L);
	119	for (i=0; i<p->nkstr; i++) {
	120	lua_pushnumber(L, i+1);
	121	lua_pushstring(L, p->kstr[i]->str);
	122	lua_settable(L, -3);
	123	}
	124	return 1;
	125	}
	126
	127
	128	static int listlocals (lua_State *L) {
	129	Proto *p;
	130	int pc = luaL_check_int(L, 2) - 1;
	131	int i = 0;
	132	const char *name;
	133	luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
	134	1, "Lua function expected");
	135	p = clvalue(luaA_index(L, 1))->f.l;
	136	while ((name = luaF_getlocalname(p, ++i, pc)) != NULL)
	137	lua_pushstring(L, name);
	138	return i-1;
	139	}
	140
	141	/* }====================================================== */
	142
	143
	144
	145	static int get_limits (lua_State *L) {
	146	lua_newtable(L);
	147	setnameval(L, "BITS_INT", BITS_INT);
	148	setnameval(L, "LFPF", LFIELDS_PER_FLUSH);
	149	setnameval(L, "MAXARG_A", MAXARG_A);
	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);
	155	setnameval(L, "MAXSTACK", MAXSTACK);
	156	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;
	164	}
	165
	166
	167	static int mem_query (lua_State *L) {
	168	if (lua_isnull(L, 1)) {
	169	lua_pushnumber(L, memdebug_total);
	170	lua_pushnumber(L, memdebug_numblocks);
	171	lua_pushnumber(L, memdebug_maxmem);
	172	return 3;
	173	}
	174	else {
	175	memdebug_memlimit = luaL_check_int(L, 1);
	176	return 0;
	177	}
	178	}
	179
	180
	181	static int hash_query (lua_State *L) {
	182	if (lua_isnull(L, 2)) {
	183	luaL_arg_check(L, lua_tag(L, 1) == LUA_TSTRING, 1, "string expected");
	184	lua_pushnumber(L, tsvalue(luaA_index(L, 1))->u.s.hash);
	185	}
	186	else {
	187	Hash *t;
	188	luaL_checktype(L, 2, LUA_TTABLE);
	189	t = hvalue(luaA_index(L, 2));
	190	lua_pushnumber(L, luaH_mainposition(t, luaA_index(L, 1)) - t->node);
	191	}
	192	return 1;
	193	}
	194
	195
	196	static int table_query (lua_State *L) {
	197	const Hash *t;
	198	int i = luaL_opt_int(L, 2, -1);
	199	luaL_checktype(L, 1, LUA_TTABLE);
	200	t = hvalue(luaA_index(L, 1));
	201	if (i == -1) {
	202	lua_pushnumber(L, t->size);
	203	lua_pushnumber(L, t->firstfree - t->node);
	204	return 2;
	205	}
	206	else if (i < t->size) {
	207	luaA_pushobject(L, &t->node[i].key);
	208	luaA_pushobject(L, &t->node[i].val);
	209	if (t->node[i].next) {
	210	lua_pushnumber(L, t->node[i].next - t->node);
	211	return 3;
	212	}
	213	else
	214	return 2;
	215	}
	216	return 0;
	217	}
	218
	219
	220	static int string_query (lua_State *L) {
	221	stringtable tb = (luaL_check_string(L, 1) == 's') ? &L->strt : &L->udt;
	222	int s = luaL_opt_int(L, 2, 0) - 1;
	223	if (s==-1) {
	224	lua_pushnumber(L ,tb->nuse);
	225	lua_pushnumber(L ,tb->size);
	226	return 2;
	227	}
	228	else if (s < tb->size) {
	229	TString *ts;
	230	int n = 0;
	231	for (ts = tb->hash[s]; ts; ts = ts->nexthash) {
	232	ttype(L->top) = LUA_TSTRING;
	233	tsvalue(L->top) = ts;
	234	incr_top;
	235	n++;
	236	}
	237	return n;
	238	}
	239	return 0;
	240	}
	241
	242
	243	static int tref (lua_State *L) {
	244	luaL_checkany(L, 1);
	245	lua_pushvalue(L, 1);
	246	lua_pushnumber(L, lua_ref(L, luaL_opt_int(L, 2, 1)));
	247	return 1;
	248	}
	249
	250	static int getref (lua_State *L) {
	251	if (lua_getref(L, luaL_check_int(L, 1)))
	252	return 1;
	253	else
	254	return 0;
	255	}
	256
	257	static int unref (lua_State *L) {
	258	lua_unref(L, luaL_check_int(L, 1));
	259	return 0;
	260	}
	261
	262	static int newuserdata (lua_State *L) {
	263	if (lua_isnumber(L, 2))
	264	lua_pushusertag(L, (void *)luaL_check_int(L, 1), luaL_check_int(L, 2));
	265	else
	266	lua_newuserdata(L, luaL_check_int(L, 1));
	267	return 1;
	268	}
	269
	270	static int udataval (lua_State *L) {
	271	luaL_checktype(L, 1, LUA_TUSERDATA);
	272	lua_pushnumber(L, (int)lua_touserdata(L, 1));
	273	return 1;
	274	}
	275
	276	static int newstate (lua_State *L) {
	277	lua_State *L1 = lua_open(luaL_check_int(L, 1));
	278	if (L1)
	279	lua_pushuserdata(L, L1);
	280	else
	281	lua_pushnil(L);
	282	return 1;
	283	}
	284
	285	static int loadlib (lua_State *L) {
	286	lua_State L1 = (lua_State )lua_touserdata(L, 1);
	287	switch (*luaL_check_string(L, 2)) {
	288	case 'm': lua_mathlibopen(L1); break;
	289	case 's': lua_strlibopen(L1); break;
	290	case 'i': lua_iolibopen(L1); break;
	291	case 'd': lua_dblibopen(L1); break;
	292	case 'b': lua_baselibopen(L1); break;
	293	default: luaL_argerror(L, 2, "invalid option");
	294	}
	295	return 0;
	296	}
	297
	298	static int closestate (lua_State *L) {
	299	luaL_checktype(L, 1, LUA_TUSERDATA);
	300	lua_close((lua_State *)lua_touserdata(L, 1));
	301	return 0;
	302	}
	303
	304	static int doremote (lua_State *L) {
	305	lua_State *L1;
	306	const char *code = luaL_check_string(L, 2);
	307	int status;
	308	luaL_checktype(L, 1, LUA_TUSERDATA);
	309	L1 = (lua_State *)lua_touserdata(L, 1);
	310	status = lua_dostring(L1, code);
	311	if (status != 0) {
	312	lua_pushnil(L);
	313	lua_pushnumber(L, status);
	314	return 2;
	315	}
	316	else {
	317	int i = 0;
	318	while (!lua_isnull(L1, ++i))
	319	lua_pushstring(L, lua_tostring(L1, i));
	320	return i-1;
	321	}
	322	}
	323
	324	static int settagmethod (lua_State *L) {
	325	int tag = luaL_check_int(L, 1);
	326	const char *event = luaL_check_string(L, 2);
	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;
	332	}
	333
	334	static int pushbool (lua_State *L, int b) {
	335	if (b) lua_pushnumber(L, 1);
	336	else lua_pushnil(L);
	337	return 1;
	338	}
	339
	340	static int equal (lua_State *L) {
	341	return pushbool(L, lua_equal(L, 1, 2));
	342	}
	343
	344
	345
	346	/*
	347	** {======================================================
	348	** 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
	350	** =======================================================
	351	*/
	352
	353	static const char *const delimits = " \t\n,;";
	354
	355	static void skip (const char **pc) {
	356	while (pc != '\0' && strchr(delimits, pc)) (*pc)++;
	357	}
	358
	359	static int getnum (lua_State L, const char *pc) {
	360	int res = 0;
	361	int sig = 1;
	362	skip(pc);
	363	if (**pc == '.') {
	364	res = (int)lua_tonumber(L, -1);
	365	lua_pop(L, 1);
	366	(*pc)++;
	367	return res;
	368	}
	369	else if (**pc == '-') {
	370	sig = -1;
	371	(*pc)++;
	372	}
	373	while (isdigit(*pc)) res = res10 + ((pc)++) - '0';
	374	return sig*res;
	375	}
	376
	377	static const char getname (char buff, const char **pc) {
	378	int i = 0;
	379	skip(pc);
	380	while (pc != '\0' && !strchr(delimits, pc))
	381	buff[i++] = (pc)++;
	382	buff[i] = '\0';
	383	return buff;
	384	}
	385
	386
	387	#define EQ(s1) (strcmp(s1, inst) == 0)
	388
	389	#define getnum ((getnum)(L, &pc))
	390	#define getname ((getname)(buff, &pc))
	391
	392
	393	static int testC (lua_State *L) {
	394	char buff[30];
	395	const char *pc = luaL_check_string(L, 1);
	396	for (;;) {
	397	const char *inst = getname;
	398	if EQ("") return 0;
	399	else if EQ("isnumber") {
	400	lua_pushnumber(L, lua_isnumber(L, getnum));
	401	}
	402	else if EQ("isstring") {
	403	lua_pushnumber(L, lua_isstring(L, getnum));
	404	}
	405	else if EQ("istable") {
	406	lua_pushnumber(L, lua_istable(L, getnum));
	407	}
	408	else if EQ("iscfunction") {
	409	lua_pushnumber(L, lua_iscfunction(L, getnum));
	410	}
	411	else if EQ("isfunction") {
	412	lua_pushnumber(L, lua_isfunction(L, getnum));
	413	}
	414	else if EQ("isuserdata") {
	415	lua_pushnumber(L, lua_isuserdata(L, getnum));
	416	}
	417	else if EQ("isnil") {
	418	lua_pushnumber(L, lua_isnil(L, getnum));
	419	}
	420	else if EQ("isnull") {
	421	lua_pushnumber(L, lua_isnull(L, getnum));
	422	}
	423	else if EQ("tonumber") {
	424	lua_pushnumber(L, lua_tonumber(L, getnum));
	425	}
	426	else if EQ("tostring") {
	427	lua_pushstring(L, lua_tostring(L, getnum));
	428	}
	429	else if EQ("tonumber") {
	430	lua_pushnumber(L, lua_tonumber(L, getnum));
	431	}
	432	else if EQ("strlen") {
	433	lua_pushnumber(L, lua_strlen(L, getnum));
	434	}
	435	else if EQ("tocfunction") {
	436	lua_pushcfunction(L, lua_tocfunction(L, getnum));
	437	}
	438	else if EQ("return") {
	439	return getnum;
	440	}
	441	else if EQ("gettop") {
	442	lua_pushnumber(L, lua_gettop(L));
	443	}
	444	else if EQ("settop") {
	445	lua_settop(L, getnum);
	446	}
	447	else if EQ("pop") {
	448	lua_pop(L, getnum);
	449	}
	450	else if EQ("pushnum") {
	451	lua_pushnumber(L, getnum);
	452	}
	453	else if EQ("pushvalue") {
	454	lua_pushvalue(L, getnum);
	455	}
	456	else if EQ("remove") {
	457	lua_remove(L, getnum);
	458	}
	459	else if EQ("insert") {
	460	lua_insert(L, getnum);
	461	}
	462	else if EQ("gettable") {
	463	lua_gettable(L, getnum);
	464	}
	465	else if EQ("settable") {
	466	lua_settable(L, getnum);
	467	}
	468	else if EQ("next") {
	469	lua_next(L, -2);
	470	}
	471	else if EQ("concat") {
	472	lua_concat(L, getnum);
	473	}
	474	else if EQ("rawcall") {
	475	int narg = getnum;
	476	int nres = getnum;
	477	lua_rawcall(L, narg, nres);
	478	}
	479	else if EQ("call") {
	480	int narg = getnum;
	481	int nres = getnum;
	482	lua_call(L, narg, nres);
	483	}
	484	else if EQ("dostring") {
	485	lua_dostring(L, luaL_check_string(L, getnum));
	486	}
	487	else if EQ("settagmethod") {
	488	int tag = getnum;
	489	const char *event = getname;
	490	lua_settagmethod(L, tag, event);
	491	}
	492	else if EQ("gettagmethod") {
	493	int tag = getnum;
	494	const char *event = getname;
	495	lua_gettagmethod(L, tag, event);
	496	}
	497	else if EQ("type") {
	498	lua_pushstring(L, lua_typename(L, lua_type(L, getnum)));
	499	}
	500	else luaL_verror(L, "unknown instruction %.30s", buff);
	501	}
	502	return 0;
	503	}
	504
	505	/* }====================================================== */
	506
	507
	508
	509	static const struct luaL_reg tests_funcs[] = {
	510	{"hash", hash_query},
	511	{"limits", get_limits},
	512	{"listcode", listcode},
	513	{"liststrings", liststrings},
	514	{"listlocals", listlocals},
	515	{"loadlib", loadlib},
	516	{"querystr", string_query},
	517	{"querytab", table_query},
	518	{"testC", testC},
	519	{"ref", tref},
	520	{"getref", getref},
	521	{"unref", unref},
	522	{"newuserdata", newuserdata},
	523	{"udataval", udataval},
	524	{"newstate", newstate},
	525	{"closestate", closestate},
	526	{"doremote", doremote},
	527	{"settagmethod", settagmethod},
	528	{"equal", equal},
	529	{"totalmem", mem_query}
	530	};
	531
	532
	533	void luaB_opentests (lua_State *L) {
	534	lua_newtable(L);
	535	lua_getglobals(L);
	536	lua_pushvalue(L, -2);
	537	lua_setglobals(L);
	538	luaL_openl(L, tests_funcs); /* open functions inside new table */
	539	lua_setglobals(L); /* restore old table of globals */
	540	lua_setglobal(L, "T"); /* set new table as global T */
	541	}
	542
	543	#endif

src/ltm.c+93−178

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: ltm.c,v 1.25 1999/05/21 19:41:49 roberto Exp $	2	** $Id: ltm.c,v 1.56 2000/10/31 13:10:24 roberto Exp $
3	** Tag methods	3	** Tag methods
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -8,241 +8,156 @@ · 2 unmodified lines
8	#include <stdio.h>	8	#include <stdio.h>
9	#include <string.h>	9	#include <string.h>
10		10
11	#include "lauxlib.h"	11	#include "lua.h"
		12
		13	#include "ldo.h"
12	#include "lmem.h"	14	#include "lmem.h"
13	#include "lobject.h"	15	#include "lobject.h"
14	#include "lstate.h"	16	#include "lstate.h"
15	#include "ltm.h"	17	#include "ltm.h"
16		18
17		19
18	char luaT_eventname[] = { / ORDER IM */	20	const char const luaT_eventname[] = { / ORDER TM */
19	"gettable", "settable", "index", "getglobal", "setglobal", "add",	21	"gettable", "settable", "index", "getglobal", "setglobal", "add", "sub",
20	"sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge",	22	"mul", "div", "pow", "unm", "lt", "concat", "gc", "function",
21	"concat", "gc", "function", NULL	23	"le", "gt", "ge", /* deprecated options!! */
		24	NULL
22	};	25	};
23		26
24		27
25	static int luaI_checkevent (char name, char list[]) {	28	static int findevent (const char *name) {
26	int e = luaL_findstring(name, list);	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");
27	if (e < 0)	43	if (e < 0)
28	luaL_verror("`%.50s' is not a valid event name", name);	44	luaO_verror(L, "`%.50s' is not a valid event name", name);
29	return e;	45	return e;
30	}	46	}
31		47
32		48
33		49
34	/* events in LUA_T_NIL are all allowed, since this is used as a	50	/* events in LUA_TNIL are all allowed, since this is used as a
35	* 'placeholder' for "default" fallbacks	51	* 'placeholder' for "default" fallbacks
36	*/	52	*/
37	static char luaT_validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */	53	/* ORDER LUA_T, ORDER TM */
38	{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_T_USERDATA */	54	static const char luaT_validevents[NUM_TAGS][TM_N] = {
39	{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_NUMBER */	55	{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_TUSERDATA */
40	{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_T_STRING */	56	{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_TNIL */
41	{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}, /* LUA_T_ARRAY */	57	{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1}, /* LUA_TNUMBER */
42	{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_PROTO */	58	{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1}, /* LUA_TSTRING */
43	{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0}, /* LUA_T_CPROTO */	59	{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1}, /* LUA_TTABLE */
44	{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} /* LUA_T_NIL */	60	{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0} /* LUA_TFUNCTION */
45	};	61	};
46		62
47	static int luaT_validevent (int t, int e) { /* ORDER LUA_T */	63	int luaT_validevent (int t, int e) { /* ORDER LUA_T */
48	return (t < LUA_T_NIL) ? 1 : luaT_validevents[-t][e];	64	return (t >= NUM_TAGS) ? 1 : luaT_validevents[t][e];
49	}	65	}
50		66
51		67
52	static void init_entry (int tag) {	68	static void init_entry (lua_State *L, int tag) {
53	int i;	69	int i;
54	for (i=0; i<IM_N; i++)	70	for (i=0; i<TM_N; i++)
55	ttype(luaT_getim(tag, i)) = LUA_T_NIL;	71	luaT_gettm(L, tag, i) = NULL;
		72	L->TMtable[tag].collected = NULL;
56	}	73	}
57		74
58		75
59	void luaT_init (void) {	76	void luaT_init (lua_State *L) {
60	int t;	77	int t;
61	L->last_tag = -(NUM_TAGS-1);	78	luaM_growvector(L, L->TMtable, 0, NUM_TAGS, struct TM, "", MAX_INT);
62	luaM_growvector(L->IMtable, 0, NUM_TAGS, struct IM, arrEM, MAX_INT);	79	L->nblocks += NUM_TAGS*sizeof(struct TM);
63	for (t=L->last_tag; t<=0; t++)	80	L->last_tag = NUM_TAGS-1;
64	init_entry(t);	81	for (t=0; t<=L->last_tag; t++)
		82	init_entry(L, t);
65	}	83	}
66		84
67		85
68	int lua_newtag (void) {	86	LUA_API int lua_newtag (lua_State *L) {
69	--L->last_tag;	87	luaM_growvector(L, L->TMtable, L->last_tag, 1, struct TM,
70	luaM_growvector(L->IMtable, -(L->last_tag), 1, struct IM, arrEM, MAX_INT);	88	"tag table overflow", MAX_INT);
71	init_entry(L->last_tag);	89	L->nblocks += sizeof(struct TM);
		90	L->last_tag++;
		91	init_entry(L, L->last_tag);
72	return L->last_tag;	92	return L->last_tag;
73	}	93	}
74		94
75		95
76	static void checktag (int tag) {	96	static void checktag (lua_State *L, int tag) {
77	if (!(L->last_tag <= tag && tag <= 0))	97	if (!(0 <= tag && tag <= L->last_tag))
78	luaL_verror("%d is not a valid tag", tag);	98	luaO_verror(L, "%d is not a valid tag", tag);
79	}	99	}
80		100
81	void luaT_realtag (int tag) {	101	void luaT_realtag (lua_State *L, int tag) {
82	if (!(L->last_tag <= tag && tag < LUA_T_NIL))	102	if (!validtag(tag))
83	luaL_verror("tag %d was not created by `newtag'", tag);	103	luaO_verror(L, "tag %d was not created by `newtag'", tag);
84	}	104	}
85		105
86		106
87	int lua_copytagmethods (int tagto, int tagfrom) {	107	LUA_API int lua_copytagmethods (lua_State *L, int tagto, int tagfrom) {
88	int e;	108	int e;
89	checktag(tagto);	109	checktag(L, tagto);
90	checktag(tagfrom);	110	checktag(L, tagfrom);
91	for (e=0; e<IM_N; e++) {	111	for (e=0; e<TM_N; e++) {
92	if (luaT_validevent(tagto, e))	112	if (luaT_validevent(tagto, e))
93	luaT_getim(tagto, e) = luaT_getim(tagfrom, e);	113	luaT_gettm(L, tagto, e) = luaT_gettm(L, tagfrom, e);
94	}	114	}
95	return tagto;	115	return tagto;
96	}	116	}
97		117
98		118
99	int luaT_effectivetag (TObject *o) {	119	int luaT_tag (const TObject *o) {
100	int t;	120	int t = ttype(o);
101	switch (t = ttype(o)) {	121	switch (t) {
102	case LUA_T_ARRAY:	122	case LUA_TUSERDATA: return tsvalue(o)->u.d.tag;
103	return o->value.a->htag;	123	case LUA_TTABLE: return hvalue(o)->htag;
104	case LUA_T_USERDATA: {	124	default: return t;
105	int tag = o->value.ts->u.d.tag;
106	return (tag >= 0) ? LUA_T_USERDATA : tag;
107	}
108	case LUA_T_CLOSURE:
109	return o->value.cl->consts[0].ttype;
110	#ifdef DEBUG
111	case LUA_T_PMARK: case LUA_T_CMARK:
112	case LUA_T_CLMARK: case LUA_T_LINE:
113	LUA_INTERNALERROR("invalid type");
114	#endif
115	default:
116	return t;
117	}	125	}
118	}	126	}
119		127
120		128
121	TObject luaT_gettagmethod (int t, char event) {	129	LUA_API void lua_gettagmethod (lua_State L, int t, const char event) {
122	int e = luaI_checkevent(event, luaT_eventname);
123	checktag(t);
124	if (luaT_validevent(t, e))
125	return luaT_getim(t,e);
126	else
127	return &luaO_nilobject;
128	}
129
130
131	void luaT_settagmethod (int t, char event, TObject func) {
132	TObject temp;
133	int e = luaI_checkevent(event, luaT_eventname);
134	checktag(t);
135	if (!luaT_validevent(t, e))
136	luaL_verror("cannot change tag method `%.20s' for type `%.20s'%.20s",
137	luaT_eventname[e], luaO_typenames[-t],
138	(t == LUA_T_ARRAY \|\| t == LUA_T_USERDATA) ? " with default tag"
139	: "");
140	temp = *func;
141	func = luaT_getim(t,e);
142	*luaT_getim(t, e) = temp;
143	}
144
145
146	char luaT_travtagmethods (int (fn)(TObject )) { / ORDER IM */
147	int e;	130	int e;
148	for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) {	131	e = luaI_checkevent(L, event, t);
149	int t;	132	checktag(L, t);
150	for (t=0; t>=L->last_tag; t--)	133	if (luaT_validevent(t, e) && luaT_gettm(L, t, e)) {
151	if (fn(luaT_getim(t,e)))	134	clvalue(L->top) = luaT_gettm(L, t, e);
152	return luaT_eventname[e];	135	ttype(L->top) = LUA_TFUNCTION;
153	}	136	}
154	return NULL;
155	}
156
157
158	/*
159	* ===================================================================
160	* compatibility with old fallback system
161	*/
162	#ifdef LUA_COMPAT2_5
163
164	#include "lapi.h"
165	#include "lstring.h"
166
167	static void errorFB (void)
168	{
169	lua_Object o = lua_getparam(1);
170	if (lua_isstring(o))
171	fprintf(stderr, "lua: %s\n", lua_getstring(o));
172	else	137	else
173	fprintf(stderr, "lua: unknown error\n");	138	ttype(L->top) = LUA_TNIL;
174	}	139	incr_top;
175
176
177	static void nilFB (void) { }
178
179
180	static void typeFB (void) {
181	lua_error("unexpected type");
182	}	140	}
183		141
184		142
185	static void fillvalids (IMS e, TObject *func) {	143	LUA_API void lua_settagmethod (lua_State L, int t, const char event) {
186	int t;	144	int e = luaI_checkevent(L, event, t);
187	for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)	145	checktag(L, t);
188	if (luaT_validevent(t, e))	146	if (!luaT_validevent(t, e))
189	luaT_getim(t, e) = func;	147	luaO_verror(L, "cannot change `%.20s' tag method for type `%.20s'%.20s",
190	}	148	luaT_eventname[e], luaO_typenames[t],
191		149	(t == LUA_TTABLE \|\| t == LUA_TUSERDATA) ?
192		150	" with default tag" : "");
193	void luaT_setfallback (void) {	151	switch (ttype(L->top - 1)) {
194	static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL};	152	case LUA_TNIL:
195	TObject oldfunc;	153	luaT_gettm(L, t, e) = NULL;
196	lua_CFunction replace;
197	char *name = luaL_check_string(1);
198	lua_Object func = lua_getparam(2);
199	luaL_arg_check(lua_isfunction(func), 2, "function expected");
200	switch (luaL_findstring(name, oldnames)) {
201	case 0: { /* old error fallback */
202	TObject *em = &(luaS_new("_ERRORMESSAGE")->u.s.globalval);
203	oldfunc = *em;
204	em = luaA_Address(func);
205	replace = errorFB;
206	break;
207	}
208	case 1: /* old getglobal fallback */
209	oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
210	luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = luaA_Address(func);
211	replace = nilFB;
212	break;
213	case 2: { /* old arith fallback */
214	int i;
215	oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW);
216	for (i=IM_ADD; i<=IM_UNM; i++) /* ORDER IM */
217	fillvalids(i, luaA_Address(func));
218	replace = typeFB;
219	break;	154	break;
220	}	155	case LUA_TFUNCTION:
221	case 3: { /* old order fallback */	156	luaT_gettm(L, t, e) = clvalue(L->top - 1);
222	int i;
223	oldfunc = *luaT_getim(LUA_T_NIL, IM_LT);
224	for (i=IM_LT; i<=IM_GE; i++) /* ORDER IM */
225	fillvalids(i, luaA_Address(func));
226	replace = typeFB;
227	break;	157	break;
228	}	158	default:
229	default: {	159	lua_error(L, "tag method must be a function (or nil)");
230	int e;
231	if ((e = luaL_findstring(name, luaT_eventname)) >= 0) {
232	oldfunc = *luaT_getim(LUA_T_NIL, e);
233	fillvalids(e, luaA_Address(func));
234	replace = (e == IM_GC \|\| e == IM_INDEX) ? nilFB : typeFB;
235	}
236	else {
237	luaL_verror("`%.50s' is not a valid fallback name", name);
238	replace = NULL; /* to avoid warnings */
239	}
240	}
241	}	160	}
242	if (oldfunc.ttype != LUA_T_NIL)	161	L->top--;
243	luaA_pushobject(&oldfunc);
244	else
245	lua_pushcfunction(replace);
246	}	162	}
247	#endif
248		163

src/ltm.h+34−37

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: ltm.h,v 1.5 1999/01/15 13:11:57 roberto Exp $	2	** $Id: ltm.h,v 1.18 2000/10/05 13:00:17 roberto Exp $
3	** Tag methods	3	** Tag methods
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -13,50 +13,47 @@ · 7 unmodified lines
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 IM"	16	* grep "ORDER TM"
17	*/	17	*/
18	typedef enum {	18	typedef enum {
19	IM_GETTABLE = 0,	19	TM_GETTABLE = 0,
20	IM_SETTABLE,	20	TM_SETTABLE,
21	IM_INDEX,	21	TM_INDEX,
22	IM_GETGLOBAL,	22	TM_GETGLOBAL,
23	IM_SETGLOBAL,	23	TM_SETGLOBAL,
24	IM_ADD,	24	TM_ADD,
25	IM_SUB,	25	TM_SUB,
26	IM_MUL,	26	TM_MUL,
27	IM_DIV,	27	TM_DIV,
28	IM_POW,	28	TM_POW,
29	IM_UNM,	29	TM_UNM,
30	IM_LT,	30	TM_LT,
31	IM_LE,	31	TM_CONCAT,
32	IM_GT,	32	TM_GC,
33	IM_GE,	33	TM_FUNCTION,
34	IM_CONCAT,	34	TM_N /* number of elements in the enum */
35	IM_GC,	35	} TMS;
36	IM_FUNCTION	36
37	} IMS;	37
38		38	struct TM {
39	#define IM_N 18	39	Closure *method[TM_N];
40		40	TString collected; / list of garbage-collected udata with this tag */
41
42	struct IM {
43	TObject int_method[IM_N];
44	};	41	};
45		42
46		43
47	#define luaT_getim(tag,event) (&L->IMtable[-(tag)].int_method[event])	44	#define luaT_gettm(L,tag,event) (L->TMtable[tag].method[event])
48	#define luaT_getimbyObj(o,e) (luaT_getim(luaT_effectivetag(o),(e)))	45	#define luaT_gettmbyObj(L,o,e) (luaT_gettm((L),luaT_tag(o),(e)))
49		46
50	extern char *luaT_eventname[];
51		47
		48	#define validtag(t) (NUM_TAGS <= (t) && (t) <= L->last_tag)
52		49
53	void luaT_init (void);	50	extern const char *const luaT_eventname[];
54	void luaT_realtag (int tag);	51
55	int luaT_effectivetag (TObject *o);	52
56	void luaT_settagmethod (int t, char event, TObject func);	53	void luaT_init (lua_State *L);
57	TObject luaT_gettagmethod (int t, char event);	54	void luaT_realtag (lua_State *L, int tag);
58	char luaT_travtagmethods (int (fn)(TObject *));	55	int luaT_tag (const TObject *o);
		56	int luaT_validevent (int t, int e); /* used by compatibility module */
59		57
60	void luaT_setfallback (void); /* only if LUA_COMPAT2_5 */
61		58
62	#endif	59	#endif

src/lua/Makefile+2−2

@@ -1,4 +1,4 @@
1	# makefile for lua interpreter	1	# makefile for Lua interpreter
2		2
3	LUA= ../..	3	LUA= ../..
4		4
@@ -14,7 +14,7 @@ T= $(BIN)/lua · 9 unmodified lines
14	all: $T	14	all: $T
15		15
16	$T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a	16	$T: $(OBJS) $(LIB)/liblua.a $(LIB)/liblualib.a
17	$(CC) -o $@ $(OBJS) -L$(LIB) -llua -llualib -lm	17	$(CC) -o $@ $(OBJS) -L$(LIB) -llua -llualib $(EXTRA_LIBS)
18		18
19	$(LIB)/liblua.a:	19	$(LIB)/liblua.a:
20	cd ..; $(MAKE)	20	cd ..; $(MAKE)

src/lua/README+26−24

@@ -1,38 +1,40 @@
1	This client is a sample lua interpreter.	1	This is lua, a sample Lua interpreter.
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		3	There are man pages for it in both nroff and html in ../../doc.
4	Here are the options it understands:	4
5		5	Here are the options that it understands:
		6	- execute stdin as a file
		7	-c close Lua when exiting
		8	-e stat execute string `stat'
		9	-f name execute file `name' with remaining arguments in table `arg'
		10	-i enter interactive mode with prompt
		11	-q enter interactive mode without prompt
		12	-sNUM set stack size to NUM (must be the first option)
6	-v print version information	13	-v print version information
7	-d turn debug on	14	a=b set global `a' to string `b'
8	-e stat dostring `stat'	15	name execute file `name'
9	-q interactive mode without prompt
10	-i interactive mode with prompt
11	- executes stdin as a file
12	a=b sets global `a' with string `b' (no need to quote b)
13	name dofile `name'
14		16
15	If no options are given, then it reads lines from stdin and executes them	17	If no options are given, then it reads lines from stdin and executes them
16	as they are read. So, each line must contain a complete statement.	18	as they are read -- so, each line must contain a complete statement.
17	To span a statement across several lines, end each line with a backslash '\'.	19	To span a statement across several lines, end each line with a backslash '\'.
18		20
19	To change the prompt, set the global variable _PROMPT to whatever you want.	21	To change the prompt, set the global variable _PROMPT to whatever you want.
20	You can do after calling the interpreter or on the command line with	22	You can do this after calling the interpreter or on the command line with
21	_PROMPT="lua: "	23	lua _PROMPT="lua: " -i
22	for example.	24	for example. Note that you need "-i" in this case.
23		25
24	You must be careful when using quotes on the command line because they are	26	You must be careful when using quotes on the command line because they are
25	usually handled by the shell.	27	usually handled by the shell.
26		28
27	This interpreter is good for using Lua as a standalone language.	29	This interpreter is good for using Lua as a standalone language.
28	For a minimal interpreter, see etc/min.c.	30	For a minimal interpreter, see ../../etc/min.c.
29		31
30	If your application simply exports new functions to Lua (which is common),	32	If your application simply exports new functions to Lua (which is common),
31	then you can use this interpreter unmodified: just define a function	33	then you can use this interpreter (almost) unmodified, as follows:
32		34	First, define a function
33	void lua_userinit (void)	35	void myinit (lua_State *L)
34		36	in your own code. In this function, you should do whatever initializations
35	in your code. In this function, you should do whatever initializations are	37	are needed by your application, typically exporting your functions to Lua.
36	need, typically exporting your functions to Lua.	38	Then, add a call "myinit(L)" in lua.c after the place marked
37	If you use this scheme, you must explicily open any standard libraries you need.	39	"add your libraries here"
38	See ../lib/linit.c	40	Of course, you can use any name instead of "myinit".

src/lua/lua.c+224−90

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lua.c,v 1.21 1999/07/02 18:22:38 roberto Exp $	2	** $Id: lua.c,v 1.55 2000/10/20 16:36:32 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	*/
@@ -11,24 +11,51 @@ · 5 unmodified lines
11	#include <string.h>	11	#include <string.h>
12		12
13	#include "lua.h"	13	#include "lua.h"
		14
14	#include "luadebug.h"	15	#include "luadebug.h"
15	#include "lualib.h"	16	#include "lualib.h"
16		17
17		18
		19	static lua_State *L = NULL;
		20
		21
		22	#ifndef PROMPT
		23	#define PROMPT "> "
		24	#endif
		25
18	#ifdef _POSIX_SOURCE	26	#ifdef _POSIX_SOURCE
19	#include <unistd.h>	27	#include <unistd.h>
20	#else	28	#else
21	#define isatty(x) (x==0) /* assume stdin is a tty */	29	static int isatty (int x) { return x==0; } /* assume stdin is a tty */
22	#endif	30	#endif
23		31
24		32
		33	/*
		34	** global options
		35	*/
		36	struct Options {
		37	int toclose;
		38	int stacksize;
		39	};
		40
		41
25	typedef void (handler)(int); / type for signal actions */	42	typedef void (handler)(int); / type for signal actions */
26		43
27	static void laction (int i);	44	static void laction (int i);
28		45
29		46
30	static lua_LHFunction old_linehook = NULL;	47	static lua_Hook old_linehook = NULL;
31	static lua_CHFunction old_callhook = NULL;	48	static lua_Hook old_callhook = NULL;
		49
		50
		51	static void userinit (void) {
		52	lua_baselibopen(L);
		53	lua_iolibopen(L);
		54	lua_strlibopen(L);
		55	lua_mathlibopen(L);
		56	lua_dblibopen(L);
		57	/* add your libraries here */
		58	}
32		59
33		60
34	static handler lreset (void) {	61	static handler lreset (void) {
@@ -37,66 +64,125 @@ static handler lreset (void) { · 2 unmodified lines
37		64
38		65
39	static void lstop (void) {	66	static void lstop (void) {
40	lua_setlinehook(old_linehook);	67	lua_setlinehook(L, old_linehook);
41	lua_setcallhook(old_callhook);	68	lua_setcallhook(L, old_callhook);
42	lreset();	69	lreset();
43	lua_error("interrupted!");	70	lua_error(L, "interrupted!");
44	}	71	}
45		72
46		73
47	static void laction (int i) {	74	static void laction (int i) {
		75	(void)i; /* to avoid warnings */
48	signal(SIGINT, SIG_DFL); /* if another SIGINT happens before lstop,	76	signal(SIGINT, SIG_DFL); /* if another SIGINT happens before lstop,
49	terminate process (default action) */	77	terminate process (default action) */
50	old_linehook = lua_setlinehook((lua_LHFunction)lstop);	78	old_linehook = lua_setlinehook(L, (lua_Hook)lstop);
51	old_callhook = lua_setcallhook((lua_CHFunction)lstop);	79	old_callhook = lua_setcallhook(L, (lua_Hook)lstop);
52	}	80	}
53		81
54		82
55	static int ldo (int (f)(char ), char *name) {	83	static int ldo (int (f)(lua_State l, const char ), const char name) {
56	int res;	84	int res;
57	handler h = lreset();	85	handler h = lreset();
58	res = f(name); /* dostring \| dofile */	86	int top = lua_gettop(L);
		87	res = f(L, name); /* dostring \| dofile */
		88	lua_settop(L, top); /* remove eventual results */
59	signal(SIGINT, h); /* restore old action */	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");
60	return res;	96	return res;
61	}	97	}
62		98
63		99
64	static void print_message (void) {	100	static void print_message (void) {
65	fprintf(stderr,	101	fprintf(stderr,
66	"Lua: command line options:\n"	102	"usage: lua [options]. Available options are:\n"
67	" -v print version information\n"	103	" - execute stdin as a file\n"
68	" -d turn debug on\n"	104	" -c close Lua when exiting\n"
69	" -e stat dostring `stat'\n"	105	" -e stat execute string `stat'\n"
70	" -q interactive mode without prompt\n"	106	" -f name execute file `name' with remaining arguments in table `arg'\n"
71	" -i interactive mode with prompt\n"	107	" -i enter interactive mode with prompt\n"
72	" - executes stdin as a file\n"	108	" -q enter interactive mode without prompt\n"
73	" a=b sets global `a' with string `b'\n"	109	" -sNUM set stack size to NUM (must be the first option)\n"
74	" name dofile `name'\n\n");	110	" -v print version information\n"
		111	" a=b set global `a' to string `b'\n"
		112	" name execute file `name'\n"
		113	);
		114	}
		115
		116
		117	static void print_version (void) {
		118	printf("%.80s %.80s\n", LUA_VERSION, LUA_COPYRIGHT);
75	}	119	}
76		120
77		121
78	static void assign (char *arg) {	122	static void assign (char *arg) {
79	if (strlen(arg) >= 500)	123	char *eq = strchr(arg, '=');
80	fprintf(stderr, "lua: shell argument too long");	124	eq = '\0'; / spilt `arg' in two strings (name & value) */
81	else {	125	lua_pushstring(L, eq+1);
82	char buffer[500];	126	lua_setglobal(L, arg);
83	char *eq = strchr(arg, '=');	127	}
84	lua_pushstring(eq+1);	128
85	strncpy(buffer, arg, eq-arg);	129
86	buffer[eq-arg] = 0;	130	static void getargs (char *argv[]) {
87	lua_setglobal(buffer);	131	int i;
		132	lua_newtable(L);
		133	for (i=0; argv[i]; i++) {
		134	/* arg[i] = argv[i] */
		135	lua_pushnumber(L, i);
		136	lua_pushstring(L, argv[i]);
		137	lua_settable(L, -3);
		138	}
		139	/* arg.n = maximum index in table `arg' */
		140	lua_pushstring(L, "n");
		141	lua_pushnumber(L, i-1);
		142	lua_settable(L, -3);
		143	}
		144
		145
		146	static int l_getargs (lua_State *l) {
		147	char argv = (char )lua_touserdata(l, -1);
		148	getargs(argv);
		149	return 1;
		150	}
		151
		152
		153	static int file_input (const char *argv) {
		154	int result = ldo(lua_dofile, argv);
		155	if (result) {
		156	if (result == LUA_ERRFILE) {
		157	fprintf(stderr, "lua: cannot execute file ");
		158	perror(argv);
		159	}
		160	return EXIT_FAILURE;
88	}	161	}
		162	else
		163	return EXIT_SUCCESS;
89	}	164	}
90		165
91		166
92	static void manual_input (int prompt) {	167	/* maximum length of an input string */
		168	#ifndef MAXINPUT
		169	#define MAXINPUT BUFSIZ
		170	#endif
		171
		172	static void manual_input (int version, int prompt) {
93	int cont = 1;	173	int cont = 1;
		174	if (version) print_version();
94	while (cont) {	175	while (cont) {
95	char buffer[BUFSIZ];	176	char buffer[MAXINPUT];
96	int i = 0;	177	int i = 0;
97	lua_beginblock();	178	if (prompt) {
98	if (prompt)	179	const char *s;
99	printf("%s", lua_getstring(lua_getglobal("_PROMPT")));	180	lua_getglobal(L, "_PROMPT");
		181	s = lua_tostring(L, -1);
		182	if (!s) s = PROMPT;
		183	fputs(s, stdout);
		184	lua_pop(L, 1); /* remove global */
		185	}
100	for(;;) {	186	for(;;) {
101	int c = getchar();	187	int c = getchar();
102	if (c == EOF) {	188	if (c == EOF) {
@@ -108,81 +194,129 @@ static void manual_input (int prompt) { · 5 unmodified lines
108	buffer[i-1] = '\n';	194	buffer[i-1] = '\n';
109	else break;	195	else break;
110	}	196	}
111	else if (i >= BUFSIZ-1) {	197	else if (i >= MAXINPUT-1) {
112	fprintf(stderr, "lua: argument line too long\n");	198	fprintf(stderr, "lua: input line too long\n");
113	break;	199	break;
114	}	200	}
115	else buffer[i++] = (char)c;	201	else buffer[i++] = (char)c;
116	}	202	}
117	buffer[i] = '\0';	203	buffer[i] = '\0';
118	ldo(lua_dostring, buffer);	204	ldo(lua_dostring, buffer);
119	lua_endblock();	205	lua_settop(L, 0); /* remove eventual results */
120	}	206	}
121	printf("\n");	207	printf("\n");
122	}	208	}
123		209
124		210
125	int main (int argc, char *argv[])	211	static int handle_argv (char argv[], struct Options opt) {
126	{	212	if (opt->stacksize > 0) argv++; /* skip option `-s' (if present) */
127	int i;	213	if (argv == NULL) { / no more arguments? */
128	lua_open();
129	lua_pushstring("> "); lua_setglobal("_PROMPT");
130	lua_userinit();
131	if (argc < 2) { /* no arguments? */
132	if (isatty(0)) {	214	if (isatty(0)) {
133	printf("%s %s\n", LUA_VERSION, LUA_COPYRIGHT);	215	manual_input(1, 1);
134	manual_input(1);
135	}	216	}
136	else	217	else
137	ldo(lua_dofile, NULL); /* executes stdin as a file */	218	ldo(lua_dofile, NULL); /* executes stdin as a file */
138	}	219	}
139	else for (i=1; i<argc; i++) {	220	else { /* other arguments; loop over them */
140	if (argv[i][0] == '-') { /* option? */	221	int i;
141	switch (argv[i][1]) {	222	for (i = 0; argv[i] != NULL; i++) {
142	case 0:	223	if (argv[i][0] != '-') { /* not an option? */
143	ldo(lua_dofile, NULL); /* executes stdin as a file */	224	if (strchr(argv[i], '='))
144	break;	225	assign(argv[i]);
145	case 'i':	226	else
146	manual_input(1);	227	if (file_input(argv[i]) != EXIT_SUCCESS)
147	break;	228	return EXIT_FAILURE; /* stop if file fails */
148	case 'q':	229	}
149	manual_input(0);	230	else switch (argv[i][1]) { /* option */
150	break;	231	case 0: {
151	case 'd':	232	ldo(lua_dofile, NULL); /* executes stdin as a file */
152	lua_setdebug(1);	233	break;
153	break;	234	}
154	case 'v':	235	case 'i': {
155	printf("%s %s\n(written by %s)\n\n",	236	manual_input(0, 1);
156	LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);	237	break;
157	break;	238	}
158	case 'e':	239	case 'q': {
159	i++;	240	manual_input(0, 0);
160	if (ldo(lua_dostring, argv[i]) != 0) {	241	break;
161	fprintf(stderr, "lua: error running argument `%s'\n", argv[i]);	242	}
162	return 1;	243	case 'c': {
		244	opt->toclose = 1;
		245	break;
		246	}
		247	case 'v': {
		248	print_version();
		249	break;
		250	}
		251	case 'e': {
		252	i++;
		253	if (argv[i] == NULL) {
		254	print_message();
		255	return EXIT_FAILURE;
		256	}
		257	if (ldo(lua_dostring, argv[i]) != 0) {
		258	fprintf(stderr, "lua: error running argument `%.99s'\n", argv[i]);
		259	return EXIT_FAILURE;
		260	}
		261	break;
		262	}
		263	case 'f': {
		264	i++;
		265	if (argv[i] == NULL) {
		266	print_message();
		267	return EXIT_FAILURE;
		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	}
		277	default: {
		278	print_message();
		279	return EXIT_FAILURE;
163	}	280	}
164	break;
165	default:
166	print_message();
167	exit(1);
168	}
169	}
170	else if (strchr(argv[i], '='))
171	assign(argv[i]);
172	else {
173	int result = ldo(lua_dofile, argv[i]);
174	if (result) {
175	if (result == 2) {
176	fprintf(stderr, "lua: cannot execute file ");
177	perror(argv[i]);
178	}	281	}
179	exit(1);
180	}
181	}	282	}
182	}	283	}
183	#ifdef DEBUG	284	return EXIT_SUCCESS;
184	lua_close();	285	}
185	#endif	286
186	return 0;	287
		288	static void getstacksize (int argc, char argv[], struct Options opt) {
		289	if (argc >= 2 && argv[1][0] == '-' && argv[1][1] == 's') {
		290	int stacksize = atoi(&argv[1][2]);
		291	if (stacksize <= 0) {
		292	fprintf(stderr, "lua: invalid stack size ('%.20s')\n", &argv[1][2]);
		293	exit(EXIT_FAILURE);
		294	}
		295	opt->stacksize = stacksize;
		296	}
		297	else
		298	opt->stacksize = 0; /* no stack size */
		299	}
		300
		301
		302	static void register_getargs (char *argv[]) {
		303	lua_pushuserdata(L, argv);
		304	lua_pushcclosure(L, l_getargs, 1);
		305	lua_setglobal(L, "getargs");
		306	}
		307
		308
		309	int main (int argc, char *argv[]) {
		310	struct Options opt;
		311	int status;
		312	opt.toclose = 0;
		313	getstacksize(argc, argv, &opt); /* handle option `-s' */
		314	L = lua_open(opt.stacksize); /* create state */
		315	userinit(); /* open libraries */
		316	register_getargs(argv); /* create `getargs' function */
		317	status = handle_argv(argv+1, &opt);
		318	if (opt.toclose)
		319	lua_close(L);
		320	return status;
187	}	321	}
188		322

src/luac/Makefile+3−3

@@ -1,12 +1,12 @@
1	# makefile for lua compiler	1	# makefile for Lua compiler
2		2
3	LUA= ../..	3	LUA= ../..
4		4
5	include $(LUA)/config	5	include $(LUA)/config
6		6
7	INCS= -I$(INC) $(EXTRA_INCS) -I..	7	INCS= -I$(INC) $(EXTRA_INCS) -I..
8	OBJS= dump.o luac.o opcode.o opt.o print.o stubs.o test.o	8	OBJS= dump.o luac.o opt.o print.o stubs.o
9	SRCS= dump.c luac.c opcode.c opt.c print.c stubs.c test.c luac.h opcode.h	9	SRCS= dump.c luac.c opt.c print.c stubs.c luac.h print.h
10		10
11	T= $(BIN)/luac	11	T= $(BIN)/luac
12		12

src/luac/README+14−20

@@ -1,28 +1,22 @@
		1	This is luac, the Lua compiler.
		2	There are man pages for it in both nroff and html in ../../doc.
		3
1	luac translates Lua programs into binary files that can be loaded and executed	4	luac translates Lua programs into binary files that can be loaded and executed
2	with lua_dofile in C or with dofile in Lua.	5	with lua_dofile in C or with dofile in Lua.
3	The main advantages of pre-compiling chunks are: faster loading,	6	The main advantages of pre-compiling chunks are: faster loading, protecting
4	protecting source code from user changes, off-line syntax error detection.	7	source code from user changes, and off-line syntax error detection.
5	luac can also be used to learn about the Lua virtual machine.	8	luac can also be used to learn about the Lua virtual machine.
6		9
7	Here are the options that luac understands:	10	Here are the options that luac understands:
8		11
9	-c compile (default)	12	- process stdin
10	-d generate debugging information	13	-l list
11	-D name predefine 'name' for conditional compilation	14	-o file output file (default is "luac.out")
12	-l list (default for -u)	15	-p parse only
13	-n save numbers in native format (file may not be portable)	16	-s strip debug information
14	-o file output file for -c (default is "luac.out")	17	-t test code integrity
15	-O optimize	18	-v show version information
16	-p parse only
17	-q quiet (default for -c)
18	-t test code integrity
19	-u undump
20	-U name undefine 'name' for conditional compilation
21	-v show version information
22	-V verbose
23	- compile "stdin"
24		19
25	Finally, luac is an example of how to use the internals of Lua (politely).	20	luac is also an example of how to use the internals of Lua (politely).
26	Also, luac does not need the runtime code and stubs.c makes sure it is not	21	Finally, luac does not need the runtime code, and stubs.c makes sure it is not
27	linked into luac. This file also shows how to avoid linking the parser.	22	linked into luac. This file also shows how to avoid linking the parser.
28

src/luac/dump.c+70−103

 /*
-** $Id: dump.c,v 1.20 1999/07/02 19:34:26 lhf Exp $
+** $Id: dump.c,v 1.30 2000/10/31 16:57:23 lhf Exp $
 ** save bytecodes to file
 ** See Copyright Notice in lua.h
 */
-#include <errno.h>
 #include <stdio.h>
 #include <stdlib.h>
-#include "luac.h"
+#include <string.h>
-#ifdef OLD_ANSI
+#include "luac.h"
-#define strerror(e)     "(no error message provided by operating system)"
-#endif
+#define DumpVector(b,n,size,D)	fwrite(b,size,n,D)
 #define DumpBlock(b,size,D)	fwrite(b,size,1,D)
-#define	DumpInt			DumpLong
+#define	DumpByte		fputc
-static void DumpWord(int i, FILE* D)
+static void DumpInt(int x, FILE* D)
 {
- int hi= 0x0000FF & (i>>8);
+ DumpBlock(&x,sizeof(x),D);
- int lo= 0x0000FF &  i;
- fputc(hi,D);
- fputc(lo,D);
 }
-static void DumpLong(long i, FILE* D)
+static void DumpSize(size_t x, FILE* D)
 {
- int hi= 0x00FFFF & (i>>16);
+ DumpBlock(&x,sizeof(x),D);
- int lo= 0x00FFFF & i;
- DumpWord(hi,D);
- DumpWord(lo,D);
 }
-static void DumpNumber(real x, FILE* D, int native, TProtoFunc* tf)
+static void DumpNumber(Number x, FILE* D)
 {
- if (native)
+ DumpBlock(&x,sizeof(x),D);
-  DumpBlock(&x,sizeof(x),D);
- else
- {
-  char b[256];
-  int n;
-  sprintf(b,NUMBER_FMT"%n",x,&n);
-  luaU_str2d(b,tf->source->str);	/* help lundump not to fail */
-  fputc(n,D);
-  DumpBlock(b,n,D);
- }
 }
-static void DumpCode(TProtoFunc* tf, FILE* D)
+static void DumpString(const TString* s, FILE* D)
 {
- int size=luaU_codesize(tf);
+ if (s==NULL || s->str==NULL)
- DumpLong(size,D);
+  DumpSize(0,D);
- DumpBlock(tf->code,size,D);
-}
-static void DumpString(char* s, int size, FILE* D)
-{
- if (s==NULL)
-  DumpLong(0,D);
  else
  {
-  DumpLong(size,D);
+  size_t size=s->len+1;			/* include trailing '\0' */
-  DumpBlock(s,size,D);
+  DumpSize(size,D);
+  DumpBlock(s->str,size,D);
  }
 }
-static void DumpTString(TaggedString* s, FILE* D)
+static void DumpCode(const Proto* tf, FILE* D)
 {
- if (s==NULL)
+ DumpInt(tf->ncode,D);
-  DumpString(NULL,0,D);
+ DumpVector(tf->code,tf->ncode,sizeof(*tf->code),D);
- else
-  DumpString(s->str,s->u.s.len+1,D);
 }
-static void DumpLocals(TProtoFunc* tf, FILE* D)
+static void DumpLocals(const Proto* tf, FILE* D)
 {
- if (tf->locvars==NULL)
+ int i,n=tf->nlocvars;
-  DumpInt(0,D);
+ DumpInt(n,D);
- else
+ for (i=0; i<n; i++)
  {
-  LocVar* v;
+  DumpString(tf->locvars[i].varname,D);
-  int n=0;
+  DumpInt(tf->locvars[i].startpc,D);
-  for (v=tf->locvars; v->line>=0; v++)
+  DumpInt(tf->locvars[i].endpc,D);
-   ++n;
-  DumpInt(n,D);
-  for (v=tf->locvars; v->line>=0; v++)
-  {
-   DumpInt(v->line,D);
-   DumpTString(v->varname,D);
-  }
  }
 }
-static void DumpFunction(TProtoFunc* tf, FILE* D, int native);
+static void DumpLines(const Proto* tf, FILE* D)
+{
+ DumpInt(tf->nlineinfo,D);
+ DumpVector(tf->lineinfo,tf->nlineinfo,sizeof(*tf->lineinfo),D);
+}
+static void DumpFunction(const Proto* tf, FILE* D);
-static void DumpConstants(TProtoFunc* tf, FILE* D, int native)
+static void DumpConstants(const Proto* tf, FILE* D)
 {
- int i,n=tf->nconsts;
+ int i,n;
- DumpInt(n,D);
+ DumpInt(n=tf->nkstr,D);
  for (i=0; i<n; i++)
- {
+  DumpString(tf->kstr[i],D);
-  TObject* o=tf->consts+i;
+ DumpInt(tf->nknum,D);
-  fputc(-ttype(o),D);			/* ttype(o) is negative - ORDER LUA_T */
+ DumpVector(tf->knum,tf->nknum,sizeof(*tf->knum),D);
-  switch (ttype(o))
+ DumpInt(n=tf->nkproto,D);
-  {
+ for (i=0; i<n; i++)
-   case LUA_T_NUMBER:
+  DumpFunction(tf->kproto[i],D);
-	DumpNumber(nvalue(o),D,native,tf);
-	break;
-   case LUA_T_STRING:
-	DumpTString(tsvalue(o),D);
-	break;
-   case LUA_T_PROTO:
-	DumpFunction(tfvalue(o),D,native);
-	break;
-   case LUA_T_NIL:
-	break;
-   default:				/* cannot happen */
-	luaU_badconstant("dump",i,o,tf);
-	break;
-  }
- }
 }
-static void DumpFunction(TProtoFunc* tf, FILE* D, int native)
+static void DumpFunction(const Proto* tf, FILE* D)
 {
+ DumpString(tf->source,D);
  DumpInt(tf->lineDefined,D);
- DumpTString(tf->source,D);
+ DumpInt(tf->numparams,D);
- DumpCode(tf,D);
+ DumpByte(tf->is_vararg,D);
+ DumpInt(tf->maxstacksize,D);
  DumpLocals(tf,D);
- DumpConstants(tf,D,native);
+ DumpLines(tf,D);
+ DumpConstants(tf,D);
+ DumpCode(tf,D);
  if (ferror(D))
-  luaL_verror("write error" IN ": %s (errno=%d)",INLOC,strerror(errno),errno);
+ {
+  perror("luac: write error");
+  exit(1);
+ }
 }
-static void DumpHeader(TProtoFunc* Main, FILE* D, int native)
+static void DumpHeader(FILE* D)
 {
- fputc(ID_CHUNK,D);
+ DumpByte(ID_CHUNK,D);
  fputs(SIGNATURE,D);
- fputc(VERSION,D);
+ DumpByte(VERSION,D);
- if (native)
+ DumpByte(luaU_endianess(),D);
- {
+ DumpByte(sizeof(int),D);
-  fputc(sizeof(real),D);
+ DumpByte(sizeof(size_t),D);
-  DumpNumber(TEST_NUMBER,D,native,Main);
+ DumpByte(sizeof(Instruction),D);
- }
+ DumpByte(SIZE_INSTRUCTION,D);
- else
+ DumpByte(SIZE_OP,D);
-  fputc(0,D);
+ DumpByte(SIZE_B,D);
+ DumpByte(sizeof(Number),D);
+ DumpNumber(TEST_NUMBER,D);
 }
-void luaU_dumpchunk(TProtoFunc* Main, FILE* D, int native)
+void luaU_dumpchunk(const Proto* Main, FILE* D)
 {
- DumpHeader(Main,D,native);
+ DumpHeader(D);
- DumpFunction(Main,D,native);
+ DumpFunction(Main,D);
 }

src/luac/luac.c+134−118

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: luac.c,v 1.17 1999/07/02 19:34:26 lhf Exp $	2	** $Id: luac.c,v 1.28 2000/11/06 20:06:27 lhf Exp $
3	** lua compiler (saves bytecodes to files; also list binary files)	3	** lua compiler (saves bytecodes to files; also list binary files)
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -7,181 +7,197 @@ · 1 unmodified line
7	#include <stdio.h>	7	#include <stdio.h>
8	#include <stdlib.h>	8	#include <stdlib.h>
9	#include <string.h>	9	#include <string.h>
10	#include "luac.h"	10
11	#include "lparser.h"	11	#include "lparser.h"
12	#include "lstate.h"	12	#include "lstate.h"
13	#include "lzio.h"	13	#include "lzio.h"
		14	#include "luac.h"
14		15
15	#define OUTPUT "luac.out" /* default output file */	16	#define OUTPUT "luac.out" /* default output file */
16		17
17	static FILE* efopen(char* name, char* mode);	18	static void usage(const char* message, const char* arg);
18	static void doit(int undump, char* filename);	19	static int doargs(int argc, const char* argv[]);
		20	static Proto* load(const char* filename);
		21	static FILE* efopen(const char* name, const char* mode);
		22	static void strip(Proto* tf);
		23	static Proto* combine(Proto** P, int n);
		24
		25	lua_State* lua_state=NULL; /* lazy! */
19		26
20	static int listing=0; /* list bytecodes? */	27	static int listing=0; /* list bytecodes? */
21	static int debugging=0; /* emit debug information? */
22	static int dumping=1; /* dump bytecodes? */	28	static int dumping=1; /* dump bytecodes? */
23	static int undumping=0; /* undump bytecodes? */	29	static int stripping=0; /* strip debug information? */
24	static int optimizing=0; /* optimize? */
25	static int parsing=0; /* parse only? */
26	static int testing=0; /* test integrity? */	30	static int testing=0; /* test integrity? */
27	static int verbose=0; /* tell user what is done */	31	static const char* output=OUTPUT; /* output file name */
28	static int native=0; /* save numbers in native format? */
29	static FILE* D; /* output file */
30		32
31	static void usage(char* op)	33	#define IS(s) (strcmp(argv[i],s)==0)
		34
		35	int main(int argc, const char* argv[])
32	{	36	{
33	if (op) fprintf(stderr,"luac: unrecognized option '%s'\n",op);	37	Proto** P,*tf;
		38	int i=doargs(argc,argv);
		39	argc-=i; argv+=i;
		40	if (argc<=0) usage("no input files given",NULL);
		41	L=lua_open(0);
		42	P=luaM_newvector(L,argc,Proto*);
		43	for (i=0; i<argc; i++)
		44	P[i]=load(IS("-")? NULL : argv[i]);
		45	tf=combine(P,argc);
		46	if (dumping) luaU_optchunk(tf);
		47	if (listing) luaU_printchunk(tf);
		48	if (testing) luaU_testchunk(tf);
		49	if (dumping)
		50	{
		51	if (stripping) strip(tf);
		52	luaU_dumpchunk(tf,efopen(output,"wb"));
		53	}
		54	return 0;
		55	}
		56
		57	static void usage(const char* message, const char* arg)
		58	{
		59	if (message!=NULL)
		60	{
		61	fprintf(stderr,"luac: "); fprintf(stderr,message,arg); fprintf(stderr,"\n");
		62	}
34	fprintf(stderr,	63	fprintf(stderr,
35	"usage: luac [options] [filenames]. Available options are:\n"	64	"usage: luac [options] [filenames]. Available options are:\n"
36	" -c\t\tcompile (default)\n"	65	" - process stdin\n"
37	" -d\t\tgenerate debugging information\n"	66	" -l list\n"
38	" -D name\tpredefine 'name' for conditional compilation\n"	67	" -o file output file (default is \"" OUTPUT "\")\n"
39	" -l\t\tlist (default for -u)\n"	68	" -p parse only\n"
40	" -n\t\tsave numbers in native format (file may not be portable)\n"	69	" -s strip debug information\n"
41	" -o file\toutput file for -c (default is \"" OUTPUT "\")\n"	70	" -t test code integrity\n"
42	" -O\t\toptimize\n"	71	" -v show version information\n"
43	" -p\t\tparse only\n"
44	" -q\t\tquiet (default for -c)\n"
45	" -t\t\ttest code integrity\n"
46	" -u\t\tundump\n"
47	" -U name\tundefine 'name' for conditional compilation\n"
48	" -v\t\tshow version information\n"
49	" -V\t\tverbose\n"
50	" -\t\tcompile \"stdin\"\n"
51	);	72	);
52	exit(1);	73	exit(1);
53	}	74	}
54		75
55	#define IS(s) (strcmp(argv[i],s)==0)	76	static int doargs(int argc, const char* argv[])
56
57	int main(int argc, char* argv[])
58	{	77	{
59	char* d=OUTPUT; /* output file name */
60	int i;	78	int i;
61	lua_open();
62	for (i=1; i<argc; i++)	79	for (i=1; i<argc; i++)
63	{	80	{
64	if (argv[i][0]!='-') /* end of options */	81	if (argv[i]!='-') / end of options */
65	break;	82	break;
66	else if (IS("-")) /* end of options; use stdin */	83	else if (IS("-")) /* end of options; use stdin */
67	break;	84	return i;
68	else if (IS("-c")) /* compile (and dump) */
69	{
70	dumping=1;
71	undumping=0;
72	}
73	else if (IS("-D")) /* $define */
74	{
75	TaggedString* s=luaS_new(argv[++i]);
76	s->u.s.globalval.ttype=LUA_T_NUMBER;
77	s->u.s.globalval.value.n=1;
78	}
79	else if (IS("-d")) /* debug */
80	debugging=1;
81	else if (IS("-l")) /* list */	85	else if (IS("-l")) /* list */
82	listing=1;	86	listing=1;
83	else if (IS("-n")) /* native */
84	native=1;
85	else if (IS("-o")) /* output file */	87	else if (IS("-o")) /* output file */
86	d=argv[++i];
87	else if (IS("-O")) /* optimize */
88	optimizing=1;
89	else if (IS("-p")) /* parse only */
90	{	88	{
91	dumping=0;	89	output=argv[++i];
92	parsing=1;	90	if (output==NULL) usage(NULL,NULL);
93	}	91	}
94	else if (IS("-q")) /* quiet */	92	else if (IS("-p")) /* parse only */
95	listing=0;	93	dumping=0;
		94	else if (IS("-s")) /* strip debug information */
		95	stripping=1;
96	else if (IS("-t")) /* test */	96	else if (IS("-t")) /* test */
97	testing=1;
98	else if (IS("-u")) /* undump */
99	{	97	{
		98	testing=1;
100	dumping=0;	99	dumping=0;
101	undumping=1;
102	listing=1;
103	}
104	else if (IS("-U")) /* undefine */
105	{
106	TaggedString* s=luaS_new(argv[++i]);
107	s->u.s.globalval.ttype=LUA_T_NIL;
108	}	100	}
109	else if (IS("-v")) /* show version */	101	else if (IS("-v")) /* show version */
110	printf("%s %s\n(written by %s)\n\n",LUA_VERSION,LUA_COPYRIGHT,LUA_AUTHORS);
111	else if (IS("-V")) /* verbose */
112	verbose=1;
113	else /* unknown option */
114	usage(argv[i]);
115	}
116	--i; /* fake new argv[0] */
117	argc-=i;
118	argv+=i;
119	if (dumping \|\| parsing)
120	{
121	if (argc<2) usage(NULL);
122	if (dumping)
123	{	102	{
124	for (i=1; i<argc; i++) /* play safe with output file */	103	printf("%s %s\n",LUA_VERSION,LUA_COPYRIGHT);
125	if (IS(d)) luaL_verror("will not overwrite input file \"%s\"",d);	104	if (argc==2) exit(0);
126	D=efopen(d,"wb"); /* must open in binary mode */
127	}	105	}
128	for (i=1; i<argc; i++) doit(0,IS("-")? NULL : argv[i]);	106	else /* unknown option */
129	if (dumping) fclose(D);	107	usage("unrecognized option `%s'",argv[i]);
130	}	108	}
131	if (undumping)	109	if (i==argc && (listing \|\| testing))
132	{	110	{
133	if (argc<2)	111	dumping=0;
134	doit(1,OUTPUT);	112	argv[--i]=OUTPUT;
135	else
136	for (i=1; i<argc; i++) doit(1,IS("-")? NULL : argv[i]);
137	}	113	}
138	return 0;	114	return i;
139	}	115	}
140		116
141	static void do_compile(ZIO* z)	117	static Proto* load(const char* filename)
142	{	118	{
143	TProtoFunc* Main;	119	Proto* tf;
144	if (optimizing) L->debug=0;	120	ZIO z;
145	if (debugging) L->debug=1;	121	char source[512];
146	Main=luaY_parser(z);	122	FILE* f;
147	if (optimizing) luaU_optchunk(Main);	123	int c,undump;
148	if (listing) luaU_printchunk(Main);	124	if (filename==NULL)
149	if (testing) luaU_testchunk(Main);	125	{
150	if (dumping) luaU_dumpchunk(Main,D,native);	126	f=stdin;
		127	filename="(stdin)";
		128	}
		129	else
		130	f=efopen(filename,"r");
		131	c=ungetc(fgetc(f),f);
		132	if (ferror(f))
		133	{
		134	fprintf(stderr,"luac: cannot read from ");
		135	perror(filename);
		136	exit(1);
		137	}
		138	undump=(c==ID_CHUNK);
		139	if (undump && f!=stdin)
		140	{
		141	fclose(f);
		142	f=efopen(filename,"rb");
		143	}
		144	sprintf(source,"@%.*s",Sizeof(source)-2,filename);
		145	luaZ_Fopen(&z,f,source);
		146	tf = undump ? luaU_undump(L,&z) : luaY_parser(L,&z);
		147	if (f!=stdin) fclose(f);
		148	return tf;
151	}	149	}
152		150
153	static void do_undump(ZIO* z)	151	static Proto* combine(Proto** P, int n)
154	{	152	{
155	for (;;)	153	if (n==1)
		154	return P[0];
		155	else
156	{	156	{
157	TProtoFunc* Main=luaU_undump1(z);	157	int i,pc=0;
158	if (Main==NULL) break;	158	Proto* tf=luaF_newproto(L);
159	if (optimizing) luaU_optchunk(Main);	159	tf->source=luaS_new(L,"=(luac)");
160	if (listing) luaU_printchunk(Main);	160	tf->maxstacksize=1;
161	if (testing) luaU_testchunk(Main);	161	tf->kproto=P;
		162	tf->nkproto=n;
		163	tf->ncode=2*n+1;
		164	tf->code=luaM_newvector(L,tf->ncode,Instruction);
		165	for (i=0; i<n; i++)
		166	{
		167	tf->code[pc++]=CREATE_AB(OP_CLOSURE,i,0);
		168	tf->code[pc++]=CREATE_AB(OP_CALL,0,0);
		169	}
		170	tf->code[pc++]=OP_END;
		171	return tf;
162	}	172	}
163	}	173	}
164		174
165	static void doit(int undump, char* filename)	175	static void strip(Proto* tf)
166	{	176	{
167	FILE* f= (filename==NULL) ? stdin : efopen(filename, undump ? "rb" : "r");	177	int i,n=tf->nkproto;
168	ZIO z;	178	tf->lineinfo=NULL;
169	char source[255+2]; /* +2 for '@' and '\0' */	179	tf->nlineinfo=0;
170	luaL_filesource(source,filename,sizeof(source));	180	tf->source=luaS_new(L,"=(none)");
171	zFopen(&z,f,source);	181	tf->locvars=NULL;
172	if (verbose) fprintf(stderr,"%s\n",source+1);	182	tf->nlocvars=0;
173	if (undump) do_undump(&z); else do_compile(&z);	183	for (i=0; i<n; i++) strip(tf->kproto[i]);
174	if (f!=stdin) fclose(f);
175	}	184	}
176		185
177	static FILE* efopen(char* name, char* mode)	186	static FILE* efopen(const char* name, const char* mode)
178	{	187	{
179	FILE* f=fopen(name,mode);	188	FILE* f=fopen(name,mode);
180	if (f==NULL)	189	if (f==NULL)
181	{	190	{
182	fprintf(stderr,"luac: cannot open %sput file ",mode[0]=='r' ? "in" : "out");	191	fprintf(stderr,"luac: cannot open %sput file ",*mode=='r' ? "in" : "out");
183	perror(name);	192	perror(name);
184	exit(1);	193	exit(1);
185	}	194	}
186	return f;	195	return f;
187	}	196	}
		197
		198	void luaU_testchunk(const Proto* Main)
		199	{
		200	UNUSED(Main);
		201	fprintf(stderr,"luac: -t not operational in this version\n");
		202	exit(1);
		203	}

src/luac/luac.h+10−27

 /*
-** $Id: luac.h,v 1.11 1999/07/02 19:34:26 lhf Exp $
+** $Id: luac.h,v 1.18 2000/10/31 16:57:23 lhf Exp $
 ** definitions for luac
 ** See Copyright Notice in lua.h
 */
-#include "lauxlib.h"
+#include "ldebug.h"
 #include "lfunc.h"
 #include "lmem.h"
 #include "lobject.h"
 #include "lopcodes.h"
 #include "lstring.h"
+#include "ltable.h"
 #include "lundump.h"
-typedef struct
+extern lua_State *lua_state;
-{
+#define	L	lua_state		/* lazy! */
- char* name;				/* name of opcode */
- int op;				/* value of opcode */
- int class;				/* class of opcode (byte variant) */
- int args;				/* types of arguments (operands) */
- int arg;				/* arg #1 */
- int arg2;				/* arg #2 */
-} Opcode;
 /* from dump.c */
-void luaU_dumpchunk(TProtoFunc* Main, FILE* D, int native);
+void luaU_dumpchunk(const Proto* Main, FILE* D);
-/* from opcode.c */
-int luaU_opcodeinfo(TProtoFunc* tf, Byte* p, Opcode* I, char* xFILE, int xLINE);
-int luaU_codesize(TProtoFunc* tf);
 /* from opt.c */
-void luaU_optchunk(TProtoFunc* Main);
+void luaU_optchunk(Proto* Main);
 /* from print.c */
-void luaU_printchunk(TProtoFunc* Main);
+void luaU_printchunk(const Proto* Main);
 /* from test.c */
-void luaU_testchunk(TProtoFunc* Main);
+void luaU_testchunk(const Proto* Main);
-TObject* luaU_getconstant(TProtoFunc* tf, int i, int at);
-#define INFO(tf,p,I)	luaU_opcodeinfo(tf,p,I,__FILE__,__LINE__)
-/* fake (but convenient) opcodes */
+#define Sizeof(x)	((int)sizeof(x))
-#define NOP	255
-#define STACK	(-1)
-#define ARGS	(-2)
-#define VARARGS	(-3)

src/luac/opcode.c+0−102

@@ -1,102 +0,0 @@
1	/*
2	** $Id: opcode.c,v 1.9 1999/05/25 19:58:55 lhf Exp $
3	** opcode information
4	** See Copyright Notice in lua.h
5	*/
6
7	#include "luac.h"
8
9	enum { /* for Opcode.args */
10	ARGS_NONE,
11	ARGS_B,
12	ARGS_W,
13	ARGS_BB,
14	ARGS_WB
15	};
16
17	static Opcode Info[]= /* ORDER lopcodes.h */
18	{
19	#include "opcode.h"
20	};
21
22	static Opcode Fake[]= /* ORDER luac.h */
23	{
24	{ "NOP", NOP, NOP, ARGS_NONE, -1, -1 },
25	{ "STACK", STACK, STACK, ARGS_B, -1, -1 },
26	{ "ARGS", ARGS, ARGS, ARGS_B, -1, -1 },
27	{ "VARARGS", VARARGS, VARARGS, ARGS_B, -1, -1 },
28	};
29
30	#define NOPCODES (sizeof(Info)/sizeof(Info[0]))
31
32	int luaU_opcodeinfo(TProtoFunc* tf, Byte* p, Opcode* I, char* xFILE, int xLINE)
33	{
34	Opcode OP;
35	Byte* code=tf->code;
36	int op=*p;
37	int size=1;
38	if (p==code) /* first byte is STACK */
39	{
40	OP=Fake[-STACK];
41	OP.arg=op;
42	}
43	else if (p==code+1) /* second byte is ARGS or VARARGS */
44	{
45	if (op<ZEROVARARG)
46	{
47	OP=Fake[-ARGS];
48	OP.arg=op;
49	}
50	else
51	{
52	OP=Fake[-VARARGS];
53	OP.arg=op-ZEROVARARG;
54	}
55	}
56	else if (op==NOP) /* NOP is fake */
57	{
58	OP=Fake[0];
59	}
60	else if (op>=NOPCODES) /* cannot happen */
61	{
62	luaL_verror("[%s:%d] bad opcode %d at pc=%d" IN,
63	xFILE,xLINE,op,(int)(p-code),INLOC);
64	return 0;
65	}
66	else /* ordinary opcode */
67	{
68	OP=Info[op];
69	switch (OP.args)
70	{
71	case ARGS_NONE: size=1;
72	break;
73	case ARGS_B: size=2; OP.arg=p[1];
74	break;
75	case ARGS_W: size=3; OP.arg=(p[1]<<8)+p[2];
76	break;
77	case ARGS_BB: size=3; OP.arg=p[1]; OP.arg2=p[2];
78	break;
79	case ARGS_WB: size=4; OP.arg=(p[1]<<8)+p[2]; OP.arg2=p[3];
80	break;
81	default: /* cannot happen */
82	luaL_verror("[%s:%d] bad args %d for %s at pc=%d" IN,
83	__FILE__,__LINE__,OP.args,OP.name,(int)(p-code),INLOC);
84	break;
85	}
86	}
87	*I=OP;
88	return size;
89	}
90
91	int luaU_codesize(TProtoFunc* tf)
92	{
93	Byte* code=tf->code;
94	Byte* p=code;
95	for (;;)
96	{
97	Opcode OP;
98	p+=INFO(tf,p,&OP);
99	if (OP.op==ENDCODE) break;
100	}
101	return p-code;
102	}

src/luac/opcode.h+0−70

@@ -1,70 +0,0 @@
1	/*
2	** $Id: opcode.h,v 1.1 1999/03/25 13:43:05 lhf Exp $
3	** opcode info to be #included into opcode.c
4	** extracted automatically from lopcodes.h by mkopcodeh -- DO NOT EDIT
5	** See Copyright Notice in lua.h
6	*/
7	{ "ENDCODE", ENDCODE, ENDCODE, ARGS_NONE, -1, -1 },
8	{ "RETCODE", RETCODE, RETCODE, ARGS_B, -1, -1 },
9	{ "CALL", CALL, CALL, ARGS_BB, -1, -1 },
10	{ "TAILCALL", TAILCALL, TAILCALL, ARGS_BB, -1, -1 },
11	{ "PUSHNIL", PUSHNIL, PUSHNIL, ARGS_B, -1, -1 },
12	{ "POP", POP, POP, ARGS_B, -1, -1 },
13	{ "PUSHNUMBERW", PUSHNUMBERW, PUSHNUMBER, ARGS_W, -1, -1 },
14	{ "PUSHNUMBER", PUSHNUMBER, PUSHNUMBER, ARGS_B, -1, -1 },
15	{ "PUSHNUMBERNEGW", PUSHNUMBERNEGW, PUSHNUMBERNEG, ARGS_W, -1, -1 },
16	{ "PUSHNUMBERNEG", PUSHNUMBERNEG, PUSHNUMBERNEG, ARGS_B, -1, -1 },
17	{ "PUSHCONSTANTW", PUSHCONSTANTW, PUSHCONSTANT, ARGS_W, -1, -1 },
18	{ "PUSHCONSTANT", PUSHCONSTANT, PUSHCONSTANT, ARGS_B, -1, -1 },
19	{ "PUSHUPVALUE", PUSHUPVALUE, PUSHUPVALUE, ARGS_B, -1, -1 },
20	{ "PUSHLOCAL", PUSHLOCAL, PUSHLOCAL, ARGS_B, -1, -1 },
21	{ "GETGLOBALW", GETGLOBALW, GETGLOBAL, ARGS_W, -1, -1 },
22	{ "GETGLOBAL", GETGLOBAL, GETGLOBAL, ARGS_B, -1, -1 },
23	{ "GETTABLE", GETTABLE, GETTABLE, ARGS_NONE, -1, -1 },
24	{ "GETDOTTEDW", GETDOTTEDW, GETDOTTED, ARGS_W, -1, -1 },
25	{ "GETDOTTED", GETDOTTED, GETDOTTED, ARGS_B, -1, -1 },
26	{ "PUSHSELFW", PUSHSELFW, PUSHSELF, ARGS_W, -1, -1 },
27	{ "PUSHSELF", PUSHSELF, PUSHSELF, ARGS_B, -1, -1 },
28	{ "CREATEARRAYW", CREATEARRAYW, CREATEARRAY, ARGS_W, -1, -1 },
29	{ "CREATEARRAY", CREATEARRAY, CREATEARRAY, ARGS_B, -1, -1 },
30	{ "SETLOCAL", SETLOCAL, SETLOCAL, ARGS_B, -1, -1 },
31	{ "SETGLOBALW", SETGLOBALW, SETGLOBAL, ARGS_W, -1, -1 },
32	{ "SETGLOBAL", SETGLOBAL, SETGLOBAL, ARGS_B, -1, -1 },
33	{ "SETTABLEPOP", SETTABLEPOP, SETTABLEPOP, ARGS_NONE, -1, -1 },
34	{ "SETTABLE", SETTABLE, SETTABLE, ARGS_B, -1, -1 },
35	{ "SETLISTW", SETLISTW, SETLIST, ARGS_WB, -1, -1 },
36	{ "SETLIST", SETLIST, SETLIST, ARGS_BB, -1, -1 },
37	{ "SETMAP", SETMAP, SETMAP, ARGS_B, -1, -1 },
38	{ "NEQOP", NEQOP, NEQOP, ARGS_NONE, -1, -1 },
39	{ "EQOP", EQOP, EQOP, ARGS_NONE, -1, -1 },
40	{ "LTOP", LTOP, LTOP, ARGS_NONE, -1, -1 },
41	{ "LEOP", LEOP, LEOP, ARGS_NONE, -1, -1 },
42	{ "GTOP", GTOP, GTOP, ARGS_NONE, -1, -1 },
43	{ "GEOP", GEOP, GEOP, ARGS_NONE, -1, -1 },
44	{ "ADDOP", ADDOP, ADDOP, ARGS_NONE, -1, -1 },
45	{ "SUBOP", SUBOP, SUBOP, ARGS_NONE, -1, -1 },
46	{ "MULTOP", MULTOP, MULTOP, ARGS_NONE, -1, -1 },
47	{ "DIVOP", DIVOP, DIVOP, ARGS_NONE, -1, -1 },
48	{ "POWOP", POWOP, POWOP, ARGS_NONE, -1, -1 },
49	{ "CONCOP", CONCOP, CONCOP, ARGS_NONE, -1, -1 },
50	{ "MINUSOP", MINUSOP, MINUSOP, ARGS_NONE, -1, -1 },
51	{ "NOTOP", NOTOP, NOTOP, ARGS_NONE, -1, -1 },
52	{ "ONTJMPW", ONTJMPW, ONTJMP, ARGS_W, -1, -1 },
53	{ "ONTJMP", ONTJMP, ONTJMP, ARGS_B, -1, -1 },
54	{ "ONFJMPW", ONFJMPW, ONFJMP, ARGS_W, -1, -1 },
55	{ "ONFJMP", ONFJMP, ONFJMP, ARGS_B, -1, -1 },
56	{ "JMPW", JMPW, JMP, ARGS_W, -1, -1 },
57	{ "JMP", JMP, JMP, ARGS_B, -1, -1 },
58	{ "IFFJMPW", IFFJMPW, IFFJMP, ARGS_W, -1, -1 },
59	{ "IFFJMP", IFFJMP, IFFJMP, ARGS_B, -1, -1 },
60	{ "IFTUPJMPW", IFTUPJMPW, IFTUPJMP, ARGS_W, -1, -1 },
61	{ "IFTUPJMP", IFTUPJMP, IFTUPJMP, ARGS_B, -1, -1 },
62	{ "IFFUPJMPW", IFFUPJMPW, IFFUPJMP, ARGS_W, -1, -1 },
63	{ "IFFUPJMP", IFFUPJMP, IFFUPJMP, ARGS_B, -1, -1 },
64	{ "CLOSUREW", CLOSUREW, CLOSURE, ARGS_WB, -1, -1 },
65	{ "CLOSURE", CLOSURE, CLOSURE, ARGS_BB, -1, -1 },
66	{ "SETLINEW", SETLINEW, SETLINE, ARGS_W, -1, -1 },
67	{ "SETLINE", SETLINE, SETLINE, ARGS_B, -1, -1 },
68	{ "LONGARGW", LONGARGW, LONGARG, ARGS_W, -1, -1 },
69	{ "LONGARG", LONGARG, LONGARG, ARGS_B, -1, -1 },
70	{ "CHECKSTACK", CHECKSTACK, CHECKSTACK, ARGS_B, -1, -1 },

src/luac/opt.c+86−240

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: opt.c,v 1.12 1999/07/02 19:34:26 lhf Exp $	2	** $Id: opt.c,v 1.22 2000/10/31 16:57:23 lhf Exp $
3	** optimize bytecodes	3	** optimize bytecodes
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -7,275 +7,121 @@ · 1 unmodified line
7	#include <stdio.h>	7	#include <stdio.h>
8	#include <stdlib.h>	8	#include <stdlib.h>
9	#include <string.h>	9	#include <string.h>
10	#include "luac.h"
11		10
12	static void FixArg(Byte* p, int i, int j, int isconst)	11	#include "luac.h"
13	{
14	if (j==i)
15	;
16	else if (i<=MAX_BYTE) /* j<i, so j fits where i did */
17	p[1]=j;
18	else if (i<=MAX_WORD)
19	{
20	if (isconst && j<=MAX_BYTE) /* may use byte variant instead */
21	{
22	p[0]++; /* byte variant follows word variant */
23	p[1]=j;
24	p[2]=NOP;
25	}
26	else /* stuck with word variant */
27	{
28	p[1]=j>>8;
29	p[2]=j;
30	}
31	}
32	else /* previous instruction must've been LONGARG */
33	{
34	if (isconst && j<=MAX_WORD) p[-2]=p[-1]=NOP; else p[-1]=j>>16;
35	p[1]=j>>8;
36	p[2]=j;
37	}
38	}
39		12
40	static void FixConstants(TProtoFunc* tf, int* C)	13	static int MapConstant(Hash* t, int j, const TObject* key)
41	{	14	{
42	Byte* code=tf->code;	15	const TObject* o=luaH_get(L,t,key);
43	Byte* p=code;	16	if (ttype(o)==LUA_TNUMBER)
44	int longarg=0;	17	return (int) nvalue(o);
45	for (;;)	18	else
46	{	19	{
47	Opcode OP;	20	TObject val;
48	int n=INFO(tf,p,&OP);	21	ttype(&val)=LUA_TNUMBER;
49	int op=OP.class;	22	nvalue(&val)=j;
50	int i=OP.arg+longarg;	23	*luaH_set(L,t,key)=val;
51	longarg=0;	24	LUA_ASSERT(j>=0,"MapConstant returns negative!");
52	if (op==PUSHCONSTANT \|\| op==GETGLOBAL \|\| op==GETDOTTED \|\|	25	return j;
53	op==PUSHSELF \|\| op==SETGLOBAL \|\| op==CLOSURE)
54	FixArg(p,i,C[i],1);
55	else if (op==LONGARG) longarg=i<<16;
56	else if (op==ENDCODE) break;
57	p+=n;
58	}	26	}
59	}	27	}
60		28
61	#define UNREF 1 /* "type" of unused constants */	29	static int MapConstants(Proto* tf, Hash* map)
62	#define BIAS 128 /* mark for used constants */
63
64	static void NoUnrefs(TProtoFunc* tf)
65	{	30	{
66	int i,n=tf->nconsts;	31	int i,j,k,n,m=0;
67	Byte* code=tf->code;	32	TObject o;
68	Byte* p=code;	33	j=0; n=tf->nknum; ttype(&o)=LUA_TNUMBER;
69	int longarg=0;	34	for (i=0; i<n; i++)
70	for (;;) /* mark all used constants */
71	{
72	Opcode OP;
73	int n=INFO(tf,p,&OP);
74	int op=OP.class;
75	int i=OP.arg+longarg;
76	longarg=0;
77	if (op==PUSHCONSTANT \|\| op==GETGLOBAL \|\| op==GETDOTTED \|\|
78	op==PUSHSELF \|\| op==SETGLOBAL \|\| op==CLOSURE)
79	{
80	TObject* o=tf->consts+i;
81	if (ttype(o)<=0) ttype(o)+=BIAS; /* mark as used */
82	}
83	else if (op==LONGARG) longarg=i<<16;
84	else if (op==ENDCODE) break;
85	p+=n;
86	}
87	for (i=0; i<n; i++) /* mark all unused constants */
88	{	35	{
89	TObject* o=tf->consts+i;	36	nvalue(&o)=tf->knum[i];
90	if (ttype(o)<=0)	37	k=MapConstant(map,j,&o);
91	ttype(o)=UNREF; /* mark as unused */	38	if (k==j) j++;
92	else
93	ttype(o)-=BIAS; /* unmark used constant */
94	}	39	}
95	}	40	m=j;
96		41	j=0; n=tf->nkstr; ttype(&o)=LUA_TSTRING;
97	#define CMP(oa,ob,f) memcmp(&f(oa),&f(ob),sizeof(f(oa)))	42	for (i=0; i<n; i++)
98
99	static int compare(TProtoFunc* tf, int ia, int ib)
100	{
101	TObject* oa=tf->consts+ia;
102	TObject* ob=tf->consts+ib;
103	int t=ttype(oa)-ttype(ob);
104	if (t) return t;
105	switch (ttype(oa))
106	{	43	{
107	case LUA_T_NUMBER: return CMP(oa,ob,nvalue);	44	tsvalue(&o)=tf->kstr[i];
108	case LUA_T_STRING: return CMP(oa,ob,tsvalue);	45	k=MapConstant(map,j,&o);
109	case LUA_T_PROTO: return CMP(oa,ob,tfvalue);	46	if (k==j) j++;
110	case LUA_T_NIL: return 0;
111	case UNREF: return 0;
112	default: return ia-ib; /* cannot happen */
113	}	47	}
		48	return m+j;
114	}	49	}
115		50
116	static TProtoFunc* TF; /* for sort */	51	static void PackConstants(Proto* tf, Hash* map)
117
118	static int compare1(const void* a, const void* b)
119	{
120	int ia=(int)a;
121	int ib=(int)b;
122	int t=compare(TF,ia,ib);
123	return (t) ? t : ia-ib;
124	}
125
126	static void OptConstants(TProtoFunc* tf)
127	{	52	{
128	static int* C=NULL;	53	int i,j,k,n;
129	static int* D=NULL;	54	TObject o;
130	int i,k;	55	#ifdef DEBUG
131	int n=tf->nconsts;	56	printf("%p before pack nknum=%d nkstr=%d\n",tf,tf->nknum,tf->nkstr);
132	if (n==0) return;	57	#endif
133	luaM_reallocvector(C,n,int);	58	j=0; n=tf->nknum; ttype(&o)=LUA_TNUMBER;
134	luaM_reallocvector(D,n,int);
135	NoUnrefs(tf);
136	for (i=0; i<n; i++) C[i]=D[i]=i; /* group duplicates */
137	TF=tf; qsort(C,n,sizeof(C[0]),compare1);
138	k=C[0]; /* build duplicate table */
139	for (i=1; i<n; i++)
140	{
141	int j=C[i];
142	if (compare(tf,k,j)==0) D[j]=k; else k=j;
143	}
144	k=0; /* build rename map & pack constants */
145	for (i=0; i<n; i++)	59	for (i=0; i<n; i++)
146	{	60	{
147	if (D[i]==i) /* new value */	61	nvalue(&o)=tf->knum[i];
148	{	62	k=MapConstant(map,-1,&o);
149	TObject* o=tf->consts+i;	63	if (k==j) tf->knum[j++]=tf->knum[i];
150	if (ttype(o)!=UNREF)
151	{
152	tf->consts[k]=tf->consts[i];
153	C[i]=k++;
154	}
155	}
156	else C[i]=C[D[i]];
157	}	64	}
158	if (k<n)	65	tf->nknum=j;
		66	j=0; n=tf->nkstr; ttype(&o)=LUA_TSTRING;
		67	for (i=0; i<n; i++)
159	{	68	{
160	printf("\t" SOURCE " reduced constants from %d to %d\n",	69	tsvalue(&o)=tf->kstr[i];
161	tf->source->str,tf->lineDefined,n,k);	70	k=MapConstant(map,-1,&o);
162	FixConstants(tf,C);	71	if (k==j) tf->kstr[j++]=tf->kstr[i];
163	tf->nconsts=k;
164	}	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
165	}	77	}
166		78
167	static int NoDebug(TProtoFunc* tf)	79	static void OptConstants(Proto* tf)
168	{	80	{
169	Byte* code=tf->code;	81	Instruction* p;
170	Byte* p=code;	82	int n=tf->nknum+tf->nkstr;
171	int lop=NOP; /* last opcode */	83	Hash* map=luaH_new(L,n);
172	int nop=0;	84	int m=MapConstants(tf,map);
173	for (;;) /* change SETLINE to NOP */	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++)
174	{	90	{
175	Opcode OP;	91	Instruction i=*p;
176	int n=INFO(tf,p,&OP);	92	int op=GET_OPCODE(i);
177	int op=OP.class;	93	switch (op)
178	if (op==NOP) ++nop;
179	else if (op==SETLINE)
180	{	94	{
181	int m;	95	TObject o;
182	if (lop==LONGARG) m=2; else if (lop==LONGARGW) m=3; else m=0;	96	int j,k;
183	nop+=n+m; memset(p-m,NOP,n+m);	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;
184	}	116	}
185	else if (op==ENDCODE) break;
186	lop=OP.op;
187	p+=n;
188	}	117	}
189	return nop;
190	}	118	}
191		119
192	static int FixJump(TProtoFunc* tf, Byte* a, Byte* b)	120	#define OptFunction luaU_optchunk
193	{
194	Byte* p;
195	int nop=0;
196	for (p=a; p<b; )
197	{
198	Opcode OP;
199	int n=INFO(tf,p,&OP);
200	int op=OP.class;
201	if (op==NOP) ++nop;
202	else if (op==ENDCODE) break;
203	p+=n;
204	}
205	return nop;
206	}
207		121
208	static void FixJumps(TProtoFunc* tf)	122	void OptFunction(Proto* tf)
209	{
210	Byte* code=tf->code;
211	Byte* p=code;
212	int longarg=0;
213	for (;;)
214	{
215	Opcode OP;
216	int n=INFO(tf,p,&OP);
217	int op=OP.class;
218	int i=OP.arg+longarg;
219	int nop=0;
220	longarg=0;
221	if (op==ENDCODE) break;
222	else if (op==IFTUPJMP \|\| op==IFFUPJMP)
223	nop=FixJump(tf,p-i+n,p);
224	else if (op==ONTJMP \|\| op==ONFJMP \|\| op==JMP \|\| op==IFFJMP)
225	nop=FixJump(tf,p,p+i+n);
226	else if (op==LONGARG) longarg=i<<16;
227	if (nop>0) FixArg(p,i,i-nop,0);
228	p+=n;
229	}
230	}
231
232	static void PackCode(TProtoFunc* tf)
233	{
234	Byte* code=tf->code;
235	Byte* p=code;
236	Byte* q=code;
237	for (;;)
238	{
239	Opcode OP;
240	int n=INFO(tf,p,&OP);
241	int op=OP.class;
242	if (op!=NOP) { memcpy(q,p,n); q+=n; }
243	p+=n;
244	if (op==ENDCODE) break;
245	}
246	printf("\t" SOURCE " reduced code from %d to %d\n",
247	tf->source->str,tf->lineDefined,(int)(p-code),(int)(q-code));
248	}
249
250	static void OptCode(TProtoFunc* tf)
251	{
252	if (NoDebug(tf)==0) return; /* cannot improve code */
253	FixJumps(tf);
254	PackCode(tf);
255	}
256
257	static void OptFunction(TProtoFunc* tf);
258
259	static void OptFunctions(TProtoFunc* tf)
260	{
261	int i,n=tf->nconsts;
262	for (i=0; i<n; i++)
263	{
264	TObject* o=tf->consts+i;
265	if (ttype(o)==LUA_T_PROTO) OptFunction(tfvalue(o));
266	}
267	}
268
269	static void OptFunction(TProtoFunc* tf)
270	{	123	{
		124	int i,n=tf->nkproto;
271	OptConstants(tf);	125	OptConstants(tf);
272	OptCode(tf);	126	for (i=0; i<n; i++) OptFunction(tf->kproto[i]);
273	OptFunctions(tf);
274	tf->source=luaS_new("");
275	tf->locvars=NULL;
276	}
277
278	void luaU_optchunk(TProtoFunc* Main)
279	{
280	OptFunction(Main);
281	}	127	}

src/luac/print.c+64−188

@@ -1,223 +1,99 @@
1	/*	1	/*
2	** $Id: print.c,v 1.21 1999/05/25 19:58:55 lhf Exp $	2	** $Id: print.c,v 1.32 2000/11/06 20:04:36 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	#include <stdlib.h>
		9
9	#include "luac.h"	10	#include "luac.h"
10		11
11	#ifdef DEBUG	12	/* macros used in print.h, included in PrintCode */
12	static void PrintConstants(TProtoFunc* tf)	13	#define P_OP(x) printf("%-11s\t",x)
		14	#define P_NONE
		15	#define P_AB printf("%d %d",GETARG_A(i),GETARG_B(i))
		16	#define P_F printf("%d %d\t; %p",GETARG_A(i),GETARG_B(i),tf->kproto[GETARG_A(i)])
		17	#define P_J printf("%d\t; to %d",GETARG_S(i),GETARG_S(i)+at+1)
		18	#define P_Q PrintString(tf,GETARG_U(i))
		19	#define P_K printf("%d\t; %s",GETARG_U(i),tf->kstr[GETARG_U(i)]->str)
		20	#define P_L PrintLocal(tf,GETARG_U(i),at-1)
		21	#define P_N printf("%d\t; " NUMBER_FMT,GETARG_U(i),tf->knum[GETARG_U(i)])
		22	#define P_S printf("%d",GETARG_S(i))
		23	#define P_U printf("%u",GETARG_U(i))
		24
		25	static void PrintString(const Proto* tf, int n)
13	{	26	{
14	int i,n=tf->nconsts;	27	const char* s=tf->kstr[n]->str;
15	printf("constants (%d) for %p:\n",n,tf);	28	printf("%d\t; ",n);
16	for (i=0; i<n; i++)	29	putchar('"');
		30	for (; *s; s++)
17	{	31	{
18	TObject* o=tf->consts+i;	32	switch (*s)
19	printf("%6d ",i);
20	switch (ttype(o))
21	{	33	{
22	case LUA_T_NUMBER:	34	case '"': printf("\\\""); break;
23	printf("N " NUMBER_FMT "\n",(double)nvalue(o));	35	case '\a': printf("\\a"); break;
24	break;	36	case '\b': printf("\\b"); break;
25	case LUA_T_STRING:	37	case '\f': printf("\\f"); break;
26	printf("S %p\t\"%s\"\n",tsvalue(o),svalue(o));	38	case '\n': printf("\\n"); break;
27	break;	39	case '\r': printf("\\r"); break;
28	case LUA_T_PROTO:	40	case '\t': printf("\\t"); break;
29	printf("F %p\n",tfvalue(o));	41	case '\v': printf("\\v"); break;
30	break;	42	default: putchar(*s); break;
31	case LUA_T_NIL:
32	printf("nil\n");
33	break;
34	default: /* cannot happen */
35	printf("? type=%d\n",ttype(o));
36	break;
37	}	43	}
38	}	44	}
		45	putchar('"');
39	}	46	}
40	#endif
41		47
42	static void PrintConstant(TProtoFunc* tf, int i, int at)	48	static void PrintLocal(const Proto* tf, int n, int pc)
43	{	49	{
44	TObject* o=luaU_getconstant(tf,i,at);	50	const char* s=luaF_getlocalname(tf,n+1,pc);
45	switch (ttype(o))	51	printf("%u",n);
46	{	52	if (s!=NULL) printf("\t; %s",s);
47	case LUA_T_NUMBER:
48	printf(NUMBER_FMT,(double)nvalue(o));
49	break;
50	case LUA_T_STRING:
51	printf("\"%s\"",svalue(o));
52	break;
53	case LUA_T_PROTO:
54	printf("function at %p",(void*)tfvalue(o));
55	break;
56	case LUA_T_NIL:
57	printf("(nil)");
58	break;
59	default: /* cannot happen */
60	luaU_badconstant("print",i,o,tf);
61	break;
62	}
63	}	53	}
64		54
65	static void PrintCode(TProtoFunc* tf)	55	static void PrintCode(const Proto* tf)
66	{	56	{
67	Byte* code=tf->code;	57	const Instruction* code=tf->code;
68	Byte* p=code;	58	const Instruction* p=code;
69	int line=0;
70	int longarg=0;
71	for (;;)	59	for (;;)
72	{	60	{
73	Opcode OP;	61	int at=p-code+1;
74	int n=INFO(tf,p,&OP);	62	Instruction i=*p;
75	int i=OP.arg+longarg;	63	int line=luaG_getline(tf->lineinfo,at-1,1,NULL);
76	int at=p-code;	64	printf("%6d\t",at);
77	longarg=0;	65	if (line>=0) printf("[%d]\t",line); else printf("[-]\t");
78	printf("%6d ",at);	66	switch (GET_OPCODE(i)) {
79	{	67	#include "print.h"
80	Byte* q=p;
81	int j=n;
82	while (j--) printf("%02X",*q++);
83	}
84	printf("%s%-14s ",2(5-n),"",OP.name);
85	if (OP.arg >=0) printf("%d",i);
86	if (OP.arg2>=0) printf(" %d",OP.arg2);
87
88	switch (OP.class)
89	{
90
91	case ENDCODE:
92	printf("\n");
93	return;
94
95	case PUSHCONSTANT:
96	case GETGLOBAL:
97	case SETGLOBAL:
98	case GETDOTTED:
99	case PUSHSELF:
100	case CLOSURE:
101	printf("\t; ");
102	PrintConstant(tf,i,at);
103	break;
104
105	case PUSHLOCAL:
106	case SETLOCAL:
107	{
108	char* s=luaF_getlocalname(tf,i+1,line);
109	if (s) printf("\t; %s",s);
110	break;
111	}
112
113	case SETLINE:
114	printf("\t; " SOURCE,tf->source->str,line=i);
115	break;
116
117	case LONGARG:
118	longarg=i<<16;
119	break;
120
121	/* suggested by Norman Ramsey <nr@cs.virginia.edu> */
122	case ONTJMP:
123	case ONFJMP:
124	case JMP:
125	case IFFJMP:
126	printf("\t; to %d",at+i+n);
127	break;
128	case IFTUPJMP:
129	case IFFUPJMP:
130	printf("\t; to %d",at-i+n);
131	break;
132
133	}
134	printf("\n");
135	p+=n;
136	}
137	}
138
139	static void PrintLocals(TProtoFunc* tf)
140	{
141	LocVar* v=tf->locvars;
142	int n,i;
143	if (v==NULL \|\| v->line<0) return;
144	n=tf->code[1]; if (n>=ZEROVARARG) n-=ZEROVARARG;
145	printf("locals:");
146	for (i=0; i<n; v++,i++) /* arguments */
147	printf(" %s",v->varname->str);
148	for (; v->line>=0; v++)
149	{
150	if (v->varname==NULL)
151	{
152	--i; if (i<0) luaL_verror("bad locvars[%d]",v-tf->locvars); else printf(")");
153	}
154	else
155	{
156	++i; printf(" (%s",v->varname->str);
157	}	68	}
		69	printf("\n");
		70	if (i==OP_END) break;
		71	p++;
158	}	72	}
159	i-=n;
160	while (i--) printf(")");
161	printf("\n");
162	}	73	}
163		74
164	#define IsMain(tf) (tf->lineDefined==0)	75	#define IsMain(tf) (tf->lineDefined==0)
165		76
166	static void PrintHeader(TProtoFunc* tf, TProtoFunc* Main, int at)	77	#define SS(x) (x==1)?"":"s"
167	{	78	#define S(x) x,SS(x)
168	int size=luaU_codesize(tf);
169	if (IsMain(tf))
170	printf("\nmain " SOURCE " (%d bytes at %p)\n",
171	tf->source->str,tf->lineDefined,size,tf);
172	else
173	{
174	printf("\nfunction " SOURCE " (%d bytes at %p); used at ",
175	tf->source->str,tf->lineDefined,size,tf);
176	if (Main && IsMain(Main))
177	printf("main");
178	else
179	printf("%p",Main);
180	printf("+%d\n",at);
181	}
182	}
183
184	static void PrintFunction(TProtoFunc* tf, TProtoFunc* Main, int at);
185		79
186	static void PrintFunctions(TProtoFunc* Main)	80	static void PrintHeader(const Proto* tf)
187	{	81	{
188	Byte* code=Main->code;	82	printf("\n%s " SOURCE_FMT " (%d instruction%s/%d bytes at %p)\n",
189	Byte* p=code;	83	IsMain(tf)?"main":"function",SOURCE,
190	int longarg=0;	84	S(tf->ncode),tf->ncode*Sizeof(Instruction),tf);
191	for (;;)	85	printf("%d%s param%s, %d stack%s, ",
192	{	86	tf->numparams,tf->is_vararg?"+":"",SS(tf->numparams),S(tf->maxstacksize));
193	Opcode OP;	87	printf("%d local%s, %d string%s, %d number%s, %d function%s, %d line%s\n",
194	int n=INFO(Main,p,&OP);	88	S(tf->nlocvars),S(tf->nkstr),S(tf->nknum),S(tf->nkproto),S(tf->nlineinfo));
195	int op=OP.class;
196	int i=OP.arg+longarg;
197	longarg=0;
198	if (op==PUSHCONSTANT \|\| op==CLOSURE)
199	{
200	TObject* o=Main->consts+i;
201	if (ttype(o)==LUA_T_PROTO) PrintFunction(tfvalue(o),Main,(int)(p-code));
202	}
203	else if (op==LONGARG) longarg=i<<16;
204	else if (op==ENDCODE) break;
205	p+=n;
206	}
207	}	89	}
208		90
209	static void PrintFunction(TProtoFunc* tf, TProtoFunc* Main, int at)	91	#define PrintFunction luaU_printchunk
210	{
211	PrintHeader(tf,Main,at);
212	PrintLocals(tf);
213	PrintCode(tf);
214	#ifdef DEBUG
215	PrintConstants(tf);
216	#endif
217	PrintFunctions(tf);
218	}
219		92
220	void luaU_printchunk(TProtoFunc* Main)	93	void PrintFunction(const Proto* tf)
221	{	94	{
222	PrintFunction(Main,0,0);	95	int i,n=tf->nkproto;
		96	PrintHeader(tf);
		97	PrintCode(tf);
		98	for (i=0; i<n; i++) PrintFunction(tf->kproto[i]);
223	}	99	}

src/luac/print.h+55−0

@@ -0,0 +1,55 @@
	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+91−85

@@ -1,68 +1,109 @@
1	/*	1	/*
2	** $Id: stubs.c,v 1.11 1999/03/11 17:09:10 lhf Exp $	2	** $Id: stubs.c,v 1.20 2000/10/31 16:57:23 lhf Exp $
3	** avoid runtime modules in luac	3	** avoid runtime modules in luac
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
6		6
7	#ifdef NOSTUBS
8
9	/* according to gcc, ANSI C forbids an empty source file */
10	void luaU_dummy(void);
11	void luaU_dummy(void){}
12
13	#else
14
15	#include <stdarg.h>
16	#include <stdio.h>	7	#include <stdio.h>
17	#include <stdlib.h>	8	#include <stdlib.h>
		9
		10	#include "ldo.h"
		11	#include "llex.h"
18	#include "luac.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		19
20	/*	20	/*
21	* avoid lapi lauxlib lbuiltin ldo lgc ltable ltm lvm	21	* avoid lapi ldebug ldo lgc lstate ltm lvm
22	* use only lbuffer lfunc llex lmem lobject lparser lstate lstring lzio	22	* use only lcode lfunc llex lmem lobject lparser lstring ltable lzio
23	*/	23	*/
24		24
25	/* simplified from ldo.c */	25	/* simplified from ldo.c */
26	void lua_error(char* s)	26	void lua_error (lua_State* L, const char* s) {
27	{	27	UNUSED(L);
28	if (s) fprintf(stderr,"luac: %s\n",s);	28	if (s) fprintf(stderr,"luac: %s\n",s);
29	exit(1);	29	exit(1);
30	}	30	}
31		31
32	/* copied from lauxlib.c */	32	/* simplified from ldo.c */
33	void luaL_verror (char *fmt, ...)	33	void luaD_breakrun (lua_State *L, int errcode) {
34	{	34	UNUSED(errcode);
35	char buff[500];	35	lua_error(L,"memory allocation error");
36	va_list argp;
37	va_start(argp, fmt);
38	vsprintf(buff, fmt, argp);
39	va_end(argp);
40	lua_error(buff);
41	}	36	}
42		37
43	/* copied from lauxlib.c */	38	/* simplified from lstate.c */
44	void luaL_filesource (char out, char filename, int len) {	39	lua_State *lua_open (int stacksize) {
45	if (filename == NULL) filename = "(stdin)";	40	lua_State *L = luaM_new(NULL, lua_State);
46	sprintf(out, "@%.s", len-2, filename); / -2 for '@' and '\0' */	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;
47	}	72	}
48		73
49	/* avoid runtime modules in lstate.c */	74	/* copied from ldebug.c */
50		75	int luaG_getline (int lineinfo, int pc, int refline, int prefi) {
51	#include "lbuiltin.h"	76	int refi;
52	#include "ldo.h"	77	if (lineinfo == NULL \|\| pc == -1)
53	#include "lgc.h"	78	return -1; /* no line info or function is not active */
54	#include "ltable.h"	79	refi = prefi ? *prefi : 0;
55	#include "ltm.h"	80	if (lineinfo[refi] < 0)
56		81	refline += -lineinfo[refi++];
57	void luaB_predefine(void){}	82	LUA_ASSERT(lineinfo[refi] >= 0, "invalid line info");
58	void luaC_hashcallIM(Hash *l){}	83	while (lineinfo[refi] > pc) {
59	void luaC_strcallIM(TaggedString *l){}	84	refline--;
60	void luaD_gcIM(TObject *o){}	85	refi--;
61	void luaH_free(Hash *frees){}	86	if (lineinfo[refi] < 0)
62	void luaT_init(void){}	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	}
63		104
64	/*	105	/*
65	* the code below avoids the lexer and the parser (llex lparser).	106	* the code below avoids the lexer and the parser (llex lparser lcode).
66	* it is useful if you only want to load binary files.	107	* it is useful if you only want to load binary files.
67	* this works for interpreters like lua.c too.	108	* this works for interpreters like lua.c too.
68	*/	109	*/
@@ -72,49 +113,14 @@ void luaT_init(void){} · 3 unmodified lines
72	#include "llex.h"	113	#include "llex.h"
73	#include "lparser.h"	114	#include "lparser.h"
74		115
75	void luaX_init(void){}	116	void luaX_init(lua_State *L) {
76	void luaD_init(void){}	117	UNUSED(L);
77
78	TProtoFunc* luaY_parser(ZIO *z) {
79	lua_error("parser not loaded");
80	return NULL;
81	}
82
83	#else
84
85	/* copied from lauxlib.c */
86	int luaL_findstring (char name, char list[]) {
87	int i;
88	for (i=0; list[i]; i++)
89	if (strcmp(list[i], name) == 0)
90	return i;
91	return -1; /* name not found */
92	}
93
94	/* copied from lauxlib.c */
95	void luaL_chunkid (char out, char source, int len) {
96	len -= 13; /* 13 = strlen("string ''...\0") */
97	if (*source == '@')
98	sprintf(out, "file `%.*s'", len, source+1);
99	else if (*source == '(')
100	strcpy(out, "(C code)");
101	else {
102	char b = strchr(source , '\n'); / stop string at first new line */
103	int lim = (b && (b-source)<len) ? b-source : len;
104	sprintf(out, "string `%.*s'", lim, source);
105	strcpy(out+lim+(13-5), "...'"); /* 5 = strlen("...'\0") */
106	}
107	}	118	}
108		119
109	void luaD_checkstack(int n){}	120	Proto luaY_parser(lua_State L, ZIO *z) {
110		121	UNUSED(z);
111	#define STACK_UNIT 128	122	lua_error(L,"parser not loaded");
112		123	return NULL;
113	/* copied from ldo.c */
114	void luaD_init (void) {
115	L->stack.stack = luaM_newvector(STACK_UNIT, TObject);
116	L->stack.top = L->stack.stack;
117	L->stack.last = L->stack.stack+(STACK_UNIT-1);
118	}	124	}
119		125
120	#endif	126	#endif

src/luac/test.c+0−253

@@ -1,253 +0,0 @@
1	/*
2	** $Id: test.c,v 1.10 1999/07/02 19:34:26 lhf Exp $
3	** test integrity
4	** See Copyright Notice in lua.h
5	*/
6
7	#include <stdio.h>
8	#include <stdlib.h>
9	#include <string.h>
10	#include "luac.h"
11
12	#define AT "pc=%d"
13	#define ATLOC 0)
14	#define UNSAFE(s) \
15	luaL_verror("unsafe code at " AT IN "\n " s,at,INLOC
16
17	TObject* luaU_getconstant(TProtoFunc* tf, int i, int at)
18	{
19	if (i>=tf->nconsts) UNSAFE("bad constant #%d (max=%d)"),i,tf->nconsts-1,ATLOC;
20	return tf->consts+i;
21	}
22
23	static int check(int n, TProtoFunc* tf, int at, int sp, int ss)
24	{
25	if (n==0) return sp;
26	sp+=n;
27	if (sp<00) UNSAFE("stack underflow (sp=%d)"),sp,ATLOC;
28	if (sp>ss) UNSAFE("stack overflow (sp=%d ss=%d)"),sp,ss,ATLOC;
29	return sp;
30	}
31
32	#define CHECK(before,after) \
33	sp=check(-(before),tf,at,sp,ss), sp=check(after,tf,at,sp,ss)
34
35	static int jmpok(TProtoFunc* tf, int size, int at, int d)
36	{
37	int to=at+d;
38	if (to<2 \|\| to>=size)
39	UNSAFE("invalid jump to %d (valid range is 2..%d)"),to,size-1,ATLOC;
40	return to;
41	}
42
43	static void TestStack(TProtoFunc* tf, int size, int* SP, int* JP)
44	{
45	Byte* code=tf->code;
46	Byte* p=code;
47	int longarg=0;
48	int ss=0;
49	int sp=0;
50	for (;;)
51	{
52	Opcode OP;
53	int n=INFO(tf,p,&OP);
54	int op=OP.class;
55	int i=OP.arg+longarg;
56	int at=p-code;
57	longarg=0;
58	switch (op) /* test sanity of operands */
59	{
60	case PUSHCONSTANT:
61	case GETGLOBAL:
62	case GETDOTTED:
63	case PUSHSELF:
64	case SETGLOBAL:
65	case CLOSURE:
66	{
67	TObject* o=luaU_getconstant(tf,i,at);
68	if ((op==CLOSURE && ttype(o)!=LUA_T_PROTO)
69	\|\| (op==GETGLOBAL && ttype(o)!=LUA_T_STRING)
70	\|\| (op==SETGLOBAL && ttype(o)!=LUA_T_STRING))
71	UNSAFE("bad operand to %s"),OP.name,ATLOC;
72	break;
73	}
74	case PUSHLOCAL:
75	if (i>=sp) UNSAFE("bad local #%d (max=%d)"),i,sp-1,ATLOC;
76	break;
77	case SETLOCAL:
78	if (i>=(sp-1)) UNSAFE("bad local #%d (max=%d)"),i,sp-2,ATLOC;
79	break;
80	case ONTJMP:
81	case ONFJMP: /* negate to remember ON?JMP */
82	JP[at]=-jmpok(tf,size,at,i+n);
83	break;
84	case JMP: /* remember JMP targets */
85	case IFFJMP:
86	JP[at]= jmpok(tf,size,at,i+n);
87	break;
88	case IFTUPJMP:
89	case IFFUPJMP:
90	JP[at]= jmpok(tf,size,at,-i+n);
91	break;
92	}
93
94	SP[at]=sp; /* remember depth before instruction */
95
96	switch (op)
97	{
98	case STACK: ss=i; break;
99	case ARGS: CHECK(0,i); break;
100	case VARARGS: break;
101	case ENDCODE: return;
102	case RETCODE: CHECK(i,0); sp=i; break;
103	case CALL: CHECK(OP.arg2+1,i); break;
104	case TAILCALL: CHECK(OP.arg2,0); sp=i; break;
105	case PUSHNIL: CHECK(0,i+1); break;
106	case POP: CHECK(0,-i); break;
107	case PUSHNUMBER:
108	case PUSHNUMBERNEG:
109	case PUSHCONSTANT:
110	case PUSHUPVALUE:
111	case PUSHLOCAL:
112	case GETGLOBAL: CHECK(0,1); break;
113	case GETTABLE: CHECK(2,1); break;
114	case GETDOTTED: CHECK(1,1); break;
115	case PUSHSELF: CHECK(1,2); break;
116	case CREATEARRAY: CHECK(0,1); break;
117	case SETLOCAL: CHECK(1,0); break;
118	case SETGLOBAL: CHECK(1,0); break;
119	case SETTABLEPOP: CHECK(3,0); break;
120	case SETTABLE: CHECK(i+3,i+2); break;
121	case SETLIST: CHECK(OP.arg2+1,1); break;
122	case SETMAP: CHECK(2*(i+1)+1,1); break;
123	case NEQOP:
124	case EQOP:
125	case LTOP:
126	case LEOP:
127	case GTOP:
128	case GEOP:
129	case ADDOP:
130	case SUBOP:
131	case MULTOP:
132	case DIVOP:
133	case POWOP:
134	case CONCOP: CHECK(2,1); break;
135	case MINUSOP:
136	case NOTOP: CHECK(1,1); break;
137	case ONTJMP:
138	case ONFJMP:
139	case IFFJMP:
140	case IFTUPJMP:
141	case IFFUPJMP: CHECK(1,0); break;
142	case JMP: break;
143	case CLOSURE: CHECK(OP.arg2,1); break;
144	case SETLINE: break;
145	case LONGARG:
146	longarg=i<<16;
147	if (longarg<0) UNSAFE("longarg overflow"),ATLOC;
148	break;
149	case CHECKSTACK: break;
150	default: /* cannot happen */
151	UNSAFE("cannot test opcode %d [%s]"),OP.op,OP.name,ATLOC;
152	break;
153	}
154	p+=n;
155	}
156	}
157
158	static void TestJumps(TProtoFunc* tf, int size, int* SP, int* JP)
159	{
160	int i;
161	for (i=0; i<size; i++)
162	{
163	int to=JP[i];
164	if (to!=0)
165	{
166	int at=i; /* for ATLOC */
167	int a,b,j;
168	int on=(to<0); /* ON?JMP */
169	if (on) to=-to;
170	a=SP[to];
171	if (a<0)
172	UNSAFE("invalid jump to %d (not an instruction)"),to,ATLOC;
173	for (j=i; SP[++j]<0; ) /* find next instruction */
174	;
175	b=SP[j]+on;
176	if (a!=b)
177	UNSAFE("stack inconsistency in jump to %d (expected %d, found %d)"),
178	to,a,b,ATLOC;
179	}
180	}
181	}
182
183	static void TestCode(TProtoFunc* tf)
184	{
185	static int* SP=NULL;
186	static int* JP=NULL;
187	int size=luaU_codesize(tf);
188	luaM_reallocvector(SP,size,int); memset(SP,-1,size*sizeof(int));
189	luaM_reallocvector(JP,size,int); memset(JP, 0,size*sizeof(int));
190	TestStack(tf,size,SP,JP);
191	TestJumps(tf,size,SP,JP);
192	}
193
194	#undef AT
195	#define AT "locvars[%d]"
196	static void TestLocals(TProtoFunc* tf)
197	{
198	LocVar* v;
199	int l=1;
200	int d=0;
201	if (tf->locvars==NULL) return;
202	for (v=tf->locvars; v->line>=0; v++)
203	{
204	int at=v-tf->locvars; /* for ATLOC */
205	if (l>v->line)
206	UNSAFE("bad line number %d; expected at least %d"),v->line,l,ATLOC;
207	l=v->line;
208	if (v->varname==NULL)
209	{
210	if (--d<0) UNSAFE("no scope to close"),ATLOC;
211	}
212	else
213	++d;
214	}
215	}
216
217	static void TestFunction(TProtoFunc* tf);
218
219	static void TestConstants(TProtoFunc* tf)
220	{
221	int i,n=tf->nconsts;
222	for (i=0; i<n; i++)
223	{
224	TObject* o=tf->consts+i;
225	switch (ttype(o))
226	{
227	case LUA_T_NUMBER:
228	break;
229	case LUA_T_STRING:
230	break;
231	case LUA_T_PROTO:
232	TestFunction(tfvalue(o));
233	break;
234	case LUA_T_NIL:
235	break;
236	default: /* cannot happen */
237	luaU_badconstant("print",i,o,tf);
238	break;
239	}
240	}
241	}
242
243	static void TestFunction(TProtoFunc* tf)
244	{
245	TestCode(tf);
246	TestLocals(tf);
247	TestConstants(tf);
248	}
249
250	void luaU_testchunk(TProtoFunc* Main)
251	{
252	TestFunction(Main);
253	}

src/lundump.c+154−149

@@ -1,239 +1,244 @@
1	/*	1	/*
2	** $Id: lundump.c,v 1.21 1999/07/02 19:34:26 lhf Exp $	2	** $Id: lundump.c,v 1.33 2000/10/31 16:57:23 lhf Exp $
3	** load bytecodes from files	3	** load bytecodes from files
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 <string.h>	8	#include <string.h>
9	#include "lauxlib.h"	9
10	#include "lfunc.h"	10	#include "lfunc.h"
11	#include "lmem.h"	11	#include "lmem.h"
12	#include "lopcodes.h"	12	#include "lopcodes.h"
13	#include "lstring.h"	13	#include "lstring.h"
14	#include "lundump.h"	14	#include "lundump.h"
15		15
16	#define LoadBlock(b,size,Z) ezread(Z,b,size)	16	#define LoadByte ezgetc
17		17
18	static void unexpectedEOZ (ZIO* Z)	18	static const char* ZNAME (ZIO* Z)
19	{	19	{
20	luaL_verror("unexpected end of file in %s",zname(Z));	20	const char* s=zname(Z);
		21	return (*s=='@') ? s+1 : s;
21	}	22	}
22		23
23	static int ezgetc (ZIO* Z)	24	static void unexpectedEOZ (lua_State* L, ZIO* Z)
24	{	25	{
25	int c=zgetc(Z);	26	luaO_verror(L,"unexpected end of file in `%.99s'",ZNAME(Z));
26	if (c==EOZ) unexpectedEOZ(Z);
27	return c;
28	}	27	}
29		28
30	static void ezread (ZIO* Z, void* b, int n)	29	static int ezgetc (lua_State* L, ZIO* Z)
31	{	30	{
32	int r=zread(Z,b,n);	31	int c=zgetc(Z);
33	if (r!=0) unexpectedEOZ(Z);	32	if (c==EOZ) unexpectedEOZ(L,Z);
		33	return c;
34	}	34	}
35		35
36	static unsigned int LoadWord (ZIO* Z)	36	static void ezread (lua_State* L, ZIO* Z, void* b, int n)
37	{	37	{
38	unsigned int hi=ezgetc(Z);	38	int r=zread(Z,b,n);
39	unsigned int lo=ezgetc(Z);	39	if (r!=0) unexpectedEOZ(L,Z);
40	return (hi<<8)\|lo;
41	}	40	}
42		41
43	static unsigned long LoadLong (ZIO* Z)	42	static void LoadBlock (lua_State* L, void* b, size_t size, ZIO* Z, int swap)
44	{	43	{
45	unsigned long hi=LoadWord(Z);	44	if (swap)
46	unsigned long lo=LoadWord(Z);	45	{
47	return (hi<<16)\|lo;	46	char p=(char ) b+size-1;
48	}	47	int n=size;
49		48	while (n--) *p--=(char)ezgetc(L,Z);
50	/*	49	}
51	* convert number from text	50	else
52	*/	51	ezread(L,Z,b,size);
53	double luaU_str2d (char* b, char* where)
54	{
55	int negative=(b[0]=='-');
56	double x=luaO_str2d(b+negative);
57	if (x<0) luaL_verror("cannot convert number '%s' in %s",b,where);
58	return negative ? -x : x;
59	}	52	}
60		53
61	static real LoadNumber (ZIO* Z, int native)	54	static void LoadVector (lua_State* L, void* b, int m, size_t size, ZIO* Z, int swap)
62	{	55	{
63	real x;	56	if (swap)
64	if (native)
65	{	57	{
66	LoadBlock(&x,sizeof(x),Z);	58	char q=(char ) b;
67	return x;	59	while (m--)
		60	{
		61	char *p=q+size-1;
		62	int n=size;
		63	while (n--) *p--=(char)ezgetc(L,Z);
		64	q+=size;
		65	}
68	}	66	}
69	else	67	else
70	{	68	ezread(L,Z,b,m*size);
71	char b[256];
72	int size=ezgetc(Z);
73	LoadBlock(b,size,Z);
74	b[size]=0;
75	return luaU_str2d(b,zname(Z));
76	}
77	}	69	}
78		70
79	static int LoadInt (ZIO* Z, char* message)	71	static int LoadInt (lua_State* L, ZIO* Z, int swap)
80	{	72	{
81	unsigned long l=LoadLong(Z);	73	int x;
82	unsigned int i=l;	74	LoadBlock(L,&x,sizeof(x),Z,swap);
83	if (i!=l) luaL_verror(message,l,zname(Z));	75	return x;
84	return i;
85	}	76	}
86		77
87	#define PAD 5 /* two word operands plus opcode */	78	static size_t LoadSize (lua_State* L, ZIO* Z, int swap)
		79	{
		80	size_t x;
		81	LoadBlock(L,&x,sizeof(x),Z,swap);
		82	return x;
		83	}
88		84
89	static Byte* LoadCode (ZIO* Z)	85	static Number LoadNumber (lua_State* L, ZIO* Z, int swap)
90	{	86	{
91	int size=LoadInt(Z,"code too long (%ld bytes) in %s");	87	Number x;
92	Byte* b=luaM_malloc(size+PAD);	88	LoadBlock(L,&x,sizeof(x),Z,swap);
93	LoadBlock(b,size,Z);	89	return x;
94	if (b[size-1]!=ENDCODE) luaL_verror("bad code in %s",zname(Z));
95	memset(b+size,ENDCODE,PAD); /* pad code for safety */
96	return b;
97	}	90	}
98		91
99	static TaggedString* LoadTString (ZIO* Z)	92	static TString* LoadString (lua_State* L, ZIO* Z, int swap)
100	{	93	{
101	long size=LoadLong(Z);	94	size_t size=LoadSize(L,Z,swap);
102	if (size==0)	95	if (size==0)
103	return NULL;	96	return NULL;
104	else	97	else
105	{	98	{
106	char* s=luaL_openspace(size);	99	char* s=luaO_openspace(L,size);
107	LoadBlock(s,size,Z);	100	LoadBlock(L,s,size,Z,0);
108	return luaS_newlstr(s,size-1);	101	return luaS_newlstr(L,s,size-1); /* remove trailing '\0' */
109	}	102	}
110	}	103	}
111		104
112	static void LoadLocals (TProtoFunc* tf, ZIO* Z)	105	static void LoadCode (lua_State* L, Proto* tf, ZIO* Z, int swap)
113	{	106	{
114	int i,n=LoadInt(Z,"too many locals (%ld) in %s");	107	int size=LoadInt(L,Z,swap);
115	if (n==0) return;	108	tf->code=luaM_newvector(L,size,Instruction);
116	tf->locvars=luaM_newvector(n+1,LocVar);	109	LoadVector(L,tf->code,size,sizeof(*tf->code),Z,swap);
		110	if (tf->code[size-1]!=OP_END) luaO_verror(L,"bad code in `%.99s'",ZNAME(Z));
		111	luaF_protook(L,tf,size);
		112	}
		113
		114	static void LoadLocals (lua_State* L, Proto* tf, ZIO* Z, int swap)
		115	{
		116	int i,n;
		117	tf->nlocvars=n=LoadInt(L,Z,swap);
		118	tf->locvars=luaM_newvector(L,n,LocVar);
117	for (i=0; i<n; i++)	119	for (i=0; i<n; i++)
118	{	120	{
119	tf->locvars[i].line=LoadInt(Z,"too many lines (%ld) in %s");	121	tf->locvars[i].varname=LoadString(L,Z,swap);
120	tf->locvars[i].varname=LoadTString(Z);	122	tf->locvars[i].startpc=LoadInt(L,Z,swap);
		123	tf->locvars[i].endpc=LoadInt(L,Z,swap);
121	}	124	}
122	tf->locvars[i].line=-1; /* flag end of vector */
123	tf->locvars[i].varname=NULL;
124	}	125	}
125		126
126	static TProtoFunc* LoadFunction (ZIO* Z, int native);	127	static void LoadLines (lua_State* L, Proto* tf, ZIO* Z, int swap)
		128	{
		129	int n;
		130	tf->nlineinfo=n=LoadInt(L,Z,swap);
		131	tf->lineinfo=luaM_newvector(L,n,int);
		132	LoadVector(L,tf->lineinfo,n,sizeof(*tf->lineinfo),Z,swap);
		133	}
		134
		135	static Proto* LoadFunction (lua_State* L, ZIO* Z, int swap);
127		136
128	static void LoadConstants (TProtoFunc* tf, ZIO* Z, int native)	137	static void LoadConstants (lua_State* L, Proto* tf, ZIO* Z, int swap)
129	{	138	{
130	int i,n=LoadInt(Z,"too many constants (%ld) in %s");	139	int i,n;
131	tf->nconsts=n;	140	tf->nkstr=n=LoadInt(L,Z,swap);
132	if (n==0) return;	141	tf->kstr=luaM_newvector(L,n,TString*);
133	tf->consts=luaM_newvector(n,TObject);
134	for (i=0; i<n; i++)	142	for (i=0; i<n; i++)
135	{	143	tf->kstr[i]=LoadString(L,Z,swap);
136	TObject* o=tf->consts+i;	144	tf->nknum=n=LoadInt(L,Z,swap);
137	ttype(o)=-ezgetc(Z); /* ttype(o) is negative - ORDER LUA_T */	145	tf->knum=luaM_newvector(L,n,Number);
138	switch (ttype(o))	146	LoadVector(L,tf->knum,n,sizeof(*tf->knum),Z,swap);
139	{	147	tf->nkproto=n=LoadInt(L,Z,swap);
140	case LUA_T_NUMBER:	148	tf->kproto=luaM_newvector(L,n,Proto*);
141	nvalue(o)=LoadNumber(Z,native);	149	for (i=0; i<n; i++)
142	break;	150	tf->kproto[i]=LoadFunction(L,Z,swap);
143	case LUA_T_STRING:
144	tsvalue(o)=LoadTString(Z);
145	break;
146	case LUA_T_PROTO:
147	tfvalue(o)=LoadFunction(Z,native);
148	break;
149	case LUA_T_NIL:
150	break;
151	default: /* cannot happen */
152	luaU_badconstant("load",i,o,tf);
153	break;
154	}
155	}
156	}	151	}
157		152
158	static TProtoFunc* LoadFunction (ZIO* Z, int native)	153	static Proto* LoadFunction (lua_State* L, ZIO* Z, int swap)
159	{	154	{
160	TProtoFunc* tf=luaF_newproto();	155	Proto* tf=luaF_newproto(L);
161	tf->lineDefined=LoadInt(Z,"lineDefined too large (%ld) in %s");	156	tf->source=LoadString(L,Z,swap);
162	tf->source=LoadTString(Z);	157	tf->lineDefined=LoadInt(L,Z,swap);
163	if (tf->source==NULL) tf->source=luaS_new(zname(Z));	158	tf->numparams=LoadInt(L,Z,swap);
164	tf->code=LoadCode(Z);	159	tf->is_vararg=LoadByte(L,Z);
165	LoadLocals(tf,Z);	160	tf->maxstacksize=LoadInt(L,Z,swap);
166	LoadConstants(tf,Z,native);	161	LoadLocals(L,tf,Z,swap);
		162	LoadLines(L,tf,Z,swap);
		163	LoadConstants(L,tf,Z,swap);
		164	LoadCode(L,tf,Z,swap);
167	return tf;	165	return tf;
168	}	166	}
169		167
170	static void LoadSignature (ZIO* Z)	168	static void LoadSignature (lua_State* L, ZIO* Z)
171	{	169	{
172	char* s=SIGNATURE;	170	const char* s=SIGNATURE;
173	while (s!=0 && ezgetc(Z)==s)	171	while (s!=0 && ezgetc(L,Z)==s)
174	++s;	172	++s;
175	if (*s!=0) luaL_verror("bad signature in %s",zname(Z));	173	if (*s!=0) luaO_verror(L,"bad signature in `%.99s'",ZNAME(Z));
176	}	174	}
177		175
178	static int LoadHeader (ZIO* Z)	176	static void TestSize (lua_State* L, int s, const char* what, ZIO* Z)
		177	{
		178	int r=ezgetc(L,Z);
		179	if (r!=s)
		180	luaO_verror(L,"virtual machine mismatch in `%.99s':\n"
		181	" %.20s is %d but read %d",ZNAME(Z),what,s,r);
		182	}
		183
		184	#define TESTSIZE(s) TestSize(L,s,#s,Z)
		185	#define V(v) v/16,v%16
		186
		187	static int LoadHeader (lua_State* L, ZIO* Z)
179	{	188	{
180	int version,sizeofR;	189	int version,swap;
181	int native;	190	Number f=0,tf=TEST_NUMBER;
182	LoadSignature(Z);	191	LoadSignature(L,Z);
183	version=ezgetc(Z);	192	version=ezgetc(L,Z);
184	if (version>VERSION)	193	if (version>VERSION)
185	luaL_verror(	194	luaO_verror(L,"`%.99s' too new:\n"
186	"%s too new: version=0x%02x; expected at most 0x%02x",	195	" read version %d.%d; expected at most %d.%d",
187	zname(Z),version,VERSION);	196	ZNAME(Z),V(version),V(VERSION));
188	if (version<VERSION0) /* check last major change */	197	if (version<VERSION0) /* check last major change */
189	luaL_verror(	198	luaO_verror(L,"`%.99s' too old:\n"
190	"%s too old: version=0x%02x; expected at least 0x%02x",	199	" read version %d.%d; expected at least %d.%d",
191	zname(Z),version,VERSION0);	200	ZNAME(Z),V(version),V(VERSION));
192	sizeofR=ezgetc(Z);	201	swap=(luaU_endianess()!=ezgetc(L,Z)); /* need to swap bytes? */
193	native=(sizeofR!=0);	202	TESTSIZE(sizeof(int));
194	if (native) /* test number representation */	203	TESTSIZE(sizeof(size_t));
195	{	204	TESTSIZE(sizeof(Instruction));
196	if (sizeofR!=sizeof(real))	205	TESTSIZE(SIZE_INSTRUCTION);
197	luaL_verror("unknown number size in %s: read %d; expected %d",	206	TESTSIZE(SIZE_OP);
198	zname(Z),sizeofR,sizeof(real));	207	TESTSIZE(SIZE_B);
199	else	208	TESTSIZE(sizeof(Number));
200	{	209	f=LoadNumber(L,Z,swap);
201	real tf=TEST_NUMBER;	210	if ((long)f!=(long)tf) /* disregard errors in last bit of fraction */
202	real f=LoadNumber(Z,native);	211	luaO_verror(L,"unknown number format in `%.99s':\n"
203	if ((long)f!=(long)tf)	212	" read " NUMBER_FMT "; expected " NUMBER_FMT, ZNAME(Z),f,tf);
204	luaL_verror("unknown number format in %s: "	213	return swap;
205	"read " NUMBER_FMT "; expected " NUMBER_FMT,
206	zname(Z),f,tf);
207	}
208	}
209	return native;
210	}	214	}
211		215
212	static TProtoFunc* LoadChunk (ZIO* Z)	216	static Proto* LoadChunk (lua_State* L, ZIO* Z)
213	{	217	{
214	return LoadFunction(Z,LoadHeader(Z));	218	return LoadFunction(L,Z,LoadHeader(L,Z));
215	}	219	}
216		220
217	/*	221	/*
218	** load one chunk from a file or buffer	222	** load one chunk from a file or buffer
219	** return main if ok and NULL at EOF	223	** return main if ok and NULL at EOF
220	*/	224	*/
221	TProtoFunc* luaU_undump1 (ZIO* Z)	225	Proto* luaU_undump (lua_State* L, ZIO* Z)
222	{	226	{
		227	Proto* tf=NULL;
223	int c=zgetc(Z);	228	int c=zgetc(Z);
224	if (c==ID_CHUNK)	229	if (c==ID_CHUNK)
225	return LoadChunk(Z);	230	tf=LoadChunk(L,Z);
226	else if (c!=EOZ)	231	c=zgetc(Z);
227	luaL_verror("%s is not a Lua binary file",zname(Z));	232	if (c!=EOZ)
228	return NULL;	233	luaO_verror(L,"`%.99s' apparently contains more than one chunk",ZNAME(Z));
		234	return tf;
229	}	235	}
230		236
231	/*	237	/*
232	* handle constants that cannot happen	238	** find byte order
233	*/	239	*/
234	void luaU_badconstant (char* s, int i, TObject* o, TProtoFunc* tf)	240	int luaU_endianess (void)
235	{	241	{
236	int t=ttype(o);	242	int x=1;
237	char* name= (t>0 \|\| t<LUA_T_LINE) ? "?" : luaO_typenames[-t];	243	return (char)&x;
238	luaL_verror("cannot %s constant #%d: type=%d [%s]" IN,s,i,t,name,INLOC);
239	}	244	}

src/lundump.h+12−16

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lundump.h,v 1.15 1999/07/02 19:34:26 lhf Exp $	2	** $Id: lundump.h,v 1.21 2000/10/31 16:57:23 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,27 +10,23 @@ · 4 unmodified lines
10	#include "lobject.h"	10	#include "lobject.h"
11	#include "lzio.h"	11	#include "lzio.h"
12		12
13	TProtoFunc* luaU_undump1 (ZIO* Z); /* load one chunk */	13	/* load one chunk */
14	void luaU_badconstant (char* s, int i, TObject* o, TProtoFunc* tf);	14	Proto* luaU_undump (lua_State* L, ZIO* Z);
15	/* handle cases that cannot happen */	15
16	double luaU_str2d (char* b, char* where);	16	/* find byte order */
17	/* convert number from text */	17	int luaU_endianess (void);
18		18
19	/* definitions for headers of binary files */	19	/* definitions for headers of binary files */
20	#define VERSION 0x32 /* last format change was in 3.2 */	20	#define VERSION 0x40 /* last format change was in 4.0 */
21	#define VERSION0 0x32 /* last major change was in 3.2 */	21	#define VERSION0 0x40 /* last major change was in 4.0 */
22	#define ID_CHUNK 27 /* binary files start with ESC... */	22	#define ID_CHUNK 27 /* binary files start with ESC... */
23	#define SIGNATURE "Lua" /* ...followed by this signature */	23	#define SIGNATURE "Lua" /* ...followed by this signature */
24		24
25	/* formats for error messages */	25	/* formats for error messages */
26	#define SOURCE "<%s:%d>"	26	#define SOURCE_FMT "<%d:%.99s>"
27	#define IN " in %p " SOURCE	27	#define SOURCE tf->lineDefined,tf->source->str
28	#define INLOC tf,tf->source->str,tf->lineDefined	28	#define IN_FMT " in %p " SOURCE_FMT
29		29	#define IN tf,SOURCE
30	/* format for numbers in listings and error messages */
31	#ifndef NUMBER_FMT
32	#define NUMBER_FMT "%.16g" /* LUA_NUMBER */
33	#endif
34		30
35	/* a multiple of PI for testing native format */	31	/* a multiple of PI for testing native format */
36	/* multiplying by 1E8 gives non-trivial integer values */	32	/* multiplying by 1E8 gives non-trivial integer values */

src/lvm.c+549−474

@@ -1,28 +1,27 @@
1	/*	1	/*
2	** $Id: lvm.c,v 1.58 1999/06/22 20:37:23 roberto Exp $	2	** $Id: lvm.c,v 1.146 2000/10/26 12:47:05 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 <ctype.h>
9	#include <limits.h>
10	#include <stdio.h>	8	#include <stdio.h>
11	#include <stdlib.h>	9	#include <stdlib.h>
12	#include <string.h>	10	#include <string.h>
13		11
14	#include "lauxlib.h"	12	#include "lua.h"
		13
		14	#include "lapi.h"
		15	#include "ldebug.h"
15	#include "ldo.h"	16	#include "ldo.h"
16	#include "lfunc.h"	17	#include "lfunc.h"
17	#include "lgc.h"	18	#include "lgc.h"
18	#include "lmem.h"
19	#include "lobject.h"	19	#include "lobject.h"
20	#include "lopcodes.h"	20	#include "lopcodes.h"
21	#include "lstate.h"	21	#include "lstate.h"
22	#include "lstring.h"	22	#include "lstring.h"
23	#include "ltable.h"	23	#include "ltable.h"
24	#include "ltm.h"	24	#include "ltm.h"
25	#include "luadebug.h"
26	#include "lvm.h"	25	#include "lvm.h"
27		26
28		27
@@ -31,605 +30,681 @@ · 2 unmodified lines
31	#endif	30	#endif
32		31
33		32
34	#define highbyte(x) ((x)<<8)
35
36
37	/* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */
38	#define EXTRA_STACK 5
39
40		33
		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
41		39
42	static TaggedString strconc (TaggedString l, TaggedString *r) {
43	long nl = l->u.s.len;
44	long nr = r->u.s.len;
45	char *buffer = luaL_openspace(nl+nr);
46	memcpy(buffer, l->str, nl);
47	memcpy(buffer+nl, r->str, nr);
48	return luaS_newlstr(buffer, nl+nr);
49	}
50		40
51		41
52	int luaV_tonumber (TObject obj) { / LUA_NUMBER */	42	int luaV_tonumber (TObject *obj) {
53	if (ttype(obj) != LUA_T_STRING)	43	if (ttype(obj) != LUA_TSTRING)
54	return 1;	44	return 1;
55	else {	45	else {
56	double t;	46	if (!luaO_str2d(svalue(obj), &nvalue(obj)))
57	char *e = svalue(obj);
58	int sig = 1;
59	while (isspace((unsigned char)*e)) e++;
60	if (*e == '-') {
61	e++;
62	sig = -1;
63	}
64	else if (*e == '+') e++;
65	/* no digit before or after decimal point? */
66	if (!isdigit((unsigned char)e) && !isdigit((unsigned char)(e+1)))
67	return 2;	47	return 2;
68	t = luaO_str2d(e);	48	ttype(obj) = LUA_TNUMBER;
69	if (t<0) return 2;
70	nvalue(obj) = (real)t*sig;
71	ttype(obj) = LUA_T_NUMBER;
72	return 0;	49	return 0;
73	}	50	}
74	}	51	}
75		52
76		53
77	int luaV_tostring (TObject obj) { / LUA_NUMBER */	54	int luaV_tostring (lua_State L, TObject obj) { /* LUA_NUMBER */
78	if (ttype(obj) != LUA_T_NUMBER)	55	if (ttype(obj) != LUA_TNUMBER)
79	return 1;	56	return 1;
80	else {	57	else {
81	char s[32]; /* 16 digits, signal, point and \0 (+ some extra...) */	58	char s[32]; /* 16 digits, sign, point and \0 (+ some extra...) */
82	sprintf(s, "%.16g", (double)nvalue(obj));	59	lua_number2str(s, nvalue(obj)); /* convert `s' to number */
83	tsvalue(obj) = luaS_new(s);	60	tsvalue(obj) = luaS_new(L, s);
84	ttype(obj) = LUA_T_STRING;	61	ttype(obj) = LUA_TSTRING;
85	return 0;	62	return 0;
86	}	63	}
87	}	64	}
88		65
89		66
90	void luaV_setn (Hash *t, int val) {	67	static void traceexec (lua_State *L, StkId base, StkId top, lua_Hook linehook) {
91	TObject index, value;	68	CallInfo *ci = infovalue(base-1);
92	ttype(&index) = LUA_T_STRING; tsvalue(&index) = luaS_new("n");	69	int *lineinfo = ci->func->f.l->lineinfo;
93	ttype(&value) = LUA_T_NUMBER; nvalue(&value) = val;	70	int pc = (*ci->pc - ci->func->f.l->code) - 1;
94	luaH_set(t, &index, &value);	71	int newline;
		72	if (pc == 0) { /* may be first time? */
		73	ci->line = 1;
		74	ci->refi = 0;
		75	ci->lastpc = pc+1; /* make sure it will call linehook */
		76	}
		77	newline = luaG_getline(lineinfo, pc, ci->line, &ci->refi);
		78	/* calls linehook when enters a new line or jumps back (loop) */
		79	if (newline != ci->line \|\| pc <= ci->lastpc) {
		80	ci->line = newline;
		81	L->top = top;
		82	luaD_lineHook(L, base-2, newline, linehook);
		83	}
		84	ci->lastpc = pc;
		85	}
		86
		87
		88	static Closure luaV_closure (lua_State L, int nelems) {
		89	Closure *c = luaF_newclosure(L, nelems);
		90	L->top -= nelems;
		91	while (nelems--)
		92	c->upvalue[nelems] = *(L->top+nelems);
		93	clvalue(L->top) = c;
		94	ttype(L->top) = LUA_TFUNCTION;
		95	incr_top;
		96	return c;
95	}	97	}
96		98
97		99
98	void luaV_closure (int nelems) {	100	void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems) {
99	if (nelems > 0) {	101	Closure *cl = luaV_closure(L, nelems);
100	struct Stack *S = &L->stack;	102	cl->f.c = c;
101	Closure *c = luaF_newclosure(nelems);	103	cl->isC = 1;
102	c->consts[0] = *(S->top-1);	104	}
103	memcpy(&c->consts[1], S->top-(nelems+1), nelems*sizeof(TObject));	105
104	S->top -= nelems;	106
105	ttype(S->top-1) = LUA_T_CLOSURE;	107	void luaV_Lclosure (lua_State L, Proto l, int nelems) {
106	(S->top-1)->value.cl = c;	108	Closure *cl = luaV_closure(L, nelems);
107	}	109	cl->f.l = l;
		110	cl->isC = 0;
108	}	111	}
109		112
110		113
111	/*	114	/*
112	** Function to index a table.	115	** Function to index a table.
113	** Receives the table at top-2 and the index at top-1.	116	** Receives the table at `t' and the key at top.
114	*/	117	*/
115	void luaV_gettable (void) {	118	const TObject luaV_gettable (lua_State L, StkId t) {
116	TObject *table = L->stack.top-2;	119	Closure *tm;
117	TObject *im;	120	int tg;
118	if (ttype(table) != LUA_T_ARRAY) { /* not a table, get gettable method */	121	if (ttype(t) == LUA_TTABLE && /* `t' is a table? */
119	im = luaT_getimbyObj(table, IM_GETTABLE);	122	((tg = hvalue(t)->htag) == LUA_TTABLE \|\| /* with default tag? */
120	if (ttype(im) == LUA_T_NIL)	123	luaT_gettm(L, tg, TM_GETTABLE) == NULL)) { /* or no TM? */
121	lua_error("indexed expression not a table");	124	/* do a primitive get */
		125	const TObject *h = luaH_get(L, hvalue(t), L->top-1);
		126	/* result is no nil or there is no `index' tag method? */
		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 */
122	}	130	}
123	else { /* object is a table... */	131	else { /* try a `gettable' tag method */
124	int tg = table->value.a->htag;	132	tm = luaT_gettmbyObj(L, t, TM_GETTABLE);
125	im = luaT_getim(tg, IM_GETTABLE);	133	}
126	if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */	134	if (tm != NULL) { /* is there a tag method? */
127	TObject *h = luaH_get(avalue(table), table+1);	135	luaD_checkstack(L, 2);
128	if (ttype(h) == LUA_T_NIL &&	136	(L->top+1) = (L->top-1); /* key */
129	(ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL)) {	137	L->top = t; /* table */
130	/* result is nil and there is an "index" tag method */	138	clvalue(L->top-1) = tm; /* tag method */
131	luaD_callTM(im, 2, 1); /* calls it */	139	ttype(L->top-1) = LUA_TFUNCTION;
132	}	140	L->top += 2;
133	else {	141	luaD_call(L, L->top - 3, 1);
134	L->stack.top--;	142	return L->top - 1; /* call result */
135	table = h; /* "push" result into table position */	143	}
136	}	144	else { /* no tag method */
137	return;	145	luaG_typeerror(L, t, "index");
138	}	146	return NULL; /* to avoid warnings */
139	/* else it has a "gettable" method, go through to next command */
140	}	147	}
141	/* object is not a table, or it has a "gettable" method */
142	luaD_callTM(im, 2, 1);
143	}	148	}
144		149
145		150
146	/*	151	/*
147	** Receives table at t, index at (t+1) and value at top.	152	** Receives table at `t', key at `key' and value at top.
148	*/	153	*/
149	void luaV_settable (TObject *t) {	154	void luaV_settable (lua_State *L, StkId t, StkId key) {
150	struct Stack *S = &L->stack;	155	int tg;
151	TObject *im;	156	if (ttype(t) == LUA_TTABLE && /* `t' is a table? */
152	if (ttype(t) != LUA_T_ARRAY) { /* not a table, get "settable" method */	157	((tg = hvalue(t)->htag) == LUA_TTABLE \|\| /* with default tag? */
153	im = luaT_getimbyObj(t, IM_SETTABLE);	158	luaT_gettm(L, tg, TM_SETTABLE) == NULL)) /* or no TM? */
154	if (ttype(im) == LUA_T_NIL)	159	luaH_set(L, hvalue(t), key) = (L->top-1); /* do a primitive set */
155	lua_error("indexed expression not a table");	160	else { /* try a `settable' tag method */
156	}	161	Closure *tm = luaT_gettmbyObj(L, t, TM_SETTABLE);
157	else { /* object is a table... */	162	if (tm != NULL) {
158	im = luaT_getim(avalue(t)->htag, IM_SETTABLE);	163	luaD_checkstack(L, 3);
159	if (ttype(im) == LUA_T_NIL) { /* and does not have a "settable" method */	164	(L->top+2) = (L->top-1);
160	luaH_set(avalue(t), t+1, S->top-1);	165	(L->top+1) = key;
161	S->top--; /* pop value */	166	(L->top) = t;
162	return;	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 */
163	}	171	}
164	/* else it has a "settable" method, go through to next command */	172	else /* no tag method... */
		173	luaG_typeerror(L, t, "index");
165	}	174	}
166	/* object is not a table, or it has a "settable" method */
167	/* prepare arguments and call the tag method */
168	(S->top+1) = (L->stack.top-1);
169	(S->top) = (t+1);
170	(S->top-1) = t;
171	S->top += 2; /* WARNING: caller must assure stack space */
172	luaD_callTM(im, 3, 0);
173	}	175	}
174		176
175		177
176	void luaV_rawsettable (TObject *t) {	178	const TObject luaV_getglobal (lua_State L, TString *s) {
177	if (ttype(t) != LUA_T_ARRAY)	179	const TObject *value = luaH_getstr(L->gt, s);
178	lua_error("indexed expression not a table");	180	Closure *tm = luaT_gettmbyObj(L, value, TM_GETGLOBAL);
179	else {	181	if (tm == NULL) /* is there a tag method? */
180	struct Stack *S = &L->stack;	182	return value; /* default behavior */
181	luaH_set(avalue(t), t+1, S->top-1);	183	else { /* tag method */
182	S->top -= 3;	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;
183	}	193	}
184	}	194	}
185		195
186		196
187	void luaV_getglobal (TaggedString *ts) {	197	void luaV_setglobal (lua_State L, TString s) {
188	/* WARNING: caller must assure stack space */	198	const TObject *oldvalue = luaH_getstr(L->gt, s);
189	/* only userdata, tables and nil can have getglobal tag methods */	199	Closure *tm = luaT_gettmbyObj(L, oldvalue, TM_SETGLOBAL);
190	static char valid_getglobals[] = {1, 0, 0, 1, 0, 0, 1, 0}; /* ORDER LUA_T */	200	if (tm == NULL) { /* is there a tag method? */
191	TObject *value = &ts->u.s.globalval;	201	if (oldvalue != &luaO_nilobject) {
192	if (valid_getglobals[-ttype(value)]) {	202	/* cast to remove `const' is OK, because `oldvalue' != luaO_nilobject */
193	TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL);	203	(TObject )oldvalue = *(L->top - 1);
194	if (ttype(im) != LUA_T_NIL) { /* is there a tag method? */	204	}
195	struct Stack *S = &L->stack;	205	else {
196	ttype(S->top) = LUA_T_STRING;	206	TObject key;
197	tsvalue(S->top) = ts;	207	ttype(&key) = LUA_TSTRING;
198	S->top++;	208	tsvalue(&key) = s;
199	S->top++ = value;	209	luaH_set(L, L->gt, &key) = (L->top - 1);
200	luaD_callTM(im, 2, 1);
201	return;
202	}	210	}
203	/* else no tag method: go through to default behavior */
204	}	211	}
205	L->stack.top++ = value; /* default behavior */
206	}
207
208
209	void luaV_setglobal (TaggedString *ts) {
210	TObject *oldvalue = &ts->u.s.globalval;
211	TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL);
212	if (ttype(im) == LUA_T_NIL) /* is there a tag method? */
213	luaS_rawsetglobal(ts, --L->stack.top);
214	else {	212	else {
215	/* WARNING: caller must assure stack space */	213	luaD_checkstack(L, 3);
216	struct Stack *S = &L->stack;	214	(L->top+2) = (L->top-1); /* new value */
217	TObject newvalue;	215	(L->top+1) = oldvalue;
218	newvalue = *(S->top-1);	216	ttype(L->top) = LUA_TSTRING;
219	ttype(S->top-1) = LUA_T_STRING;	217	tsvalue(L->top) = s;
220	tsvalue(S->top-1) = ts;	218	clvalue(L->top-1) = tm;
221	S->top++ = oldvalue;	219	ttype(L->top-1) = LUA_TFUNCTION;
222	*S->top++ = newvalue;	220	L->top += 3;
223	luaD_callTM(im, 3, 0);	221	luaD_call(L, L->top - 4, 0);
224	}	222	}
225	}	223	}
226		224
227		225
228	static void call_binTM (IMS event, char *msg)	226	static int call_binTM (lua_State *L, StkId top, TMS event) {
229	{	227	/* try first operand */
230	TObject im = luaT_getimbyObj(L->stack.top-2, event);/ try first operand */	228	Closure *tm = luaT_gettmbyObj(L, top-2, event);
231	if (ttype(im) == LUA_T_NIL) {	229	L->top = top;
232	im = luaT_getimbyObj(L->stack.top-1, event); /* try second operand */	230	if (tm == NULL) {
233	if (ttype(im) == LUA_T_NIL) {	231	tm = luaT_gettmbyObj(L, top-1, event); /* try second operand */
234	im = luaT_getim(0, event); /* try a 'global' i.m. */	232	if (tm == NULL) {
235	if (ttype(im) == LUA_T_NIL)	233	tm = luaT_gettm(L, 0, event); /* try a `global' method */
236	lua_error(msg);	234	if (tm == NULL)
		235	return 0; /* error */
237	}	236	}
238	}	237	}
239	lua_pushstring(luaT_eventname[event]);	238	lua_pushstring(L, luaT_eventname[event]);
240	luaD_callTM(im, 3, 1);	239	luaD_callTM(L, tm, 3, 1);
		240	return 1;
241	}	241	}
242		242
243		243
244	static void call_arith (IMS event)	244	static void call_arith (lua_State *L, StkId top, TMS event) {
245	{	245	if (!call_binTM(L, top, event))
246	call_binTM(event, "unexpected type in arithmetic operation");	246	luaG_binerror(L, top-2, LUA_TNUMBER, "perform arithmetic on");
247	}	247	}
248		248
249		249
250	static int luaV_strcomp (char l, long ll, char r, long lr)	250	static int luaV_strcomp (const TString ls, const TString rs) {
251	{	251	const char *l = ls->str;
		252	size_t ll = ls->len;
		253	const char *r = rs->str;
		254	size_t lr = rs->len;
252	for (;;) {	255	for (;;) {
253	long temp = strcoll(l, r);	256	int temp = strcoll(l, r);
254	if (temp != 0) return temp;	257	if (temp != 0) return temp;
255	/* strings are equal up to a '\0' */	258	else { /* strings are equal up to a '\0' */
256	temp = strlen(l); /* index of first '\0' in both strings */	259	size_t len = strlen(l); /* index of first '\0' in both strings */
257	if (temp == ll) /* l is finished? */	260	if (len == ll) /* l is finished? */
258	return (temp == lr) ? 0 : -1; /* l is equal or smaller than r */	261	return (len == lr) ? 0 : -1; /* l is equal or smaller than r */
259	else if (temp == lr) /* r is finished? */	262	else if (len == lr) /* r is finished? */
260	return 1; /* l is greater than r (because l is not finished) */	263	return 1; /* l is greater than r (because l is not finished) */
261	/* both strings longer than temp; go on comparing (after the '\0') */	264	/* both strings longer than `len'; go on comparing (after the '\0') */
262	temp++;	265	len++;
263	l += temp; ll -= temp; r += temp; lr -= temp;	266	l += len; ll -= len; r += len; lr -= len;
		267	}
264	}	268	}
265	}	269	}
266		270
267	void luaV_comparison (lua_Type ttype_less, lua_Type ttype_equal,	271
268	lua_Type ttype_great, IMS op) {	272	int luaV_lessthan (lua_State L, const TObject l, const TObject *r, StkId top) {
269	struct Stack *S = &L->stack;	273	if (ttype(l) == LUA_TNUMBER && ttype(r) == LUA_TNUMBER)
270	TObject *l = S->top-2;	274	return (nvalue(l) < nvalue(r));
271	TObject *r = S->top-1;	275	else if (ttype(l) == LUA_TSTRING && ttype(r) == LUA_TSTRING)
272	real result;	276	return (luaV_strcomp(tsvalue(l), tsvalue(r)) < 0);
273	if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)	277	else { /* call TM */
274	result = nvalue(l)-nvalue(r);	278	luaD_checkstack(L, 2);
275	else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING)	279	top++ = l;
276	result = luaV_strcomp(svalue(l), tsvalue(l)->u.s.len,	280	top++ = r;
277	svalue(r), tsvalue(r)->u.s.len);	281	if (!call_binTM(L, top, TM_LT))
278	else {	282	luaG_ordererror(L, top-2);
279	call_binTM(op, "unexpected type in comparison");	283	L->top--;
280	return;	284	return (ttype(L->top) != LUA_TNIL);
281	}	285	}
282	S->top--;
283	nvalue(S->top-1) = 1;
284	ttype(S->top-1) = (result < 0) ? ttype_less :
285	(result == 0) ? ttype_equal : ttype_great;
286	}	286	}
287		287
288		288
289	void luaV_pack (StkId firstel, int nvararg, TObject *tab) {	289	void luaV_strconc (lua_State *L, int total, StkId top) {
290	TObject *firstelem = L->stack.stack+firstel;	290	do {
		291	int n = 2; /* number of elements handled in this pass (at least 2) */
		292	if (tostring(L, top-2) \|\| tostring(L, top-1)) {
		293	if (!call_binTM(L, top, TM_CONCAT))
		294	luaG_binerror(L, top-2, LUA_TSTRING, "concat");
		295	}
		296	else if (tsvalue(top-1)->len > 0) { /* if len=0, do nothing */
		297	/* at least two string values; get as many as possible */
		298	lint32 tl = (lint32)tsvalue(top-1)->len +
		299	(lint32)tsvalue(top-2)->len;
		300	char *buffer;
		301	int i;
		302	while (n < total && !tostring(L, top-n-1)) { /* collect total length */
		303	tl += tsvalue(top-n-1)->len;
		304	n++;
		305	}
		306	if (tl > MAX_SIZET) lua_error(L, "string size overflow");
		307	buffer = luaO_openspace(L, tl);
		308	tl = 0;
		309	for (i=n; i>0; i--) { /* concat all strings */
		310	size_t l = tsvalue(top-i)->len;
		311	memcpy(buffer+tl, tsvalue(top-i)->str, l);
		312	tl += l;
		313	}
		314	tsvalue(top-n) = luaS_newlstr(L, buffer, tl);
		315	}
		316	total -= n-1; /* got `n' strings to create 1 new */
		317	top -= n-1;
		318	} while (total > 1); /* repeat until only 1 result left */
		319	}
		320
		321
		322	static void luaV_pack (lua_State *L, StkId firstelem) {
291	int i;	323	int i;
292	Hash *htab;	324	Hash *htab = luaH_new(L, 0);
293	if (nvararg < 0) nvararg = 0;	325	for (i=0; firstelem+i<L->top; i++)
294	htab = avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */	326	luaH_setint(L, htab, i+1) = (firstelem+i);
295	ttype(tab) = LUA_T_ARRAY;	327	/* store counter in field `n' */
296	for (i=0; i<nvararg; i++)	328	luaH_setstrnum(L, htab, luaS_new(L, "n"), i);
297	luaH_setint(htab, i+1, firstelem+i);	329	L->top = firstelem; /* remove elements from the stack */
298	luaV_setn(htab, nvararg); /* store counter in field "n" */	330	ttype(L->top) = LUA_TTABLE;
		331	hvalue(L->top) = htab;
		332	incr_top;
299	}	333	}
300		334
301		335
302	static void adjust_varargs (StkId first_extra_arg)	336	static void adjust_varargs (lua_State *L, StkId base, int nfixargs) {
303	{	337	int nvararg = (L->top-base) - nfixargs;
304	TObject arg;	338	if (nvararg < 0)
305	luaV_pack(first_extra_arg,	339	luaD_adjusttop(L, base, nfixargs);
306	(L->stack.top-L->stack.stack)-first_extra_arg, &arg);	340	luaV_pack(L, base+nfixargs);
307	luaD_adjusttop(first_extra_arg);
308	*L->stack.top++ = arg;
309	}	341	}
310		342
311		343
312		344
		345	#define dojump(pc, i) { int d = GETARG_S(i); pc += d; }
		346
313	/*	347	/*
314	** Execute the given opcode, until a RET. Parameters are between	348	** Executes the given Lua function. Parameters are between [base,top).
315	** [stack+base,top). Returns n such that the the results are between	349	** Returns n such that the the results are between [n,top).
316	** [stack+n,top).
317	*/	350	*/
318	StkId luaV_execute (Closure cl, TProtoFunc tf, StkId base) {	351	StkId luaV_execute (lua_State L, const Closure cl, StkId base) {
319	struct Stack S = &L->stack; / to optimize */	352	const Proto *const tf = cl->f.l;
320	register Byte *pc = tf->code;	353	StkId top; /* keep top local, for performance */
321	TObject *consts = tf->consts;	354	const Instruction *pc = tf->code;
322	if (L->callhook)	355	TString **const kstr = tf->kstr;
323	luaD_callHook(base, tf, 0);	356	const lua_Hook linehook = L->linehook;
324	luaD_checkstack((*pc++)+EXTRA_STACK);	357	infovalue(base-1)->pc = &pc;
325	if (*pc < ZEROVARARG)	358	luaD_checkstack(L, tf->maxstacksize+EXTRA_STACK);
326	luaD_adjusttop(base+*(pc++));	359	if (tf->is_vararg) /* varargs? */
327	else { /* varargs */	360	adjust_varargs(L, base, tf->numparams);
328	luaC_checkGC();	361	else
329	adjust_varargs(base+(*pc++)-ZEROVARARG);	362	luaD_adjusttop(L, base, tf->numparams);
330	}	363	top = L->top;
		364	/* main loop of interpreter */
331	for (;;) {	365	for (;;) {
332	register int aux = 0;	366	const Instruction i = *pc++;
333	switchentry:	367	if (linehook)
334	switch ((OpCode)*pc++) {	368	traceexec(L, base, top, linehook);
335		369	switch (GET_OPCODE(i)) {
336	case ENDCODE:	370	case OP_END: {
337	S->top = S->stack + base;	371	L->top = top;
338	goto ret;	372	return top;
339		373	}
340	case RETCODE:	374	case OP_RETURN: {
341	base += *pc++;	375	L->top = top;
342	goto ret;	376	return base+GETARG_U(i);
343		377	}
344	case CALL: aux = *pc++;	378	case OP_CALL: {
345	luaD_calln(*pc++, aux);	379	int nres = GETARG_B(i);
		380	if (nres == MULT_RET) nres = LUA_MULTRET;
		381	L->top = top;
		382	luaD_call(L, base+GETARG_A(i), nres);
		383	top = L->top;
346	break;	384	break;
347		385	}
348	case TAILCALL: aux = *pc++;	386	case OP_TAILCALL: {
349	luaD_calln(*pc++, MULT_RET);	387	L->top = top;
350	base += aux;	388	luaD_call(L, base+GETARG_A(i), LUA_MULTRET);
351	goto ret;	389	return base+GETARG_B(i);
352		390	}
353	case PUSHNIL: aux = *pc++;	391	case OP_PUSHNIL: {
		392	int n = GETARG_U(i);
		393	LUA_ASSERT(n>0, "invalid argument");
354	do {	394	do {
355	ttype(S->top++) = LUA_T_NIL;	395	ttype(top++) = LUA_TNIL;
356	} while (aux--);	396	} while (--n > 0);
357	break;	397	break;
358		398	}
359	case POP: aux = *pc++;	399	case OP_POP: {
360	S->top -= aux;	400	top -= GETARG_U(i);
361	break;	401	break;
362		402	}
363	case PUSHNUMBERW: aux += highbyte(*pc++);	403	case OP_PUSHINT: {
364	case PUSHNUMBER: aux += *pc++;	404	ttype(top) = LUA_TNUMBER;
365	ttype(S->top) = LUA_T_NUMBER;	405	nvalue(top) = (Number)GETARG_S(i);
366	nvalue(S->top) = aux;	406	top++;
367	S->top++;
368	break;	407	break;
369		408	}
370	case PUSHNUMBERNEGW: aux += highbyte(*pc++);	409	case OP_PUSHSTRING: {
371	case PUSHNUMBERNEG: aux += *pc++;	410	ttype(top) = LUA_TSTRING;
372	ttype(S->top) = LUA_T_NUMBER;	411	tsvalue(top) = kstr[GETARG_U(i)];
373	nvalue(S->top) = -aux;	412	top++;
374	S->top++;
375	break;	413	break;
376		414	}
377	case PUSHCONSTANTW: aux += highbyte(*pc++);	415	case OP_PUSHNUM: {
378	case PUSHCONSTANT: aux += *pc++;	416	ttype(top) = LUA_TNUMBER;
379	*S->top++ = consts[aux];	417	nvalue(top) = tf->knum[GETARG_U(i)];
		418	top++;
380	break;	419	break;
381		420	}
382	case PUSHUPVALUE: aux = *pc++;	421	case OP_PUSHNEGNUM: {
383	*S->top++ = cl->consts[aux+1];	422	ttype(top) = LUA_TNUMBER;
		423	nvalue(top) = -tf->knum[GETARG_U(i)];
		424	top++;
384	break;	425	break;
385		426	}
386	case PUSHLOCAL: aux = *pc++;	427	case OP_PUSHUPVALUE: {
387	S->top++ = ((S->stack+base) + aux);	428	*top++ = cl->upvalue[GETARG_U(i)];
388	break;	429	break;
389		430	}
390	case GETGLOBALW: aux += highbyte(*pc++);	431	case OP_GETLOCAL: {
391	case GETGLOBAL: aux += *pc++;	432	top++ = (base+GETARG_U(i));
392	luaV_getglobal(tsvalue(&consts[aux]));
393	break;	433	break;
394		434	}
395	case GETTABLE:	435	case OP_GETGLOBAL: {
396	luaV_gettable();	436	L->top = top;
		437	top = luaV_getglobal(L, kstr[GETARG_U(i)]);
		438	top++;
397	break;	439	break;
398		440	}
399	case GETDOTTEDW: aux += highbyte(*pc++);	441	case OP_GETTABLE: {
400	case GETDOTTED: aux += *pc++;	442	L->top = top;
401	*S->top++ = consts[aux];	443	top--;
402	luaV_gettable();	444	(top-1) = luaV_gettable(L, top-1);
403	break;	445	break;
404		446	}
405	case PUSHSELFW: aux += highbyte(*pc++);	447	case OP_GETDOTTED: {
406	case PUSHSELF: aux += *pc++; {	448	ttype(top) = LUA_TSTRING;
407	TObject receiver;	449	tsvalue(top) = kstr[GETARG_U(i)];
408	receiver = *(S->top-1);	450	L->top = top+1;
409	*S->top++ = consts[aux];	451	(top-1) = luaV_gettable(L, top-1);
410	luaV_gettable();
411	*S->top++ = receiver;
412	break;	452	break;
413	}	453	}
414		454	case OP_GETINDEXED: {
415	case CREATEARRAYW: aux += highbyte(*pc++);	455	top = (base+GETARG_U(i));
416	case CREATEARRAY: aux += *pc++;	456	L->top = top+1;
417	luaC_checkGC();	457	(top-1) = luaV_gettable(L, top-1);
418	avalue(S->top) = luaH_new(aux);
419	ttype(S->top) = LUA_T_ARRAY;
420	S->top++;
421	break;	458	break;
422		459	}
423	case SETLOCAL: aux = *pc++;	460	case OP_PUSHSELF: {
424	((S->stack+base) + aux) = (--S->top);	461	TObject receiver;
		462	receiver = *(top-1);
		463	ttype(top) = LUA_TSTRING;
		464	tsvalue(top++) = kstr[GETARG_U(i)];
		465	L->top = top;
		466	(top-2) = luaV_gettable(L, top-2);
		467	*(top-1) = receiver;
425	break;	468	break;
426		469	}
427	case SETGLOBALW: aux += highbyte(*pc++);	470	case OP_CREATETABLE: {
428	case SETGLOBAL: aux += *pc++;	471	L->top = top;
429	luaV_setglobal(tsvalue(&consts[aux]));	472	luaC_checkGC(L);
		473	hvalue(top) = luaH_new(L, GETARG_U(i));
		474	ttype(top) = LUA_TTABLE;
		475	top++;
430	break;	476	break;
431		477	}
432	case SETTABLEPOP:	478	case OP_SETLOCAL: {
433	luaV_settable(S->top-3);	479	(base+GETARG_U(i)) = (--top);
434	S->top -= 2; /* pop table and index */
435	break;	480	break;
436		481	}
437	case SETTABLE:	482	case OP_SETGLOBAL: {
438	luaV_settable(S->top-3-(*pc++));	483	L->top = top;
		484	luaV_setglobal(L, kstr[GETARG_U(i)]);
		485	top--;
439	break;	486	break;
440		487	}
441	case SETLISTW: aux += highbyte(*pc++);	488	case OP_SETTABLE: {
442	case SETLIST: aux += *pc++; {	489	StkId t = top-GETARG_A(i);
443	int n = *(pc++);	490	L->top = top;
444	Hash *arr = avalue(S->top-n-1);	491	luaV_settable(L, t, t+1);
445	aux *= LFIELDS_PER_FLUSH;	492	top -= GETARG_B(i); /* pop values */
		493	break;
		494	}
		495	case OP_SETLIST: {
		496	int aux = GETARG_A(i) * LFIELDS_PER_FLUSH;
		497	int n = GETARG_B(i);
		498	Hash *arr = hvalue(top-n-1);
		499	L->top = top-n; /* final value of `top' (in case of errors) */
446	for (; n; n--)	500	for (; n; n--)
447	luaH_setint(arr, n+aux, --S->top);	501	luaH_setint(L, arr, n+aux) = (--top);
448	break;	502	break;
449	}	503	}
450		504	case OP_SETMAP: {
451	case SETMAP: aux = *pc++; {	505	int n = GETARG_U(i);
452	Hash arr = avalue(S->top-(2aux)-3);	506	StkId finaltop = top-2*n;
453	do {	507	Hash *arr = hvalue(finaltop-1);
454	luaH_set(arr, S->top-2, S->top-1);	508	L->top = finaltop; /* final value of `top' (in case of errors) */
455	S->top-=2;	509	for (; n; n--) {
456	} while (aux--);	510	top-=2;
		511	luaH_set(L, arr, top) = (top+1);
		512	}
457	break;	513	break;
458	}	514	}
459		515	case OP_ADD: {
460	case NEQOP: aux = 1;	516	if (tonumber(top-2) \|\| tonumber(top-1))
461	case EQOP: {	517	call_arith(L, top, TM_ADD);
462	int res = luaO_equalObj(S->top-2, S->top-1);	518	else
463	if (aux) res = !res;	519	nvalue(top-2) += nvalue(top-1);
464	S->top--;	520	top--;
465	ttype(S->top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
466	nvalue(S->top-1) = 1;
467	break;	521	break;
468	}	522	}
469		523	case OP_ADDI: {
470	case LTOP:	524	if (tonumber(top-1)) {
471	luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);	525	ttype(top) = LUA_TNUMBER;
472	break;	526	nvalue(top) = (Number)GETARG_S(i);
473		527	call_arith(L, top+1, TM_ADD);
474	case LEOP:	528	}
475	luaV_comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);	529	else
		530	nvalue(top-1) += (Number)GETARG_S(i);
476	break;	531	break;
477		532	}
478	case GTOP:	533	case OP_SUB: {
479	luaV_comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);	534	if (tonumber(top-2) \|\| tonumber(top-1))
		535	call_arith(L, top, TM_SUB);
		536	else
		537	nvalue(top-2) -= nvalue(top-1);
		538	top--;
480	break;	539	break;
481		540	}
482	case GEOP:	541	case OP_MULT: {
483	luaV_comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);	542	if (tonumber(top-2) \|\| tonumber(top-1))
		543	call_arith(L, top, TM_MUL);
		544	else
		545	nvalue(top-2) *= nvalue(top-1);
		546	top--;
484	break;	547	break;
485		548	}
486	case ADDOP: {	549	case OP_DIV: {
487	TObject *l = S->top-2;	550	if (tonumber(top-2) \|\| tonumber(top-1))
488	TObject *r = S->top-1;	551	call_arith(L, top, TM_DIV);
489	if (tonumber(r) \|\| tonumber(l))	552	else
490	call_arith(IM_ADD);	553	nvalue(top-2) /= nvalue(top-1);
491	else {	554	top--;
492	nvalue(l) += nvalue(r);
493	--S->top;
494	}
495	break;	555	break;
496	}	556	}
497		557	case OP_POW: {
498	case SUBOP: {	558	if (!call_binTM(L, top, TM_POW))
499	TObject *l = S->top-2;	559	lua_error(L, "undefined operation");
500	TObject *r = S->top-1;	560	top--;
501	if (tonumber(r) \|\| tonumber(l))
502	call_arith(IM_SUB);
503	else {
504	nvalue(l) -= nvalue(r);
505	--S->top;
506	}
507	break;	561	break;
508	}	562	}
509		563	case OP_CONCAT: {
510	case MULTOP: {	564	int n = GETARG_U(i);
511	TObject *l = S->top-2;	565	luaV_strconc(L, n, top);
512	TObject *r = S->top-1;	566	top -= n-1;
513	if (tonumber(r) \|\| tonumber(l))	567	L->top = top;
514	call_arith(IM_MUL);	568	luaC_checkGC(L);
515	else {
516	nvalue(l) *= nvalue(r);
517	--S->top;
518	}
519	break;	569	break;
520	}	570	}
521		571	case OP_MINUS: {
522	case DIVOP: {	572	if (tonumber(top-1)) {
523	TObject *l = S->top-2;	573	ttype(top) = LUA_TNIL;
524	TObject *r = S->top-1;	574	call_arith(L, top+1, TM_UNM);
525	if (tonumber(r) \|\| tonumber(l))
526	call_arith(IM_DIV);
527	else {
528	nvalue(l) /= nvalue(r);
529	--S->top;
530	}	575	}
		576	else
		577	nvalue(top-1) = -nvalue(top-1);
531	break;	578	break;
532	}	579	}
533		580	case OP_NOT: {
534	case POWOP:	581	ttype(top-1) =
535	call_binTM(IM_POW, "undefined operation");	582	(ttype(top-1) == LUA_TNIL) ? LUA_TNUMBER : LUA_TNIL;
		583	nvalue(top-1) = 1;
536	break;	584	break;
537		585	}
538	case CONCOP: {	586	case OP_JMPNE: {
539	TObject *l = S->top-2;	587	top -= 2;
540	TObject *r = S->top-1;	588	if (!luaO_equalObj(top, top+1)) dojump(pc, i);
541	if (tostring(l) \|\| tostring(r))
542	call_binTM(IM_CONCAT, "unexpected type for concatenation");
543	else {
544	tsvalue(l) = strconc(tsvalue(l), tsvalue(r));
545	--S->top;
546	}
547	luaC_checkGC();
548	break;	589	break;
549	}	590	}
550		591	case OP_JMPEQ: {
551	case MINUSOP:	592	top -= 2;
552	if (tonumber(S->top-1)) {	593	if (luaO_equalObj(top, top+1)) dojump(pc, i);
553	ttype(S->top) = LUA_T_NIL;
554	S->top++;
555	call_arith(IM_UNM);
556	}
557	else
558	nvalue(S->top-1) = - nvalue(S->top-1);
559	break;	594	break;
560		595	}
561	case NOTOP:	596	case OP_JMPLT: {
562	ttype(S->top-1) =	597	top -= 2;
563	(ttype(S->top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;	598	if (luaV_lessthan(L, top, top+1, top+2)) dojump(pc, i);
564	nvalue(S->top-1) = 1;
565	break;	599	break;
566		600	}
567	case ONTJMPW: aux += highbyte(*pc++);	601	case OP_JMPLE: { /* a <= b === !(b<a) */
568	case ONTJMP: aux += *pc++;	602	top -= 2;
569	if (ttype(S->top-1) != LUA_T_NIL) pc += aux;	603	if (!luaV_lessthan(L, top+1, top, top+2)) dojump(pc, i);
570	else S->top--;
571	break;	604	break;
572		605	}
573	case ONFJMPW: aux += highbyte(*pc++);	606	case OP_JMPGT: { /* a > b === (b<a) */
574	case ONFJMP: aux += *pc++;	607	top -= 2;
575	if (ttype(S->top-1) == LUA_T_NIL) pc += aux;	608	if (luaV_lessthan(L, top+1, top, top+2)) dojump(pc, i);
576	else S->top--;
577	break;	609	break;
578		610	}
579	case JMPW: aux += highbyte(*pc++);	611	case OP_JMPGE: { /* a >= b === !(a<b) */
580	case JMP: aux += *pc++;	612	top -= 2;
581	pc += aux;	613	if (!luaV_lessthan(L, top, top+1, top+2)) dojump(pc, i);
582	break;	614	break;
583		615	}
584	case IFFJMPW: aux += highbyte(*pc++);	616	case OP_JMPT: {
585	case IFFJMP: aux += *pc++;	617	if (ttype(--top) != LUA_TNIL) dojump(pc, i);
586	if (ttype(--S->top) == LUA_T_NIL) pc += aux;
587	break;	618	break;
588		619	}
589	case IFTUPJMPW: aux += highbyte(*pc++);	620	case OP_JMPF: {
590	case IFTUPJMP: aux += *pc++;	621	if (ttype(--top) == LUA_TNIL) dojump(pc, i);
591	if (ttype(--S->top) != LUA_T_NIL) pc -= aux;
592	break;	622	break;
593		623	}
594	case IFFUPJMPW: aux += highbyte(*pc++);	624	case OP_JMPONT: {
595	case IFFUPJMP: aux += *pc++;	625	if (ttype(top-1) == LUA_TNIL) top--;
596	if (ttype(--S->top) == LUA_T_NIL) pc -= aux;	626	else dojump(pc, i);
597	break;	627	break;
598		628	}
599	case CLOSUREW: aux += highbyte(*pc++);	629	case OP_JMPONF: {
600	case CLOSURE: aux += *pc++;	630	if (ttype(top-1) != LUA_TNIL) top--;
601	*S->top++ = consts[aux];	631	else dojump(pc, i);
602	luaV_closure(*pc++);
603	luaC_checkGC();
604	break;	632	break;
605		633	}
606	case SETLINEW: aux += highbyte(*pc++);	634	case OP_JMP: {
607	case SETLINE: aux += *pc++;	635	dojump(pc, i);
608	if ((S->stack+base-1)->ttype != LUA_T_LINE) {	636	break;
609	/* open space for LINE value */	637	}
610	luaD_openstack((S->top-S->stack)-base);	638	case OP_PUSHNILJMP: {
611	base++;	639	ttype(top++) = LUA_TNIL;
612	(S->stack+base-1)->ttype = LUA_T_LINE;	640	pc++;
		641	break;
		642	}
		643	case OP_FORPREP: {
		644	if (tonumber(top-1))
		645	lua_error(L, "`for' step must be a number");
		646	if (tonumber(top-2))
		647	lua_error(L, "`for' limit must be a number");
		648	if (tonumber(top-3))
		649	lua_error(L, "`for' initial value must be a number");
		650	if (nvalue(top-1) > 0 ?
		651	nvalue(top-3) > nvalue(top-2) :
		652	nvalue(top-3) < nvalue(top-2)) { /* `empty' loop? */
		653	top -= 3; /* remove control variables */
		654	dojump(pc, i); /* jump to loop end */
613	}	655	}
614	(S->stack+base-1)->value.i = aux;
615	if (L->linehook)
616	luaD_lineHook(aux);
617	break;	656	break;
618		657	}
619	case LONGARGW: aux += highbyte(*pc++);	658	case OP_FORLOOP: {
620	case LONGARG: aux += *pc++;	659	LUA_ASSERT(ttype(top-1) == LUA_TNUMBER, "invalid step");
621	aux = highbyte(highbyte(aux));	660	LUA_ASSERT(ttype(top-2) == LUA_TNUMBER, "invalid limit");
622	goto switchentry; /* do not reset "aux" */	661	if (ttype(top-3) != LUA_TNUMBER)
623		662	lua_error(L, "`for' index must be a number");
624	case CHECKSTACK: aux = *pc++;	663	nvalue(top-3) += nvalue(top-1); /* increment index */
625	LUA_ASSERT((S->top-S->stack)-base == aux && S->last >= S->top,	664	if (nvalue(top-1) > 0 ?
626	"wrong stack size");	665	nvalue(top-3) > nvalue(top-2) :
		666	nvalue(top-3) < nvalue(top-2))
		667	top -= 3; /* end loop: remove control variables */
		668	else
		669	dojump(pc, i); /* repeat loop */
627	break;	670	break;
628		671	}
		672	case OP_LFORPREP: {
		673	Node *node;
		674	if (ttype(top-1) != LUA_TTABLE)
		675	lua_error(L, "`for' table must be a table");
		676	node = luaH_next(L, hvalue(top-1), &luaO_nilobject);
		677	if (node == NULL) { /* `empty' loop? */
		678	top--; /* remove table */
		679	dojump(pc, i); /* jump to loop end */
		680	}
		681	else {
		682	top += 2; /* index,value */
		683	(top-2) = key(node);
		684	(top-1) = val(node);
		685	}
		686	break;
		687	}
		688	case OP_LFORLOOP: {
		689	Node *node;
		690	LUA_ASSERT(ttype(top-3) == LUA_TTABLE, "invalid table");
		691	node = luaH_next(L, hvalue(top-3), top-2);
		692	if (node == NULL) /* end loop? */
		693	top -= 3; /* remove table, key, and value */
		694	else {
		695	(top-2) = key(node);
		696	(top-1) = val(node);
		697	dojump(pc, i); /* repeat loop */
		698	}
		699	break;
		700	}
		701	case OP_CLOSURE: {
		702	L->top = top;
		703	luaV_Lclosure(L, tf->kproto[GETARG_A(i)], GETARG_B(i));
		704	top = L->top;
		705	luaC_checkGC(L);
		706	break;
		707	}
629	}	708	}
630	} ret:	709	}
631	if (L->callhook)
632	luaD_callHook(0, NULL, 1);
633	return base;
634	}	710	}
635

src/lvm.h+13−15

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lvm.h,v 1.8 1999/02/08 17:07:59 roberto Exp $	2	** $Id: lvm.h,v 1.27 2000/10/05 12:14:08 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	*/
@@ -13,22 +13,20 @@ · 7 unmodified lines
13	#include "ltm.h"	13	#include "ltm.h"
14		14
15		15
16	#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0))	16	#define tonumber(o) ((ttype(o) != LUA_TNUMBER) && (luaV_tonumber(o) != 0))
17	#define tostring(o) ((ttype(o) != LUA_T_STRING) && (luaV_tostring(o) != 0))	17	#define tostring(L,o) ((ttype(o) != LUA_TSTRING) && (luaV_tostring(L, o) != 0))
18		18
19		19
20	void luaV_pack (StkId firstel, int nvararg, TObject *tab);
21	int luaV_tonumber (TObject *obj);	20	int luaV_tonumber (TObject *obj);
22	int luaV_tostring (TObject *obj);	21	int luaV_tostring (lua_State L, TObject obj);
23	void luaV_setn (Hash *t, int val);	22	const TObject luaV_gettable (lua_State L, StkId t);
24	void luaV_gettable (void);	23	void luaV_settable (lua_State *L, StkId t, StkId key);
25	void luaV_settable (TObject *t);	24	const TObject luaV_getglobal (lua_State L, TString *s);
26	void luaV_rawsettable (TObject *t);	25	void luaV_setglobal (lua_State L, TString s);
27	void luaV_getglobal (TaggedString *ts);	26	StkId luaV_execute (lua_State L, const Closure cl, StkId base);
28	void luaV_setglobal (TaggedString *ts);	27	void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems);
29	StkId luaV_execute (Closure cl, TProtoFunc tf, StkId base);	28	void luaV_Lclosure (lua_State L, Proto l, int nelems);
30	void luaV_closure (int nelems);	29	int luaV_lessthan (lua_State L, const TObject l, const TObject *r, StkId top);
31	void luaV_comparison (lua_Type ttype_less, lua_Type ttype_equal,	30	void luaV_strconc (lua_State *L, int total, StkId top);
32	lua_Type ttype_great, IMS op);
33		31
34	#endif	32	#endif

src/lzio.c+34−34

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lzio.c,v 1.7 1999/03/05 13:15:50 roberto Exp $	2	** $Id: lzio.c,v 1.13 2000/06/12 13:52:05 roberto Exp $
3	** a generic input stream interface	3	** a generic input stream interface
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -9,6 +9,8 @@ · 3 unmodified lines
9	#include <stdio.h>	9	#include <stdio.h>
10	#include <string.h>	10	#include <string.h>
11		11
		12	#include "lua.h"
		13
12	#include "lzio.h"	14	#include "lzio.h"
13		15
14		16
@@ -16,62 +18,60 @@ · 1 unmodified line
16	/* ----------------------------------------------------- memory buffers --- */	18	/* ----------------------------------------------------- memory buffers --- */
17		19
18	static int zmfilbuf (ZIO* z) {	20	static int zmfilbuf (ZIO* z) {
19	return EOZ;	21	(void)z; /* to avoid warnings */
		22	return EOZ;
20	}	23	}
21		24
22		25
23	ZIO* zmopen (ZIO* z, char* b, int size, char *name)	26	ZIO* zmopen (ZIO* z, const char* b, size_t size, const char *name) {
24	{	27	if (b==NULL) return NULL;
25	if (b==NULL) return NULL;	28	z->n = size;
26	z->n=size;	29	z->p = (const unsigned char *)b;
27	z->p= (unsigned char *)b;	30	z->filbuf = zmfilbuf;
28	z->filbuf=zmfilbuf;	31	z->u = NULL;
29	z->u=NULL;	32	z->name = name;
30	z->name=name;	33	return z;
31	return z;
32	}	34	}
33		35
34	/* ------------------------------------------------------------ strings --- */	36	/* ------------------------------------------------------------ strings --- */
35		37
36	ZIO* zsopen (ZIO* z, char* s, char *name)	38	ZIO* zsopen (ZIO* z, const char* s, const char *name) {
37	{	39	if (s==NULL) return NULL;
38	if (s==NULL) return NULL;	40	return zmopen(z, s, strlen(s), name);
39	return zmopen(z,s,strlen(s),name);
40	}	41	}
41		42
42	/* -------------------------------------------------------------- FILEs --- */	43	/* -------------------------------------------------------------- FILEs --- */
43		44
44	static int zffilbuf (ZIO* z) {	45	static int zffilbuf (ZIO* z) {
45	int n;	46	size_t n;
46	if (feof((FILE *)z->u)) return EOZ;	47	if (feof((FILE *)z->u)) return EOZ;
47	n=fread(z->buffer,1,ZBSIZE,z->u);	48	n = fread(z->buffer, 1, ZBSIZE, (FILE *)z->u);
48	if (n==0) return EOZ;	49	if (n==0) return EOZ;
49	z->n=n-1;	50	z->n = n-1;
50	z->p=z->buffer;	51	z->p = z->buffer;
51	return *(z->p++);	52	return *(z->p++);
52	}	53	}
53		54
54		55
55	ZIO* zFopen (ZIO* z, FILE* f, char *name)	56	ZIO* zFopen (ZIO* z, FILE* f, const char *name) {
56	{	57	if (f==NULL) return NULL;
57	if (f==NULL) return NULL;	58	z->n = 0;
58	z->n=0;	59	z->p = z->buffer;
59	z->p=z->buffer;	60	z->filbuf = zffilbuf;
60	z->filbuf=zffilbuf;	61	z->u = f;
61	z->u=f;	62	z->name = name;
62	z->name=name;	63	return z;
63	return z;
64	}	64	}
65		65
66		66
67	/* --------------------------------------------------------------- read --- */	67	/* --------------------------------------------------------------- read --- */
68	int zread (ZIO z, void b, int n) {	68	size_t zread (ZIO z, void b, size_t n) {
69	while (n) {	69	while (n) {
70	int m;	70	size_t m;
71	if (z->n == 0) {	71	if (z->n == 0) {
72	if (z->filbuf(z) == EOZ)	72	if (z->filbuf(z) == EOZ)
73	return n; /* return number of missing bytes */	73	return n; /* return number of missing bytes */
74	zungetc(z); /* put result from 'filbuf' in the buffer */	74	zungetc(z); /* put result from `filbuf' in the buffer */
75	}	75	}
76	m = (n <= z->n) ? n : z->n; /* min. between n and z->n */	76	m = (n <= z->n) ? n : z->n; /* min. between n and z->n */
77	memcpy(b, z->p, m);	77	memcpy(b, z->p, m);

src/lzio.h+15−12

@@ -1,5 +1,5 @@
1	/*	1	/*
2	** $Id: lzio.h,v 1.4 1998/01/09 14:57:43 roberto Exp $	2	** $Id: lzio.h,v 1.7 2000/10/20 16:36:32 roberto Exp $
3	** Buffered streams	3	** Buffered streams
4	** See Copyright Notice in lua.h	4	** See Copyright Notice in lua.h
5	*/	5	*/
@@ -22,28 +22,31 @@ · 16 unmodified lines
22		22
23	typedef struct zio ZIO;	23	typedef struct zio ZIO;
24		24
25	ZIO* zFopen (ZIO* z, FILE* f, char name); / open FILEs */	25	ZIO* zFopen (ZIO* z, FILE* f, const char name); / open FILEs */
26	ZIO* zsopen (ZIO* z, char* s, char name); / string */	26	ZIO* zsopen (ZIO* z, const char* s, const char name); / string */
27	ZIO* zmopen (ZIO* z, char* b, int size, char name); / memory */	27	ZIO* zmopen (ZIO* z, const char* b, size_t size, const char name); / memory */
28		28
29	int zread (ZIO* z, void* b, int n); /* read next n bytes */	29	size_t zread (ZIO* z, void* b, size_t n); /* read next n bytes */
30		30
31	#define zgetc(z) (--(z)->n>=0 ? ((int)*(z)->p++): (z)->filbuf(z))	31	#define zgetc(z) (((z)->n--)>0 ? ((int)*(z)->p++): (z)->filbuf(z))
32	#define zungetc(z) (++(z)->n,--(z)->p)	32	#define zungetc(z) (++(z)->n,--(z)->p)
33	#define zname(z) ((z)->name)	33	#define zname(z) ((z)->name)
34		34
35		35
		36
36	/* --------- Private Part ------------------ */	37	/* --------- Private Part ------------------ */
37		38
		39	#ifndef ZBSIZE
38	#define ZBSIZE 256 /* buffer size */	40	#define ZBSIZE 256 /* buffer size */
		41	#endif
39		42
40	struct zio {	43	struct zio {
41	int n; /* bytes still unread */	44	size_t n; /* bytes still unread */
42	unsigned char* p; /* current position in buffer */	45	const unsigned char* p; /* current position in buffer */
43	int (filbuf)(ZIO z);	46	int (filbuf)(ZIO z);
44	void* u; /* additional data */	47	void* u; /* additional data */
45	char *name;	48	const char *name;
46	unsigned char buffer[ZBSIZE]; /* buffer */	49	unsigned char buffer[ZBSIZE]; /* buffer */
47	};	50	};
48		51
49		52

Lua 4.0

Keyboard shortcuts

General

Issues and pull requests

Issues, pull requests and Inbox

Repository code