table.c 6.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276
  1. /*
  2. ** table.c
  3. ** Module to control static tables
  4. */
  5. char *rcs_table="$Id: table.c,v 2.22 1994/11/21 21:41:09 roberto Exp roberto $";
  6. #include <string.h>
  7. #include "mem.h"
  8. #include "opcode.h"
  9. #include "tree.h"
  10. #include "hash.h"
  11. #include "inout.h"
  12. #include "table.h"
  13. #include "lua.h"
  14. #include "fallback.h"
  15. #define MAX_WORD 0xFFFD
  16. #define BUFFER_BLOCK 256
  17. Symbol *lua_table;
  18. static Word lua_ntable = 0;
  19. static Long lua_maxsymbol = 0;
  20. TaggedString **lua_constant;
  21. static Word lua_nconstant = 0;
  22. static Long lua_maxconstant = 0;
  23. #define MAXFILE 20
  24. char *lua_file[MAXFILE];
  25. int lua_nfile;
  26. #define GARBAGE_BLOCK 256
  27. #define MIN_GARBAGE_BLOCK 10
  28. static void lua_nextvar (void);
  29. static void setglobal (void);
  30. static void getglobal (void);
  31. /*
  32. ** Initialise symbol table with internal functions
  33. */
  34. static void lua_initsymbol (void)
  35. {
  36. int n;
  37. lua_maxsymbol = BUFFER_BLOCK;
  38. lua_table = newvector(lua_maxsymbol, Symbol);
  39. n = luaI_findsymbolbyname("next");
  40. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_next;
  41. n = luaI_findsymbolbyname("dofile");
  42. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
  43. n = luaI_findsymbolbyname("setglobal");
  44. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = setglobal;
  45. n = luaI_findsymbolbyname("getglobal");
  46. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = getglobal;
  47. n = luaI_findsymbolbyname("nextvar");
  48. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_nextvar;
  49. n = luaI_findsymbolbyname("type");
  50. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_type;
  51. n = luaI_findsymbolbyname("tonumber");
  52. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_obj2number;
  53. n = luaI_findsymbolbyname("print");
  54. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_print;
  55. n = luaI_findsymbolbyname("dostring");
  56. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
  57. n = luaI_findsymbolbyname("setfallback");
  58. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_setfallback;
  59. n = luaI_findsymbolbyname("error");
  60. s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_error;
  61. }
  62. /*
  63. ** Initialise constant table with pre-defined constants
  64. */
  65. void lua_initconstant (void)
  66. {
  67. lua_maxconstant = BUFFER_BLOCK;
  68. lua_constant = newvector(lua_maxconstant, TaggedString *);
  69. }
  70. /*
  71. ** Given a name, search it at symbol table and return its index. If not
  72. ** found, allocate it.
  73. ** On error, return -1.
  74. */
  75. int luaI_findsymbol (TreeNode *t)
  76. {
  77. if (lua_table == NULL)
  78. lua_initsymbol();
  79. if (t->varindex == NOT_USED)
  80. {
  81. if (lua_ntable == lua_maxsymbol)
  82. {
  83. lua_maxsymbol *= 2;
  84. if (lua_maxsymbol > MAX_WORD)
  85. lua_error("symbol table overflow");
  86. lua_table = growvector(lua_table, lua_maxsymbol, Symbol);
  87. }
  88. t->varindex = lua_ntable;
  89. s_tag(lua_ntable) = LUA_T_NIL;
  90. lua_ntable++;
  91. }
  92. return t->varindex;
  93. }
  94. int luaI_findsymbolbyname (char *name)
  95. {
  96. return luaI_findsymbol(lua_constcreate(name));
  97. }
  98. /*
  99. ** Given a name, search it at constant table and return its index. If not
  100. ** found, allocate it.
  101. ** On error, return -1.
  102. */
  103. int luaI_findconstant (TreeNode *t)
  104. {
  105. if (lua_constant == NULL)
  106. lua_initconstant();
  107. if (t->constindex == NOT_USED)
  108. {
  109. if (lua_nconstant == lua_maxconstant)
  110. {
  111. lua_maxconstant *= 2;
  112. if (lua_maxconstant > MAX_WORD)
  113. lua_error("constant table overflow");
  114. lua_constant = growvector(lua_constant, lua_maxconstant, TaggedString *);
  115. }
  116. t->constindex = lua_nconstant;
  117. lua_constant[lua_nconstant] = &(t->ts);
  118. lua_nconstant++;
  119. }
  120. return t->constindex;
  121. }
  122. /*
  123. ** Traverse symbol table objects
  124. */
  125. void lua_travsymbol (void (*fn)(Object *))
  126. {
  127. Word i;
  128. for (i=0; i<lua_ntable; i++)
  129. fn(&s_object(i));
  130. }
  131. /*
  132. ** Mark an object if it is a string or a unmarked array.
  133. */
  134. void lua_markobject (Object *o)
  135. {
  136. if (tag(o) == LUA_T_STRING && !tsvalue(o)->marked)
  137. tsvalue(o)->marked = 1;
  138. else if (tag(o) == LUA_T_ARRAY)
  139. lua_hashmark (avalue(o));
  140. }
  141. /*
  142. ** Garbage collection.
  143. ** Delete all unused strings and arrays.
  144. */
  145. void lua_pack (void)
  146. {
  147. static int block = GARBAGE_BLOCK; /* when garbage collector will be called */
  148. static int nentity = 0; /* counter of new entities (strings and arrays) */
  149. int recovered = 0;
  150. if (nentity++ < block) return;
  151. lua_travstack(lua_markobject); /* mark stack objects */
  152. lua_travsymbol(lua_markobject); /* mark symbol table objects */
  153. luaI_travlock(lua_markobject); /* mark locked objects */
  154. recovered += lua_strcollector();
  155. recovered += lua_hashcollector();
  156. nentity = 0; /* reset counter */
  157. block=2*block-3*recovered/2; /* adapt block size */
  158. if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
  159. }
  160. /*
  161. ** Add a file name at file table, checking overflow. This function also set
  162. ** the external variable "lua_filename" with the function filename set.
  163. ** Return 0 on success or error message on error.
  164. */
  165. char *lua_addfile (char *fn)
  166. {
  167. if (lua_nfile >= MAXFILE)
  168. return "too many files";
  169. if ((lua_file[lua_nfile++] = strdup (fn)) == NULL)
  170. return "not enough memory";
  171. return NULL;
  172. }
  173. /*
  174. ** Delete a file from file stack
  175. */
  176. int lua_delfile (void)
  177. {
  178. luaI_free(lua_file[--lua_nfile]);
  179. return 1;
  180. }
  181. /*
  182. ** Return the last file name set.
  183. */
  184. char *lua_filename (void)
  185. {
  186. return lua_file[lua_nfile-1];
  187. }
  188. /*
  189. ** Internal function: return next global variable
  190. */
  191. static void lua_nextvar (void)
  192. {
  193. char *varname;
  194. TreeNode *next;
  195. lua_Object o = lua_getparam(1);
  196. if (o == 0)
  197. lua_reportbug("too few arguments to function `nextvar'");
  198. if (lua_getparam(2) != NULL)
  199. lua_reportbug("too many arguments to function `nextvar'");
  200. if (lua_isnil(o))
  201. varname = NULL;
  202. else if (!lua_isstring(o))
  203. {
  204. lua_reportbug("incorrect argument to function `nextvar'");
  205. return; /* to avoid warnings */
  206. }
  207. else
  208. varname = lua_getstring(o);
  209. next = lua_varnext(varname);
  210. if (next == NULL)
  211. {
  212. lua_pushnil();
  213. lua_pushnil();
  214. }
  215. else
  216. {
  217. Object name;
  218. tag(&name) = LUA_T_STRING;
  219. tsvalue(&name) = &(next->ts);
  220. luaI_pushobject(&name);
  221. luaI_pushobject(&s_object(next->varindex));
  222. }
  223. }
  224. static void setglobal (void)
  225. {
  226. lua_Object name = lua_getparam(1);
  227. lua_Object value = lua_getparam(2);
  228. if (!lua_isstring(name))
  229. lua_reportbug("incorrect argument to function `setglobal'");
  230. lua_pushobject(value);
  231. lua_storeglobal(lua_getstring(name));
  232. }
  233. static void getglobal (void)
  234. {
  235. lua_Object name = lua_getparam(1);
  236. if (!lua_isstring(name))
  237. lua_reportbug("incorrect argument to function `getglobal'");
  238. lua_pushobject(lua_getglobal(lua_getstring(name)));
  239. }