123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258 |
- /*
- ** table.c
- ** Module to control static tables
- */
- char *rcs_table="$Id: table.c,v 2.19 1994/11/16 17:39:16 roberto Exp $";
- #include <string.h>
- #include "mem.h"
- #include "opcode.h"
- #include "tree.h"
- #include "hash.h"
- #include "inout.h"
- #include "table.h"
- #include "lua.h"
- #include "fallback.h"
- #define BUFFER_BLOCK 256
- Symbol *lua_table;
- static Word lua_ntable = 0;
- static Long lua_maxsymbol = 0;
- char **lua_constant;
- static Word lua_nconstant = 0;
- static Long lua_maxconstant = 0;
- #define MAXFILE 20
- char *lua_file[MAXFILE];
- int lua_nfile;
- #define GARBAGE_BLOCK 256
- #define MIN_GARBAGE_BLOCK 10
- static void lua_nextvar (void);
- /*
- ** Initialise symbol table with internal functions
- */
- static void lua_initsymbol (void)
- {
- int n;
- lua_maxsymbol = BUFFER_BLOCK;
- lua_table = newvector(lua_maxsymbol, Symbol);
- n = luaI_findsymbolbyname("next");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_next;
- n = luaI_findsymbolbyname("nextvar");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_nextvar;
- n = luaI_findsymbolbyname("type");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_type;
- n = luaI_findsymbolbyname("tonumber");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_obj2number;
- n = luaI_findsymbolbyname("print");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_print;
- n = luaI_findsymbolbyname("dofile");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
- n = luaI_findsymbolbyname("dostring");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
- n = luaI_findsymbolbyname("setfallback");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_setfallback;
- n = luaI_findsymbolbyname("error");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_error;
- }
- /*
- ** Initialise constant table with pre-defined constants
- */
- void lua_initconstant (void)
- {
- lua_maxconstant = BUFFER_BLOCK;
- lua_constant = newvector(lua_maxconstant, char *);
- }
- /*
- ** Given a name, search it at symbol table and return its index. If not
- ** found, allocate it.
- ** On error, return -1.
- */
- int luaI_findsymbol (TreeNode *t)
- {
- if (lua_table == NULL)
- lua_initsymbol();
- if (t->varindex == UNMARKED_STRING)
- {
- if (lua_ntable == lua_maxsymbol)
- {
- lua_maxsymbol *= 2;
- if (lua_maxsymbol > MAX_WORD)
- lua_error("symbol table overflow");
- lua_table = growvector(lua_table, lua_maxsymbol, Symbol);
- }
- t->varindex = lua_ntable;
- s_tag(lua_ntable) = LUA_T_NIL;
- lua_ntable++;
- }
- return t->varindex;
- }
- int luaI_findsymbolbyname (char *name)
- {
- return luaI_findsymbol(lua_constcreate(name));
- }
- /*
- ** Given a name, search it at constant table and return its index. If not
- ** found, allocate it.
- ** On error, return -1.
- */
- int luaI_findconstant (TreeNode *t)
- {
- if (lua_constant == NULL)
- lua_initconstant();
- if (t->constindex == UNMARKED_STRING)
- {
- if (lua_nconstant == lua_maxconstant)
- {
- lua_maxconstant *= 2;
- if (lua_maxconstant > MAX_WORD)
- lua_error("constant table overflow");
- lua_constant = growvector(lua_constant, lua_maxconstant, char*);
- }
- t->constindex = lua_nconstant;
- lua_constant[lua_nconstant] = t->str;
- lua_nconstant++;
- }
- return t->constindex;
- }
- /*
- ** Traverse symbol table objects
- */
- void lua_travsymbol (void (*fn)(Object *))
- {
- Word i;
- for (i=0; i<lua_ntable; i++)
- fn(&s_object(i));
- }
- /*
- ** Mark an object if it is a string or a unmarked array.
- */
- void lua_markobject (Object *o)
- {
- if (tag(o) == LUA_T_STRING && indexstring(svalue(o)) == UNMARKED_STRING)
- indexstring(svalue(o)) = MARKED_STRING;
- else if (tag(o) == LUA_T_ARRAY)
- lua_hashmark (avalue(o));
- }
- /*
- ** Garbage collection.
- ** Delete all unused strings and arrays.
- */
- void lua_pack (void)
- {
- static int block = GARBAGE_BLOCK; /* when garbage collector will be called */
- static int nentity = 0; /* counter of new entities (strings and arrays) */
- int recovered = 0;
- if (nentity++ < block) return;
- lua_travstack(lua_markobject); /* mark stack objects */
- lua_travsymbol(lua_markobject); /* mark symbol table objects */
- luaI_travlock(lua_markobject); /* mark locked objects */
- recovered += lua_strcollector();
- recovered += lua_hashcollector();
- nentity = 0; /* reset counter */
- block=2*block-3*recovered/2; /* adapt block size */
- if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
- }
- /*
- ** If the string isn't allocated, allocate a new string at string tree.
- */
- char *lua_createstring (char *s)
- {
- if (s == NULL) return NULL;
- return lua_strcreate(s);
- }
- /*
- ** Add a file name at file table, checking overflow. This function also set
- ** the external variable "lua_filename" with the function filename set.
- ** Return 0 on success or error message on error.
- */
- char *lua_addfile (char *fn)
- {
- if (lua_nfile >= MAXFILE)
- return "too many files";
- if ((lua_file[lua_nfile++] = strdup (fn)) == NULL)
- return "not enough memory";
- return NULL;
- }
- /*
- ** Delete a file from file stack
- */
- int lua_delfile (void)
- {
- luaI_free(lua_file[--lua_nfile]);
- return 1;
- }
- /*
- ** Return the last file name set.
- */
- char *lua_filename (void)
- {
- return lua_file[lua_nfile-1];
- }
- /*
- ** Internal function: return next global variable
- */
- static void lua_nextvar (void)
- {
- char *varname;
- TreeNode *next;
- lua_Object o = lua_getparam(1);
- if (o == 0)
- lua_error ("too few arguments to function `nextvar'");
- if (lua_getparam(2) != NULL)
- lua_error ("too many arguments to function `nextvar'");
- if (lua_isnil(o))
- varname = NULL;
- else if (!lua_isstring(o))
- {
- lua_error ("incorrect argument to function `nextvar'");
- return; /* to avoid warnings */
- }
- else
- varname = lua_getstring(o);
- next = lua_varnext(varname);
- if (next == NULL)
- {
- lua_pushnil();
- lua_pushnil();
- }
- else
- {
- Object name;
- tag(&name) = LUA_T_STRING;
- svalue(&name) = next->str;
- luaI_pushobject(&name);
- luaI_pushobject(&s_object(next->varindex));
- }
- }
|