aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoberto Ierusalimschy <roberto@inf.puc-rio.br>1997-03-19 16:41:10 -0300
committerRoberto Ierusalimschy <roberto@inf.puc-rio.br>1997-03-19 16:41:10 -0300
commit1444d28476af70bc51c4fdba71deb669f41c77a3 (patch)
tree6d19c5653702ea341f6650f3e917ed77456f757f
parent2de803c250de373186afbbea0a5978f54c52850c (diff)
downloadlua-1444d28476af70bc51c4fdba71deb669f41c77a3.tar.gz
lua-1444d28476af70bc51c4fdba71deb669f41c77a3.tar.bz2
lua-1444d28476af70bc51c4fdba71deb669f41c77a3.zip
first full implementation of internal methods
Diffstat
-rw-r--r--fallback.c369
-rw-r--r--fallback.h37
-rw-r--r--hash.c9
-rw-r--r--hash.h3
-rw-r--r--inout.c4
-rw-r--r--lua.h20
-rw-r--r--opcode.c161
-rw-r--r--opcode.h22
-rw-r--r--table.c4
-rw-r--r--tree.c23
-rw-r--r--tree.h3
11 files changed, 404 insertions, 251 deletions
diff --git a/fallback.c b/fallback.c
index b0bf8fae..a451f60a 100644
--- a/fallback.c
+++ b/fallback.c
@@ -3,11 +3,12 @@
3** TecCGraf - PUC-Rio 3** TecCGraf - PUC-Rio
4*/ 4*/
5 5
6char *rcs_fallback="$Id: fallback.c,v 1.26 1997/02/26 17:38:41 roberto Unstable roberto $"; 6char *rcs_fallback="$Id: fallback.c,v 1.27 1997/03/11 18:44:28 roberto Exp roberto $";
7 7
8#include <stdio.h> 8#include <stdio.h>
9#include <string.h> 9#include <string.h>
10 10
11#include "auxlib.h"
11#include "mem.h" 12#include "mem.h"
12#include "fallback.h" 13#include "fallback.h"
13#include "opcode.h" 14#include "opcode.h"
@@ -17,105 +18,6 @@ char *rcs_fallback="$Id: fallback.c,v 1.26 1997/02/26 17:38:41 roberto Unstable
17#include "hash.h" 18#include "hash.h"
18 19
19 20
20static void errorFB (void);
21static void indexFB (void);
22static void gettableFB (void);
23static void arithFB (void);
24static void concatFB (void);
25static void orderFB (void);
26static void GDFB (void);
27static void funcFB (void);
28
29
30/*
31** Warning: This list must be in the same order as the #define's
32*/
33struct FB luaI_fallBacks[] = {
34{"gettable", {LUA_T_CFUNCTION, {gettableFB}}, 2, 1},
35{"arith", {LUA_T_CFUNCTION, {arithFB}}, 3, 1},
36{"order", {LUA_T_CFUNCTION, {orderFB}}, 3, 1},
37{"concat", {LUA_T_CFUNCTION, {concatFB}}, 2, 1},
38{"settable", {LUA_T_CFUNCTION, {gettableFB}}, 3, 0},
39{"gc", {LUA_T_CFUNCTION, {GDFB}}, 1, 0},
40{"function", {LUA_T_CFUNCTION, {funcFB}}, -1, -1},
41 /* no fixed number of params or results */
42{"getglobal", {LUA_T_CFUNCTION, {indexFB}}, 1, 1},
43 /* same default behavior of index FB */
44{"index", {LUA_T_CFUNCTION, {indexFB}}, 2, 1},
45{"error", {LUA_T_CFUNCTION, {errorFB}}, 1, 0}
46};
47
48#define N_FB (sizeof(luaI_fallBacks)/sizeof(struct FB))
49
50static int luaI_findevent (char *name)
51{
52 int i;
53 for (i=0; i<N_FB; i++)
54 if (strcmp(luaI_fallBacks[i].kind, name) == 0)
55 return i;
56 /* name not found */
57 lua_error("invalid event name");
58 return 0; /* to avoid warnings */
59}
60
61
62void luaI_setfallback (void)
63{
64 int i;
65 char *name = lua_getstring(lua_getparam(1));
66 lua_Object func = lua_getparam(2);
67 if (name == NULL || !lua_isfunction(func))
68 lua_error("incorrect argument to function `setfallback'");
69 i = luaI_findevent(name);
70 luaI_pushobject(&luaI_fallBacks[i].function);
71 luaI_fallBacks[i].function = *luaI_Address(func);
72}
73
74
75static void errorFB (void)
76{
77 lua_Object o = lua_getparam(1);
78 if (lua_isstring(o))
79 fprintf (stderr, "lua: %s\n", lua_getstring(o));
80 else
81 fprintf(stderr, "lua: unknown error\n");
82}
83
84
85static void indexFB (void)
86{
87 lua_pushnil();
88}
89
90
91static void gettableFB (void)
92{
93 lua_error("indexed expression not a table");
94}
95
96
97static void arithFB (void)
98{
99 lua_error("unexpected type at conversion to number");
100}
101
102static void concatFB (void)
103{
104 lua_error("unexpected type at conversion to string");
105}
106
107
108static void orderFB (void)
109{
110 lua_error("unexpected type at comparison");
111}
112
113static void GDFB (void) { }
114
115static void funcFB (void)
116{
117 lua_error("call expression not a function");
118}
119 21
120 22
121/* ------------------------------------------- 23/* -------------------------------------------
@@ -187,50 +89,127 @@ void luaI_invalidaterefs (void)
187 refArray[i].status = COLLECTED; 89 refArray[i].status = COLLECTED;
188} 90}
189 91
190char *luaI_travfallbacks (int (*fn)(Object *)) 92
93/* -------------------------------------------
94* Internal Methods
95*/
96
97char *eventname[] = {
98 "gettable", /* IM_GETTABLE */
99 "arith", /* IM_ARITH */
100 "order", /* IM_ORDER */
101 "concat", /* IM_CONCAT */
102 "settable", /* IM_SETTABLE */
103 "gc", /* IM_GC */
104 "function", /* IM_FUNCTION */
105 "index", /* IM_INDEX */
106 NULL
107};
108
109
110char *geventname[] = {
111 "error", /* GIM_ERROR */
112 "getglobal", /* GIM_GETGLOBAL */
113 "setglobal", /* GIM_SETGLOBAL */
114 NULL
115};
116
117static int luaI_findevent (char *name, char *list[])
191{ 118{
192 int i; 119 int i;
193 for (i=0; i<N_FB; i++) 120 for (i=0; list[i]; i++)
194 if (fn(&luaI_fallBacks[i].function)) 121 if (strcmp(list[i], name) == 0)
195 return luaI_fallBacks[i].kind; 122 return i;
196 return NULL; 123 /* name not found */
124 return -1;
197} 125}
198 126
127static int luaI_checkevent (char *name, char *list[])
128{
129 int e = luaI_findevent(name, list);
130 if (e < 0)
131 lua_error("invalid event name");
132 return e;
133}
199 134
200/* -------------------------------------------
201* Internal Methods
202*/
203#define BASE_TAG 1000
204 135
205static struct IM { 136static struct IM {
206 lua_Type tp; 137 lua_Type tp;
207 Object int_method[FB_N]; 138 Object int_method[IM_N];
208 } *luaI_IMtable = NULL; 139} *luaI_IMtable = NULL;
140
209static int IMtable_size = 0; 141static int IMtable_size = 0;
210static int last_tag = BASE_TAG-1; 142static int last_tag = LUA_T_NIL;
143
144static struct {
145 lua_Type t;
146 int event;
147} exceptions[] = { /* list of events that cannot be modified */
148 {LUA_T_NUMBER, IM_ARITH},
149 {LUA_T_NUMBER, IM_ORDER},
150 {LUA_T_NUMBER, IM_GC},
151 {LUA_T_STRING, IM_ARITH},
152 {LUA_T_STRING, IM_ORDER},
153 {LUA_T_STRING, IM_CONCAT},
154 {LUA_T_STRING, IM_GC},
155 {LUA_T_ARRAY, IM_GETTABLE},
156 {LUA_T_ARRAY, IM_SETTABLE},
157 {LUA_T_FUNCTION, IM_FUNCTION},
158 {LUA_T_FUNCTION, IM_GC},
159 {LUA_T_CFUNCTION, IM_FUNCTION},
160 {LUA_T_CFUNCTION, IM_GC},
161 {LUA_T_NIL, 0} /* flag end of list */
162};
211 163
212int lua_newtag (char *t) 164
165static int validevent (int t, int event)
166{
167 int i;
168 if (t == LUA_T_NIL) /* cannot modify any event for nil */
169 return 0;
170 for (i=0; exceptions[i].t != LUA_T_NIL; i++)
171 if (exceptions[i].t == t && exceptions[i].event == event)
172 return 0;
173 return 1;
174}
175
176static void init_entry (int tag)
213{ 177{
214 int i; 178 int i;
215 ++last_tag; 179 for (i=0; i<IM_N; i++)
216 if ((last_tag-BASE_TAG) >= IMtable_size) 180 luaI_IMtable[-tag].int_method[i].ttype = LUA_T_NIL;
181}
182
183void luaI_initfallbacks (void)
184{
185 int i;
186 IMtable_size = NUM_TYPES+10;
187 luaI_IMtable = newvector(IMtable_size, struct IM);
188 for (i=LUA_T_NIL; i<=LUA_T_USERDATA; i++) {
189 luaI_IMtable[-i].tp = (lua_Type)i;
190 init_entry(i);
191 }
192}
193
194int lua_newtag (char *t)
195{
196 --last_tag;
197 if ((-last_tag) >= IMtable_size)
217 IMtable_size = growvector(&luaI_IMtable, IMtable_size, 198 IMtable_size = growvector(&luaI_IMtable, IMtable_size,
218 struct IM, memEM, MAX_INT); 199 struct IM, memEM, MAX_INT);
219 if (strcmp(t, "table") == 0) 200 if (strcmp(t, "table") == 0)
220 luaI_IMtable[last_tag-BASE_TAG].tp = LUA_T_ARRAY; 201 luaI_IMtable[-last_tag].tp = LUA_T_ARRAY;
221 else if (strcmp(t, "userdata") == 0) 202 else if (strcmp(t, "userdata") == 0)
222 luaI_IMtable[last_tag-BASE_TAG].tp = LUA_T_USERDATA; 203 luaI_IMtable[-last_tag].tp = LUA_T_USERDATA;
223 else 204 else
224 lua_error("invalid type for new tag"); 205 lua_error("invalid type for new tag");
225 for (i=0; i<FB_N; i++) 206 init_entry(last_tag);
226 luaI_IMtable[last_tag-BASE_TAG].int_method[i].ttype = LUA_T_NIL;
227 return last_tag; 207 return last_tag;
228} 208}
229 209
230static int validtag (int tag) 210
231{ 211#define validtag(tag) (last_tag <= (tag) && (tag) <= 0)
232 return (BASE_TAG <= tag && tag <= last_tag); 212
233}
234 213
235static void checktag (int tag) 214static void checktag (int tag)
236{ 215{
@@ -238,10 +217,18 @@ static void checktag (int tag)
238 lua_error("invalid tag"); 217 lua_error("invalid tag");
239} 218}
240 219
220lua_Type luaI_typetag (int tag)
221{
222 if (tag >= 0) return LUA_T_USERDATA;
223 else {
224 checktag(tag);
225 return luaI_IMtable[-tag].tp;
226 }
227}
228
241void luaI_settag (int tag, Object *o) 229void luaI_settag (int tag, Object *o)
242{ 230{
243 checktag(tag); 231 if (ttype(o) != luaI_typetag(tag))
244 if (ttype(o) != luaI_IMtable[tag-BASE_TAG].tp)
245 lua_error("Tag is not compatible with this type"); 232 lua_error("Tag is not compatible with this type");
246 if (o->ttype == LUA_T_ARRAY) 233 if (o->ttype == LUA_T_ARRAY)
247 o->value.a->htag = tag; 234 o->value.a->htag = tag;
@@ -261,29 +248,123 @@ int luaI_tag (Object *o)
261 248
262Object *luaI_getim (int tag, int event) 249Object *luaI_getim (int tag, int event)
263{ 250{
264 if (tag == 0) 251 if (tag > LUA_T_USERDATA)
265 return &luaI_fallBacks[event].function; 252 tag = LUA_T_USERDATA; /* default for non-registered tags */
266 else if (validtag(tag)) { 253 return &luaI_IMtable[-tag].int_method[event];
267 Object *func = &luaI_IMtable[tag-BASE_TAG].int_method[event]; 254}
268 if (func->ttype == LUA_T_NIL) 255
269 return NULL; 256Object *luaI_getimbyObj (Object *o, int event)
270 else 257{
271 return func; 258 return luaI_getim(luaI_tag(o), event);
272 }
273 else return NULL;
274} 259}
275 260
276void luaI_setintmethod (void) 261void luaI_setintmethod (void)
277{ 262{
278 lua_Object tag = lua_getparam(1); 263 int t = (int)luaL_check_number(1, "setintmethod");
279 lua_Object event = lua_getparam(2); 264 int e = luaI_checkevent(luaL_check_string(2, "setintmethod"), eventname);
280 lua_Object func = lua_getparam(3); 265 lua_Object func = lua_getparam(3);
281 if (!(lua_isnumber(tag) && lua_isstring(event) && lua_isfunction(func))) 266 if (!validevent(t, e))
282 lua_error("incorrect arguments to function `setintmethod'"); 267 lua_error("cannot change this internal method");
283 else { 268 luaL_arg_check(lua_isnil(func) || lua_isfunction(func), "setintmethod",
284 int i = luaI_findevent(lua_getstring(event)); 269 3, "function expected");
285 int t = lua_getnumber(tag); 270 checktag(t);
286 checktag(t); 271 luaI_IMtable[-t].int_method[e] = *luaI_Address(func);
287 luaI_IMtable[t-BASE_TAG].int_method[i] = *luaI_Address(func); 272}
273
274static Object gmethod[GIM_N] = {
275 {LUA_T_NIL, {NULL}}, {LUA_T_NIL, {NULL}}, {LUA_T_NIL, {NULL}}
276};
277
278Object *luaI_getgim (int event)
279{
280 return &gmethod[event];
281}
282
283void luaI_setglobalmethod (void)
284{
285 int e = luaI_checkevent(luaL_check_string(1, "setintmethod"), geventname);
286 lua_Object func = lua_getparam(2);
287 luaL_arg_check(lua_isnil(func) || lua_isfunction(func), "setintmethod",
288 2, "function expected");
289 gmethod[e] = *luaI_Address(func);
290}
291
292char *luaI_travfallbacks (int (*fn)(Object *))
293{ /* ??????????
294 int i;
295 for (i=0; i<N_FB; i++)
296 if (fn(&luaI_fallBacks[i].function))
297 return luaI_fallBacks[i].kind; */
298 return NULL;
299}
300
301
302/*
303* ===================================================================
304* compatibility with old fallback system
305*/
306
307
308static void errorFB (void)
309{
310 lua_Object o = lua_getparam(1);
311 if (lua_isstring(o))
312 fprintf (stderr, "lua: %s\n", lua_getstring(o));
313 else
314 fprintf(stderr, "lua: unknown error\n");
315}
316
317
318static void nilFB (void) { }
319
320
321static void typeFB (void)
322{
323 lua_error("unexpected type");
324}
325
326
327void luaI_setfallback (void)
328{
329 int e;
330 char *name = luaL_check_string(1, "setfallback");
331 lua_Object func = lua_getparam(2);
332 luaL_arg_check(lua_isfunction(func), "setfallback", 2, "function expected");
333 e = luaI_findevent(name, geventname);
334 if (e >= 0) { /* global event */
335 switch (e) {
336 case GIM_ERROR:
337 gmethod[e] = *luaI_Address(func);
338 lua_pushcfunction(errorFB);
339 break;
340 case GIM_GETGLOBAL: /* goes through */
341 case GIM_SETGLOBAL:
342 gmethod[e] = *luaI_Address(func);
343 lua_pushcfunction(nilFB);
344 break;
345 default: lua_error("internal error");
346 }
347 }
348 else { /* tagged name? */
349 int t;
350 Object oldfunc;
351 e = luaI_checkevent(name, eventname);
352 oldfunc = luaI_IMtable[LUA_T_USERDATA].int_method[e];
353 for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
354 if (validevent(t, e))
355 luaI_IMtable[-t].int_method[e] = *luaI_Address(func);
356 if (oldfunc.ttype != LUA_T_NIL)
357 luaI_pushobject(&oldfunc);
358 else {
359 switch (e) {
360 case IM_GC: case IM_INDEX:
361 lua_pushcfunction(nilFB);
362 break;
363 default:
364 lua_pushcfunction(typeFB);
365 break;
366 }
367 }
288 } 368 }
289} 369}
370
diff --git a/fallback.h b/fallback.h
index cb0d2220..e34363af 100644
--- a/fallback.h
+++ b/fallback.h
@@ -1,5 +1,5 @@
1/* 1/*
2** $Id: fallback.h,v 1.13 1996/04/25 14:10:00 roberto Exp roberto $ 2** $Id: fallback.h,v 1.14 1997/02/26 17:38:41 roberto Unstable roberto $
3*/ 3*/
4 4
5#ifndef fallback_h 5#ifndef fallback_h
@@ -8,24 +8,20 @@
8#include "lua.h" 8#include "lua.h"
9#include "opcode.h" 9#include "opcode.h"
10 10
11extern struct FB { 11#define IM_GETTABLE 0
12 char *kind; 12#define IM_ARITH 1
13 Object function; 13#define IM_ORDER 2
14 int nParams; 14#define IM_CONCAT 3
15 int nResults; 15#define IM_SETTABLE 4
16} luaI_fallBacks[]; 16#define IM_GC 5
17#define IM_FUNCTION 6
18#define IM_INDEX 7
19#define IM_N 8
17 20
18#define FB_GETTABLE 0 21#define GIM_ERROR 0
19#define FB_ARITH 1 22#define GIM_GETGLOBAL 1
20#define FB_ORDER 2 23#define GIM_SETGLOBAL 2
21#define FB_CONCAT 3 24#define GIM_N 3
22#define FB_SETTABLE 4
23#define FB_GC 5
24#define FB_FUNCTION 6
25#define FB_GETGLOBAL 7
26#define FB_INDEX 8
27#define FB_ERROR 9
28#define FB_N 10
29 25
30void luaI_setfallback (void); 26void luaI_setfallback (void);
31int luaI_ref (Object *object, int lock); 27int luaI_ref (Object *object, int lock);
@@ -35,9 +31,14 @@ void luaI_invalidaterefs (void);
35char *luaI_travfallbacks (int (*fn)(Object *)); 31char *luaI_travfallbacks (int (*fn)(Object *));
36 32
37void luaI_settag (int tag, Object *o); 33void luaI_settag (int tag, Object *o);
34lua_Type luaI_typetag (int tag);
38Object *luaI_getim (int tag, int event); 35Object *luaI_getim (int tag, int event);
36Object *luaI_getgim (int event);
37Object *luaI_getimbyObj (Object *o, int event);
39int luaI_tag (Object *o); 38int luaI_tag (Object *o);
40void luaI_setintmethod (void); 39void luaI_setintmethod (void);
40void luaI_setglobalmethod (void);
41void luaI_initfallbacks (void);
41 42
42#endif 43#endif
43 44
diff --git a/hash.c b/hash.c
index 430eb73b..5386b364 100644
--- a/hash.c
+++ b/hash.c
@@ -3,7 +3,7 @@
3** hash manager for lua 3** hash manager for lua
4*/ 4*/
5 5
6char *rcs_hash="$Id: hash.c,v 2.34 1997/02/26 17:38:41 roberto Unstable roberto $"; 6char *rcs_hash="$Id: hash.c,v 2.35 1997/03/11 18:44:28 roberto Exp roberto $";
7 7
8 8
9#include "mem.h" 9#include "mem.h"
@@ -159,7 +159,7 @@ void lua_hashmark (Hash *h)
159} 159}
160 160
161 161
162static void call_fallbacks (void) 162void luaI_hashcallIM (void)
163{ 163{
164 Hash *curr_array; 164 Hash *curr_array;
165 Object t; 165 Object t;
@@ -168,10 +168,10 @@ static void call_fallbacks (void)
168 if (markarray(curr_array) != 1) 168 if (markarray(curr_array) != 1)
169 { 169 {
170 avalue(&t) = curr_array; 170 avalue(&t) = curr_array;
171 luaI_gcFB(&t); 171 luaI_gcIM(&t);
172 } 172 }
173 ttype(&t) = LUA_T_NIL; 173 ttype(&t) = LUA_T_NIL;
174 luaI_gcFB(&t); /* end of list */ 174 luaI_gcIM(&t); /* end of list */
175} 175}
176 176
177 177
@@ -183,7 +183,6 @@ Long lua_hashcollector (void)
183{ 183{
184 Hash *curr_array = listhead, *prev = NULL; 184 Hash *curr_array = listhead, *prev = NULL;
185 Long counter = 0; 185 Long counter = 0;
186 call_fallbacks();
187 while (curr_array != NULL) 186 while (curr_array != NULL)
188 { 187 {
189 Hash *next = curr_array->next; 188 Hash *next = curr_array->next;
diff --git a/hash.h b/hash.h
index f64de254..1497dd0b 100644
--- a/hash.h
+++ b/hash.h
@@ -1,7 +1,7 @@
1/* 1/*
2** hash.h 2** hash.h
3** hash manager for lua 3** hash manager for lua
4** $Id: hash.h,v 2.12 1996/05/06 14:30:27 roberto Exp roberto $ 4** $Id: hash.h,v 2.13 1997/02/26 17:38:41 roberto Unstable roberto $
5*/ 5*/
6 6
7#ifndef hash_h 7#ifndef hash_h
@@ -30,6 +30,7 @@ int luaI_redimension (int nhash);
30Hash *lua_createarray (int nhash); 30Hash *lua_createarray (int nhash);
31void lua_hashmark (Hash *h); 31void lua_hashmark (Hash *h);
32Long lua_hashcollector (void); 32Long lua_hashcollector (void);
33void luaI_hashcallIM (void);
33Object *lua_hashget (Hash *t, Object *ref); 34Object *lua_hashget (Hash *t, Object *ref);
34Object *lua_hashdefine (Hash *t, Object *ref); 35Object *lua_hashdefine (Hash *t, Object *ref);
35void lua_next (void); 36void lua_next (void);
diff --git a/inout.c b/inout.c
index b0b3d2c3..13cf73e9 100644
--- a/inout.c
+++ b/inout.c
@@ -5,11 +5,12 @@
5** Also provides some predefined lua functions. 5** Also provides some predefined lua functions.
6*/ 6*/
7 7
8char *rcs_inout="$Id: inout.c,v 2.45 1997/03/11 18:44:28 roberto Exp roberto $"; 8char *rcs_inout="$Id: inout.c,v 2.46 1997/03/17 17:01:10 roberto Exp roberto $";
9 9
10#include <stdio.h> 10#include <stdio.h>
11#include <string.h> 11#include <string.h>
12 12
13#include "auxlib.h"
13#include "lex.h" 14#include "lex.h"
14#include "opcode.h" 15#include "opcode.h"
15#include "inout.h" 16#include "inout.h"
@@ -322,6 +323,7 @@ static struct {
322 {"print", luaI_print}, 323 {"print", luaI_print},
323 {"setfallback", luaI_setfallback}, 324 {"setfallback", luaI_setfallback},
324 {"setintmethod", luaI_setintmethod}, 325 {"setintmethod", luaI_setintmethod},
326 {"setglobalmethod", luaI_setglobalmethod},
325 {"setglobal", luaI_setglobal}, 327 {"setglobal", luaI_setglobal},
326 {"tonumber", lua_obj2number}, 328 {"tonumber", lua_obj2number},
327 {"tostring", luaI_tostring}, 329 {"tostring", luaI_tostring},
diff --git a/lua.h b/lua.h
index 2aeb9981..9c057a85 100644
--- a/lua.h
+++ b/lua.h
@@ -2,7 +2,7 @@
2** LUA - Linguagem para Usuarios de Aplicacao 2** LUA - Linguagem para Usuarios de Aplicacao
3** Grupo de Tecnologia em Computacao Grafica 3** Grupo de Tecnologia em Computacao Grafica
4** TeCGraf - PUC-Rio 4** TeCGraf - PUC-Rio
5** $Id: lua.h,v 3.35 1997/02/26 17:38:41 roberto Unstable roberto $ 5** $Id: lua.h,v 3.36 1997/03/17 17:01:10 roberto Exp roberto $
6*/ 6*/
7 7
8 8
@@ -21,6 +21,7 @@ typedef unsigned int lua_Object;
21 21
22lua_Object lua_setfallback (char *event, lua_CFunction fallback); 22lua_Object lua_setfallback (char *event, lua_CFunction fallback);
23void lua_setintmethod (int tag, char *event, lua_CFunction method); 23void lua_setintmethod (int tag, char *event, lua_CFunction method);
24void lua_setglobalmethod (char *event, lua_CFunction method);
24 25
25int lua_newtag (char *t); 26int lua_newtag (char *t);
26void lua_settag (int tag); /* In: object */ 27void lua_settag (int tag); /* In: object */
@@ -36,8 +37,9 @@ int lua_call (char *funcname);
36void lua_beginblock (void); 37void lua_beginblock (void);
37void lua_endblock (void); 38void lua_endblock (void);
38 39
39lua_Object lua_getparam (int number); 40lua_Object lua_lua2C (int number);
40#define lua_getresult(_) lua_getparam(_) 41#define lua_getparam(_) lua_lua2C(_)
42#define lua_getresult(_) lua_lua2C(_)
41 43
42int lua_isnil (lua_Object object); 44int lua_isnil (lua_Object object);
43int lua_istable (lua_Object object); 45int lua_istable (lua_Object object);
@@ -62,7 +64,9 @@ void lua_pushusertag (void *u, int tag);
62void lua_pushobject (lua_Object object); 64void lua_pushobject (lua_Object object);
63 65
64lua_Object lua_getglobal (char *name); 66lua_Object lua_getglobal (char *name);
67lua_Object lua_basicgetglobal (char *name);
65void lua_storeglobal (char *name); /* In: value */ 68void lua_storeglobal (char *name); /* In: value */
69void lua_basicstoreglobal (char *name); /* In: value */
66 70
67void lua_storesubscript (void); /* In: table, index, value */ 71void lua_storesubscript (void); /* In: table, index, value */
68void lua_basicstoreindex (void); /* In: table, index, value */ 72void lua_basicstoreindex (void); /* In: table, index, value */
@@ -91,16 +95,6 @@ lua_Object lua_createtable (void);
91 95
92 96
93/* =============================================================== */ 97/* =============================================================== */
94/* Auxiliar functions for libraries */
95
96void luaL_arg_check(int cond, char *funcname, int numarg, char *extramsg);
97char *luaL_check_string (int numArg, char *funcname);
98char *luaL_opt_string (int numArg, char *def, char *funcname);
99double luaL_check_number (int numArg, char *funcname);
100double luaL_opt_number (int numArg, double def, char *funcname);
101
102
103/* =============================================================== */
104/* for compatibility with old versions. Avoid using these macros */ 98/* for compatibility with old versions. Avoid using these macros */
105 99
106#define lua_type(o) (lua_tag(o)) 100#define lua_type(o) (lua_tag(o))
diff --git a/opcode.c b/opcode.c
index 86fca402..b20901d9 100644
--- a/opcode.c
+++ b/opcode.c
@@ -3,7 +3,7 @@
3** TecCGraf - PUC-Rio 3** TecCGraf - PUC-Rio
4*/ 4*/
5 5
6char *rcs_opcode="$Id: opcode.c,v 3.83 1997/03/06 17:30:55 roberto Exp roberto $"; 6char *rcs_opcode="$Id: opcode.c,v 3.84 1997/03/11 18:44:28 roberto Exp roberto $";
7 7
8#include <setjmp.h> 8#include <setjmp.h>
9#include <stdio.h> 9#include <stdio.h>
@@ -268,15 +268,6 @@ static void callIM (Object *f, int nParams, int nResults)
268 do_call((top-stack)-nParams, nResults); 268 do_call((top-stack)-nParams, nResults);
269} 269}
270 270
271/*
272** Call the specified fallback, putting it on the stack below its arguments
273*/
274static void callFB (int fb)
275{
276 callIM(&luaI_fallBacks[fb].function, luaI_fallBacks[fb].nParams,
277 luaI_fallBacks[fb].nResults);
278}
279
280 271
281/* 272/*
282** Call a function (C or Lua). The parameters must be on the stack, 273** Call a function (C or Lua). The parameters must be on the stack,
@@ -289,21 +280,21 @@ static void do_call (StkId base, int nResults)
289 StkId firstResult; 280 StkId firstResult;
290 Object *func = stack+base-1; 281 Object *func = stack+base-1;
291 int i; 282 int i;
292 if (ttype(func) == LUA_T_CFUNCTION) 283 if (ttype(func) == LUA_T_CFUNCTION) {
293 {
294 ttype(func) = LUA_T_CMARK; 284 ttype(func) = LUA_T_CMARK;
295 firstResult = callC(fvalue(func), base); 285 firstResult = callC(fvalue(func), base);
296 } 286 }
297 else if (ttype(func) == LUA_T_FUNCTION) 287 else if (ttype(func) == LUA_T_FUNCTION) {
298 {
299 ttype(func) = LUA_T_MARK; 288 ttype(func) = LUA_T_MARK;
300 firstResult = lua_execute(func->value.tf->code, base); 289 firstResult = lua_execute(func->value.tf->code, base);
301 } 290 }
302 else 291 else { /* func is not a function */
303 { /* func is not a function */ 292 /* Check the fallback for invalid functions */
304 /* Call the fallback for invalid functions */ 293 Object *im = luaI_getimbyObj(func, IM_FUNCTION);
294 if (ttype(im) == LUA_T_NIL)
295 lua_error("call expression not a function");
305 open_stack((top-stack)-(base-1)); 296 open_stack((top-stack)-(base-1));
306 stack[base-1] = luaI_fallBacks[FB_FUNCTION].function; 297 stack[base-1] = *im;
307 do_call(base, nResults); 298 do_call(base, nResults);
308 return; 299 return;
309 } 300 }
@@ -326,15 +317,14 @@ static void do_call (StkId base, int nResults)
326static void pushsubscript (void) 317static void pushsubscript (void)
327{ 318{
328 int tg = luaI_tag(top-2); 319 int tg = luaI_tag(top-2);
329 Object *im = luaI_getim(tg, FB_GETTABLE); 320 Object *im = luaI_getim(tg, IM_GETTABLE);
330 if (ttype(top-2) == LUA_T_ARRAY && im == NULL) { 321 if (ttype(top-2) == LUA_T_ARRAY && ttype(im) == LUA_T_NIL) {
331 Object *h = lua_hashget(avalue(top-2), top-1); 322 Object *h = lua_hashget(avalue(top-2), top-1);
332 if (h != NULL && ttype(h) != LUA_T_NIL) { 323 if (h != NULL && ttype(h) != LUA_T_NIL) {
333 --top; 324 --top;
334 *(top-1) = *h; 325 *(top-1) = *h;
335 } 326 }
336 else if (tg == LUA_T_ARRAY && 327 else if (ttype(im=luaI_getim(tg, IM_INDEX)) != LUA_T_NIL)
337 (im=luaI_getim(0, FB_INDEX)) != NULL)
338 callIM(im, 2, 1); 328 callIM(im, 2, 1);
339 else { 329 else {
340 --top; 330 --top;
@@ -376,14 +366,14 @@ lua_Object lua_basicindex (void)
376*/ 366*/
377static void storesubscript (Object *t, int mode) 367static void storesubscript (Object *t, int mode)
378{ 368{
379 Object *im = (mode == 0) ? NULL : luaI_getim(luaI_tag(t), FB_SETTABLE); 369 Object *im = (mode == 0) ? NULL : luaI_getimbyObj(t, IM_SETTABLE);
380 if (ttype(t) == LUA_T_ARRAY && im == NULL) { 370 if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) {
381 Object *h = lua_hashdefine(avalue(t), t+1); 371 Object *h = lua_hashdefine(avalue(t), t+1);
382 *h = *(top-1); 372 *h = *(top-1);
383 top -= (mode == 2) ? 1 : 3; 373 top -= (mode == 2) ? 1 : 3;
384 } 374 }
385 else { /* object is not a table, and/or has a specific "settable" method */ 375 else { /* object is not a table, and/or has a specific "settable" method */
386 if (im) { 376 if (im && ttype(im) != LUA_T_NIL) {
387 if (mode == 2) { 377 if (mode == 2) {
388 lua_checkstack(top+2); 378 lua_checkstack(top+2);
389 *(top+1) = *(top-1); 379 *(top+1) = *(top-1);
@@ -403,11 +393,13 @@ static void getglobal (Word n)
403{ 393{
404 *top = lua_table[n].object; 394 *top = lua_table[n].object;
405 incr_top; 395 incr_top;
406 if (ttype(top-1) == LUA_T_NIL) 396 if (ttype(top-1) == LUA_T_NIL) { /* check i.m. */
407 { /* must call getglobal fallback */ 397 Object *im = luaI_getgim(GIM_GETGLOBAL);
408 ttype(top-1) = LUA_T_STRING; 398 if (ttype(im) != LUA_T_NIL) {
409 tsvalue(top-1) = lua_table[n].varname; 399 ttype(top-1) = LUA_T_STRING;
410 callFB(FB_GETGLOBAL); 400 tsvalue(top-1) = lua_table[n].varname;
401 callIM(im, 1, 1);
402 }
411 } 403 }
412} 404}
413 405
@@ -428,8 +420,13 @@ void lua_travstack (int (*fn)(Object *))
428 420
429static void lua_message (char *s) 421static void lua_message (char *s)
430{ 422{
431 lua_pushstring(s); 423 Object *im = luaI_getgim(GIM_ERROR);
432 callFB(FB_ERROR); 424 if (ttype(im) == LUA_T_NIL)
425 fprintf(stderr, "lua: %s\n", s);
426 else {
427 lua_pushstring(s);
428 callIM(im, 1, 0);
429 }
433} 430}
434 431
435/* 432/*
@@ -659,10 +656,20 @@ void lua_setintmethod (int tag, char *event, lua_CFunction method)
659{ 656{
660 lua_pushnumber(tag); 657 lua_pushnumber(tag);
661 lua_pushstring(event); 658 lua_pushstring(event);
662 lua_pushcfunction (method); 659 if (method)
660 lua_pushcfunction (method);
661 else
662 lua_pushnil();
663 do_unprotectedrun(luaI_setintmethod, 3, 0); 663 do_unprotectedrun(luaI_setintmethod, 3, 0);
664} 664}
665 665
666void lua_setglobalmethod (char *event, lua_CFunction method)
667{
668 lua_pushstring(event);
669 lua_pushcfunction (method);
670 do_unprotectedrun(luaI_setglobalmethod, 3, 0);
671}
672
666 673
667/* 674/*
668** API: receives on the stack the table and the index. 675** API: receives on the stack the table and the index.
@@ -741,7 +748,7 @@ lua_Object lua_createtable (void)
741** Get a parameter, returning the object handle or LUA_NOOBJECT on error. 748** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
742** 'number' must be 1 to get the first parameter. 749** 'number' must be 1 to get the first parameter.
743*/ 750*/
744lua_Object lua_getparam (int number) 751lua_Object lua_lua2C (int number)
745{ 752{
746 if (number <= 0 || number > CLS_current.num) return LUA_NOOBJECT; 753 if (number <= 0 || number > CLS_current.num) return LUA_NOOBJECT;
747 /* Ref(stack+(CLS_current.base-CLS_current.num+number-1)) == 754 /* Ref(stack+(CLS_current.base-CLS_current.num+number-1)) ==
@@ -874,6 +881,17 @@ lua_Object lua_getglobal (char *name)
874 return Ref(top-1); 881 return Ref(top-1);
875} 882}
876 883
884
885lua_Object lua_basicgetglobal (char *name)
886{
887 adjustC(0);
888 *top = lua_table[luaI_findsymbolbyname(name)].object;
889 incr_top;
890 CLS_current.base++; /* incorporate object in the stack */
891 return Ref(top-1);
892}
893
894
877/* 895/*
878** Store top of the stack at a global variable array field. 896** Store top of the stack at a global variable array field.
879*/ 897*/
@@ -944,7 +962,7 @@ void lua_pushbinarydata (void *buff, int size, int tag)
944*/ 962*/
945void lua_pushusertag (void *u, int tag) 963void lua_pushusertag (void *u, int tag)
946{ 964{
947 if (tag < LUA_T_USERDATA) 965 if (luaI_typetag(tag) != LUA_T_USERDATA)
948 lua_error("invalid tag in `lua_pushusertag'"); 966 lua_error("invalid tag in `lua_pushusertag'");
949 lua_pushbinarydata(&u, sizeof(void *), tag); 967 lua_pushbinarydata(&u, sizeof(void *), tag);
950} 968}
@@ -977,18 +995,47 @@ int lua_tag (lua_Object o)
977} 995}
978 996
979 997
980void luaI_gcFB (Object *o) 998void luaI_gcIM (Object *o)
981{ 999{
982 *top = *o; 1000 Object *im = luaI_getimbyObj(o, IM_GC);
983 incr_top; 1001 if (ttype(im) != LUA_T_NIL) {
984 callFB(FB_GC); 1002 *top = *o;
1003 incr_top;
1004 callIM(im, 1, 0);
1005 }
985} 1006}
986 1007
987 1008
988static void call_arith (char *op) 1009static void call_arith (char *op)
989{ 1010{
1011 Object *im = luaI_getimbyObj(top-2, IM_ARITH); /* try first operand */
1012 if (ttype(im) == LUA_T_NIL) {
1013 im = luaI_getimbyObj(top-1, IM_ARITH); /* try second operand */
1014 if (ttype(im) == LUA_T_NIL) {
1015 im = luaI_getim(0, IM_ARITH); /* try a 'global' i.m. */
1016 if (ttype(im) == LUA_T_NIL)
1017 lua_error("unexpected type at conversion to number");
1018 }
1019 }
990 lua_pushstring(op); 1020 lua_pushstring(op);
991 callFB(FB_ARITH); 1021 callIM(im, 3, 1);
1022}
1023
1024static void concim (Object *o)
1025{
1026 Object *im = luaI_getimbyObj(o, IM_CONCAT);
1027 if (ttype(im) == LUA_T_NIL)
1028 lua_error("unexpected type at conversion to string");
1029 callIM(im, 2, 1);
1030}
1031
1032static void ordim (Object *o, char *op)
1033{
1034 Object *im = luaI_getimbyObj(o, IM_ORDER);
1035 if (ttype(im) == LUA_T_NIL)
1036 lua_error("unexpected type at comparison");
1037 lua_pushstring(op);
1038 callIM(im, 3, 1);
992} 1039}
993 1040
994static void comparison (lua_Type ttype_less, lua_Type ttype_equal, 1041static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
@@ -999,10 +1046,12 @@ static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
999 int result; 1046 int result;
1000 if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER) 1047 if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
1001 result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1; 1048 result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
1002 else if (tostring(l) || tostring(r)) 1049 else if (tostring(l)) {
1003 { 1050 ordim(l, op);
1004 lua_pushstring(op); 1051 return;
1005 callFB(FB_ORDER); 1052 }
1053 else if (tostring(r)) {
1054 ordim(r, op);
1006 return; 1055 return;
1007 } 1056 }
1008 else 1057 else
@@ -1318,17 +1367,17 @@ static StkId lua_execute (Byte *pc, StkId base)
1318 call_arith("pow"); 1367 call_arith("pow");
1319 break; 1368 break;
1320 1369
1321 case CONCOP: 1370 case CONCOP: {
1322 { 1371 Object *l = top-2;
1323 Object *l = top-2; 1372 Object *r = top-1;
1324 Object *r = top-1; 1373 if (tostring(l)) /* first argument is not a string */
1325 if (tostring(r) || tostring(l)) 1374 concim(l);
1326 callFB(FB_CONCAT); 1375 else if (tostring(r)) /* second argument is not a string */
1327 else 1376 concim(r);
1328 { 1377 else {
1329 tsvalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r))); 1378 tsvalue(l) = lua_createstring(lua_strconc(svalue(l),svalue(r)));
1330 --top; 1379 --top;
1331 } 1380 }
1332 } 1381 }
1333 break; 1382 break;
1334 1383
@@ -1356,7 +1405,7 @@ static StkId lua_execute (Byte *pc, StkId base)
1356 } 1405 }
1357 break; 1406 break;
1358 1407
1359 case ONFJMP: 1408 case ONFJMP:
1360 { 1409 {
1361 Word w; 1410 Word w;
1362 get_word(w,pc); 1411 get_word(w,pc);
diff --git a/opcode.h b/opcode.h
index 53f71ba8..177d21c4 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1,6 +1,6 @@
1/* 1/*
2** TeCGraf - PUC-Rio 2** TeCGraf - PUC-Rio
3** $Id: opcode.h,v 3.27 1997/03/06 17:30:55 roberto Exp roberto $ 3** $Id: opcode.h,v 3.28 1997/03/11 18:44:28 roberto Exp roberto $
4*/ 4*/
5 5
6#ifndef opcode_h 6#ifndef opcode_h
@@ -16,18 +16,20 @@
16 16
17typedef enum 17typedef enum
18{ 18{
19 LUA_T_NIL = -1, 19 LUA_T_NIL = -9,
20 LUA_T_NUMBER = -2, 20 LUA_T_NUMBER = -8,
21 LUA_T_STRING = -3, 21 LUA_T_STRING = -7,
22 LUA_T_ARRAY = -4, /* array==table */ 22 LUA_T_ARRAY = -6, /* array==table */
23 LUA_T_FUNCTION = -5, 23 LUA_T_FUNCTION = -5,
24 LUA_T_CFUNCTION= -6, 24 LUA_T_CFUNCTION= -4,
25 LUA_T_MARK = -7, 25 LUA_T_MARK = -3,
26 LUA_T_CMARK = -8, 26 LUA_T_CMARK = -2,
27 LUA_T_LINE = -9, 27 LUA_T_LINE = -1,
28 LUA_T_USERDATA = 0 28 LUA_T_USERDATA = 0
29} lua_Type; 29} lua_Type;
30 30
31#define NUM_TYPES 10
32
31 33
32typedef enum { 34typedef enum {
33/* name parm before after side effect 35/* name parm before after side effect
@@ -156,7 +158,7 @@ void luaI_codedebugline (int line); /* from "lua.stx" module */
156void lua_travstack (int (*fn)(Object *)); 158void lua_travstack (int (*fn)(Object *));
157Object *luaI_Address (lua_Object o); 159Object *luaI_Address (lua_Object o);
158void luaI_pushobject (Object *o); 160void luaI_pushobject (Object *o);
159void luaI_gcFB (Object *o); 161void luaI_gcIM (Object *o);
160int luaI_dorun (TFunc *tf); 162int luaI_dorun (TFunc *tf);
161 163
162#endif 164#endif
diff --git a/table.c b/table.c
index a7b895d4..e545195f 100644
--- a/table.c
+++ b/table.c
@@ -3,7 +3,7 @@
3** Module to control static tables 3** Module to control static tables
4*/ 4*/
5 5
6char *rcs_table="$Id: table.c,v 2.59 1997/02/26 17:38:41 roberto Unstable roberto $"; 6char *rcs_table="$Id: table.c,v 2.60 1997/03/11 18:44:28 roberto Exp roberto $";
7 7
8#include "mem.h" 8#include "mem.h"
9#include "opcode.h" 9#include "opcode.h"
@@ -168,6 +168,8 @@ Long luaI_collectgarbage (void)
168 lua_travsymbol(lua_markobject); /* mark symbol table objects */ 168 lua_travsymbol(lua_markobject); /* mark symbol table objects */
169 luaI_travlock(lua_markobject); /* mark locked objects */ 169 luaI_travlock(lua_markobject); /* mark locked objects */
170 luaI_travfallbacks(lua_markobject); /* mark fallbacks */ 170 luaI_travfallbacks(lua_markobject); /* mark fallbacks */
171 luaI_hashcallIM();
172 luaI_strcallIM();
171 luaI_invalidaterefs(); 173 luaI_invalidaterefs();
172 recovered += lua_strcollector(); 174 recovered += lua_strcollector();
173 recovered += lua_hashcollector(); 175 recovered += lua_hashcollector();
diff --git a/tree.c b/tree.c
index f594824f..1afded62 100644
--- a/tree.c
+++ b/tree.c
@@ -3,7 +3,7 @@
3** TecCGraf - PUC-Rio 3** TecCGraf - PUC-Rio
4*/ 4*/
5 5
6char *rcs_tree="$Id: tree.c,v 1.20 1996/03/14 15:56:26 roberto Exp roberto $"; 6char *rcs_tree="$Id: tree.c,v 1.21 1997/02/11 11:35:05 roberto Exp roberto $";
7 7
8 8
9#include <string.h> 9#include <string.h>
@@ -14,6 +14,7 @@ char *rcs_tree="$Id: tree.c,v 1.20 1996/03/14 15:56:26 roberto Exp roberto $";
14#include "lex.h" 14#include "lex.h"
15#include "hash.h" 15#include "hash.h"
16#include "table.h" 16#include "table.h"
17#include "fallback.h"
17 18
18 19
19#define NUM_HASHS 64 20#define NUM_HASHS 64
@@ -45,6 +46,7 @@ static void initialize (void)
45 luaI_addReserved(); 46 luaI_addReserved();
46 luaI_initsymbol(); 47 luaI_initsymbol();
47 luaI_initconstant(); 48 luaI_initconstant();
49 luaI_initfallbacks();
48} 50}
49 51
50 52
@@ -120,6 +122,25 @@ TaggedString *lua_createstring (char *str)
120} 122}
121 123
122 124
125void luaI_strcallIM (void)
126{
127 int i;
128 Object o;
129 ttype(&o) = LUA_T_USERDATA;
130 for (i=0; i<NUM_HASHS; i++) {
131 stringtable *tb = &string_root[i];
132 int j;
133 for (j=0; j<tb->size; j++) {
134 TaggedString *t = tb->hash[j];
135 if (t != NULL && t->tag != LUA_T_STRING && t->marked == 0) {
136 tsvalue(&o) = t;
137 luaI_gcIM(&o);
138 }
139 }
140 }
141}
142
143
123/* 144/*
124** Garbage collection function. 145** Garbage collection function.
125** This function traverse the string list freeing unindexed strings 146** This function traverse the string list freeing unindexed strings
diff --git a/tree.h b/tree.h
index 4f2212b4..ea9422ea 100644
--- a/tree.h
+++ b/tree.h
@@ -1,7 +1,7 @@
1/* 1/*
2** tree.h 2** tree.h
3** TecCGraf - PUC-Rio 3** TecCGraf - PUC-Rio
4** $Id: tree.h,v 1.14 1996/02/26 17:07:49 roberto Exp roberto $ 4** $Id: tree.h,v 1.15 1997/02/11 11:35:05 roberto Exp roberto $
5*/ 5*/
6 6
7#ifndef tree_h 7#ifndef tree_h
@@ -27,5 +27,6 @@ typedef struct TaggedString
27TaggedString *lua_createstring (char *str); 27TaggedString *lua_createstring (char *str);
28TaggedString *luaI_createuserdata (char *buff, long size, int tag); 28TaggedString *luaI_createuserdata (char *buff, long size, int tag);
29Long lua_strcollector (void); 29Long lua_strcollector (void);
30void luaI_strcallIM (void);
30 31
31#endif 32#endif
generated by cgit v1.2.3-55-g6feb (git 2.39.1) at 2025-03-16 23:19:31 +0000