jianf/LuaCangjia_api
1
0
Fork 0
mirror of https://gitcode.com/JianFeeeee/LuaCangjia_api.git synced 2026-09-19 16:42:48 +00:00
Code Issues Packages Projects Releases Wiki Activity

vendor: 引入 Lua 5.0.3 官方源码 (lua_5.0 分支)

Browse Source 
桥接层适配尚未完成。Lua 5.0 与 5.1+ 差异显著:
- 无 linit.c/loslib.c(luaopen_os 混于 liolib.c)
- 无 luaL_setfuncs/lua_getextraspace/lua_isinteger
- 无 LUA_REGISTRYINDEX 现代用法差异需逐一核对
后续移植需按 ADAPTATION.md 指引重写 I/O 重定向与 typed interop 层
This commit is contained in:
JianFeeeee
2026-08-25 10:14:33 +08:00
parent 80880edbce
commit 95d474ea07
65 changed files with 9165 additions and 27114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

81
lib/lua/CMakeLists.txt
View File

@ -1,81 +0,0 @@
cmake_minimum_required(VERSION 3.12)
project(lua VERSION 5.5.1 LANGUAGES C)
# 基础配置
set(CMAKE_C_STANDARD 99)
set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -O2 -Wall -Wextra")
set(CMAKE_POSITION_INDEPENDENT_CODE ON)
# 检测目标系统 - 通过编译器名称检测
set(IS_WINDOWS FALSE)
if(CMAKE_C_COMPILER MATCHES "mingw" OR CMAKE_SYSTEM_NAME STREQUAL "Windows")
set(IS_WINDOWS TRUE)
endif()
# 根据目标系统配置
if(IS_WINDOWS)
message(STATUS "Configuring for Windows/MinGW")
add_compile_definitions(LUA_USE_WINDOWS LUA_COMPAT_5_3)
list(APPEND EXTRA_LIBS "")
elseif(CMAKE_SYSTEM_NAME STREQUAL "Linux")
message(STATUS "Configuring for Linux/HarmonyOS")
add_compile_definitions(LUA_USE_LINUX LUA_COMPAT_5_3)
list(APPEND EXTRA_LIBS dl)
else()
message(STATUS "Configuring for generic Unix")
add_compile_definitions(LUA_USE_POSIX LUA_COMPAT_5_3)
list(APPEND EXTRA_LIBS dl)
endif()
# Lua 核心文件列表
file(GLOB LUA_CORE_SOURCES
lapi.c
lcode.c
lctype.c
ldebug.c
ldo.c
ldump.c
lfunc.c
lgc.c
llex.c
lmem.c
lobject.c
lopcodes.c
lparser.c
lstate.c
lstring.c
ltable.c
ltm.c
lundump.c
lvm.c
lzio.c
)
# Lua 库文件列表
file(GLOB LUA_LIB_SOURCES
lauxlib.c
lbaselib.c
lcorolib.c
ldblib.c
liolib.c
lmathlib.c
loadlib.c
loslib.c
lstrlib.c
ltablib.c
lutf8lib.c
linit.c
)
# 特殊源文件的编译器优化
set_source_files_properties(
llex.c
lparser.c
lcode.c
PROPERTIES COMPILE_FLAGS "-Os"
)
add_library(lua STATIC
${LUA_CORE_SOURCES}
${LUA_LIB_SOURCES}
)

233
lib/lua/Makefile
View File

@ -1,232 +1,17 @@
# Makefile for building Lua
# See ../doc/readme.html for installation and customization instructions.
# makefile for Lua distribution (includes)
# == CHANGE THE SETTINGS BELOW TO SUIT YOUR ENVIRONMENT =======================
LUA= ..
# Your platform. See PLATS for possible values.
PLAT= guess
include $(LUA)/config
CC= gcc -std=gnu99
CFLAGS= -O2 -Wall -Wextra $(SYSCFLAGS) $(MYCFLAGS)
LDFLAGS= $(SYSLDFLAGS) $(MYLDFLAGS)
LIBS= -lm $(SYSLIBS) $(MYLIBS)
SRCS= lua.h lualib.h lauxlib.h
AR= ar rcu
RANLIB= ranlib
RM= rm -f
UNAME= uname
SYSCFLAGS=
SYSLDFLAGS=
SYSLIBS=
MYCFLAGS=
MYLDFLAGS=
MYLIBS=
MYOBJS=
# Special flags for compiler modules; -Os reduces code size.
CMCFLAGS=
# == END OF USER SETTINGS -- NO NEED TO CHANGE ANYTHING BELOW THIS LINE =======
PLATS= guess aix bsd c89 freebsd generic ios linux linux-readline macosx mingw posix solaris
LUA_A= liblua.a
CORE_O= lapi.o lcode.o lctype.o ldebug.o ldo.o ldump.o lfunc.o lgc.o llex.o lmem.o lobject.o lopcodes.o lparser.o lstate.o lstring.o ltable.o ltm.o lundump.o lvm.o lzio.o
LIB_O= lauxlib.o lbaselib.o lcorolib.o ldblib.o liolib.o lmathlib.o loadlib.o loslib.o lstrlib.o ltablib.o lutf8lib.o linit.o
BASE_O= $(CORE_O) $(LIB_O) $(MYOBJS)
LUA_T= lua
LUA_O= lua.o
LUAC_T= luac
LUAC_O= luac.o
ALL_O= $(BASE_O) $(LUA_O) $(LUAC_O)
ALL_T= $(LUA_A) $(LUA_T) $(LUAC_T)
ALL_A= $(LUA_A)
# Targets start here.
default: $(PLAT)
all: $(ALL_T)
o: $(ALL_O)
a: $(ALL_A)
$(LUA_A): $(BASE_O)
$(AR) $@ $(BASE_O)
$(RANLIB) $@
$(LUA_T): $(LUA_O) $(LUA_A)
$(CC) -o $@ $(LDFLAGS) $(LUA_O) $(LUA_A) $(LIBS)
$(LUAC_T): $(LUAC_O) $(LUA_A)
$(CC) -o $@ $(LDFLAGS) $(LUAC_O) $(LUA_A) $(LIBS)
test:
./$(LUA_T) -v
all:
clean:
$(RM) $(ALL_T) $(ALL_O)
depend:
@$(CC) $(CFLAGS) -MM l*.c
co:
co -q -f -M $(SRCS)
echo:
@echo "PLAT= $(PLAT)"
@echo "CC= $(CC)"
@echo "CFLAGS= $(CFLAGS)"
@echo "LDFLAGS= $(LDFLAGS)"
@echo "LIBS= $(LIBS)"
@echo "AR= $(AR)"
@echo "RANLIB= $(RANLIB)"
@echo "RM= $(RM)"
@echo "UNAME= $(UNAME)"
# Convenience targets for popular platforms.
ALL= all
help:
@echo "Do 'make PLATFORM' where PLATFORM is one of these:"
@echo " $(PLATS)"
@echo "See doc/readme.html for complete instructions."
guess:
@echo Guessing `$(UNAME)`
@$(MAKE) `$(UNAME)`
AIX aix:
$(MAKE) $(ALL) CC="xlc" CFLAGS="-O2 -DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-ldl" SYSLDFLAGS="-brtl -bexpall"
bsd:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN" SYSLIBS="-Wl,-E"
c89:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_C89" CC="gcc -std=c89"
@echo ''
@echo '*** C89 does not guarantee 64-bit integers for Lua.'
@echo '*** Make sure to compile all external Lua libraries'
@echo '*** with LUA_USE_C89 to ensure consistency'
@echo ''
FreeBSD NetBSD OpenBSD freebsd:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX -DLUA_USE_READLINE -I/usr/include/edit" SYSLIBS="-Wl,-E -ledit" CC="cc"
generic: $(ALL)
ios:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_IOS"
Linux linux:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX" SYSLIBS="-Wl,-E -ldl"
linux-readline:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_LINUX -DLUA_USE_READLINE" SYSLIBS="-Wl,-E -ldl -lreadline"
Darwin macos macosx:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_MACOSX" SYSLIBS="-lreadline"
mingw:
$(MAKE) "LUA_A=lua55.dll" "LUA_T=lua.exe" \
"AR=$(CC) -shared -o" "RANLIB=strip --strip-unneeded" \
"SYSCFLAGS=-DLUA_BUILD_AS_DLL" "SYSLIBS=" "SYSLDFLAGS=-s" lua.exe
$(MAKE) "LUAC_T=luac.exe" luac.exe
posix:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX"
SunOS solaris:
$(MAKE) $(ALL) SYSCFLAGS="-DLUA_USE_POSIX -DLUA_USE_DLOPEN -D_REENTRANT" SYSLIBS="-ldl"
# Targets that do not create files (not all makes understand .PHONY).
.PHONY: all $(PLATS) help test clean default o a depend echo
# Compiler modules may use special flags.
llex.o:
$(CC) $(CFLAGS) $(CMCFLAGS) -c llex.c
lparser.o:
$(CC) $(CFLAGS) $(CMCFLAGS) -c lparser.c
lcode.o:
$(CC) $(CFLAGS) $(CMCFLAGS) -c lcode.c
# DO NOT DELETE
lapi.o: lapi.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lstring.h \
ltable.h lundump.h lvm.h
lauxlib.o: lauxlib.c lprefix.h lua.h luaconf.h lauxlib.h llimits.h
lbaselib.o: lbaselib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \
llimits.h
lcode.o: lcode.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \
llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \
ldo.h lgc.h lstring.h ltable.h lvm.h lopnames.h
lcorolib.o: lcorolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \
llimits.h
lctype.o: lctype.c lprefix.h lctype.h lua.h luaconf.h llimits.h
ldblib.o: ldblib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llimits.h
ldebug.o: ldebug.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
lobject.h ltm.h lzio.h lmem.h lcode.h llex.h lopcodes.h lparser.h \
ldebug.h ldo.h lfunc.h lstring.h lgc.h ltable.h lvm.h
ldo.o: ldo.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h \
lparser.h lstring.h ltable.h lundump.h lvm.h
ldump.o: ldump.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
lobject.h ltm.h lzio.h lmem.h lgc.h ltable.h lundump.h
lfunc.o: lfunc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h
lgc.o: lgc.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lgc.h lstring.h ltable.h
linit.o: linit.c lprefix.h lua.h luaconf.h lualib.h lauxlib.h llimits.h
liolib.o: liolib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llimits.h
llex.o: llex.c lprefix.h lua.h luaconf.h lctype.h llimits.h ldebug.h \
lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lgc.h llex.h lparser.h \
lstring.h ltable.h
lmathlib.o: lmathlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \
llimits.h
lmem.o: lmem.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h
loadlib.o: loadlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \
llimits.h
lobject.o: lobject.c lprefix.h lua.h luaconf.h lctype.h llimits.h \
ldebug.h lstate.h lobject.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h \
lvm.h
lopcodes.o: lopcodes.c lprefix.h lopcodes.h llimits.h lua.h luaconf.h \
lobject.h
loslib.o: loslib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llimits.h
lparser.o: lparser.c lprefix.h lua.h luaconf.h lcode.h llex.h lobject.h \
llimits.h lzio.h lmem.h lopcodes.h lparser.h ldebug.h lstate.h ltm.h \
ldo.h lfunc.h lstring.h lgc.h ltable.h
lstate.o: lstate.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h llex.h \
lstring.h ltable.h
lstring.o: lstring.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \
lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lstring.h lgc.h
lstrlib.o: lstrlib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \
llimits.h
ltable.o: ltable.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
ltablib.o: ltablib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \
llimits.h
ltm.o: ltm.c lprefix.h lua.h luaconf.h ldebug.h lstate.h lobject.h \
llimits.h ltm.h lzio.h lmem.h ldo.h lgc.h lstring.h ltable.h lvm.h
lua.o: lua.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h llimits.h
luac.o: luac.c lprefix.h lua.h luaconf.h lauxlib.h lapi.h llimits.h \
lstate.h lobject.h ltm.h lzio.h lmem.h ldebug.h lopcodes.h lopnames.h \
lundump.h
lundump.o: lundump.c lprefix.h lua.h luaconf.h ldebug.h lstate.h \
lobject.h llimits.h ltm.h lzio.h lmem.h ldo.h lfunc.h lstring.h lgc.h \
ltable.h lundump.h
lutf8lib.o: lutf8lib.c lprefix.h lua.h luaconf.h lauxlib.h lualib.h \
llimits.h
lvm.o: lvm.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
lobject.h ltm.h lzio.h lmem.h ldebug.h ldo.h lfunc.h lgc.h lopcodes.h \
lstring.h ltable.h lvm.h ljumptab.h
lzio.o: lzio.c lprefix.h lua.h luaconf.h lapi.h llimits.h lstate.h \
lobject.h ltm.h lzio.h lmem.h
# (end of Makefile)
klean: clean
rm -f $(SRCS)

1485
lib/lua/lapi.c
View File

File diff suppressed because it is too large Load Diff

55
lib/lua/lapi.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lapi.h $
** $Id: lapi.h,v 1.21 2002/03/04 21:29:41 roberto Exp $
** Auxiliary functions from Lua API
** See Copyright Notice in lua.h
*/
@ -8,58 +8,9 @@
#define lapi_h
#include "llimits.h"
#include "lstate.h"
#include "lobject.h"
#if defined(LUA_USE_APICHECK)
#include <assert.h>
#define api_check(l,e,msg) assert(e)
#else /* for testing */
#define api_check(l,e,msg) ((void)(l), lua_assert((e) && msg))
#endif
/* Increments 'L->top.p', checking for stack overflows */
#define api_incr_top(L) \
(L->top.p++, api_check(L, L->top.p <= L->ci->top.p, "stack overflow"))
/*
** macros that are executed whenever program enters the Lua core
** ('lua_lock') and leaves the core ('lua_unlock')
*/
#if !defined(lua_lock)
#define lua_lock(L) ((void) 0)
#define lua_unlock(L) ((void) 0)
#endif
/*
** If a call returns too many multiple returns, the callee may not have
** stack space to accommodate all results. In this case, this macro
** increases its stack space ('L->ci->top.p').
*/
#define adjustresults(L,nres) \
{ if ((nres) <= LUA_MULTRET && L->ci->top.p < L->top.p) \
L->ci->top.p = L->top.p; }
/* Ensure the stack has at least 'n' elements */
#define api_checknelems(L,n) \
api_check(L, (n) < (L->top.p - L->ci->func.p), \
"not enough elements in the stack")
/* Ensure the stack has at least 'n' elements to be popped. (Some
** functions only update a slot after checking it for popping, but that
** is only an optimization for a pop followed by a push.)
*/
#define api_checkpop(L,n) \
api_check(L, (n) < L->top.p - L->ci->func.p && \
L->tbclist.p < L->top.p - (n), \
"not enough free elements in the stack")
void luaA_pushobject (lua_State *L, const TObject *o);
#endif

1270
lib/lua/lauxlib.c
View File

File diff suppressed because it is too large Load Diff

278
lib/lua/lauxlib.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lauxlib.h $
** $Id: lauxlib.h,v 1.60 2003/04/03 13:35:34 roberto Exp $
** Auxiliary functions for building Lua libraries
** See Copyright Notice in lua.h
*/
@ -12,115 +12,57 @@
#include <stddef.h>
#include <stdio.h>
#include "luaconf.h"
#include "lua.h"
/* global table */
#define LUA_GNAME "_G"
#ifndef LUALIB_API
#define LUALIB_API LUA_API
#endif
typedef struct luaL_Buffer luaL_Buffer;
/* extra error code for 'luaL_loadfilex' */
#define LUA_ERRFILE (LUA_ERRERR+1)
/* key, in the registry, for table of loaded modules */
#define LUA_LOADED_TABLE "_LOADED"
/* key, in the registry, for table of preloaded loaders */
#define LUA_PRELOAD_TABLE "_PRELOAD"
typedef struct luaL_Reg {
typedef struct luaL_reg {
const char *name;
lua_CFunction func;
} luaL_Reg;
} luaL_reg;
#define LUAL_NUMSIZES (sizeof(lua_Integer)*16 + sizeof(lua_Number))
LUALIB_API void luaL_openlib (lua_State *L, const char *libname,
const luaL_reg *l, int nup);
LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *e);
LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *e);
LUALIB_API int luaL_typerror (lua_State *L, int narg, const char *tname);
LUALIB_API int luaL_argerror (lua_State *L, int numarg, const char *extramsg);
LUALIB_API const char *luaL_checklstring (lua_State *L, int numArg, size_t *l);
LUALIB_API const char *luaL_optlstring (lua_State *L, int numArg,
const char *def, size_t *l);
LUALIB_API lua_Number luaL_checknumber (lua_State *L, int numArg);
LUALIB_API lua_Number luaL_optnumber (lua_State *L, int nArg, lua_Number def);
LUALIB_API void (luaL_checkversion_) (lua_State *L, lua_Number ver, size_t sz);
#define luaL_checkversion(L) \
luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES)
LUALIB_API void luaL_checkstack (lua_State *L, int sz, const char *msg);
LUALIB_API void luaL_checktype (lua_State *L, int narg, int t);
LUALIB_API void luaL_checkany (lua_State *L, int narg);
LUALIB_API int (luaL_getmetafield) (lua_State *L, int obj, const char *e);
LUALIB_API int (luaL_callmeta) (lua_State *L, int obj, const char *e);
LUALIB_API const char *(luaL_tolstring) (lua_State *L, int idx, size_t *len);
LUALIB_API int (luaL_argerror) (lua_State *L, int arg, const char *extramsg);
LUALIB_API int (luaL_typeerror) (lua_State *L, int arg, const char *tname);
LUALIB_API const char *(luaL_checklstring) (lua_State *L, int arg,
size_t *l);
LUALIB_API const char *(luaL_optlstring) (lua_State *L, int arg,
const char *def, size_t *l);
LUALIB_API lua_Number (luaL_checknumber) (lua_State *L, int arg);
LUALIB_API lua_Number (luaL_optnumber) (lua_State *L, int arg, lua_Number def);
LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname);
LUALIB_API void luaL_getmetatable (lua_State *L, const char *tname);
LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname);
LUALIB_API lua_Integer (luaL_checkinteger) (lua_State *L, int arg);
LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int arg,
lua_Integer def);
LUALIB_API void luaL_where (lua_State *L, int lvl);
LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...);
LUALIB_API void (luaL_checkstack) (lua_State *L, int sz, const char *msg);
LUALIB_API void (luaL_checktype) (lua_State *L, int arg, int t);
LUALIB_API void (luaL_checkany) (lua_State *L, int arg);
LUALIB_API int luaL_findstring (const char *st, const char *const lst[]);
LUALIB_API int (luaL_newmetatable) (lua_State *L, const char *tname);
LUALIB_API void (luaL_setmetatable) (lua_State *L, const char *tname);
LUALIB_API void *(luaL_testudata) (lua_State *L, int ud, const char *tname);
LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname);
LUALIB_API int luaL_ref (lua_State *L, int t);
LUALIB_API void luaL_unref (lua_State *L, int t, int ref);
LUALIB_API void (luaL_where) (lua_State *L, int lvl);
LUALIB_API int (luaL_error) (lua_State *L, const char *fmt, ...);
LUALIB_API int luaL_getn (lua_State *L, int t);
LUALIB_API void luaL_setn (lua_State *L, int t, int n);
LUALIB_API int (luaL_checkoption) (lua_State *L, int arg, const char *def,
const char *const lst[]);
LUALIB_API int (luaL_fileresult) (lua_State *L, int stat, const char *fname);
LUALIB_API int (luaL_execresult) (lua_State *L, int stat);
LUALIB_API void *(luaL_alloc) (void *ud, void *ptr, size_t osize,
size_t nsize);
LUALIB_API int luaL_loadfile (lua_State *L, const char *filename);
LUALIB_API int luaL_loadbuffer (lua_State *L, const char *buff, size_t sz,
const char *name);
/* predefined references */
#define LUA_NOREF (-2)
#define LUA_REFNIL (-1)
LUALIB_API int (luaL_ref) (lua_State *L, int t);
LUALIB_API void (luaL_unref) (lua_State *L, int t, int ref);
LUALIB_API int (luaL_loadfilex) (lua_State *L, const char *filename,
const char *mode);
#define luaL_loadfile(L,f) luaL_loadfilex(L,f,NULL)
LUALIB_API int (luaL_loadbufferx) (lua_State *L, const char *buff, size_t sz,
const char *name, const char *mode);
LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s);
LUALIB_API lua_State *(luaL_newstate) (void);
LUALIB_API unsigned (luaL_makeseed) (lua_State *L);
LUALIB_API lua_Integer (luaL_len) (lua_State *L, int idx);
LUALIB_API void (luaL_addgsub) (luaL_Buffer *b, const char *s,
const char *p, const char *r);
LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s,
const char *p, const char *r);
LUALIB_API void (luaL_setfuncs) (lua_State *L, const luaL_Reg *l, int nup);
LUALIB_API int (luaL_getsubtable) (lua_State *L, int idx, const char *fname);
LUALIB_API void (luaL_traceback) (lua_State *L, lua_State *L1,
const char *msg, int level);
LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname,
lua_CFunction openf, int glb);
/*
** ===============================================================
@ -128,52 +70,14 @@ LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname,
** ===============================================================
*/
#define luaL_newlibtable(L,l) \
lua_createtable(L, 0, sizeof(l)/sizeof((l)[0]) - 1)
#define luaL_newlib(L,l) \
(luaL_checkversion(L), luaL_newlibtable(L,l), luaL_setfuncs(L,l,0))
#define luaL_argcheck(L, cond,arg,extramsg) \
((void)(luai_likely(cond) || luaL_argerror(L, (arg), (extramsg))))
#define luaL_argexpected(L,cond,arg,tname) \
((void)(luai_likely(cond) || luaL_typeerror(L, (arg), (tname))))
#define luaL_argcheck(L, cond,numarg,extramsg) if (!(cond)) \
luaL_argerror(L, numarg,extramsg)
#define luaL_checkstring(L,n) (luaL_checklstring(L, (n), NULL))
#define luaL_optstring(L,n,d) (luaL_optlstring(L, (n), (d), NULL))
#define luaL_typename(L,i) lua_typename(L, lua_type(L,(i)))
#define luaL_dofile(L, fn) \
(luaL_loadfile(L, fn) || lua_pcall(L, 0, LUA_MULTRET, 0))
#define luaL_dostring(L, s) \
(luaL_loadstring(L, s) || lua_pcall(L, 0, LUA_MULTRET, 0))
#define luaL_getmetatable(L,n) (lua_getfield(L, LUA_REGISTRYINDEX, (n)))
#define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n)))
#define luaL_loadbuffer(L,s,sz,n) luaL_loadbufferx(L,s,sz,n,NULL)
/*
** Perform arithmetic operations on lua_Integer values with wrap-around
** semantics, as the Lua core does.
*/
#define luaL_intop(op,v1,v2) \
((lua_Integer)((lua_Unsigned)(v1) op (lua_Unsigned)(v2)))
/* push the value used to represent failure/error */
#if defined(LUA_FAILISFALSE)
#define luaL_pushfail(L) lua_pushboolean(L, 0)
#else
#define luaL_pushfail(L) lua_pushnil(L)
#endif
#define luaL_checkint(L,n) ((int)luaL_checknumber(L, n))
#define luaL_checklong(L,n) ((long)luaL_checknumber(L, n))
#define luaL_optint(L,n,d) ((int)luaL_optnumber(L, n,(lua_Number)(d)))
#define luaL_optlong(L,n,d) ((long)luaL_optnumber(L, n,(lua_Number)(d)))
/*
@ -182,88 +86,58 @@ LUALIB_API void (luaL_requiref) (lua_State *L, const char *modname,
** =======================================================
*/
struct luaL_Buffer {
char *b; /* buffer address */
size_t size; /* buffer size */
size_t n; /* number of characters in buffer */
#ifndef LUAL_BUFFERSIZE
#define LUAL_BUFFERSIZE BUFSIZ
#endif
typedef struct luaL_Buffer {
char *p; /* current position in buffer */
int lvl; /* number of strings in the stack (level) */
lua_State *L;
union {
LUAI_MAXALIGN; /* ensure maximum alignment for buffer */
char b[LUAL_BUFFERSIZE]; /* initial buffer */
} init;
};
char buffer[LUAL_BUFFERSIZE];
} luaL_Buffer;
#define luaL_putchar(B,c) \
((void)((B)->p < ((B)->buffer+LUAL_BUFFERSIZE) || luaL_prepbuffer(B)), \
(*(B)->p++ = (char)(c)))
#define luaL_bufflen(bf) ((bf)->n)
#define luaL_buffaddr(bf) ((bf)->b)
#define luaL_addsize(B,n) ((B)->p += (n))
LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B);
LUALIB_API char *luaL_prepbuffer (luaL_Buffer *B);
LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l);
LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s);
LUALIB_API void luaL_addvalue (luaL_Buffer *B);
LUALIB_API void luaL_pushresult (luaL_Buffer *B);
#define luaL_addchar(B,c) \
((void)((B)->n < (B)->size || luaL_prepbuffsize((B), 1)), \
((B)->b[(B)->n++] = (c)))
#define luaL_addsize(B,s) ((B)->n += (s))
#define luaL_buffsub(B,s) ((B)->n -= (s))
LUALIB_API void (luaL_buffinit) (lua_State *L, luaL_Buffer *B);
LUALIB_API char *(luaL_prepbuffsize) (luaL_Buffer *B, size_t sz);
LUALIB_API void (luaL_addlstring) (luaL_Buffer *B, const char *s, size_t l);
LUALIB_API void (luaL_addstring) (luaL_Buffer *B, const char *s);
LUALIB_API void (luaL_addvalue) (luaL_Buffer *B);
LUALIB_API void (luaL_pushresult) (luaL_Buffer *B);
LUALIB_API void (luaL_pushresultsize) (luaL_Buffer *B, size_t sz);
LUALIB_API char *(luaL_buffinitsize) (lua_State *L, luaL_Buffer *B, size_t sz);
#define luaL_prepbuffer(B) luaL_prepbuffsize(B, LUAL_BUFFERSIZE)
/* }====================================================== */
/*
** {======================================================
** File handles for IO library
** =======================================================
** Compatibility macros and functions
*/
/*
** A file handle is a userdata with metatable 'LUA_FILEHANDLE' and
** initial structure 'luaL_Stream' (it may contain other fields
** after that initial structure).
*/
#define LUA_FILEHANDLE "FILE*"
LUALIB_API int lua_dofile (lua_State *L, const char *filename);
LUALIB_API int lua_dostring (lua_State *L, const char *str);
LUALIB_API int lua_dobuffer (lua_State *L, const char *buff, size_t sz,
const char *n);
typedef struct luaL_Stream {
FILE *f; /* stream (NULL for incompletely created streams) */
lua_CFunction closef; /* to close stream (NULL for closed streams) */
} luaL_Stream;
/* }====================================================== */
/*
** {============================================================
** Compatibility with deprecated conversions
** =============================================================
*/
#if defined(LUA_COMPAT_APIINTCASTS)
#define luaL_checkunsigned(L,a) ((lua_Unsigned)luaL_checkinteger(L,a))
#define luaL_optunsigned(L,a,d) \
((lua_Unsigned)luaL_optinteger(L,a,(lua_Integer)(d)))
#define luaL_checkint(L,n) ((int)luaL_checkinteger(L, (n)))
#define luaL_optint(L,n,d) ((int)luaL_optinteger(L, (n), (d)))
#define luaL_checklong(L,n) ((long)luaL_checkinteger(L, (n)))
#define luaL_optlong(L,n,d) ((long)luaL_optinteger(L, (n), (d)))
#endif
/* }============================================================ */
#define luaL_check_lstr luaL_checklstring
#define luaL_opt_lstr luaL_optlstring
#define luaL_check_number luaL_checknumber
#define luaL_opt_number luaL_optnumber
#define luaL_arg_check luaL_argcheck
#define luaL_check_string luaL_checkstring
#define luaL_opt_string luaL_optstring
#define luaL_check_int luaL_checkint
#define luaL_check_long luaL_checklong
#define luaL_opt_int luaL_optint
#define luaL_opt_long luaL_optlong
#endif

873
lib/lua/lbaselib.c
View File

File diff suppressed because it is too large Load Diff

2016
lib/lua/lcode.c
View File

File diff suppressed because it is too large Load Diff

105
lib/lua/lcode.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lcode.h $
** $Id: lcode.h,v 1.38 2002/12/11 12:34:22 roberto Exp $
** Code generator for Lua
** See Copyright Notice in lua.h
*/
@ -21,85 +21,54 @@
/*
** grep "ORDER OPR" if you change these enums (ORDER OP)
** grep "ORDER OPR" if you change these enums
*/
typedef enum BinOpr {
/* arithmetic operators */
OPR_ADD, OPR_SUB, OPR_MUL, OPR_MOD, OPR_POW,
OPR_DIV, OPR_IDIV,
/* bitwise operators */
OPR_BAND, OPR_BOR, OPR_BXOR,
OPR_SHL, OPR_SHR,
/* string operator */
OPR_ADD, OPR_SUB, OPR_MULT, OPR_DIV, OPR_POW,
OPR_CONCAT,
/* comparison operators */
OPR_EQ, OPR_LT, OPR_LE,
OPR_NE, OPR_GT, OPR_GE,
/* logical operators */
OPR_NE, OPR_EQ,
OPR_LT, OPR_LE, OPR_GT, OPR_GE,
OPR_AND, OPR_OR,
OPR_NOBINOPR
} BinOpr;
#define binopistest(op) ((op) >= OPR_NE)
/* true if operation is foldable (that is, it is arithmetic or bitwise) */
#define foldbinop(op) ((op) <= OPR_SHR)
typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_NOUNOPR } UnOpr;
#define luaK_codeABC(fs,o,a,b,c) luaK_codeABCk(fs,o,a,b,c,0)
#define getcode(fs,e) ((fs)->f->code[(e)->info])
#define luaK_codeAsBx(fs,o,A,sBx) luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx)
typedef enum UnOpr { OPR_MINUS, OPR_BNOT, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr;
/* get (pointer to) instruction of given 'expdesc' */
#define getinstruction(fs,e) ((fs)->f->code[(e)->u.info])
#define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET)
#define luaK_jumpto(fs,t) luaK_patchlist(fs, luaK_jump(fs), t)
LUAI_FUNC int luaK_code (FuncState *fs, Instruction i);
LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, int Bx);
LUAI_FUNC int luaK_codeABCk (FuncState *fs, OpCode o, int A, int B, int C,
int k);
LUAI_FUNC int luaK_codevABCk (FuncState *fs, OpCode o, int A, int B, int C,
int k);
LUAI_FUNC int luaK_exp2const (FuncState *fs, const expdesc *e, TValue *v);
LUAI_FUNC void luaK_fixline (FuncState *fs, int line);
LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n);
LUAI_FUNC void luaK_codecheckglobal (FuncState *fs, expdesc *var, int k,
int line);
LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n);
LUAI_FUNC void luaK_checkstack (FuncState *fs, int n);
LUAI_FUNC void luaK_int (FuncState *fs, int reg, lua_Integer n);
LUAI_FUNC void luaK_vapar2local (FuncState *fs, expdesc *var);
LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e);
LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e);
LUAI_FUNC void luaK_exp2anyregup (FuncState *fs, expdesc *e);
LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e);
LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e);
LUAI_FUNC void luaK_self (FuncState *fs, expdesc *e, expdesc *key);
LUAI_FUNC void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);
LUAI_FUNC void luaK_goiftrue (FuncState *fs, expdesc *e);
LUAI_FUNC void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);
LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults);
LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e);
LUAI_FUNC int luaK_jump (FuncState *fs);
LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret);
LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target);
LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list);
LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2);
LUAI_FUNC int luaK_getlabel (FuncState *fs);
LUAI_FUNC void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v, int line);
LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1,
expdesc *v2, int line);
LUAI_FUNC void luaK_settablesize (FuncState *fs, int pc,
int ra, int asize, int hsize);
LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore);
LUAI_FUNC void luaK_finish (FuncState *fs);
LUAI_FUNC l_noret luaK_semerror (LexState *ls, const char *fmt, ...);
int luaK_code (FuncState *fs, Instruction i, int line);
int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx);
int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C);
void luaK_fixline (FuncState *fs, int line);
void luaK_nil (FuncState *fs, int from, int n);
void luaK_reserveregs (FuncState *fs, int n);
void luaK_checkstack (FuncState *fs, int n);
int luaK_stringK (FuncState *fs, TString *s);
int luaK_numberK (FuncState *fs, lua_Number r);
void luaK_dischargevars (FuncState *fs, expdesc *e);
int luaK_exp2anyreg (FuncState *fs, expdesc *e);
void luaK_exp2nextreg (FuncState *fs, expdesc *e);
void luaK_exp2val (FuncState *fs, expdesc *e);
int luaK_exp2RK (FuncState *fs, expdesc *e);
void luaK_self (FuncState *fs, expdesc *e, expdesc *key);
void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k);
void luaK_goiftrue (FuncState *fs, expdesc *e);
void luaK_goiffalse (FuncState *fs, expdesc *e);
void luaK_storevar (FuncState *fs, expdesc *var, expdesc *e);
void luaK_setcallreturns (FuncState *fs, expdesc *var, int nresults);
int luaK_jump (FuncState *fs);
void luaK_patchlist (FuncState *fs, int list, int target);
void luaK_patchtohere (FuncState *fs, int list);
void luaK_concat (FuncState *fs, int *l1, int l2);
int luaK_getlabel (FuncState *fs);
void luaK_prefix (FuncState *fs, UnOpr op, expdesc *v);
void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, expdesc *v2);
#endif

225
lib/lua/lcorolib.c
View File

@ -1,225 +0,0 @@
/*
** $Id: lcorolib.c $
** Coroutine Library
** See Copyright Notice in lua.h
*/
#define lcorolib_c
#define LUA_LIB
#include "lprefix.h"
#include <stdlib.h>
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#include "llimits.h"
static lua_State *getco (lua_State *L) {
lua_State *co = lua_tothread(L, 1);
luaL_argexpected(L, co, 1, "thread");
return co;
}
/*
** Resumes a coroutine. Returns the number of results for non-error
** cases or -1 for errors.
*/
static int auxresume (lua_State *L, lua_State *co, int narg) {
int status, nres;
if (l_unlikely(!lua_checkstack(co, narg))) {
lua_pushliteral(L, "too many arguments to resume");
return -1; /* error flag */
}
lua_xmove(L, co, narg);
status = lua_resume(co, L, narg, &nres);
if (l_likely(status == LUA_OK || status == LUA_YIELD)) {
if (l_unlikely(!lua_checkstack(L, nres + 1))) {
lua_pop(co, nres); /* remove results anyway */
lua_pushliteral(L, "too many results to resume");
return -1; /* error flag */
}
lua_xmove(co, L, nres); /* move yielded values */
return nres;
}
else {
lua_xmove(co, L, 1); /* move error message */
return -1; /* error flag */
}
}
static int luaB_coresume (lua_State *L) {
lua_State *co = getco(L);
int r;
r = auxresume(L, co, lua_gettop(L) - 1);
if (l_unlikely(r < 0)) {
lua_pushboolean(L, 0);
lua_insert(L, -2);
return 2; /* return false + error message */
}
else {
lua_pushboolean(L, 1);
lua_insert(L, -(r + 1));
return r + 1; /* return true + 'resume' returns */
}
}
static int luaB_auxwrap (lua_State *L) {
lua_State *co = lua_tothread(L, lua_upvalueindex(1));
int r = auxresume(L, co, lua_gettop(L));
if (l_unlikely(r < 0)) { /* error? */
int stat = lua_status(co);
if (stat != LUA_OK && stat != LUA_YIELD) { /* error in the coroutine? */
stat = lua_closethread(co, L); /* close its tbc variables */
lua_assert(stat != LUA_OK);
lua_xmove(co, L, 1); /* move error message to the caller */
}
if (stat != LUA_ERRMEM && /* not a memory error and ... */
lua_type(L, -1) == LUA_TSTRING) { /* ... error object is a string? */
luaL_where(L, 1); /* add extra info, if available */
lua_insert(L, -2);
lua_concat(L, 2);
}
return lua_error(L); /* propagate error */
}
return r;
}
static int luaB_cocreate (lua_State *L) {
lua_State *NL;
luaL_checktype(L, 1, LUA_TFUNCTION);
NL = lua_newthread(L);
lua_pushvalue(L, 1); /* move function to top */
lua_xmove(L, NL, 1); /* move function from L to NL */
return 1;
}
static int luaB_cowrap (lua_State *L) {
luaB_cocreate(L);
lua_pushcclosure(L, luaB_auxwrap, 1);
return 1;
}
static int luaB_yield (lua_State *L) {
return lua_yield(L, lua_gettop(L));
}
#define COS_RUN 0
#define COS_DEAD 1
#define COS_YIELD 2
#define COS_NORM 3
static const char *const statname[] =
{"running", "dead", "suspended", "normal"};
static int auxstatus (lua_State *L, lua_State *co) {
if (L == co) return COS_RUN;
else {
switch (lua_status(co)) {
case LUA_YIELD:
return COS_YIELD;
case LUA_OK: {
lua_Debug ar;
if (lua_getstack(co, 0, &ar)) /* does it have frames? */
return COS_NORM; /* it is running */
else if (lua_gettop(co) == 0)
return COS_DEAD;
else
return COS_YIELD; /* initial state */
}
default: /* some error occurred */
return COS_DEAD;
}
}
}
static int luaB_costatus (lua_State *L) {
lua_State *co = getco(L);
lua_pushstring(L, statname[auxstatus(L, co)]);
return 1;
}
static lua_State *getoptco (lua_State *L) {
return (lua_isnone(L, 1) ? L : getco(L));
}
static int luaB_yieldable (lua_State *L) {
lua_State *co = getoptco(L);
lua_pushboolean(L, lua_isyieldable(co));
return 1;
}
static int luaB_corunning (lua_State *L) {
int ismain = lua_pushthread(L);
lua_pushboolean(L, ismain);
return 2;
}
static int luaB_close (lua_State *L) {
lua_State *co = getoptco(L);
int status = auxstatus(L, co);
switch (status) {
case COS_DEAD: case COS_YIELD: {
status = lua_closethread(co, L);
if (status == LUA_OK) {
lua_pushboolean(L, 1);
return 1;
}
else {
lua_pushboolean(L, 0);
lua_xmove(co, L, 1); /* move error message */
return 2;
}
}
case COS_NORM:
return luaL_error(L, "cannot close a %s coroutine", statname[status]);
case COS_RUN:
lua_geti(L, LUA_REGISTRYINDEX, LUA_RIDX_MAINTHREAD); /* get main */
if (lua_tothread(L, -1) == co)
return luaL_error(L, "cannot close main thread");
lua_closethread(co, L); /* close itself */
/* previous call does not return *//* FALLTHROUGH */
default:
lua_assert(0);
return 0;
}
}
static const luaL_Reg co_funcs[] = {
{"create", luaB_cocreate},
{"resume", luaB_coresume},
{"running", luaB_corunning},
{"status", luaB_costatus},
{"wrap", luaB_cowrap},
{"yield", luaB_yield},
{"isyieldable", luaB_yieldable},
{"close", luaB_close},
{NULL, NULL}
};
LUAMOD_API int luaopen_coroutine (lua_State *L) {
luaL_newlib(L, co_funcs);
return 1;
}

64
lib/lua/lctype.c
View File

@ -1,64 +0,0 @@
/*
** $Id: lctype.c $
** 'ctype' functions for Lua
** See Copyright Notice in lua.h
*/
#define lctype_c
#define LUA_CORE
#include "lprefix.h"
#include "lctype.h"
#if !LUA_USE_CTYPE /* { */
#include <limits.h>
#if defined (LUA_UCID) /* accept UniCode IDentifiers? */
/* consider all non-ASCII codepoints to be alphabetic */
#define NONA 0x01
#else
#define NONA 0x00 /* default */
#endif
LUAI_DDEF const lu_byte luai_ctype_[UCHAR_MAX + 2] = {
0x00, /* EOZ */
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 0. */
0x00, 0x08, 0x08, 0x08, 0x08, 0x08, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, /* 1. */
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x0c, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, /* 2. */
0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,
0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, 0x16, /* 3. */
0x16, 0x16, 0x04, 0x04, 0x04, 0x04, 0x04, 0x04,
0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 4. */
0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,
0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 5. */
0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x05,
0x04, 0x15, 0x15, 0x15, 0x15, 0x15, 0x15, 0x05, /* 6. */
0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05,
0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, 0x05, /* 7. */
0x05, 0x05, 0x05, 0x04, 0x04, 0x04, 0x04, 0x00,
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* 8. */
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* 9. */
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* a. */
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* b. */
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
0x00, 0x00, NONA, NONA, NONA, NONA, NONA, NONA, /* c. */
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* d. */
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA, /* e. */
NONA, NONA, NONA, NONA, NONA, NONA, NONA, NONA,
NONA, NONA, NONA, NONA, NONA, 0x00, 0x00, 0x00, /* f. */
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
};
#endif /* } */

101
lib/lua/lctype.h
View File

@ -1,101 +0,0 @@
/*
** $Id: lctype.h $
** 'ctype' functions for Lua
** See Copyright Notice in lua.h
*/
#ifndef lctype_h
#define lctype_h
#include "lua.h"
/*
** WARNING: the functions defined here do not necessarily correspond
** to the similar functions in the standard C ctype.h. They are
** optimized for the specific needs of Lua.
*/
#if !defined(LUA_USE_CTYPE)
#if 'A' == 65 && '0' == 48
/* ASCII case: can use its own tables; faster and fixed */
#define LUA_USE_CTYPE 0
#else
/* must use standard C ctype */
#define LUA_USE_CTYPE 1
#endif
#endif
#if !LUA_USE_CTYPE /* { */
#include <limits.h>
#include "llimits.h"
#define ALPHABIT 0
#define DIGITBIT 1
#define PRINTBIT 2
#define SPACEBIT 3
#define XDIGITBIT 4
#define MASK(B) (1 << (B))
/*
** add 1 to char to allow index -1 (EOZ)
*/
#define testprop(c,p) (luai_ctype_[(c)+1] & (p))
/*
** 'lalpha' (Lua alphabetic) and 'lalnum' (Lua alphanumeric) both include '_'
*/
#define lislalpha(c) testprop(c, MASK(ALPHABIT))
#define lislalnum(c) testprop(c, (MASK(ALPHABIT) | MASK(DIGITBIT)))
#define lisdigit(c) testprop(c, MASK(DIGITBIT))
#define lisspace(c) testprop(c, MASK(SPACEBIT))
#define lisprint(c) testprop(c, MASK(PRINTBIT))
#define lisxdigit(c) testprop(c, MASK(XDIGITBIT))
/*
** In ASCII, this 'ltolower' is correct for alphabetic characters and
** for '.'. That is enough for Lua needs. ('check_exp' ensures that
** the character either is an upper-case letter or is unchanged by
** the transformation, which holds for lower-case letters and '.'.)
*/
#define ltolower(c) \
check_exp(('A' <= (c) && (c) <= 'Z') || (c) == ((c) | ('A' ^ 'a')), \
(c) | ('A' ^ 'a'))
/* one entry for each character and for -1 (EOZ) */
LUAI_DDEC(const lu_byte luai_ctype_[UCHAR_MAX + 2];)
#else /* }{ */
/*
** use standard C ctypes
*/
#include <ctype.h>
#define lislalpha(c) (isalpha(c) || (c) == '_')
#define lislalnum(c) (isalnum(c) || (c) == '_')
#define lisdigit(c) (isdigit(c))
#define lisspace(c) (isspace(c))
#define lisprint(c) (isprint(c))
#define lisxdigit(c) (isxdigit(c))
#define ltolower(c) (tolower(c))
#endif /* } */
#endif

522
lib/lua/ldblib.c
View File

@ -1,347 +1,159 @@
/*
** $Id: ldblib.c $
** $Id: ldblib.c,v 1.80 2003/04/03 13:35:34 roberto Exp $
** Interface from Lua to its debug API
** See Copyright Notice in lua.h
*/
#define ldblib_c
#define LUA_LIB
#include "lprefix.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define ldblib_c
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#include "llimits.h"
/*
** The hook table at registry[HOOKKEY] maps threads to their current
** hook function.
*/
static const char *const HOOKKEY = "_HOOKKEY";
/*
** If L1 != L, L1 can be in any state, and therefore there are no
** guarantees about its stack space; any push in L1 must be
** checked.
*/
static void checkstack (lua_State *L, lua_State *L1, int n) {
if (l_unlikely(L != L1 && !lua_checkstack(L1, n)))
luaL_error(L, "stack overflow");
}
static int db_getregistry (lua_State *L) {
lua_pushvalue(L, LUA_REGISTRYINDEX);
return 1;
}
static int db_getmetatable (lua_State *L) {
luaL_checkany(L, 1);
if (!lua_getmetatable(L, 1)) {
lua_pushnil(L); /* no metatable */
}
return 1;
}
static int db_setmetatable (lua_State *L) {
int t = lua_type(L, 2);
luaL_argexpected(L, t == LUA_TNIL || t == LUA_TTABLE, 2, "nil or table");
lua_settop(L, 2);
lua_setmetatable(L, 1);
return 1; /* return 1st argument */
}
static int db_getuservalue (lua_State *L) {
int n = (int)luaL_optinteger(L, 2, 1);
if (lua_type(L, 1) != LUA_TUSERDATA)
luaL_pushfail(L);
else if (lua_getiuservalue(L, 1, n) != LUA_TNONE) {
lua_pushboolean(L, 1);
return 2;
}
return 1;
}
static int db_setuservalue (lua_State *L) {
int n = (int)luaL_optinteger(L, 3, 1);
luaL_checktype(L, 1, LUA_TUSERDATA);
luaL_checkany(L, 2);
lua_settop(L, 2);
if (!lua_setiuservalue(L, 1, n))
luaL_pushfail(L);
return 1;
}
/*
** Auxiliary function used by several library functions: check for
** an optional thread as function's first argument and set 'arg' with
** 1 if this argument is present (so that functions can skip it to
** access their other arguments)
*/
static lua_State *getthread (lua_State *L, int *arg) {
if (lua_isthread(L, 1)) {
*arg = 1;
return lua_tothread(L, 1);
}
else {
*arg = 0;
return L; /* function will operate over current thread */
}
}
/*
** Variations of 'lua_settable', used by 'db_getinfo' to put results
** from 'lua_getinfo' into result table. Key is always a string;
** value can be a string, an int, or a boolean.
*/
static void settabss (lua_State *L, const char *k, const char *v) {
static void settabss (lua_State *L, const char *i, const char *v) {
lua_pushstring(L, i);
lua_pushstring(L, v);
lua_setfield(L, -2, k);
}
static void settabsi (lua_State *L, const char *k, int v) {
lua_pushinteger(L, v);
lua_setfield(L, -2, k);
}
static void settabsb (lua_State *L, const char *k, int v) {
lua_pushboolean(L, v);
lua_setfield(L, -2, k);
lua_rawset(L, -3);
}
/*
** In function 'db_getinfo', the call to 'lua_getinfo' may push
** results on the stack; later it creates the result table to put
** these objects. Function 'treatstackoption' puts the result from
** 'lua_getinfo' on top of the result table so that it can call
** 'lua_setfield'.
*/
static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) {
if (L == L1)
lua_rotate(L, -2, 1); /* exchange object and table */
else
lua_xmove(L1, L, 1); /* move object to the "main" stack */
lua_setfield(L, -2, fname); /* put object into table */
static void settabsi (lua_State *L, const char *i, int v) {
lua_pushstring(L, i);
lua_pushnumber(L, (lua_Number)v);
lua_rawset(L, -3);
}
/*
** Calls 'lua_getinfo' and collects all results in a new table.
** L1 needs stack space for an optional input (function) plus
** two optional outputs (function and line table) from function
** 'lua_getinfo'.
*/
static int db_getinfo (lua_State *L) {
static int getinfo (lua_State *L) {
lua_Debug ar;
int arg;
lua_State *L1 = getthread(L, &arg);
const char *options = luaL_optstring(L, arg+2, "flnSrtu");
checkstack(L, L1, 3);
luaL_argcheck(L, options[0] != '>', arg + 2, "invalid option '>'");
if (lua_isfunction(L, arg + 1)) { /* info about a function? */
options = lua_pushfstring(L, ">%s", options); /* add '>' to 'options' */
lua_pushvalue(L, arg + 1); /* move function to 'L1' stack */
lua_xmove(L, L1, 1);
}
else { /* stack level */
if (!lua_getstack(L1, (int)luaL_checkinteger(L, arg + 1), &ar)) {
luaL_pushfail(L); /* level out of range */
const char *options = luaL_optstring(L, 2, "flnSu");
if (lua_isnumber(L, 1)) {
if (!lua_getstack(L, (int)(lua_tonumber(L, 1)), &ar)) {
lua_pushnil(L); /* level out of range */
return 1;
}
}
if (!lua_getinfo(L1, options, &ar))
return luaL_argerror(L, arg+2, "invalid option");
lua_newtable(L); /* table to collect results */
if (strchr(options, 'S')) {
lua_pushlstring(L, ar.source, ar.srclen);
lua_setfield(L, -2, "source");
settabss(L, "short_src", ar.short_src);
settabsi(L, "linedefined", ar.linedefined);
settabsi(L, "lastlinedefined", ar.lastlinedefined);
settabss(L, "what", ar.what);
else if (lua_isfunction(L, 1)) {
lua_pushfstring(L, ">%s", options);
options = lua_tostring(L, -1);
lua_pushvalue(L, 1);
}
if (strchr(options, 'l'))
settabsi(L, "currentline", ar.currentline);
if (strchr(options, 'u')) {
settabsi(L, "nups", ar.nups);
settabsi(L, "nparams", ar.nparams);
settabsb(L, "isvararg", ar.isvararg);
else
return luaL_argerror(L, 1, "function or level expected");
if (!lua_getinfo(L, options, &ar))
return luaL_argerror(L, 2, "invalid option");
lua_newtable(L);
for (; *options; options++) {
switch (*options) {
case 'S':
settabss(L, "source", 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_pushliteral(L, "func");
lua_pushvalue(L, -3);
lua_rawset(L, -3);
break;
}
}
if (strchr(options, 'n')) {
settabss(L, "name", ar.name);
settabss(L, "namewhat", ar.namewhat);
}
if (strchr(options, 'r')) {
settabsi(L, "ftransfer", ar.ftransfer);
settabsi(L, "ntransfer", ar.ntransfer);
}
if (strchr(options, 't')) {
settabsb(L, "istailcall", ar.istailcall);
settabsi(L, "extraargs", ar.extraargs);
}
if (strchr(options, 'L'))
treatstackoption(L, L1, "activelines");
if (strchr(options, 'f'))
treatstackoption(L, L1, "func");
return 1; /* return table */
}
static int db_getlocal (lua_State *L) {
int arg;
lua_State *L1 = getthread(L, &arg);
int nvar = (int)luaL_checkinteger(L, arg + 2); /* local-variable index */
if (lua_isfunction(L, arg + 1)) { /* function argument? */
lua_pushvalue(L, arg + 1); /* push function */
lua_pushstring(L, lua_getlocal(L, NULL, nvar)); /* push local name */
return 1; /* return only name (there is no value) */
static int getlocal (lua_State *L) {
lua_Debug ar;
const char *name;
if (!lua_getstack(L, luaL_checkint(L, 1), &ar)) /* level out of range? */
return luaL_argerror(L, 1, "level out of range");
name = lua_getlocal(L, &ar, luaL_checkint(L, 2));
if (name) {
lua_pushstring(L, name);
lua_pushvalue(L, -2);
return 2;
}
else { /* stack-level argument */
lua_Debug ar;
const char *name;
int level = (int)luaL_checkinteger(L, arg + 1);
if (l_unlikely(!lua_getstack(L1, level, &ar))) /* out of range? */
return luaL_argerror(L, arg+1, "level out of range");
checkstack(L, L1, 1);
name = lua_getlocal(L1, &ar, nvar);
if (name) {
lua_xmove(L1, L, 1); /* move local value */
lua_pushstring(L, name); /* push name */
lua_rotate(L, -2, 1); /* re-order */
return 2;
}
else {
luaL_pushfail(L); /* no name (nor value) */
return 1;
}
else {
lua_pushnil(L);
return 1;
}
}
static int db_setlocal (lua_State *L) {
int arg;
const char *name;
lua_State *L1 = getthread(L, &arg);
static int setlocal (lua_State *L) {
lua_Debug ar;
int level = (int)luaL_checkinteger(L, arg + 1);
int nvar = (int)luaL_checkinteger(L, arg + 2);
if (l_unlikely(!lua_getstack(L1, level, &ar))) /* out of range? */
return luaL_argerror(L, arg+1, "level out of range");
luaL_checkany(L, arg+3);
lua_settop(L, arg+3);
checkstack(L, L1, 1);
lua_xmove(L, L1, 1);
name = lua_setlocal(L1, &ar, nvar);
if (name == NULL)
lua_pop(L1, 1); /* pop value (if not popped by 'lua_setlocal') */
lua_pushstring(L, name);
if (!lua_getstack(L, luaL_checkint(L, 1), &ar)) /* level out of range? */
return luaL_argerror(L, 1, "level out of range");
luaL_checkany(L, 3);
lua_pushstring(L, lua_setlocal(L, &ar, luaL_checkint(L, 2)));
return 1;
}
/*
** get (if 'get' is true) or set an upvalue from a closure
*/
static int auxupvalue (lua_State *L, int get) {
const char *name;
int n = (int)luaL_checkinteger(L, 2); /* upvalue index */
luaL_checktype(L, 1, LUA_TFUNCTION); /* closure */
int n = luaL_checkint(L, 2);
luaL_checktype(L, 1, LUA_TFUNCTION);
if (lua_iscfunction(L, 1)) return 0; /* cannot touch C upvalues from Lua */
name = get ? lua_getupvalue(L, 1, n) : lua_setupvalue(L, 1, n);
if (name == NULL) return 0;
lua_pushstring(L, name);
lua_insert(L, -(get+1)); /* no-op if get is false */
lua_insert(L, -(get+1));
return get + 1;
}
static int db_getupvalue (lua_State *L) {
static int getupvalue (lua_State *L) {
return auxupvalue(L, 1);
}
static int db_setupvalue (lua_State *L) {
static int setupvalue (lua_State *L) {
luaL_checkany(L, 3);
return auxupvalue(L, 0);
}
/*
** Check whether a given upvalue from a given closure exists and
** returns its index
*/
static void *checkupval (lua_State *L, int argf, int argnup, int *pnup) {
void *id;
int nup = (int)luaL_checkinteger(L, argnup); /* upvalue index */
luaL_checktype(L, argf, LUA_TFUNCTION); /* closure */
id = lua_upvalueid(L, argf, nup);
if (pnup) {
luaL_argcheck(L, id != NULL, argnup, "invalid upvalue index");
*pnup = nup;
}
return id;
}
static const char KEY_HOOK = 'h';
static int db_upvalueid (lua_State *L) {
void *id = checkupval(L, 1, 2, NULL);
if (id != NULL)
lua_pushlightuserdata(L, id);
else
luaL_pushfail(L);
return 1;
}
static int db_upvaluejoin (lua_State *L) {
int n1, n2;
checkupval(L, 1, 2, &n1);
checkupval(L, 3, 4, &n2);
luaL_argcheck(L, !lua_iscfunction(L, 1), 1, "Lua function expected");
luaL_argcheck(L, !lua_iscfunction(L, 3), 3, "Lua function expected");
lua_upvaluejoin(L, 1, n1, 3, n2);
return 0;
}
/*
** Call hook function registered at hook table for the current
** thread (if there is one)
*/
static void hookf (lua_State *L, lua_Debug *ar) {
static const char *const hooknames[] =
{"call", "return", "line", "count", "tail call"};
lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
lua_pushthread(L);
if (lua_rawget(L, -2) == LUA_TFUNCTION) { /* is there a hook function? */
lua_pushstring(L, hooknames[(int)ar->event]); /* push event name */
{"call", "return", "line", "count", "tail return"};
lua_pushlightuserdata(L, (void *)&KEY_HOOK);
lua_rawget(L, LUA_REGISTRYINDEX);
if (lua_isfunction(L, -1)) {
lua_pushstring(L, hooknames[(int)ar->event]);
if (ar->currentline >= 0)
lua_pushinteger(L, ar->currentline); /* push current line */
lua_pushnumber(L, (lua_Number)ar->currentline);
else lua_pushnil(L);
lua_assert(lua_getinfo(L, "lS", ar));
lua_call(L, 2, 0); /* call hook function */
lua_call(L, 2, 0);
}
else
lua_pop(L, 1); /* pop result from gettable */
}
/*
** Convert a string mask (for 'sethook') into a bit mask
*/
static int makemask (const char *smask, int count) {
int mask = 0;
if (strchr(smask, 'c')) mask |= LUA_MASKCALL;
@ -352,9 +164,6 @@ static int makemask (const char *smask, int count) {
}
/*
** Convert a bit mask (for 'gethook') into a string mask
*/
static char *unmakemask (int mask, char *smask) {
int i = 0;
if (mask & LUA_MASKCALL) smask[i++] = 'c';
@ -365,113 +174,126 @@ static char *unmakemask (int mask, char *smask) {
}
static int db_sethook (lua_State *L) {
int arg, mask, count;
lua_Hook func;
lua_State *L1 = getthread(L, &arg);
if (lua_isnoneornil(L, arg+1)) { /* no hook? */
lua_settop(L, arg+1);
func = NULL; mask = 0; count = 0; /* turn off hooks */
static int sethook (lua_State *L) {
if (lua_isnoneornil(L, 1)) {
lua_settop(L, 1);
lua_sethook(L, NULL, 0, 0); /* turn off hooks */
}
else {
const char *smask = luaL_checkstring(L, arg+2);
luaL_checktype(L, arg+1, LUA_TFUNCTION);
count = (int)luaL_optinteger(L, arg + 3, 0);
func = hookf; mask = makemask(smask, count);
const char *smask = luaL_checkstring(L, 2);
int count = luaL_optint(L, 3, 0);
luaL_checktype(L, 1, LUA_TFUNCTION);
lua_sethook(L, hookf, makemask(smask, count), count);
}
if (!luaL_getsubtable(L, LUA_REGISTRYINDEX, HOOKKEY)) {
/* table just created; initialize it */
lua_pushliteral(L, "k");
lua_setfield(L, -2, "__mode"); /** hooktable.__mode = "k" */
lua_pushvalue(L, -1);
lua_setmetatable(L, -2); /* metatable(hooktable) = hooktable */
}
checkstack(L, L1, 1);
lua_pushthread(L1); lua_xmove(L1, L, 1); /* key (thread) */
lua_pushvalue(L, arg + 1); /* value (hook function) */
lua_rawset(L, -3); /* hooktable[L1] = new Lua hook */
lua_sethook(L1, func, mask, count);
lua_pushlightuserdata(L, (void *)&KEY_HOOK);
lua_pushvalue(L, 1);
lua_rawset(L, LUA_REGISTRYINDEX); /* set new hook */
return 0;
}
static int db_gethook (lua_State *L) {
int arg;
lua_State *L1 = getthread(L, &arg);
static int gethook (lua_State *L) {
char buff[5];
int mask = lua_gethookmask(L1);
lua_Hook hook = lua_gethook(L1);
if (hook == NULL) { /* no hook? */
luaL_pushfail(L);
return 1;
}
else if (hook != hookf) /* external hook? */
int mask = lua_gethookmask(L);
lua_Hook hook = lua_gethook(L);
if (hook != NULL && hook != hookf) /* external hook? */
lua_pushliteral(L, "external hook");
else { /* hook table must exist */
lua_getfield(L, LUA_REGISTRYINDEX, HOOKKEY);
checkstack(L, L1, 1);
lua_pushthread(L1); lua_xmove(L1, L, 1);
lua_rawget(L, -2); /* 1st result = hooktable[L1] */
lua_remove(L, -2); /* remove hook table */
else {
lua_pushlightuserdata(L, (void *)&KEY_HOOK);
lua_rawget(L, LUA_REGISTRYINDEX); /* get hook */
}
lua_pushstring(L, unmakemask(mask, buff)); /* 2nd result = mask */
lua_pushinteger(L, lua_gethookcount(L1)); /* 3rd result = count */
lua_pushstring(L, unmakemask(mask, buff));
lua_pushnumber(L, (lua_Number)lua_gethookcount(L));
return 3;
}
static int db_debug (lua_State *L) {
static int debug (lua_State *L) {
for (;;) {
char buffer[250];
lua_writestringerror("%s", "lua_debug> ");
if (fgets(buffer, sizeof(buffer), stdin) == NULL ||
fputs("lua_debug> ", stderr);
if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
strcmp(buffer, "cont\n") == 0)
return 0;
if (luaL_loadbufferx(L, buffer, strlen(buffer), "=(debug command)", "t") ||
lua_pcall(L, 0, 0, 0))
lua_writestringerror("%s\n", luaL_tolstring(L, -1, NULL));
lua_dostring(L, buffer);
lua_settop(L, 0); /* remove eventual returns */
}
}
static int db_traceback (lua_State *L) {
int arg;
lua_State *L1 = getthread(L, &arg);
const char *msg = lua_tostring(L, arg + 1);
if (msg == NULL && !lua_isnoneornil(L, arg + 1)) /* non-string 'msg'? */
lua_pushvalue(L, arg + 1); /* return it untouched */
else {
int level = (int)luaL_optinteger(L, arg + 2, (L == L1) ? 1 : 0);
luaL_traceback(L, L1, msg, level);
#define LEVELS1 12 /* size of the first part of the stack */
#define LEVELS2 10 /* size of the second part of the stack */
static int errorfb (lua_State *L) {
int level = 1; /* skip level 0 (it's this function) */
int firstpart = 1; /* still before eventual `...' */
lua_Debug ar;
if (lua_gettop(L) == 0)
lua_pushliteral(L, "");
else if (!lua_isstring(L, 1)) return 1; /* no string message */
else lua_pushliteral(L, "\n");
lua_pushliteral(L, "stack traceback:");
while (lua_getstack(L, level++, &ar)) {
if (level > LEVELS1 && firstpart) {
/* no more than `LEVELS2' more levels? */
if (!lua_getstack(L, level+LEVELS2, &ar))
level--; /* keep going */
else {
lua_pushliteral(L, "\n\t..."); /* too many levels */
while (lua_getstack(L, level+LEVELS2, &ar)) /* find last levels */
level++;
}
firstpart = 0;
continue;
}
lua_pushliteral(L, "\n\t");
lua_getinfo(L, "Snl", &ar);
lua_pushfstring(L, "%s:", ar.short_src);
if (ar.currentline > 0)
lua_pushfstring(L, "%d:", ar.currentline);
switch (*ar.namewhat) {
case 'g': /* global */
case 'l': /* local */
case 'f': /* field */
case 'm': /* method */
lua_pushfstring(L, " in function `%s'", ar.name);
break;
default: {
if (*ar.what == 'm') /* main? */
lua_pushfstring(L, " in main chunk");
else if (*ar.what == 'C' || *ar.what == 't')
lua_pushliteral(L, " ?"); /* C function or tail call */
else
lua_pushfstring(L, " in function <%s:%d>",
ar.short_src, ar.linedefined);
}
}
lua_concat(L, lua_gettop(L));
}
lua_concat(L, lua_gettop(L));
return 1;
}
static const luaL_Reg dblib[] = {
{"debug", db_debug},
{"getuservalue", db_getuservalue},
{"gethook", db_gethook},
{"getinfo", db_getinfo},
{"getlocal", db_getlocal},
{"getregistry", db_getregistry},
{"getmetatable", db_getmetatable},
{"getupvalue", db_getupvalue},
{"upvaluejoin", db_upvaluejoin},
{"upvalueid", db_upvalueid},
{"setuservalue", db_setuservalue},
{"sethook", db_sethook},
{"setlocal", db_setlocal},
{"setmetatable", db_setmetatable},
{"setupvalue", db_setupvalue},
{"traceback", db_traceback},
static const luaL_reg dblib[] = {
{"getlocal", getlocal},
{"getinfo", getinfo},
{"gethook", gethook},
{"getupvalue", getupvalue},
{"sethook", sethook},
{"setlocal", setlocal},
{"setupvalue", setupvalue},
{"debug", debug},
{"traceback", errorfb},
{NULL, NULL}
};
LUAMOD_API int luaopen_debug (lua_State *L) {
luaL_newlib(L, dblib);
LUALIB_API int luaopen_debug (lua_State *L) {
luaL_openlib(L, LUA_DBLIBNAME, dblib, 0);
lua_pushliteral(L, "_TRACEBACK");
lua_pushcfunction(L, errorfb);
lua_settable(L, LUA_GLOBALSINDEX);
return 1;
}

1130
lib/lua/ldebug.c
View File

File diff suppressed because it is too large Load Diff

56
lib/lua/ldebug.h
View File

@ -1,5 +1,5 @@
/*
** $Id: ldebug.h $
** $Id: ldebug.h,v 1.32 2002/11/18 11:01:55 roberto Exp $
** Auxiliary functions from Debug Interface module
** See Copyright Notice in lua.h
*/
@ -11,55 +11,21 @@
#include "lstate.h"
#define pcRel(pc, p) (cast_int((pc) - (p)->code) - 1)
/* Active Lua function (given call info) */
#define ci_func(ci) (clLvalue(s2v((ci)->func.p)))
#define pcRel(pc, p) (cast(int, (pc) - (p)->code) - 1)
#define getline(f,pc) (((f)->lineinfo) ? (f)->lineinfo[pc] : 0)
#define resethookcount(L) (L->hookcount = L->basehookcount)
/*
** mark for entries in 'lineinfo' array that has absolute information in
** 'abslineinfo' array
*/
#define ABSLINEINFO (-0x80)
/*
** MAXimum number of successive Instructions WiTHout ABSolute line
** information. (A power of two allows fast divisions.)
*/
#if !defined(MAXIWTHABS)
#define MAXIWTHABS 128
#endif
LUAI_FUNC int luaG_getfuncline (const Proto *f, int pc);
LUAI_FUNC const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n,
StkId *pos);
LUAI_FUNC l_noret luaG_typeerror (lua_State *L, const TValue *o,
const char *opname);
LUAI_FUNC l_noret luaG_callerror (lua_State *L, const TValue *o);
LUAI_FUNC l_noret luaG_forerror (lua_State *L, const TValue *o,
const char *what);
LUAI_FUNC l_noret luaG_concaterror (lua_State *L, const TValue *p1,
const TValue *p2);
LUAI_FUNC l_noret luaG_opinterror (lua_State *L, const TValue *p1,
const TValue *p2,
const char *msg);
LUAI_FUNC l_noret luaG_tointerror (lua_State *L, const TValue *p1,
const TValue *p2);
LUAI_FUNC l_noret luaG_ordererror (lua_State *L, const TValue *p1,
const TValue *p2);
LUAI_FUNC l_noret luaG_errnnil (lua_State *L, LClosure *cl, int k);
LUAI_FUNC l_noret luaG_runerror (lua_State *L, const char *fmt, ...);
LUAI_FUNC const char *luaG_addinfo (lua_State *L, const char *msg,
TString *src, int line);
LUAI_FUNC l_noret luaG_errormsg (lua_State *L);
LUAI_FUNC int luaG_traceexec (lua_State *L, const Instruction *pc);
LUAI_FUNC int luaG_tracecall (lua_State *L);
void luaG_inithooks (lua_State *L);
void luaG_typeerror (lua_State *L, const TObject *o, const char *opname);
void luaG_concaterror (lua_State *L, StkId p1, StkId p2);
void luaG_aritherror (lua_State *L, const TObject *p1, const TObject *p2);
int luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2);
void luaG_runerror (lua_State *L, const char *fmt, ...);
void luaG_errormsg (lua_State *L);
int luaG_checkcode (const Proto *pt);
#endif

1369
lib/lua/ldo.c
View File

File diff suppressed because it is too large Load Diff

111
lib/lua/ldo.h
View File

@ -1,5 +1,5 @@
/*
** $Id: ldo.h $
** $Id: ldo.h,v 1.56 2002/12/04 17:29:32 roberto Exp $
** Stack and Call structure of Lua
** See Copyright Notice in lua.h
*/
@ -8,92 +8,53 @@
#define ldo_h
#include "llimits.h"
#include "lobject.h"
#include "lstate.h"
#include "lzio.h"
/*
** Macro to check stack size and grow stack if needed. Parameters
** 'pre'/'pos' allow the macro to preserve a pointer into the
** stack across reallocations, doing the work only when needed.
** It also allows the running of one GC step when the stack is
** reallocated.
** 'condmovestack' is used in heavy tests to force a stack reallocation
** at every check.
*/
#if !defined(HARDSTACKTESTS)
#define condmovestack(L,pre,pos) ((void)0)
** macro to control inclusion of some hard tests on stack reallocation
*/
#ifndef HARDSTACKTESTS
#define condhardstacktests(x) { /* empty */ }
#else
/* realloc stack keeping its size */
#define condmovestack(L,pre,pos) \
{ int sz_ = stacksize(L); pre; luaD_reallocstack((L), sz_, 0); pos; }
#endif
#define luaD_checkstackaux(L,n,pre,pos) \
if (l_unlikely(L->stack_last.p - L->top.p <= (n))) \
{ pre; luaD_growstack(L, n, 1); pos; } \
else { condmovestack(L,pre,pos); }
/* In general, 'pre'/'pos' are empty (nothing to save) */
#define luaD_checkstack(L,n) luaD_checkstackaux(L,n,(void)0,(void)0)
#define savestack(L,pt) (cast_charp(pt) - cast_charp(L->stack.p))
#define restorestack(L,n) cast(StkId, cast_charp(L->stack.p) + (n))
/* macro to check stack size, preserving 'p' */
#define checkstackp(L,n,p) \
luaD_checkstackaux(L, n, \
ptrdiff_t t__ = savestack(L, p), /* save 'p' */ \
p = restorestack(L, t__)) /* 'pos' part: restore 'p' */
/*
** Maximum depth for nested C calls, syntactical nested non-terminals,
** and other features implemented through recursion in C. (Value must
** fit in a 16-bit unsigned integer. It must also be compatible with
** the size of the C stack.)
*/
#if !defined(LUAI_MAXCCALLS)
#define LUAI_MAXCCALLS 200
#define condhardstacktests(x) x
#endif
/* type of protected functions, to be ran by 'runprotected' */
#define luaD_checkstack(L,n) \
if ((char *)L->stack_last - (char *)L->top <= (n)*(int)sizeof(TObject)) \
luaD_growstack(L, n); \
else condhardstacktests(luaD_reallocstack(L, L->stacksize));
#define incr_top(L) {luaD_checkstack(L,1); L->top++;}
#define savestack(L,p) ((char *)(p) - (char *)L->stack)
#define restorestack(L,n) ((TObject *)((char *)L->stack + (n)))
#define saveci(L,p) ((char *)(p) - (char *)L->base_ci)
#define restoreci(L,n) ((CallInfo *)((char *)L->base_ci + (n)))
/* type of protected functions, to be ran by `runprotected' */
typedef void (*Pfunc) (lua_State *L, void *ud);
LUAI_FUNC l_noret luaD_errerr (lua_State *L);
LUAI_FUNC void luaD_seterrorobj (lua_State *L, TStatus errcode, StkId oldtop);
LUAI_FUNC TStatus luaD_protectedparser (lua_State *L, ZIO *z,
const char *name,
const char *mode);
LUAI_FUNC void luaD_hook (lua_State *L, int event, int line,
int fTransfer, int nTransfer);
LUAI_FUNC void luaD_hookcall (lua_State *L, CallInfo *ci);
LUAI_FUNC int luaD_pretailcall (lua_State *L, CallInfo *ci, StkId func,
int narg1, int delta);
LUAI_FUNC CallInfo *luaD_precall (lua_State *L, StkId func, int nResults);
LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults);
LUAI_FUNC void luaD_callnoyield (lua_State *L, StkId func, int nResults);
LUAI_FUNC TStatus luaD_closeprotected (lua_State *L, ptrdiff_t level,
TStatus status);
LUAI_FUNC TStatus luaD_pcall (lua_State *L, Pfunc func, void *u,
ptrdiff_t oldtop, ptrdiff_t ef);
LUAI_FUNC void luaD_poscall (lua_State *L, CallInfo *ci, int nres);
LUAI_FUNC int luaD_reallocstack (lua_State *L, int newsize, int raiseerror);
LUAI_FUNC int luaD_growstack (lua_State *L, int n, int raiseerror);
LUAI_FUNC void luaD_shrinkstack (lua_State *L);
LUAI_FUNC int luaD_checkminstack (lua_State *L);
LUAI_FUNC void luaD_anchorobj (lua_State *L, Table *anchor, GCObject *obj);
void luaD_resetprotection (lua_State *L);
int luaD_protectedparser (lua_State *L, ZIO *z, int bin);
void luaD_callhook (lua_State *L, int event, int line);
StkId luaD_precall (lua_State *L, StkId func);
void luaD_call (lua_State *L, StkId func, int nResults);
int luaD_pcall (lua_State *L, Pfunc func, void *u,
ptrdiff_t oldtop, ptrdiff_t ef);
void luaD_poscall (lua_State *L, int wanted, StkId firstResult);
void luaD_reallocCI (lua_State *L, int newsize);
void luaD_reallocstack (lua_State *L, int newsize);
void luaD_growstack (lua_State *L, int n);
void luaD_throw (lua_State *L, int errcode);
int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud);
LUAI_FUNC l_noret luaD_throw (lua_State *L, TStatus errcode);
LUAI_FUNC l_noret luaD_throwbaselevel (lua_State *L, TStatus errcode);
LUAI_FUNC TStatus luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud);
#endif

435
lib/lua/ldump.c
View File

@ -1,307 +1,170 @@
/*
** $Id: ldump.c $
** save precompiled Lua chunks
** $Id: ldump.c,v 1.4 2003/02/11 23:52:12 lhf Exp $
** save bytecodes
** See Copyright Notice in lua.h
*/
#define ldump_c
#define LUA_CORE
#include "lprefix.h"
#include <limits.h>
#include <stddef.h>
#define ldump_c
#include "lua.h"
#include "lapi.h"
#include "lgc.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lstate.h"
#include "ltable.h"
#include "lundump.h"
#define DumpVector(b,n,size,D) DumpBlock(b,(n)*(size),D)
#define DumpLiteral(s,D) DumpBlock("" s,(sizeof(s))-1,D)
typedef struct {
lua_State *L;
lua_Writer writer;
void *data;
size_t offset; /* current position relative to beginning of dump */
int strip;
int status;
Table *h; /* table to track saved strings */
lua_Unsigned nstr; /* counter for counting saved strings */
lua_State* L;
lua_Chunkwriter write;
void* data;
} DumpState;
static void DumpBlock(const void* b, size_t size, DumpState* D)
{
lua_unlock(D->L);
(*D->write)(D->L,b,size,D->data);
lua_lock(D->L);
}
static void DumpByte(int y, DumpState* D)
{
char x=(char)y;
DumpBlock(&x,sizeof(x),D);
}
static void DumpInt(int x, DumpState* D)
{
DumpBlock(&x,sizeof(x),D);
}
static void DumpSize(size_t x, DumpState* D)
{
DumpBlock(&x,sizeof(x),D);
}
static void DumpNumber(lua_Number x, DumpState* D)
{
DumpBlock(&x,sizeof(x),D);
}
static void DumpString(TString* s, DumpState* D)
{
if (s==NULL || getstr(s)==NULL)
DumpSize(0,D);
else
{
size_t size=s->tsv.len+1; /* include trailing '\0' */
DumpSize(size,D);
DumpBlock(getstr(s),size,D);
}
}
static void DumpCode(const Proto* f, DumpState* D)
{
DumpInt(f->sizecode,D);
DumpVector(f->code,f->sizecode,sizeof(*f->code),D);
}
static void DumpLocals(const Proto* f, DumpState* D)
{
int i,n=f->sizelocvars;
DumpInt(n,D);
for (i=0; i<n; i++)
{
DumpString(f->locvars[i].varname,D);
DumpInt(f->locvars[i].startpc,D);
DumpInt(f->locvars[i].endpc,D);
}
}
static void DumpLines(const Proto* f, DumpState* D)
{
DumpInt(f->sizelineinfo,D);
DumpVector(f->lineinfo,f->sizelineinfo,sizeof(*f->lineinfo),D);
}
static void DumpUpvalues(const Proto* f, DumpState* D)
{
int i,n=f->sizeupvalues;
DumpInt(n,D);
for (i=0; i<n; i++) DumpString(f->upvalues[i],D);
}
static void DumpFunction(const Proto* f, const TString* p, DumpState* D);
static void DumpConstants(const Proto* f, DumpState* D)
{
int i,n;
DumpInt(n=f->sizek,D);
for (i=0; i<n; i++)
{
const TObject* o=&f->k[i];
DumpByte(ttype(o),D);
switch (ttype(o))
{
case LUA_TNUMBER:
DumpNumber(nvalue(o),D);
break;
case LUA_TSTRING:
DumpString(tsvalue(o),D);
break;
case LUA_TNIL:
break;
default:
lua_assert(0); /* cannot happen */
break;
}
}
DumpInt(n=f->sizep,D);
for (i=0; i<n; i++) DumpFunction(f->p[i],f->source,D);
}
static void DumpFunction(const Proto* f, const TString* p, DumpState* D)
{
DumpString((f->source==p) ? NULL : f->source,D);
DumpInt(f->lineDefined,D);
DumpByte(f->nups,D);
DumpByte(f->numparams,D);
DumpByte(f->is_vararg,D);
DumpByte(f->maxstacksize,D);
DumpLines(f,D);
DumpLocals(f,D);
DumpUpvalues(f,D);
DumpConstants(f,D);
DumpCode(f,D);
}
static void DumpHeader(DumpState* D)
{
DumpLiteral(LUA_SIGNATURE,D);
DumpByte(VERSION,D);
DumpByte(luaU_endianness(),D);
DumpByte(sizeof(int),D);
DumpByte(sizeof(size_t),D);
DumpByte(sizeof(Instruction),D);
DumpByte(SIZE_OP,D);
DumpByte(SIZE_A,D);
DumpByte(SIZE_B,D);
DumpByte(SIZE_C,D);
DumpByte(sizeof(lua_Number),D);
DumpNumber(TEST_NUMBER,D);
}
/*
** All high-level dumps go through dumpVector; you can change it to
** change the endianness of the result
** dump function as precompiled chunk
*/
#define dumpVector(D,v,n) dumpBlock(D,v,(n)*sizeof((v)[0]))
#define dumpLiteral(D, s) dumpBlock(D,s,sizeof(s) - sizeof(char))
/*
** Dump the block of memory pointed by 'b' with given 'size'.
** 'b' should not be NULL, except for the last call signaling the end
** of the dump.
*/
static void dumpBlock (DumpState *D, const void *b, size_t size) {
if (D->status == 0) { /* do not write anything after an error */
lua_unlock(D->L);
D->status = (*D->writer)(D->L, b, size, D->data);
lua_lock(D->L);
D->offset += size;
}
}
/*
** Dump enough zeros to ensure that current position is a multiple of
** 'align'.
*/
static void dumpAlign (DumpState *D, unsigned align) {
unsigned padding = align - cast_uint(D->offset % align);
if (padding < align) { /* padding == align means no padding */
static lua_Integer paddingContent = 0;
lua_assert(align <= sizeof(lua_Integer));
dumpBlock(D, &paddingContent, padding);
}
lua_assert(D->offset % align == 0);
}
#define dumpVar(D,x) dumpVector(D,&x,1)
static void dumpByte (DumpState *D, int y) {
lu_byte x = (lu_byte)y;
dumpVar(D, x);
}
/*
** size for 'dumpVarint' buffer: each byte can store up to 7 bits.
** (The "+6" rounds up the division.)
*/
#define DIBS ((l_numbits(lua_Unsigned) + 6) / 7)
/*
** Dumps an unsigned integer using the MSB Varint encoding
*/
static void dumpVarint (DumpState *D, lua_Unsigned x) {
lu_byte buff[DIBS];
unsigned n = 1;
buff[DIBS - 1] = x & 0x7f; /* fill least-significant byte */
while ((x >>= 7) != 0) /* fill other bytes in reverse order */
buff[DIBS - (++n)] = cast_byte((x & 0x7f) | 0x80);
dumpVector(D, buff + DIBS - n, n);
}
static void dumpSize (DumpState *D, size_t sz) {
dumpVarint(D, cast(lua_Unsigned, sz));
}
static void dumpInt (DumpState *D, int x) {
lua_assert(x >= 0);
dumpVarint(D, cast_uint(x));
}
static void dumpNumber (DumpState *D, lua_Number x) {
dumpVar(D, x);
}
/*
** Signed integers are coded to keep small values small. (Coding -1 as
** 0xfff...fff would use too many bytes to save a quite common value.)
** A non-negative x is coded as 2x; a negative x is coded as -2x - 1.
** (0 => 0; -1 => 1; 1 => 2; -2 => 3; 2 => 4; ...)
*/
static void dumpInteger (DumpState *D, lua_Integer x) {
lua_Unsigned cx = (x >= 0) ? 2u * l_castS2U(x)
: (2u * ~l_castS2U(x)) + 1;
dumpVarint(D, cx);
}
/*
** Dump a String. First dump its "size":
** size==0 is followed by an index and means "reuse saved string with
** that index"; index==0 means NULL.
** size>=1 is followed by the string contents with real size==size-1 and
** means that string, which will be saved with the next available index.
** The real size does not include the ending '\0' (which is not dumped),
** so adding 1 to it cannot overflow a size_t.
*/
static void dumpString (DumpState *D, TString *ts) {
if (ts == NULL) {
dumpVarint(D, 0); /* will "reuse" NULL */
dumpVarint(D, 0); /* special index for NULL */
}
else {
TValue idx;
int tag = luaH_getstr(D->h, ts, &idx);
if (!tagisempty(tag)) { /* string already saved? */
dumpVarint(D, 0); /* reuse a saved string */
dumpVarint(D, l_castS2U(ivalue(&idx))); /* index of saved string */
}
else { /* must write and save the string */
TValue key, value; /* to save the string in the hash */
size_t size;
const char *s = getlstr(ts, size);
dumpSize(D, size + 1);
dumpVector(D, s, size + 1); /* include ending '\0' */
D->nstr++; /* one more saved string */
setsvalue(D->L, &key, ts); /* the string is the key */
setivalue(&value, l_castU2S(D->nstr)); /* its index is the value */
luaH_set(D->L, D->h, &key, &value); /* h[ts] = nstr */
/* integer value does not need barrier */
}
}
}
static void dumpCode (DumpState *D, const Proto *f) {
dumpInt(D, f->sizecode);
dumpAlign(D, sizeof(f->code[0]));
lua_assert(f->code != NULL);
dumpVector(D, f->code, cast_uint(f->sizecode));
}
static void dumpFunction (DumpState *D, const Proto *f);
static void dumpConstants (DumpState *D, const Proto *f) {
int i;
int n = f->sizek;
dumpInt(D, n);
for (i = 0; i < n; i++) {
const TValue *o = &f->k[i];
int tt = ttypetag(o);
dumpByte(D, tt);
switch (tt) {
case LUA_VNUMFLT:
dumpNumber(D, fltvalue(o));
break;
case LUA_VNUMINT:
dumpInteger(D, ivalue(o));
break;
case LUA_VSHRSTR:
case LUA_VLNGSTR:
dumpString(D, tsvalue(o));
break;
default:
lua_assert(tt == LUA_VNIL || tt == LUA_VFALSE || tt == LUA_VTRUE);
}
}
}
static void dumpProtos (DumpState *D, const Proto *f) {
int i;
int n = f->sizep;
dumpInt(D, n);
for (i = 0; i < n; i++)
dumpFunction(D, f->p[i]);
}
static void dumpUpvalues (DumpState *D, const Proto *f) {
int i, n = f->sizeupvalues;
dumpInt(D, n);
for (i = 0; i < n; i++) {
dumpByte(D, f->upvalues[i].instack);
dumpByte(D, f->upvalues[i].idx);
dumpByte(D, f->upvalues[i].kind);
}
}
static void dumpDebug (DumpState *D, const Proto *f) {
int i, n;
n = (D->strip) ? 0 : f->sizelineinfo;
dumpInt(D, n);
if (f->lineinfo != NULL)
dumpVector(D, f->lineinfo, cast_uint(n));
n = (D->strip) ? 0 : f->sizeabslineinfo;
dumpInt(D, n);
if (n > 0) {
/* 'abslineinfo' is an array of structures of int's */
dumpAlign(D, sizeof(int));
dumpVector(D, f->abslineinfo, cast_uint(n));
}
n = (D->strip) ? 0 : f->sizelocvars;
dumpInt(D, n);
for (i = 0; i < n; i++) {
dumpString(D, f->locvars[i].varname);
dumpInt(D, f->locvars[i].startpc);
dumpInt(D, f->locvars[i].endpc);
}
n = (D->strip) ? 0 : f->sizeupvalues;
dumpInt(D, n);
for (i = 0; i < n; i++)
dumpString(D, f->upvalues[i].name);
}
static void dumpFunction (DumpState *D, const Proto *f) {
dumpInt(D, f->linedefined);
dumpInt(D, f->lastlinedefined);
dumpByte(D, f->numparams);
dumpByte(D, f->flag);
dumpByte(D, f->maxstacksize);
dumpCode(D, f);
dumpConstants(D, f);
dumpUpvalues(D, f);
dumpProtos(D, f);
dumpString(D, D->strip ? NULL : f->source);
dumpDebug(D, f);
}
#define dumpNumInfo(D, tvar, value) \
{ tvar i = value; dumpByte(D, sizeof(tvar)); dumpVar(D, i); }
static void dumpHeader (DumpState *D) {
dumpLiteral(D, LUA_SIGNATURE);
dumpByte(D, LUAC_VERSION);
dumpByte(D, LUAC_FORMAT);
dumpLiteral(D, LUAC_DATA);
dumpNumInfo(D, int, LUAC_INT);
dumpNumInfo(D, Instruction, LUAC_INST);
dumpNumInfo(D, lua_Integer, LUAC_INT);
dumpNumInfo(D, lua_Number, LUAC_NUM);
}
/*
** dump Lua function as precompiled chunk
*/
int luaU_dump (lua_State *L, const Proto *f, lua_Writer w, void *data,
int strip) {
DumpState D;
D.h = luaH_new(L); /* aux. table to keep strings already dumped */
sethvalue2s(L, L->top.p, D.h); /* anchor it */
L->top.p++;
D.L = L;
D.writer = w;
D.offset = 0;
D.data = data;
D.strip = strip;
D.status = 0;
D.nstr = 0;
dumpHeader(&D);
dumpByte(&D, f->sizeupvalues);
dumpFunction(&D, f);
dumpBlock(&D, NULL, 0); /* signal end of dump */
return D.status;
void luaU_dump (lua_State* L, const Proto* Main, lua_Chunkwriter w, void* data)
{
DumpState D;
D.L=L;
D.write=w;
D.data=data;
DumpHeader(&D);
DumpFunction(Main,NULL,&D);
}

297
lib/lua/lfunc.c
View File

@ -1,21 +1,16 @@
/*
** $Id: lfunc.c $
** $Id: lfunc.c,v 1.67a 2003/03/18 12:50:04 roberto Exp $
** Auxiliary functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#define lfunc_c
#define LUA_CORE
#include "lprefix.h"
#include <stddef.h>
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
@ -23,281 +18,99 @@
#include "lstate.h"
CClosure *luaF_newCclosure (lua_State *L, int nupvals) {
GCObject *o = luaC_newobj(L, LUA_VCCL, sizeCclosure(nupvals));
CClosure *c = gco2ccl(o);
c->nupvalues = cast_byte(nupvals);
Closure *luaF_newCclosure (lua_State *L, int nelems) {
Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems)));
luaC_link(L, valtogco(c), LUA_TFUNCTION);
c->c.isC = 1;
c->c.nupvalues = cast(lu_byte, nelems);
return c;
}
LClosure *luaF_newLclosure (lua_State *L, int nupvals) {
GCObject *o = luaC_newobj(L, LUA_VLCL, sizeLclosure(nupvals));
LClosure *c = gco2lcl(o);
c->p = NULL;
c->nupvalues = cast_byte(nupvals);
while (nupvals--) c->upvals[nupvals] = NULL;
Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *e) {
Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems)));
luaC_link(L, valtogco(c), LUA_TFUNCTION);
c->l.isC = 0;
c->l.g = *e;
c->l.nupvalues = cast(lu_byte, nelems);
return c;
}
/*
** fill a closure with new closed upvalues
*/
void luaF_initupvals (lua_State *L, LClosure *cl) {
int i;
for (i = 0; i < cl->nupvalues; i++) {
GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
UpVal *uv = gco2upv(o);
uv->v.p = &uv->u.value; /* make it closed */
setnilvalue(uv->v.p);
cl->upvals[i] = uv;
luaC_objbarrier(L, cl, uv);
}
}
/*
** Create a new upvalue at the given level, and link it to the list of
** open upvalues of 'L' after entry 'prev'.
**/
static UpVal *newupval (lua_State *L, StkId level, UpVal **prev) {
GCObject *o = luaC_newobj(L, LUA_VUPVAL, sizeof(UpVal));
UpVal *uv = gco2upv(o);
UpVal *next = *prev;
uv->v.p = s2v(level); /* current value lives in the stack */
uv->u.open.next = next; /* link it to list of open upvalues */
uv->u.open.previous = prev;
if (next)
next->u.open.previous = &uv->u.open.next;
*prev = uv;
if (!isintwups(L)) { /* thread not in list of threads with upvalues? */
L->twups = G(L)->twups; /* link it to the list */
G(L)->twups = L;
}
return uv;
}
/*
** Find and reuse, or create if it does not exist, an upvalue
** at the given level.
*/
UpVal *luaF_findupval (lua_State *L, StkId level) {
UpVal **pp = &L->openupval;
GCObject **pp = &L->openupval;
UpVal *p;
lua_assert(isintwups(L) || L->openupval == NULL);
while ((p = *pp) != NULL && uplevel(p) >= level) { /* search for it */
lua_assert(!isdead(G(L), p));
if (uplevel(p) == level) /* corresponding upvalue? */
return p; /* return it */
pp = &p->u.open.next;
UpVal *v;
while ((p = ngcotouv(*pp)) != NULL && p->v >= level) {
if (p->v == level) return p;
pp = &p->next;
}
/* not found: create a new upvalue after 'pp' */
return newupval(L, level, pp);
v = luaM_new(L, UpVal); /* not found: create a new one */
v->tt = LUA_TUPVAL;
v->marked = 1; /* open upvalues should not be collected */
v->v = level; /* current value lives in the stack */
v->next = *pp; /* chain it in the proper position */
*pp = valtogco(v);
return v;
}
/*
** Call closing method for object 'obj' with error object 'err'. The
** boolean 'yy' controls whether the call is yieldable.
** (This function assumes EXTRA_STACK.)
*/
static void callclosemethod (lua_State *L, TValue *obj, TValue *err, int yy) {
StkId top = L->top.p;
StkId func = top;
const TValue *tm = luaT_gettmbyobj(L, obj, TM_CLOSE);
setobj2s(L, top++, tm); /* will call metamethod... */
setobj2s(L, top++, obj); /* with 'self' as the 1st argument */
if (err != NULL) /* if there was an error... */
setobj2s(L, top++, err); /* then error object will be 2nd argument */
L->top.p = top; /* add function and arguments */
if (yy)
luaD_call(L, func, 0);
else
luaD_callnoyield(L, func, 0);
}
/*
** Check whether object at given level has a close metamethod and raise
** an error if not.
*/
static void checkclosemth (lua_State *L, StkId level) {
const TValue *tm = luaT_gettmbyobj(L, s2v(level), TM_CLOSE);
if (ttisnil(tm)) { /* no metamethod? */
int idx = cast_int(level - L->ci->func.p); /* variable index */
const char *vname = luaG_findlocal(L, L->ci, idx, NULL);
if (vname == NULL) vname = "?";
luaG_runerror(L, "variable '%s' got a non-closable value", vname);
void luaF_close (lua_State *L, StkId level) {
UpVal *p;
while ((p = ngcotouv(L->openupval)) != NULL && p->v >= level) {
setobj(&p->value, p->v); /* save current value (write barrier) */
p->v = &p->value; /* now current value lives here */
L->openupval = p->next; /* remove from `open' list */
luaC_link(L, valtogco(p), LUA_TUPVAL);
}
}
/*
** Prepare and call a closing method.
** If status is CLOSEKTOP, the call to the closing method will be pushed
** at the top of the stack. Otherwise, values can be pushed right after
** the 'level' of the upvalue being closed, as everything after that
** won't be used again.
*/
static void prepcallclosemth (lua_State *L, StkId level, TStatus status,
int yy) {
TValue *uv = s2v(level); /* value being closed */
TValue *errobj;
switch (status) {
case LUA_OK:
L->top.p = level + 1; /* call will be at this level */
/* FALLTHROUGH */
case CLOSEKTOP: /* don't need to change top */
errobj = NULL; /* no error object */
break;
default: /* 'luaD_seterrorobj' will set top to level + 2 */
errobj = s2v(level + 1); /* error object goes after 'uv' */
luaD_seterrorobj(L, status, level + 1); /* set error object */
break;
}
callclosemethod(L, uv, errobj, yy);
}
/* Maximum value for deltas in 'tbclist' */
#define MAXDELTA USHRT_MAX
/*
** Insert a variable in the list of to-be-closed variables.
*/
void luaF_newtbcupval (lua_State *L, StkId level) {
lua_assert(level > L->tbclist.p);
if (l_isfalse(s2v(level)))
return; /* false doesn't need to be closed */
checkclosemth(L, level); /* value must have a close method */
while (cast_uint(level - L->tbclist.p) > MAXDELTA) {
L->tbclist.p += MAXDELTA; /* create a dummy node at maximum delta */
L->tbclist.p->tbclist.delta = 0;
}
level->tbclist.delta = cast(unsigned short, level - L->tbclist.p);
L->tbclist.p = level;
}
void luaF_unlinkupval (UpVal *uv) {
lua_assert(upisopen(uv));
*uv->u.open.previous = uv->u.open.next;
if (uv->u.open.next)
uv->u.open.next->u.open.previous = uv->u.open.previous;
}
/*
** Close all upvalues up to the given stack level.
*/
void luaF_closeupval (lua_State *L, StkId level) {
UpVal *uv;
while ((uv = L->openupval) != NULL && uplevel(uv) >= level) {
TValue *slot = &uv->u.value; /* new position for value */
lua_assert(uplevel(uv) < L->top.p);
luaF_unlinkupval(uv); /* remove upvalue from 'openupval' list */
setobj(L, slot, uv->v.p); /* move value to upvalue slot */
uv->v.p = slot; /* now current value lives here */
if (!iswhite(uv)) { /* neither white nor dead? */
nw2black(uv); /* closed upvalues cannot be gray */
luaC_barrier(L, uv, slot);
}
}
}
/*
** Remove first element from the tbclist plus its dummy nodes.
*/
static void poptbclist (lua_State *L) {
StkId tbc = L->tbclist.p;
lua_assert(tbc->tbclist.delta > 0); /* first element cannot be dummy */
tbc -= tbc->tbclist.delta;
while (tbc > L->stack.p && tbc->tbclist.delta == 0)
tbc -= MAXDELTA; /* remove dummy nodes */
L->tbclist.p = tbc;
}
/*
** Close all upvalues and to-be-closed variables up to the given stack
** level. Return restored 'level'.
*/
StkId luaF_close (lua_State *L, StkId level, TStatus status, int yy) {
ptrdiff_t levelrel = savestack(L, level);
luaF_closeupval(L, level); /* first, close the upvalues */
while (L->tbclist.p >= level) { /* traverse tbc's down to that level */
StkId tbc = L->tbclist.p; /* get variable index */
poptbclist(L); /* remove it from list */
prepcallclosemth(L, tbc, status, yy); /* close variable */
level = restorestack(L, levelrel);
}
return level;
}
Proto *luaF_newproto (lua_State *L) {
GCObject *o = luaC_newobj(L, LUA_VPROTO, sizeof(Proto));
Proto *f = gco2p(o);
Proto *f = luaM_new(L, Proto);
luaC_link(L, valtogco(f), LUA_TPROTO);
f->k = NULL;
f->sizek = 0;
f->p = NULL;
f->sizep = 0;
f->code = NULL;
f->sizecode = 0;
f->lineinfo = NULL;
f->sizelineinfo = 0;
f->abslineinfo = NULL;
f->sizeabslineinfo = 0;
f->upvalues = NULL;
f->sizeupvalues = 0;
f->nups = 0;
f->upvalues = NULL;
f->numparams = 0;
f->flag = 0;
f->is_vararg = 0;
f->maxstacksize = 0;
f->locvars = NULL;
f->lineinfo = NULL;
f->sizelocvars = 0;
f->linedefined = 0;
f->lastlinedefined = 0;
f->locvars = NULL;
f->lineDefined = 0;
f->source = NULL;
return f;
}
lu_mem luaF_protosize (Proto *p) {
lu_mem sz = cast(lu_mem, sizeof(Proto))
+ cast_uint(p->sizep) * sizeof(Proto*)
+ cast_uint(p->sizek) * sizeof(TValue)
+ cast_uint(p->sizelocvars) * sizeof(LocVar)
+ cast_uint(p->sizeupvalues) * sizeof(Upvaldesc);
if (!(p->flag & PF_FIXED)) {
sz += cast_uint(p->sizecode) * sizeof(Instruction);
sz += cast_uint(p->sizelineinfo) * sizeof(lu_byte);
sz += cast_uint(p->sizeabslineinfo) * sizeof(AbsLineInfo);
}
return sz;
void luaF_freeproto (lua_State *L, Proto *f) {
luaM_freearray(L, f->code, f->sizecode, Instruction);
luaM_freearray(L, f->p, f->sizep, Proto *);
luaM_freearray(L, f->k, f->sizek, TObject);
luaM_freearray(L, f->lineinfo, f->sizelineinfo, int);
luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar);
luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *);
luaM_freelem(L, f);
}
void luaF_freeproto (lua_State *L, Proto *f) {
if (!(f->flag & PF_FIXED)) {
luaM_freearray(L, f->code, cast_sizet(f->sizecode));
luaM_freearray(L, f->lineinfo, cast_sizet(f->sizelineinfo));
luaM_freearray(L, f->abslineinfo, cast_sizet(f->sizeabslineinfo));
}
luaM_freearray(L, f->p, cast_sizet(f->sizep));
luaM_freearray(L, f->k, cast_sizet(f->sizek));
luaM_freearray(L, f->locvars, cast_sizet(f->sizelocvars));
luaM_freearray(L, f->upvalues, cast_sizet(f->sizeupvalues));
luaM_free(L, f);
void luaF_freeclosure (lua_State *L, Closure *c) {
int size = (c->c.isC) ? sizeCclosure(c->c.nupvalues) :
sizeLclosure(c->l.nupvalues);
luaM_free(L, c, size);
}
/*
** Look for n-th local variable at line 'line' in function 'func'.
** Look for n-th local variable at line `line' in function `func'.
** Returns NULL if not found.
*/
const char *luaF_getlocalname (const Proto *f, int local_number, int pc) {

59
lib/lua/lfunc.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lfunc.h $
** $Id: lfunc.h,v 1.21a 2003/03/18 12:50:04 roberto Exp $
** Auxiliary functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
@ -11,55 +11,22 @@
#include "lobject.h"
#define sizeCclosure(n) \
(offsetof(CClosure, upvalue) + sizeof(TValue) * cast_uint(n))
#define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \
cast(int, sizeof(TObject)*((n)-1)))
#define sizeLclosure(n) \
(offsetof(LClosure, upvals) + sizeof(UpVal *) * cast_uint(n))
#define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \
cast(int, sizeof(TObject *)*((n)-1)))
/* test whether thread is in 'twups' list */
#define isintwups(L) (L->twups != L)
Proto *luaF_newproto (lua_State *L);
Closure *luaF_newCclosure (lua_State *L, int nelems);
Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *e);
UpVal *luaF_findupval (lua_State *L, StkId level);
void luaF_close (lua_State *L, StkId level);
void luaF_freeproto (lua_State *L, Proto *f);
void luaF_freeclosure (lua_State *L, Closure *c);
/*
** maximum number of upvalues in a closure (both C and Lua). (Value
** must fit in a VM register.)
*/
#define MAXUPVAL 255
#define upisopen(up) ((up)->v.p != &(up)->u.value)
#define uplevel(up) check_exp(upisopen(up), cast(StkId, (up)->v.p))
/*
** maximum number of misses before giving up the cache of closures
** in prototypes
*/
#define MAXMISS 10
/* special status to close upvalues preserving the top of the stack */
#define CLOSEKTOP (LUA_ERRERR + 1)
LUAI_FUNC Proto *luaF_newproto (lua_State *L);
LUAI_FUNC CClosure *luaF_newCclosure (lua_State *L, int nupvals);
LUAI_FUNC LClosure *luaF_newLclosure (lua_State *L, int nupvals);
LUAI_FUNC void luaF_initupvals (lua_State *L, LClosure *cl);
LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level);
LUAI_FUNC void luaF_newtbcupval (lua_State *L, StkId level);
LUAI_FUNC void luaF_closeupval (lua_State *L, StkId level);
LUAI_FUNC StkId luaF_close (lua_State *L, StkId level, TStatus status, int yy);
LUAI_FUNC void luaF_unlinkupval (UpVal *uv);
LUAI_FUNC lu_mem luaF_protosize (Proto *p);
LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f);
LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number,
int pc);
const char *luaF_getlocalname (const Proto *func, int local_number, int pc);
#endif

2055
lib/lua/lgc.c
View File

File diff suppressed because it is too large Load Diff

259
lib/lua/lgc.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lgc.h $
** $Id: lgc.h,v 1.19a 2003/02/28 19:45:15 roberto Exp $
** Garbage Collector
** See Copyright Notice in lua.h
*/
@ -8,261 +8,18 @@
#define lgc_h
#include <stddef.h>
#include "lobject.h"
#include "lstate.h"
/*
** Collectable objects may have one of three colors: white, which means
** the object is not marked; gray, which means the object is marked, but
** its references may be not marked; and black, which means that the
** object and all its references are marked. The main invariant of the
** garbage collector, while marking objects, is that a black object can
** never point to a white one. Moreover, any gray object must be in a
** "gray list" (gray, grayagain, weak, allweak, ephemeron) so that it
** can be visited again before finishing the collection cycle. (Open
** upvalues are an exception to this rule, as they are attached to
** a corresponding thread.) These lists have no meaning when the
** invariant is not being enforced (e.g., sweep phase).
*/
/*
** Possible states of the Garbage Collector
*/
#define GCSpropagate 0
#define GCSenteratomic 1
#define GCSatomic 2
#define GCSswpallgc 3
#define GCSswpfinobj 4
#define GCSswptobefnz 5
#define GCSswpend 6
#define GCScallfin 7
#define GCSpause 8
#define luaC_checkGC(L) { lua_assert(!(L->ci->state & CI_CALLING)); \
if (G(L)->nblocks >= G(L)->GCthreshold) luaC_collectgarbage(L); }
#define issweepphase(g) \
(GCSswpallgc <= (g)->gcstate && (g)->gcstate <= GCSswpend)
/*
** macro to tell when main invariant (white objects cannot point to black
** ones) must be kept. During a collection, the sweep phase may break
** the invariant, as objects turned white may point to still-black
** objects. The invariant is restored when sweep ends and all objects
** are white again.
*/
#define keepinvariant(g) ((g)->gcstate <= GCSatomic)
/*
** some useful bit tricks
*/
#define resetbits(x,m) ((x) &= cast_byte(~(m)))
#define setbits(x,m) ((x) |= (m))
#define testbits(x,m) ((x) & (m))
#define bitmask(b) (1<<(b))
#define bit2mask(b1,b2) (bitmask(b1) | bitmask(b2))
#define l_setbit(x,b) setbits(x, bitmask(b))
#define resetbit(x,b) resetbits(x, bitmask(b))
#define testbit(x,b) testbits(x, bitmask(b))
/*
** Layout for bit use in 'marked' field. First three bits are
** used for object "age" in generational mode. Last bit is used
** by tests.
*/
#define WHITE0BIT 3 /* object is white (type 0) */
#define WHITE1BIT 4 /* object is white (type 1) */
#define BLACKBIT 5 /* object is black */
#define FINALIZEDBIT 6 /* object has been marked for finalization */
#define TESTBIT 7
#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT)
#define iswhite(x) testbits((x)->marked, WHITEBITS)
#define isblack(x) testbit((x)->marked, BLACKBIT)
#define isgray(x) /* neither white nor black */ \
(!testbits((x)->marked, WHITEBITS | bitmask(BLACKBIT)))
#define tofinalize(x) testbit((x)->marked, FINALIZEDBIT)
#define otherwhite(g) ((g)->currentwhite ^ WHITEBITS)
#define isdeadm(ow,m) ((m) & (ow))
#define isdead(g,v) isdeadm(otherwhite(g), (v)->marked)
#define changewhite(x) ((x)->marked ^= WHITEBITS)
#define nw2black(x) \
check_exp(!iswhite(x), l_setbit((x)->marked, BLACKBIT))
#define luaC_white(g) cast_byte((g)->currentwhite & WHITEBITS)
/* object age in generational mode */
#define G_NEW 0 /* created in current cycle */
#define G_SURVIVAL 1 /* created in previous cycle */
#define G_OLD0 2 /* marked old by frw. barrier in this cycle */
#define G_OLD1 3 /* first full cycle as old */
#define G_OLD 4 /* really old object (not to be visited) */
#define G_TOUCHED1 5 /* old object touched this cycle */
#define G_TOUCHED2 6 /* old object touched in previous cycle */
#define AGEBITS 7 /* all age bits (111) */
#define getage(o) ((o)->marked & AGEBITS)
#define setage(o,a) ((o)->marked = cast_byte(((o)->marked & (~AGEBITS)) | a))
#define isold(o) (getage(o) > G_SURVIVAL)
/*
** In generational mode, objects are created 'new'. After surviving one
** cycle, they become 'survival'. Both 'new' and 'survival' can point
** to any other object, as they are traversed at the end of the cycle.
** We call them both 'young' objects.
** If a survival object survives another cycle, it becomes 'old1'.
** 'old1' objects can still point to survival objects (but not to
** new objects), so they still must be traversed. After another cycle
** (that, being old, 'old1' objects will "survive" no matter what)
** finally the 'old1' object becomes really 'old', and then they
** are no more traversed.
**
** To keep its invariants, the generational mode uses the same barriers
** also used by the incremental mode. If a young object is caught in a
** forward barrier, it cannot become old immediately, because it can
** still point to other young objects. Instead, it becomes 'old0',
** which in the next cycle becomes 'old1'. So, 'old0' objects is
** old but can point to new and survival objects; 'old1' is old
** but cannot point to new objects; and 'old' cannot point to any
** young object.
**
** If any old object ('old0', 'old1', 'old') is caught in a back
** barrier, it becomes 'touched1' and goes into a gray list, to be
** visited at the end of the cycle. There it evolves to 'touched2',
** which can point to survivals but not to new objects. In yet another
** cycle then it becomes 'old' again.
**
** The generational mode must also control the colors of objects,
** because of the barriers. While the mutator is running, young objects
** are kept white. 'old', 'old1', and 'touched2' objects are kept black,
** as they cannot point to new objects; exceptions are threads and open
** upvalues, which age to 'old1' and 'old' but are kept gray. 'old0'
** objects may be gray or black, as in the incremental mode. 'touched1'
** objects are kept gray, as they must be visited again at the end of
** the cycle.
*/
/*
** {======================================================
** Default Values for GC parameters
** =======================================================
*/
/*
** Minor collections will shift to major ones after LUAI_MINORMAJOR%
** bytes become old.
*/
#define LUAI_MINORMAJOR 70
/*
** Major collections will shift to minor ones after a collection
** collects at least LUAI_MAJORMINOR% of the new bytes.
*/
#define LUAI_MAJORMINOR 50
/*
** A young (minor) collection will run after creating LUAI_GENMINORMUL%
** new bytes.
*/
#define LUAI_GENMINORMUL 20
/* incremental */
/* Number of bytes must be LUAI_GCPAUSE% before starting new cycle */
#define LUAI_GCPAUSE 250
/*
** Step multiplier: The collector handles LUAI_GCMUL% work units for
** each new allocated word. (Each "work unit" corresponds roughly to
** sweeping one object or traversing one slot.)
*/
#define LUAI_GCMUL 200
/* How many bytes to allocate before next GC step */
#define LUAI_GCSTEPSIZE (200 * sizeof(Table))
#define setgcparam(g,p,v) (g->gcparams[LUA_GCP##p] = luaO_codeparam(v))
#define applygcparam(g,p,x) luaO_applyparam(g->gcparams[LUA_GCP##p], x)
/* }====================================================== */
/*
** Control when GC is running:
*/
#define GCSTPUSR 1 /* bit true when GC stopped by user */
#define GCSTPGC 2 /* bit true when GC stopped by itself */
#define GCSTPCLS 4 /* bit true when closing Lua state */
#define gcrunning(g) ((g)->gcstp == 0)
/*
** Does one step of collection when debt becomes zero. 'pre'/'pos'
** allows some adjustments to be done only when needed. macro
** 'condchangemem' is used only for heavy tests (forcing a full
** GC cycle on every opportunity)
*/
#if !defined(HARDMEMTESTS)
#define condchangemem(L,pre,pos,emg) ((void)0)
#else
#define condchangemem(L,pre,pos,emg) \
{ if (gcrunning(G(L))) { pre; luaC_fullgc(L, emg); pos; } }
#endif
#define luaC_condGC(L,pre,pos) \
{ if (G(L)->GCdebt <= 0) { pre; luaC_step(L); pos;}; \
condchangemem(L,pre,pos,0); }
/* more often than not, 'pre'/'pos' are empty */
#define luaC_checkGC(L) luaC_condGC(L,(void)0,(void)0)
#define luaC_objbarrier(L,p,o) ( \
(isblack(p) && iswhite(o)) ? \
luaC_barrier_(L,obj2gco(p),obj2gco(o)) : cast_void(0))
#define luaC_barrier(L,p,v) ( \
iscollectable(v) ? luaC_objbarrier(L,p,gcvalue(v)) : cast_void(0))
#define luaC_objbarrierback(L,p,o) ( \
(isblack(p) && iswhite(o)) ? luaC_barrierback_(L,p) : cast_void(0))
#define luaC_barrierback(L,p,v) ( \
iscollectable(v) ? luaC_objbarrierback(L, p, gcvalue(v)) : cast_void(0))
LUAI_FUNC void luaC_fix (lua_State *L, GCObject *o);
LUAI_FUNC void luaC_freeallobjects (lua_State *L);
LUAI_FUNC void luaC_step (lua_State *L);
LUAI_FUNC void luaC_runtilstate (lua_State *L, int state, int fast);
LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
LUAI_FUNC GCObject *luaC_newobj (lua_State *L, lu_byte tt, size_t sz);
LUAI_FUNC GCObject *luaC_newobjdt (lua_State *L, lu_byte tt, size_t sz,
size_t offset);
LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v);
LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o);
LUAI_FUNC void luaC_checkfinalizer (lua_State *L, GCObject *o, Table *mt);
LUAI_FUNC void luaC_changemode (lua_State *L, int newmode);
size_t luaC_separateudata (lua_State *L);
void luaC_callGCTM (lua_State *L);
void luaC_sweep (lua_State *L, int all);
void luaC_collectgarbage (lua_State *L);
void luaC_link (lua_State *L, GCObject *o, lu_byte tt);
#endif

63
lib/lua/linit.c
View File

@ -1,63 +0,0 @@
/*
** $Id: linit.c $
** Initialization of libraries for lua.c and other clients
** See Copyright Notice in lua.h
*/
#define linit_c
#define LUA_LIB
#include "lprefix.h"
#include <stddef.h>
#include "lua.h"
#include "lualib.h"
#include "lauxlib.h"
#include "llimits.h"
/*
** Standard Libraries. (Must be listed in the same ORDER of their
** respective constants LUA_<libname>K.)
*/
static const luaL_Reg stdlibs[] = {
{LUA_GNAME, luaopen_base},
{LUA_LOADLIBNAME, luaopen_package},
{LUA_COLIBNAME, luaopen_coroutine},
{LUA_DBLIBNAME, luaopen_debug},
{LUA_IOLIBNAME, luaopen_io},
{LUA_MATHLIBNAME, luaopen_math},
{LUA_OSLIBNAME, luaopen_os},
{LUA_STRLIBNAME, luaopen_string},
{LUA_TABLIBNAME, luaopen_table},
{LUA_UTF8LIBNAME, luaopen_utf8},
{NULL, NULL}
};
/*
** require and preload selected standard libraries
*/
LUALIB_API void luaL_openselectedlibs (lua_State *L, int load, int preload) {
int mask;
const luaL_Reg *lib;
luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
for (lib = stdlibs, mask = 1; lib->name != NULL; lib++, mask <<= 1) {
if (load & mask) { /* selected? */
luaL_requiref(L, lib->name, lib->func, 1); /* require library */
lua_pop(L, 1); /* remove result from the stack */
}
else if (preload & mask) { /* selected? */
lua_pushcfunction(L, lib->func);
lua_setfield(L, -2, lib->name); /* add library to PRELOAD table */
}
}
lua_assert((mask >> 1) == LUA_UTF8LIBK);
lua_pop(L, 1); /* remove PRELOAD table */
}

1057
lib/lua/liolib.c
View File

File diff suppressed because it is too large Load Diff

114
lib/lua/ljumptab.h
View File

@ -1,114 +0,0 @@
/*
** $Id: ljumptab.h $
** Jump Table for the Lua interpreter
** See Copyright Notice in lua.h
*/
#undef vmdispatch
#undef vmcase
#undef vmbreak
#define vmdispatch(x) goto *disptab[x];
#define vmcase(l) L_##l:
#define vmbreak vmfetch(); vmdispatch(GET_OPCODE(i));
static const void *const disptab[NUM_OPCODES] = {
#if 0
** you can update the following list with this command:
**
** sed -n '/^OP_/!d; s/OP_/\&\&L_OP_/ ; s/,.*/,/ ; s/\/.*// ; p' lopcodes.h
**
#endif
&&L_OP_MOVE,
&&L_OP_LOADI,
&&L_OP_LOADF,
&&L_OP_LOADK,
&&L_OP_LOADKX,
&&L_OP_LOADFALSE,
&&L_OP_LFALSESKIP,
&&L_OP_LOADTRUE,
&&L_OP_LOADNIL,
&&L_OP_GETUPVAL,
&&L_OP_SETUPVAL,
&&L_OP_GETTABUP,
&&L_OP_GETTABLE,
&&L_OP_GETI,
&&L_OP_GETFIELD,
&&L_OP_SETTABUP,
&&L_OP_SETTABLE,
&&L_OP_SETI,
&&L_OP_SETFIELD,
&&L_OP_NEWTABLE,
&&L_OP_SELF,
&&L_OP_ADDI,
&&L_OP_ADDK,
&&L_OP_SUBK,
&&L_OP_MULK,
&&L_OP_MODK,
&&L_OP_POWK,
&&L_OP_DIVK,
&&L_OP_IDIVK,
&&L_OP_BANDK,
&&L_OP_BORK,
&&L_OP_BXORK,
&&L_OP_SHLI,
&&L_OP_SHRI,
&&L_OP_ADD,
&&L_OP_SUB,
&&L_OP_MUL,
&&L_OP_MOD,
&&L_OP_POW,
&&L_OP_DIV,
&&L_OP_IDIV,
&&L_OP_BAND,
&&L_OP_BOR,
&&L_OP_BXOR,
&&L_OP_SHL,
&&L_OP_SHR,
&&L_OP_MMBIN,
&&L_OP_MMBINI,
&&L_OP_MMBINK,
&&L_OP_UNM,
&&L_OP_BNOT,
&&L_OP_NOT,
&&L_OP_LEN,
&&L_OP_CONCAT,
&&L_OP_CLOSE,
&&L_OP_TBC,
&&L_OP_JMP,
&&L_OP_EQ,
&&L_OP_LT,
&&L_OP_LE,
&&L_OP_EQK,
&&L_OP_EQI,
&&L_OP_LTI,
&&L_OP_LEI,
&&L_OP_GTI,
&&L_OP_GEI,
&&L_OP_TEST,
&&L_OP_TESTSET,
&&L_OP_CALL,
&&L_OP_TAILCALL,
&&L_OP_RETURN,
&&L_OP_RETURN0,
&&L_OP_RETURN1,
&&L_OP_FORLOOP,
&&L_OP_FORPREP,
&&L_OP_TFORPREP,
&&L_OP_TFORCALL,
&&L_OP_TFORLOOP,
&&L_OP_SETLIST,
&&L_OP_CLOSURE,
&&L_OP_VARARG,
&&L_OP_GETVARG,
&&L_OP_ERRNNIL,
&&L_OP_VARARGPREP,
&&L_OP_EXTRAARG
};

793
lib/lua/llex.c
View File

@ -1,202 +1,138 @@
/*
** $Id: llex.c $
** $Id: llex.c,v 1.119 2003/03/24 12:39:34 roberto Exp $
** Lexical Analyzer
** See Copyright Notice in lua.h
*/
#define llex_c
#define LUA_CORE
#include "lprefix.h"
#include <locale.h>
#include <ctype.h>
#include <string.h>
#define llex_c
#include "lua.h"
#include "lctype.h"
#include "ldebug.h"
#include "ldo.h"
#include "lgc.h"
#include "llex.h"
#include "lobject.h"
#include "lparser.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "lzio.h"
#define next(ls) (ls->current = zgetc(ls->z))
#define next(LS) (LS->current = zgetc(LS->z))
/* minimum size for string buffer */
#if !defined(LUA_MINBUFFER)
#define LUA_MINBUFFER 32
#endif
#define currIsNewline(ls) (ls->current == '\n' || ls->current == '\r')
/* ORDER RESERVED */
static const char *const luaX_tokens [] = {
static const char *const token2string [] = {
"and", "break", "do", "else", "elseif",
"end", "false", "for", "function", "global", "goto", "if",
"end", "false", "for", "function", "if",
"in", "local", "nil", "not", "or", "repeat",
"return", "then", "true", "until", "while",
"//", "..", "...", "==", ">=", "<=", "~=",
"<<", ">>", "::", "<eof>",
"<number>", "<integer>", "<name>", "<string>"
"return", "then", "true", "until", "while", "*name",
"..", "...", "==", ">=", "<=", "~=",
"*number", "*string", "<eof>"
};
#define save_and_next(ls) (save(ls, ls->current), next(ls))
static l_noret lexerror (LexState *ls, const char *msg, int token);
static void save (LexState *ls, int c) {
Mbuffer *b = ls->buff;
if (luaZ_bufflen(b) + 1 > luaZ_sizebuffer(b)) {
size_t newsize = luaZ_sizebuffer(b); /* get old size */;
if (newsize >= (MAX_SIZE/3 * 2)) /* larger than MAX_SIZE/1.5 ? */
lexerror(ls, "lexical element too long", 0);
newsize += (newsize >> 1); /* new size is 1.5 times the old one */
luaZ_resizebuffer(ls->L, b, newsize);
}
b->buffer[luaZ_bufflen(b)++] = cast_char(c);
}
void luaX_init (lua_State *L) {
int i;
TString *e = luaS_newliteral(L, LUA_ENV); /* create env name */
luaC_fix(L, obj2gco(e)); /* never collect this name */
for (i=0; i<NUM_RESERVED; i++) {
TString *ts = luaS_new(L, luaX_tokens[i]);
luaC_fix(L, obj2gco(ts)); /* reserved words are never collected */
ts->extra = cast_byte(i+1); /* reserved word */
TString *ts = luaS_new(L, token2string[i]);
luaS_fix(ts); /* reserved words are never collected */
lua_assert(strlen(token2string[i])+1 <= TOKEN_LEN);
ts->tsv.reserved = cast(lu_byte, i+1); /* reserved word */
}
}
#define MAXSRC 80
void luaX_checklimit (LexState *ls, int val, int limit, const char *msg) {
if (val > limit) {
msg = luaO_pushfstring(ls->L, "too many %s (limit=%d)", msg, limit);
luaX_syntaxerror(ls, msg);
}
}
void luaX_errorline (LexState *ls, const char *s, const char *token, int line) {
lua_State *L = ls->L;
char buff[MAXSRC];
luaO_chunkid(buff, getstr(ls->source), MAXSRC);
luaO_pushfstring(L, "%s:%d: %s near `%s'", buff, line, s, token);
luaD_throw(L, LUA_ERRSYNTAX);
}
static void luaX_error (LexState *ls, const char *s, const char *token) {
luaX_errorline(ls, s, token, ls->linenumber);
}
void luaX_syntaxerror (LexState *ls, const char *msg) {
const char *lasttoken;
switch (ls->t.token) {
case TK_NAME:
lasttoken = getstr(ls->t.seminfo.ts);
break;
case TK_STRING:
case TK_NUMBER:
lasttoken = luaZ_buffer(ls->buff);
break;
default:
lasttoken = luaX_token2str(ls, ls->t.token);
break;
}
luaX_error(ls, msg, lasttoken);
}
const char *luaX_token2str (LexState *ls, int token) {
if (token < FIRST_RESERVED) { /* single-byte symbols? */
if (lisprint(token))
return luaO_pushfstring(ls->L, "'%c'", token);
else /* control character */
return luaO_pushfstring(ls->L, "'<\\%d>'", token);
if (token < FIRST_RESERVED) {
lua_assert(token == (unsigned char)token);
return luaO_pushfstring(ls->L, "%c", token);
}
else {
const char *s = luaX_tokens[token - FIRST_RESERVED];
if (token < TK_EOS) /* fixed format (symbols and reserved words)? */
return luaO_pushfstring(ls->L, "'%s'", s);
else /* names, strings, and numerals */
return s;
else
return token2string[token-FIRST_RESERVED];
}
static void luaX_lexerror (LexState *ls, const char *s, int token) {
if (token == TK_EOS)
luaX_error(ls, s, luaX_token2str(ls, token));
else
luaX_error(ls, s, luaZ_buffer(ls->buff));
}
static void inclinenumber (LexState *LS) {
next(LS); /* skip `\n' */
++LS->linenumber;
luaX_checklimit(LS, LS->linenumber, MAX_INT, "lines in a chunk");
}
void luaX_setinput (lua_State *L, LexState *LS, ZIO *z, TString *source) {
LS->L = L;
LS->lookahead.token = TK_EOS; /* no look-ahead token */
LS->z = z;
LS->fs = NULL;
LS->linenumber = 1;
LS->lastline = 1;
LS->source = source;
next(LS); /* read first char */
if (LS->current == '#') {
do { /* skip first line */
next(LS);
} while (LS->current != '\n' && LS->current != EOZ);
}
}
static const char *txtToken (LexState *ls, int token) {
switch (token) {
case TK_NAME: case TK_STRING:
case TK_FLT: case TK_INT:
save(ls, '\0');
return luaO_pushfstring(ls->L, "'%s'", luaZ_buffer(ls->buff));
default:
return luaX_token2str(ls, token);
}
}
static l_noret lexerror (LexState *ls, const char *msg, int token) {
msg = luaG_addinfo(ls->L, msg, ls->source, ls->linenumber);
if (token)
luaO_pushfstring(ls->L, "%s near %s", msg, txtToken(ls, token));
luaD_throw(ls->L, LUA_ERRSYNTAX);
}
l_noret luaX_syntaxerror (LexState *ls, const char *msg) {
lexerror(ls, msg, ls->t.token);
}
/*
** Anchors a string in scanner's table so that it will not be collected
** until the end of the compilation; by that time it should be anchored
** somewhere. It also internalizes long strings, ensuring there is only
** one copy of each unique string.
*/
static TString *anchorstr (LexState *ls, TString *ts) {
lua_State *L = ls->L;
TValue oldts;
int tag = luaH_getstr(ls->h, ts, &oldts);
if (!tagisempty(tag)) /* string already present? */
return tsvalue(&oldts); /* use stored value */
else { /* create a new entry */
TValue *stv = s2v(L->top.p++); /* reserve stack space for string */
setsvalue(L, stv, ts); /* push (anchor) the string on the stack */
luaH_set(L, ls->h, stv, stv); /* t[string] = string */
/* table is not a metatable, so it does not need to invalidate cache */
luaC_checkGC(L);
L->top.p--; /* remove string from stack */
return ts;
}
}
/*
** Creates a new string and anchors it in scanner's table.
*/
TString *luaX_newstring (LexState *ls, const char *str, size_t l) {
return anchorstr(ls, luaS_newlstr(ls->L, str, l));
}
/*
** increment line number and skips newline sequence (any of
** \n, \r, \n\r, or \r\n)
*/
static void inclinenumber (LexState *ls) {
int old = ls->current;
lua_assert(currIsNewline(ls));
next(ls); /* skip '\n' or '\r' */
if (currIsNewline(ls) && ls->current != old)
next(ls); /* skip '\n\r' or '\r\n' */
if (++ls->linenumber >= INT_MAX)
lexerror(ls, "chunk has too many lines", 0);
}
void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source,
int firstchar) {
ls->t.token = 0;
ls->L = L;
ls->current = firstchar;
ls->lookahead.token = TK_EOS; /* no look-ahead token */
ls->z = z;
ls->fs = NULL;
ls->linenumber = 1;
ls->lastline = 1;
ls->source = source;
/* all three strings here ("_ENV", "break", "global") were fixed,
so they cannot be collected */
ls->envn = luaS_newliteral(L, LUA_ENV); /* get env string */
ls->brkn = luaS_newliteral(L, "break"); /* get "break" string */
#if LUA_COMPAT_GLOBAL
/* compatibility mode: "global" is not a reserved word */
ls->glbn = luaS_newliteral(L, "global"); /* get "global" string */
ls->glbn->extra = 0; /* mark it as not reserved */
#endif
luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */
}
/*
** =======================================================
@ -205,400 +141,277 @@ void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source,
*/
static int check_next1 (LexState *ls, int c) {
if (ls->current == c) {
next(ls);
return 1;
}
else return 0;
}
/* use buffer to store names, literal strings and numbers */
/* extra space to allocate when growing buffer */
#define EXTRABUFF 32
/* maximum number of chars that can be read without checking buffer size */
#define MAXNOCHECK 5
#define checkbuffer(LS, len) \
if (((len)+MAXNOCHECK)*sizeof(char) > luaZ_sizebuffer((LS)->buff)) \
luaZ_openspace((LS)->L, (LS)->buff, (len)+EXTRABUFF)
#define save(LS, c, l) \
(luaZ_buffer((LS)->buff)[l++] = cast(char, c))
#define save_and_next(LS, l) (save(LS, LS->current, l), next(LS))
/*
** Check whether current char is in set 'set' (with two chars) and
** saves it
*/
static int check_next2 (LexState *ls, const char *set) {
lua_assert(set[2] == '\0');
if (ls->current == set[0] || ls->current == set[1]) {
save_and_next(ls);
return 1;
}
else return 0;
static size_t readname (LexState *LS) {
size_t l = 0;
checkbuffer(LS, l);
do {
checkbuffer(LS, l);
save_and_next(LS, l);
} while (isalnum(LS->current) || LS->current == '_');
save(LS, '\0', l);
return l-1;
}
/* LUA_NUMBER */
/*
** This function is quite liberal in what it accepts, as 'luaO_str2num'
** will reject ill-formed numerals. Roughly, it accepts the following
** pattern:
**
** %d(%x|%.|([Ee][+-]?))* | 0[Xx](%x|%.|([Pp][+-]?))*
**
** The only tricky part is to accept [+-] only after a valid exponent
** mark, to avoid reading '3-4' or '0xe+1' as a single number.
**
** The caller might have already read an initial dot.
*/
static int read_numeral (LexState *ls, SemInfo *seminfo) {
TValue obj;
const char *expo = "Ee";
int first = ls->current;
lua_assert(lisdigit(ls->current));
save_and_next(ls);
if (first == '0' && check_next2(ls, "xX")) /* hexadecimal? */
expo = "Pp";
for (;;) {
if (check_next2(ls, expo)) /* exponent mark? */
check_next2(ls, "-+"); /* optional exponent sign */
else if (lisxdigit(ls->current) || ls->current == '.') /* '%x|%.' */
save_and_next(ls);
else break;
static void read_numeral (LexState *LS, int comma, SemInfo *seminfo) {
size_t l = 0;
checkbuffer(LS, l);
if (comma) save(LS, '.', l);
while (isdigit(LS->current)) {
checkbuffer(LS, l);
save_and_next(LS, l);
}
if (lislalpha(ls->current)) /* is numeral touching a letter? */
save_and_next(ls); /* force an error */
save(ls, '\0');
if (luaO_str2num(luaZ_buffer(ls->buff), &obj) == 0) /* format error? */
lexerror(ls, "malformed number", TK_FLT);
if (ttisinteger(&obj)) {
seminfo->i = ivalue(&obj);
return TK_INT;
if (LS->current == '.') {
save_and_next(LS, l);
if (LS->current == '.') {
save_and_next(LS, l);
save(LS, '\0', l);
luaX_lexerror(LS,
"ambiguous syntax (decimal point x string concatenation)",
TK_NUMBER);
}
}
else {
lua_assert(ttisfloat(&obj));
seminfo->r = fltvalue(&obj);
return TK_FLT;
while (isdigit(LS->current)) {
checkbuffer(LS, l);
save_and_next(LS, l);
}
if (LS->current == 'e' || LS->current == 'E') {
save_and_next(LS, l); /* read `E' */
if (LS->current == '+' || LS->current == '-')
save_and_next(LS, l); /* optional exponent sign */
while (isdigit(LS->current)) {
checkbuffer(LS, l);
save_and_next(LS, l);
}
}
save(LS, '\0', l);
if (!luaO_str2d(luaZ_buffer(LS->buff), &seminfo->r))
luaX_lexerror(LS, "malformed number", TK_NUMBER);
}
/*
** read a sequence '[=*[' or ']=*]', leaving the last bracket. If
** sequence is well formed, return its number of '='s + 2; otherwise,
** return 1 if it is a single bracket (no '='s and no 2nd bracket);
** otherwise (an unfinished '[==...') return 0.
*/
static size_t skip_sep (LexState *ls) {
size_t count = 0;
int s = ls->current;
lua_assert(s == '[' || s == ']');
save_and_next(ls);
while (ls->current == '=') {
save_and_next(ls);
count++;
}
return (ls->current == s) ? count + 2
: (count == 0) ? 1
: 0;
}
static void read_long_string (LexState *ls, SemInfo *seminfo, size_t sep) {
int line = ls->linenumber; /* initial line (for error message) */
save_and_next(ls); /* skip 2nd '[' */
if (currIsNewline(ls)) /* string starts with a newline? */
inclinenumber(ls); /* skip it */
static void read_long_string (LexState *LS, SemInfo *seminfo) {
int cont = 0;
size_t l = 0;
checkbuffer(LS, l);
save(LS, '[', l); /* save first `[' */
save_and_next(LS, l); /* pass the second `[' */
if (LS->current == '\n') /* string starts with a newline? */
inclinenumber(LS); /* skip it */
for (;;) {
switch (ls->current) {
case EOZ: { /* error */
const char *what = (seminfo ? "string" : "comment");
const char *msg = luaO_pushfstring(ls->L,
"unfinished long %s (starting at line %d)", what, line);
lexerror(ls, msg, TK_EOS);
checkbuffer(LS, l);
switch (LS->current) {
case EOZ:
save(LS, '\0', l);
luaX_lexerror(LS, (seminfo) ? "unfinished long string" :
"unfinished long comment", TK_EOS);
break; /* to avoid warnings */
}
case ']': {
if (skip_sep(ls) == sep) {
save_and_next(ls); /* skip 2nd ']' */
goto endloop;
case '[':
save_and_next(LS, l);
if (LS->current == '[') {
cont++;
save_and_next(LS, l);
}
break;
}
case '\n': case '\r': {
save(ls, '\n');
inclinenumber(ls);
if (!seminfo) luaZ_resetbuffer(ls->buff); /* avoid wasting space */
break;
}
default: {
if (seminfo) save_and_next(ls);
else next(ls);
}
continue;
case ']':
save_and_next(LS, l);
if (LS->current == ']') {
if (cont == 0) goto endloop;
cont--;
save_and_next(LS, l);
}
continue;
case '\n':
save(LS, '\n', l);
inclinenumber(LS);
if (!seminfo) l = 0; /* reset buffer to avoid wasting space */
continue;
default:
save_and_next(LS, l);
}
} endloop:
save_and_next(LS, l); /* skip the second `]' */
save(LS, '\0', l);
if (seminfo)
seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + sep,
luaZ_bufflen(ls->buff) - 2 * sep);
seminfo->ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff) + 2, l - 5);
}
static void esccheck (LexState *ls, int c, const char *msg) {
if (!c) {
if (ls->current != EOZ)
save_and_next(ls); /* add current to buffer for error message */
lexerror(ls, msg, TK_STRING);
}
}
static int gethexa (LexState *ls) {
save_and_next(ls);
esccheck (ls, lisxdigit(ls->current), "hexadecimal digit expected");
return luaO_hexavalue(ls->current);
}
static int readhexaesc (LexState *ls) {
int r = gethexa(ls);
r = (r << 4) + gethexa(ls);
luaZ_buffremove(ls->buff, 2); /* remove saved chars from buffer */
return r;
}
/*
** When reading a UTF-8 escape sequence, save everything to the buffer
** for error reporting in case of errors; 'i' counts the number of
** saved characters, so that they can be removed if case of success.
*/
static l_uint32 readutf8esc (LexState *ls) {
l_uint32 r;
int i = 4; /* number of chars to be removed: start with #"\u{X" */
save_and_next(ls); /* skip 'u' */
esccheck(ls, ls->current == '{', "missing '{'");
r = cast_uint(gethexa(ls)); /* must have at least one digit */
while (cast_void(save_and_next(ls)), lisxdigit(ls->current)) {
i++;
esccheck(ls, r <= (0x7FFFFFFFu >> 4), "UTF-8 value too large");
r = (r << 4) + luaO_hexavalue(ls->current);
}
esccheck(ls, ls->current == '}', "missing '}'");
next(ls); /* skip '}' */
luaZ_buffremove(ls->buff, i); /* remove saved chars from buffer */
return r;
}
static void utf8esc (LexState *ls) {
char buff[UTF8BUFFSZ];
int n = luaO_utf8esc(buff, readutf8esc(ls));
for (; n > 0; n--) /* add 'buff' to string */
save(ls, buff[UTF8BUFFSZ - n]);
}
static int readdecesc (LexState *ls) {
int i;
int r = 0; /* result accumulator */
for (i = 0; i < 3 && lisdigit(ls->current); i++) { /* read up to 3 digits */
r = 10*r + ls->current - '0';
save_and_next(ls);
}
esccheck(ls, r <= UCHAR_MAX, "decimal escape too large");
luaZ_buffremove(ls->buff, i); /* remove read digits from buffer */
return r;
}
static void read_string (LexState *ls, int del, SemInfo *seminfo) {
save_and_next(ls); /* keep delimiter (for error messages) */
while (ls->current != del) {
switch (ls->current) {
static void read_string (LexState *LS, int del, SemInfo *seminfo) {
size_t l = 0;
checkbuffer(LS, l);
save_and_next(LS, l);
while (LS->current != del) {
checkbuffer(LS, l);
switch (LS->current) {
case EOZ:
lexerror(ls, "unfinished string", TK_EOS);
save(LS, '\0', l);
luaX_lexerror(LS, "unfinished string", TK_EOS);
break; /* to avoid warnings */
case '\n':
case '\r':
lexerror(ls, "unfinished string", TK_STRING);
save(LS, '\0', l);
luaX_lexerror(LS, "unfinished string", TK_STRING);
break; /* to avoid warnings */
case '\\': { /* escape sequences */
int c; /* final character to be saved */
save_and_next(ls); /* keep '\\' for error messages */
switch (ls->current) {
case 'a': c = '\a'; goto read_save;
case 'b': c = '\b'; goto read_save;
case 'f': c = '\f'; goto read_save;
case 'n': c = '\n'; goto read_save;
case 'r': c = '\r'; goto read_save;
case 't': c = '\t'; goto read_save;
case 'v': c = '\v'; goto read_save;
case 'x': c = readhexaesc(ls); goto read_save;
case 'u': utf8esc(ls); goto no_save;
case '\n': case '\r':
inclinenumber(ls); c = '\n'; goto only_save;
case '\\': case '\"': case '\'':
c = ls->current; goto read_save;
case EOZ: goto no_save; /* will raise an error next loop */
case 'z': { /* zap following span of spaces */
luaZ_buffremove(ls->buff, 1); /* remove '\\' */
next(ls); /* skip the 'z' */
while (lisspace(ls->current)) {
if (currIsNewline(ls)) inclinenumber(ls);
else next(ls);
}
goto no_save;
}
case '\\':
next(LS); /* do not save the `\' */
switch (LS->current) {
case 'a': save(LS, '\a', l); next(LS); break;
case 'b': save(LS, '\b', l); next(LS); break;
case 'f': save(LS, '\f', l); next(LS); break;
case 'n': save(LS, '\n', l); next(LS); break;
case 'r': save(LS, '\r', l); next(LS); break;
case 't': save(LS, '\t', l); next(LS); break;
case 'v': save(LS, '\v', l); next(LS); break;
case '\n': save(LS, '\n', l); inclinenumber(LS); break;
case EOZ: break; /* will raise an error next loop */
default: {
esccheck(ls, lisdigit(ls->current), "invalid escape sequence");
c = readdecesc(ls); /* digital escape '\ddd' */
goto only_save;
if (!isdigit(LS->current))
save_and_next(LS, l); /* handles \\, \", \', and \? */
else { /* \xxx */
int c = 0;
int i = 0;
do {
c = 10*c + (LS->current-'0');
next(LS);
} while (++i<3 && isdigit(LS->current));
if (c > UCHAR_MAX) {
save(LS, '\0', l);
luaX_lexerror(LS, "escape sequence too large", TK_STRING);
}
save(LS, c, l);
}
}
}
read_save:
next(ls);
/* go through */
only_save:
luaZ_buffremove(ls->buff, 1); /* remove '\\' */
save(ls, c);
/* go through */
no_save: break;
}
break;
default:
save_and_next(ls);
save_and_next(LS, l);
}
}
save_and_next(ls); /* skip delimiter */
seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1,
luaZ_bufflen(ls->buff) - 2);
save_and_next(LS, l); /* skip delimiter */
save(LS, '\0', l);
seminfo->ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff) + 1, l - 3);
}
static int llex (LexState *ls, SemInfo *seminfo) {
luaZ_resetbuffer(ls->buff);
int luaX_lex (LexState *LS, SemInfo *seminfo) {
for (;;) {
switch (ls->current) {
case '\n': case '\r': { /* line breaks */
inclinenumber(ls);
break;
switch (LS->current) {
case '\n': {
inclinenumber(LS);
continue;
}
case ' ': case '\f': case '\t': case '\v': { /* spaces */
next(ls);
break;
}
case '-': { /* '-' or '--' (comment) */
next(ls);
if (ls->current != '-') return '-';
case '-': {
next(LS);
if (LS->current != '-') return '-';
/* else is a comment */
next(ls);
if (ls->current == '[') { /* long comment? */
size_t sep = skip_sep(ls);
luaZ_resetbuffer(ls->buff); /* 'skip_sep' may dirty the buffer */
if (sep >= 2) {
read_long_string(ls, NULL, sep); /* skip long comment */
luaZ_resetbuffer(ls->buff); /* previous call may dirty the buff. */
break;
}
}
/* else short comment */
while (!currIsNewline(ls) && ls->current != EOZ)
next(ls); /* skip until end of line (or end of file) */
break;
next(LS);
if (LS->current == '[' && (next(LS), LS->current == '['))
read_long_string(LS, NULL); /* long comment */
else /* short comment */
while (LS->current != '\n' && LS->current != EOZ)
next(LS);
continue;
}
case '[': { /* long string or simply '[' */
size_t sep = skip_sep(ls);
if (sep >= 2) {
read_long_string(ls, seminfo, sep);
case '[': {
next(LS);
if (LS->current != '[') return '[';
else {
read_long_string(LS, seminfo);
return TK_STRING;
}
else if (sep == 0) /* '[=...' missing second bracket? */
lexerror(ls, "invalid long string delimiter", TK_STRING);
return '[';
}
case '=': {
next(ls);
if (check_next1(ls, '=')) return TK_EQ; /* '==' */
else return '=';
next(LS);
if (LS->current != '=') return '=';
else { next(LS); return TK_EQ; }
}
case '<': {
next(ls);
if (check_next1(ls, '=')) return TK_LE; /* '<=' */
else if (check_next1(ls, '<')) return TK_SHL; /* '<<' */
else return '<';
next(LS);
if (LS->current != '=') return '<';
else { next(LS); return TK_LE; }
}
case '>': {
next(ls);
if (check_next1(ls, '=')) return TK_GE; /* '>=' */
else if (check_next1(ls, '>')) return TK_SHR; /* '>>' */
else return '>';
}
case '/': {
next(ls);
if (check_next1(ls, '/')) return TK_IDIV; /* '//' */
else return '/';
next(LS);
if (LS->current != '=') return '>';
else { next(LS); return TK_GE; }
}
case '~': {
next(ls);
if (check_next1(ls, '=')) return TK_NE; /* '~=' */
else return '~';
next(LS);
if (LS->current != '=') return '~';
else { next(LS); return TK_NE; }
}
case ':': {
next(ls);
if (check_next1(ls, ':')) return TK_DBCOLON; /* '::' */
else return ':';
}
case '"': case '\'': { /* short literal strings */
read_string(ls, ls->current, seminfo);
case '"':
case '\'': {
read_string(LS, LS->current, seminfo);
return TK_STRING;
}
case '.': { /* '.', '..', '...', or number */
save_and_next(ls);
if (check_next1(ls, '.')) {
if (check_next1(ls, '.'))
return TK_DOTS; /* '...' */
else return TK_CONCAT; /* '..' */
case '.': {
next(LS);
if (LS->current == '.') {
next(LS);
if (LS->current == '.') {
next(LS);
return TK_DOTS; /* ... */
}
else return TK_CONCAT; /* .. */
}
else if (!isdigit(LS->current)) return '.';
else {
read_numeral(LS, 1, seminfo);
return TK_NUMBER;
}
else if (!lisdigit(ls->current)) return '.';
else return read_numeral(ls, seminfo);
}
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': {
return read_numeral(ls, seminfo);
}
case EOZ: {
return TK_EOS;
}
default: {
if (lislalpha(ls->current)) { /* identifier or reserved word? */
TString *ts;
do {
save_and_next(ls);
} while (lislalnum(ls->current));
/* find or create string */
ts = luaS_newlstr(ls->L, luaZ_buffer(ls->buff),
luaZ_bufflen(ls->buff));
if (isreserved(ts)) /* reserved word? */
return ts->extra - 1 + FIRST_RESERVED;
else {
seminfo->ts = anchorstr(ls, ts);
return TK_NAME;
}
if (isspace(LS->current)) {
next(LS);
continue;
}
else { /* single-char tokens ('+', '*', '%', '{', '}', ...) */
int c = ls->current;
next(ls);
return c;
else if (isdigit(LS->current)) {
read_numeral(LS, 0, seminfo);
return TK_NUMBER;
}
else if (isalpha(LS->current) || LS->current == '_') {
/* identifier or reserved word */
size_t l = readname(LS);
TString *ts = luaS_newlstr(LS->L, luaZ_buffer(LS->buff), l);
if (ts->tsv.reserved > 0) /* reserved word? */
return ts->tsv.reserved - 1 + FIRST_RESERVED;
seminfo->ts = ts;
return TK_NAME;
}
else {
int c = LS->current;
if (iscntrl(c))
luaX_error(LS, "invalid control char",
luaO_pushfstring(LS->L, "char(%d)", c));
next(LS);
return c; /* single-char tokens (+ - / ...) */
}
}
}
}
}
void luaX_next (LexState *ls) {
ls->lastline = ls->linenumber;
if (ls->lookahead.token != TK_EOS) { /* is there a look-ahead token? */
ls->t = ls->lookahead; /* use this one */
ls->lookahead.token = TK_EOS; /* and discharge it */
}
else
ls->t.token = llex(ls, &ls->t.seminfo); /* read next token */
}
int luaX_lookahead (LexState *ls) {
lua_assert(ls->lookahead.token == TK_EOS);
ls->lookahead.token = llex(ls, &ls->lookahead.seminfo);
return ls->lookahead.token;
}
#undef next

56
lib/lua/llex.h
View File

@ -1,5 +1,5 @@
/*
** $Id: llex.h $
** $Id: llex.h,v 1.47 2003/02/28 17:19:47 roberto Exp $
** Lexical Analyzer
** See Copyright Notice in lua.h
*/
@ -7,22 +7,14 @@
#ifndef llex_h
#define llex_h
#include <limits.h>
#include "lobject.h"
#include "lzio.h"
/*
** Single-char tokens (terminal symbols) are represented by their own
** numeric code. Other tokens start at the following value.
*/
#define FIRST_RESERVED (UCHAR_MAX + 1)
#define FIRST_RESERVED 257
#if !defined(LUA_ENV)
#define LUA_ENV "_ENV"
#endif
/* maximum length of a reserved word */
#define TOKEN_LEN (sizeof("function")/sizeof(char))
/*
@ -33,22 +25,19 @@ enum RESERVED {
/* terminal symbols denoted by reserved words */
TK_AND = FIRST_RESERVED, TK_BREAK,
TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION,
TK_GLOBAL, TK_GOTO, TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR,
TK_REPEAT, TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,
TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT,
TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,
/* other terminal symbols */
TK_IDIV, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE,
TK_SHL, TK_SHR,
TK_DBCOLON, TK_EOS,
TK_FLT, TK_INT, TK_NAME, TK_STRING
TK_NAME, TK_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_NUMBER,
TK_STRING, TK_EOS
};
/* number of reserved words */
#define NUM_RESERVED (cast_int(TK_WHILE-FIRST_RESERVED + 1))
#define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1))
typedef union {
lua_Number r;
lua_Integer i;
TString *ts;
} SemInfo; /* semantics information */
@ -59,35 +48,28 @@ typedef struct Token {
} Token;
/* state of the scanner plus state of the parser when shared by all
functions */
typedef struct LexState {
int current; /* current character (charint) */
int linenumber; /* input line counter */
int lastline; /* line of last token 'consumed' */
int lastline; /* line of last token `consumed' */
Token t; /* current token */
Token lookahead; /* look ahead token */
struct FuncState *fs; /* current function (parser) */
struct FuncState *fs; /* `FuncState' is private to the parser */
struct lua_State *L;
ZIO *z; /* input stream */
Mbuffer *buff; /* buffer for tokens */
Table *h; /* to avoid collection/reuse strings */
struct Dyndata *dyd; /* dynamic structures used by the parser */
TString *source; /* current source name */
TString *envn; /* environment variable name */
TString *brkn; /* "break" name (used as a label) */
TString *glbn; /* "global" name (when not a reserved word) */
int nestlevel; /* level of nested non-terminals */
} LexState;
LUAI_FUNC void luaX_init (lua_State *L);
LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z,
TString *source, int firstchar);
LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l);
LUAI_FUNC void luaX_next (LexState *ls);
LUAI_FUNC int luaX_lookahead (LexState *ls);
LUAI_FUNC l_noret luaX_syntaxerror (LexState *ls, const char *s);
LUAI_FUNC const char *luaX_token2str (LexState *ls, int token);
void luaX_init (lua_State *L);
void luaX_setinput (lua_State *L, LexState *LS, ZIO *z, TString *source);
int luaX_lex (LexState *LS, SemInfo *seminfo);
void luaX_checklimit (LexState *ls, int val, int limit, const char *msg);
void luaX_syntaxerror (LexState *ls, const char *s);
void luaX_errorline (LexState *ls, const char *s, const char *token, int line);
const char *luaX_token2str (LexState *ls, int token);
#endif

414
lib/lua/llimits.h
View File

@ -1,6 +1,6 @@
/*
** $Id: llimits.h $
** Limits, basic types, and some other 'installation-dependent' definitions
** $Id: llimits.h,v 1.52 2003/02/20 19:33:23 roberto Exp $
** Limits, basic types, and some other `installation-dependent' definitions
** See Copyright Notice in lua.h
*/
@ -15,343 +15,171 @@
#include "lua.h"
#define l_numbits(t) cast_int(sizeof(t) * CHAR_BIT)
/*
** try to find number of bits in an integer
*/
#ifndef BITS_INT
/* avoid overflows in comparison */
#if INT_MAX-20 < 32760
#define BITS_INT 16
#else
#if INT_MAX > 2147483640L
/* machine has at least 32 bits */
#define BITS_INT 32
#else
#error "you must define BITS_INT with number of bits in an integer"
#endif
#endif
#endif
/*
** 'l_mem' is a signed integer big enough to count the total memory
** used by Lua. (It is signed due to the use of debt in several
** computations.) 'lu_mem' is a corresponding unsigned type. Usually,
** 'ptrdiff_t' should work, but we use 'long' for 16-bit machines.
** the following types define integer types for values that may not
** fit in a `small int' (16 bits), but may waste space in a
** `large long' (64 bits). The current definitions should work in
** any machine, but may not be optimal.
*/
#if defined(LUAI_MEM) /* { external definitions? */
typedef LUAI_MEM l_mem;
typedef LUAI_UMEM lu_mem;
#elif LUAI_IS32INT /* }{ */
typedef ptrdiff_t l_mem;
typedef size_t lu_mem;
#else /* 16-bit ints */ /* }{ */
typedef long l_mem;
/* an unsigned integer to hold hash values */
typedef unsigned int lu_hash;
/* its signed equivalent */
typedef int ls_hash;
/* an unsigned integer big enough to count the total memory used by Lua; */
/* it should be at least as large as size_t */
typedef unsigned long lu_mem;
#endif /* } */
#define MAX_LMEM \
cast(l_mem, (cast(lu_mem, 1) << (l_numbits(l_mem) - 1)) - 1)
#define MAX_LUMEM ULONG_MAX
/* chars used as small naturals (so that 'char' is reserved for characters) */
/* an integer big enough to count the number of strings in use */
typedef long ls_nstr;
/* chars used as small naturals (so that `char' is reserved for characters) */
typedef unsigned char lu_byte;
typedef signed char ls_byte;
/* Type for thread status/error codes */
typedef lu_byte TStatus;
#define MAX_SIZET ((size_t)(~(size_t)0)-2)
/* The C API still uses 'int' for status/error codes */
#define APIstatus(st) cast_int(st)
/* maximum value for size_t */
#define MAX_SIZET ((size_t)(~(size_t)0))
#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
/*
** Maximum size for strings and userdata visible for Lua; should be
** representable as a lua_Integer and as a size_t.
** conversion of pointer to integer
** this is for hashing only; there is no problem if the integer
** cannot hold the whole pointer value
*/
#define MAX_SIZE (sizeof(size_t) < sizeof(lua_Integer) ? MAX_SIZET \
: cast_sizet(LUA_MAXINTEGER))
/*
** test whether an unsigned value is a power of 2 (or zero)
*/
#define ispow2(x) (((x) & ((x) - 1)) == 0)
/* number of chars of a literal string without the ending \0 */
#define LL(x) (sizeof(x)/sizeof(char) - 1)
/*
** conversion of pointer to unsigned integer: this is for hashing only;
** there is no problem if the integer cannot hold the whole pointer
** value. (In strict ISO C this may cause undefined behavior, but no
** actual machine seems to bother.)
*/
#if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \
__STDC_VERSION__ >= 199901L
#include <stdint.h>
#if defined(UINTPTR_MAX) /* even in C99 this type is optional */
#define L_P2I uintptr_t
#else /* no 'intptr'? */
#define L_P2I uintmax_t /* use the largest available integer */
#endif
#else /* C89 option */
#define L_P2I size_t
#endif
#define point2uint(p) cast_uint((L_P2I)(p) & UINT_MAX)
#define IntPoint(p) ((lu_hash)(p))
/* types of 'usual argument conversions' for lua_Number and lua_Integer */
typedef LUAI_UACNUMBER l_uacNumber;
typedef LUAI_UACINT l_uacInt;
/*
** Internal assertions for in-house debugging
*/
#if defined LUAI_ASSERT
#undef NDEBUG
#include <assert.h>
#define lua_assert(c) assert(c)
#define assert_code(c) c
#endif
#if defined(lua_assert)
/* type to ensure maximum alignment */
#ifndef LUSER_ALIGNMENT_T
typedef union { double u; void *s; long l; } L_Umaxalign;
#else
#define lua_assert(c) ((void)0)
#define assert_code(c) ((void)0)
#endif
#define check_exp(c,e) (lua_assert(c), (e))
/* to avoid problems with conditions too long */
#define lua_longassert(c) assert_code((c) ? (void)0 : lua_assert(0))
/* macro to avoid warnings about unused variables */
#if !defined(UNUSED)
#define UNUSED(x) ((void)(x))
typedef LUSER_ALIGNMENT_T L_Umaxalign;
#endif
/* type casts (a macro highlights casts in the code) */
/* result of `usual argument conversion' over lua_Number */
#ifndef LUA_UACNUMBER
typedef double l_uacNumber;
#else
typedef LUA_UACNUMBER l_uacNumber;
#endif
#ifndef lua_assert
#define lua_assert(c) /* empty */
#endif
#ifndef check_exp
#define check_exp(c,e) (e)
#endif
#ifndef UNUSED
#define UNUSED(x) ((void)(x)) /* to avoid warnings */
#endif
#ifndef cast
#define cast(t, exp) ((t)(exp))
#define cast_void(i) cast(void, (i))
#define cast_voidp(i) cast(void *, (i))
#define cast_num(i) cast(lua_Number, (i))
#define cast_int(i) cast(int, (i))
#define cast_short(i) cast(short, (i))
#define cast_uint(i) cast(unsigned int, (i))
#define cast_byte(i) cast(lu_byte, (i))
#define cast_uchar(i) cast(unsigned char, (i))
#define cast_char(i) cast(char, (i))
#define cast_charp(i) cast(char *, (i))
#define cast_sizet(i) cast(size_t, (i))
#define cast_Integer(i) cast(lua_Integer, (i))
#define cast_Inst(i) cast(Instruction, (i))
/* cast a signed lua_Integer to lua_Unsigned */
#if !defined(l_castS2U)
#define l_castS2U(i) ((lua_Unsigned)(i))
#endif
/*
** cast a lua_Unsigned to a signed lua_Integer; this cast is
** not strict ISO C, but two-complement architectures should
** work fine.
*/
#if !defined(l_castU2S)
#define l_castU2S(i) ((lua_Integer)(i))
#endif
/*
** cast a size_t to lua_Integer: These casts are always valid for
** sizes of Lua objects (see MAX_SIZE)
*/
#define cast_st2S(sz) ((lua_Integer)(sz))
/* Cast a ptrdiff_t to size_t, when it is known that the minuend
** comes from the subtrahend (the base)
*/
#define ct_diff2sz(df) ((size_t)(df))
/* ptrdiff_t to lua_Integer */
#define ct_diff2S(df) cast_st2S(ct_diff2sz(df))
/*
** Special type equivalent to '(void*)' for functions (to suppress some
** warnings when converting function pointers)
*/
typedef void (*voidf)(void);
/*
** Macro to convert pointer-to-void* to pointer-to-function. This cast
** is undefined according to ISO C, but POSIX assumes that it works.
** (The '__extension__' in gnu compilers is only to avoid warnings.)
*/
#if defined(__GNUC__)
#define cast_func(p) (__extension__ (voidf)(p))
#else
#define cast_func(p) ((voidf)(p))
#endif
/*
** non-return type
** type for virtual-machine instructions
** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
*/
#if !defined(l_noret)
typedef unsigned long Instruction;
#if defined(__GNUC__)
#define l_noret void __attribute__((noreturn))
#elif defined(_MSC_VER) && _MSC_VER >= 1200
#define l_noret void __declspec(noreturn)
#else
#define l_noret void
#endif
/* maximum depth for calls (unsigned short) */
#ifndef LUA_MAXCALLS
#define LUA_MAXCALLS 4096
#endif
/*
** Inline functions
** maximum depth for C calls (unsigned short): Not too big, or may
** overflow the C stack...
*/
#if !defined(LUA_USE_C89)
#define l_inline inline
#elif defined(__GNUC__)
#define l_inline __inline__
#else
#define l_inline /* empty */
#ifndef LUA_MAXCCALLS
#define LUA_MAXCCALLS 200
#endif
#define l_sinline static l_inline
/* maximum size for the C stack */
#ifndef LUA_MAXCSTACK
#define LUA_MAXCSTACK 2048
#endif
/*
** An unsigned with (at least) 4 bytes
*/
#if LUAI_IS32INT
typedef unsigned int l_uint32;
#else
typedef unsigned long l_uint32;
/* maximum stack for a Lua function */
#define MAXSTACK 250
/* maximum number of variables declared in a function */
#ifndef MAXVARS
#define MAXVARS 200 /* arbitrary limit (<MAXSTACK) */
#endif
/* maximum number of upvalues per function */
#ifndef MAXUPVALUES
#define MAXUPVALUES 32
#endif
/* maximum number of parameters in a function */
#ifndef MAXPARAMS
#define MAXPARAMS 100 /* arbitrary limit (<MAXLOCALS) */
#endif
/* minimum size for the string table (must be power of 2) */
#ifndef MINSTRTABSIZE
#define MINSTRTABSIZE 32
#endif
/* minimum size for string buffer */
#ifndef LUA_MINBUFFER
#define LUA_MINBUFFER 32
#endif
/*
** The luai_num* macros define the primitive operations over numbers.
** maximum number of syntactical nested non-terminals: Not too big,
** or may overflow the C stack...
*/
/* floor division (defined as 'floor(a/b)') */
#if !defined(luai_numidiv)
#define luai_numidiv(L,a,b) l_floor(luai_numdiv(L,a,b))
#endif
/* float division */
#if !defined(luai_numdiv)
#define luai_numdiv(L,a,b) ((void)L, (a)/(b))
#endif
/*
** modulo: defined as 'a - floor(a/b)*b'; the direct computation
** using this definition has several problems with rounding errors,
** so it is better to use 'fmod'. 'fmod' gives the result of
** 'a - trunc(a/b)*b', and therefore must be corrected when
** 'trunc(a/b) ~= floor(a/b)'. That happens when the division has a
** non-integer negative result: non-integer result is equivalent to
** a non-zero remainder 'm'; negative result is equivalent to 'a' and
** 'b' with different signs, or 'm' and 'b' with different signs
** (as the result 'm' of 'fmod' has the same sign of 'a').
*/
#if !defined(luai_nummod)
#define luai_nummod(L,a,b,m) \
{ (void)L; (m) = l_mathop(fmod)(a,b); \
if (((m) > 0) ? (b) < 0 : ((m) < 0 && (b) > 0)) (m) += (b); }
#endif
/* exponentiation */
#if !defined(luai_numpow)
#define luai_numpow(L,a,b) \
((void)L, (b == 2) ? (a)*(a) : l_mathop(pow)(a,b))
#endif
/* the others are quite standard operations */
#if !defined(luai_numadd)
#define luai_numadd(L,a,b) ((void)L, (a)+(b))
#define luai_numsub(L,a,b) ((void)L, (a)-(b))
#define luai_nummul(L,a,b) ((void)L, (a)*(b))
#define luai_numunm(L,a) ((void)L, -(a))
#define luai_numeq(a,b) ((a)==(b))
#define luai_numlt(a,b) ((a)<(b))
#define luai_numle(a,b) ((a)<=(b))
#define luai_numgt(a,b) ((a)>(b))
#define luai_numge(a,b) ((a)>=(b))
#define luai_numisnan(a) (!luai_numeq((a), (a)))
#ifndef LUA_MAXPARSERLEVEL
#define LUA_MAXPARSERLEVEL 200
#endif
/*
** lua_numbertointeger converts a float number with an integral value
** to an integer, or returns 0 if the float is not within the range of
** a lua_Integer. (The range comparisons are tricky because of
** rounding. The tests here assume a two-complement representation,
** where MININTEGER always has an exact representation as a float;
** MAXINTEGER may not have one, and therefore its conversion to float
** may have an ill-defined value.)
*/
#define lua_numbertointeger(n,p) \
((n) >= (LUA_NUMBER)(LUA_MININTEGER) && \
(n) < -(LUA_NUMBER)(LUA_MININTEGER) && \
(*(p) = (LUA_INTEGER)(n), 1))
/*
** LUAI_FUNC is a mark for all extern functions that are not to be
** exported to outside modules.
** LUAI_DDEF and LUAI_DDEC are marks for all extern (const) variables,
** none of which to be exported to outside modules (LUAI_DDEF for
** definitions and LUAI_DDEC for declarations).
** Elf and MACH/gcc (versions 3.2 and later) mark them as "hidden" to
** optimize access when Lua is compiled as a shared library. Not all elf
** targets support this attribute. Unfortunately, gcc does not offer
** a way to check whether the target offers that support, and those
** without support give a warning about it. To avoid these warnings,
** change to the default definition.
*/
#if !defined(LUAI_FUNC)
#if defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \
(defined(__ELF__) || defined(__MACH__))
#define LUAI_FUNC __attribute__((visibility("internal"))) extern
#else
#define LUAI_FUNC extern
#endif
#define LUAI_DDEC(dec) LUAI_FUNC dec
#define LUAI_DDEF /* empty */
#endif
/* Give these macros simpler names for internal use */
#define l_likely(x) luai_likely(x)
#define l_unlikely(x) luai_unlikely(x)
/*
** {==================================================================
** "Abstraction Layer" for basic report of messages and errors
** ===================================================================
*/
/* print a string */
#if !defined(lua_writestring)
#define lua_writestring(s,l) fwrite((s), sizeof(char), (l), stdout)
#endif
/* print a newline and flush the output */
#if !defined(lua_writeline)
#define lua_writeline() (lua_writestring("\n", 1), fflush(stdout))
#endif
/* print an error message */
#if !defined(lua_writestringerror)
#define lua_writestringerror(s,p) \
(fprintf(stderr, (s), (p)), fflush(stderr))
#endif
/* }================================================================== */
#endif

797
lib/lua/lmathlib.c
View File

@ -1,747 +1,231 @@
/*
** $Id: lmathlib.c $
** $Id: lmathlib.c,v 1.56 2003/03/11 12:30:37 roberto Exp $
** Standard mathematical library
** See Copyright Notice in lua.h
*/
#define lmathlib_c
#define LUA_LIB
#include "lprefix.h"
#include <float.h>
#include <limits.h>
#include <math.h>
#include <stdlib.h>
#include <time.h>
#include <math.h>
#define lmathlib_c
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#include "llimits.h"
#undef PI
#define PI (l_mathop(3.141592653589793238462643383279502884))
#define PI (3.14159265358979323846)
#define RADIANS_PER_DEGREE (PI/180.0)
static int math_abs (lua_State *L) {
if (lua_isinteger(L, 1)) {
lua_Integer n = lua_tointeger(L, 1);
if (n < 0) n = (lua_Integer)(0u - (lua_Unsigned)n);
lua_pushinteger(L, n);
}
else
lua_pushnumber(L, l_mathop(fabs)(luaL_checknumber(L, 1)));
return 1;
}
static int math_sin (lua_State *L) {
lua_pushnumber(L, l_mathop(sin)(luaL_checknumber(L, 1)));
return 1;
}
static int math_cos (lua_State *L) {
lua_pushnumber(L, l_mathop(cos)(luaL_checknumber(L, 1)));
return 1;
}
static int math_tan (lua_State *L) {
lua_pushnumber(L, l_mathop(tan)(luaL_checknumber(L, 1)));
return 1;
}
static int math_asin (lua_State *L) {
lua_pushnumber(L, l_mathop(asin)(luaL_checknumber(L, 1)));
return 1;
}
static int math_acos (lua_State *L) {
lua_pushnumber(L, l_mathop(acos)(luaL_checknumber(L, 1)));
return 1;
}
static int math_atan (lua_State *L) {
lua_Number y = luaL_checknumber(L, 1);
lua_Number x = luaL_optnumber(L, 2, 1);
lua_pushnumber(L, l_mathop(atan2)(y, x));
return 1;
}
static int math_toint (lua_State *L) {
int valid;
lua_Integer n = lua_tointegerx(L, 1, &valid);
if (l_likely(valid))
lua_pushinteger(L, n);
else {
luaL_checkany(L, 1);
luaL_pushfail(L); /* value is not convertible to integer */
}
return 1;
}
static void pushnumint (lua_State *L, lua_Number d) {
lua_Integer n;
if (lua_numbertointeger(d, &n)) /* does 'd' fit in an integer? */
lua_pushinteger(L, n); /* result is integer */
else
lua_pushnumber(L, d); /* result is float */
}
static int math_floor (lua_State *L) {
if (lua_isinteger(L, 1))
lua_settop(L, 1); /* integer is its own floor */
else {
lua_Number d = l_mathop(floor)(luaL_checknumber(L, 1));
pushnumint(L, d);
}
return 1;
}
static int math_ceil (lua_State *L) {
if (lua_isinteger(L, 1))
lua_settop(L, 1); /* integer is its own ceiling */
else {
lua_Number d = l_mathop(ceil)(luaL_checknumber(L, 1));
pushnumint(L, d);
}
return 1;
}
static int math_fmod (lua_State *L) {
if (lua_isinteger(L, 1) && lua_isinteger(L, 2)) {
lua_Integer d = lua_tointeger(L, 2);
if ((lua_Unsigned)d + 1u <= 1u) { /* special cases: -1 or 0 */
luaL_argcheck(L, d != 0, 2, "zero");
lua_pushinteger(L, 0); /* avoid overflow with 0x80000... / -1 */
}
else
lua_pushinteger(L, lua_tointeger(L, 1) % d);
}
else
lua_pushnumber(L, l_mathop(fmod)(luaL_checknumber(L, 1),
luaL_checknumber(L, 2)));
return 1;
}
/*
** next function does not use 'modf', avoiding problems with 'double*'
** (which is not compatible with 'float*') when lua_Number is not
** 'double'.
** If you want Lua to operate in degrees (instead of radians),
** define USE_DEGREES
*/
static int math_modf (lua_State *L) {
if (lua_isinteger(L ,1)) {
lua_settop(L, 1); /* number is its own integer part */
lua_pushnumber(L, 0); /* no fractional part */
}
else {
lua_Number n = luaL_checknumber(L, 1);
/* integer part (rounds toward zero) */
lua_Number ip = (n < 0) ? l_mathop(ceil)(n) : l_mathop(floor)(n);
pushnumint(L, ip);
/* fractional part (test needed for inf/-inf) */
lua_pushnumber(L, (n == ip) ? l_mathop(0.0) : (n - ip));
}
return 2;
#ifdef USE_DEGREES
#define FROMRAD(a) ((a)/RADIANS_PER_DEGREE)
#define TORAD(a) ((a)*RADIANS_PER_DEGREE)
#else
#define FROMRAD(a) (a)
#define TORAD(a) (a)
#endif
static int math_abs (lua_State *L) {
lua_pushnumber(L, fabs(luaL_checknumber(L, 1)));
return 1;
}
static int math_sin (lua_State *L) {
lua_pushnumber(L, sin(TORAD(luaL_checknumber(L, 1))));
return 1;
}
static int math_cos (lua_State *L) {
lua_pushnumber(L, cos(TORAD(luaL_checknumber(L, 1))));
return 1;
}
static int math_tan (lua_State *L) {
lua_pushnumber(L, tan(TORAD(luaL_checknumber(L, 1))));
return 1;
}
static int math_asin (lua_State *L) {
lua_pushnumber(L, FROMRAD(asin(luaL_checknumber(L, 1))));
return 1;
}
static int math_acos (lua_State *L) {
lua_pushnumber(L, FROMRAD(acos(luaL_checknumber(L, 1))));
return 1;
}
static int math_atan (lua_State *L) {
lua_pushnumber(L, FROMRAD(atan(luaL_checknumber(L, 1))));
return 1;
}
static int math_atan2 (lua_State *L) {
lua_pushnumber(L, FROMRAD(atan2(luaL_checknumber(L, 1), luaL_checknumber(L, 2))));
return 1;
}
static int math_ceil (lua_State *L) {
lua_pushnumber(L, ceil(luaL_checknumber(L, 1)));
return 1;
}
static int math_floor (lua_State *L) {
lua_pushnumber(L, floor(luaL_checknumber(L, 1)));
return 1;
}
static int math_mod (lua_State *L) {
lua_pushnumber(L, fmod(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
return 1;
}
static int math_sqrt (lua_State *L) {
lua_pushnumber(L, l_mathop(sqrt)(luaL_checknumber(L, 1)));
lua_pushnumber(L, sqrt(luaL_checknumber(L, 1)));
return 1;
}
static int math_ult (lua_State *L) {
lua_Integer a = luaL_checkinteger(L, 1);
lua_Integer b = luaL_checkinteger(L, 2);
lua_pushboolean(L, (lua_Unsigned)a < (lua_Unsigned)b);
static int math_pow (lua_State *L) {
lua_pushnumber(L, pow(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
return 1;
}
static int math_log (lua_State *L) {
lua_Number x = luaL_checknumber(L, 1);
lua_Number res;
if (lua_isnoneornil(L, 2))
res = l_mathop(log)(x);
else {
lua_Number base = luaL_checknumber(L, 2);
#if !defined(LUA_USE_C89)
if (base == l_mathop(2.0))
res = l_mathop(log2)(x);
else
#endif
if (base == l_mathop(10.0))
res = l_mathop(log10)(x);
else
res = l_mathop(log)(x)/l_mathop(log)(base);
}
lua_pushnumber(L, res);
lua_pushnumber(L, log(luaL_checknumber(L, 1)));
return 1;
}
static int math_log10 (lua_State *L) {
lua_pushnumber(L, log10(luaL_checknumber(L, 1)));
return 1;
}
static int math_exp (lua_State *L) {
lua_pushnumber(L, l_mathop(exp)(luaL_checknumber(L, 1)));
lua_pushnumber(L, exp(luaL_checknumber(L, 1)));
return 1;
}
static int math_deg (lua_State *L) {
lua_pushnumber(L, luaL_checknumber(L, 1) * (l_mathop(180.0) / PI));
lua_pushnumber(L, luaL_checknumber(L, 1)/RADIANS_PER_DEGREE);
return 1;
}
static int math_rad (lua_State *L) {
lua_pushnumber(L, luaL_checknumber(L, 1) * (PI / l_mathop(180.0)));
lua_pushnumber(L, luaL_checknumber(L, 1)*RADIANS_PER_DEGREE);
return 1;
}
static int math_frexp (lua_State *L) {
lua_Number x = luaL_checknumber(L, 1);
int ep;
lua_pushnumber(L, l_mathop(frexp)(x, &ep));
lua_pushinteger(L, ep);
int e;
lua_pushnumber(L, frexp(luaL_checknumber(L, 1), &e));
lua_pushnumber(L, e);
return 2;
}
static int math_ldexp (lua_State *L) {
lua_Number x = luaL_checknumber(L, 1);
int ep = (int)luaL_checkinteger(L, 2);
lua_pushnumber(L, l_mathop(ldexp)(x, ep));
lua_pushnumber(L, ldexp(luaL_checknumber(L, 1), luaL_checkint(L, 2)));
return 1;
}
static int math_min (lua_State *L) {
int n = lua_gettop(L); /* number of arguments */
int imin = 1; /* index of current minimum value */
lua_Number dmin = luaL_checknumber(L, 1);
int i;
luaL_argcheck(L, n >= 1, 1, "value expected");
for (i = 2; i <= n; i++) {
if (lua_compare(L, i, imin, LUA_OPLT))
imin = i;
for (i=2; i<=n; i++) {
lua_Number d = luaL_checknumber(L, i);
if (d < dmin)
dmin = d;
}
lua_pushvalue(L, imin);
lua_pushnumber(L, dmin);
return 1;
}
static int math_max (lua_State *L) {
int n = lua_gettop(L); /* number of arguments */
int imax = 1; /* index of current maximum value */
lua_Number dmax = luaL_checknumber(L, 1);
int i;
luaL_argcheck(L, n >= 1, 1, "value expected");
for (i = 2; i <= n; i++) {
if (lua_compare(L, imax, i, LUA_OPLT))
imax = i;
for (i=2; i<=n; i++) {
lua_Number d = luaL_checknumber(L, i);
if (d > dmax)
dmax = d;
}
lua_pushvalue(L, imax);
lua_pushnumber(L, dmax);
return 1;
}
static int math_type (lua_State *L) {
if (lua_type(L, 1) == LUA_TNUMBER)
lua_pushstring(L, (lua_isinteger(L, 1)) ? "integer" : "float");
else {
luaL_checkany(L, 1);
luaL_pushfail(L);
}
return 1;
}
/*
** {==================================================================
** Pseudo-Random Number Generator based on 'xoshiro256**'.
** ===================================================================
*/
/*
** This code uses lots of shifts. ISO C does not allow shifts greater
** than or equal to the width of the type being shifted, so some shifts
** are written in convoluted ways to match that restriction. For
** preprocessor tests, it assumes a width of 32 bits, so the maximum
** shift there is 31 bits.
*/
/* number of binary digits in the mantissa of a float */
#define FIGS l_floatatt(MANT_DIG)
#if FIGS > 64
/* there are only 64 random bits; use them all */
#undef FIGS
#define FIGS 64
#endif
/*
** LUA_RAND32 forces the use of 32-bit integers in the implementation
** of the PRN generator (mainly for testing).
*/
#if !defined(LUA_RAND32) && !defined(Rand64)
/* try to find an integer type with at least 64 bits */
#if ((ULONG_MAX >> 31) >> 31) >= 3
/* 'long' has at least 64 bits */
#define Rand64 unsigned long
#define SRand64 long
#elif !defined(LUA_USE_C89) && defined(LLONG_MAX)
/* there is a 'long long' type (which must have at least 64 bits) */
#define Rand64 unsigned long long
#define SRand64 long long
#elif ((LUA_MAXUNSIGNED >> 31) >> 31) >= 3
/* 'lua_Unsigned' has at least 64 bits */
#define Rand64 lua_Unsigned
#define SRand64 lua_Integer
#endif
#endif
#if defined(Rand64) /* { */
/*
** Standard implementation, using 64-bit integers.
** If 'Rand64' has more than 64 bits, the extra bits do not interfere
** with the 64 initial bits, except in a right shift. Moreover, the
** final result has to discard the extra bits.
*/
/* avoid using extra bits when needed */
#define trim64(x) ((x) & 0xffffffffffffffffu)
/* rotate left 'x' by 'n' bits */
static Rand64 rotl (Rand64 x, int n) {
return (x << n) | (trim64(x) >> (64 - n));
}
static Rand64 nextrand (Rand64 *state) {
Rand64 state0 = state[0];
Rand64 state1 = state[1];
Rand64 state2 = state[2] ^ state0;
Rand64 state3 = state[3] ^ state1;
Rand64 res = rotl(state1 * 5, 7) * 9;
state[0] = state0 ^ state3;
state[1] = state1 ^ state2;
state[2] = state2 ^ (state1 << 17);
state[3] = rotl(state3, 45);
return res;
}
/*
** Convert bits from a random integer into a float in the
** interval [0,1), getting the higher FIG bits from the
** random unsigned integer and converting that to a float.
** Some old Microsoft compilers cannot cast an unsigned long
** to a floating-point number, so we use a signed long as an
** intermediary. When lua_Number is float or double, the shift ensures
** that 'sx' is non negative; in that case, a good compiler will remove
** the correction.
*/
/* must throw out the extra (64 - FIGS) bits */
#define shift64_FIG (64 - FIGS)
/* 2^(-FIGS) == 2^-1 / 2^(FIGS-1) */
#define scaleFIG (l_mathop(0.5) / ((Rand64)1 << (FIGS - 1)))
static lua_Number I2d (Rand64 x) {
SRand64 sx = (SRand64)(trim64(x) >> shift64_FIG);
lua_Number res = (lua_Number)(sx) * scaleFIG;
if (sx < 0)
res += l_mathop(1.0); /* correct the two's complement if negative */
lua_assert(0 <= res && res < 1);
return res;
}
/* convert a 'Rand64' to a 'lua_Unsigned' */
#define I2UInt(x) ((lua_Unsigned)trim64(x))
/* convert a 'lua_Unsigned' to a 'Rand64' */
#define Int2I(x) ((Rand64)(x))
#else /* no 'Rand64' }{ */
/*
** Use two 32-bit integers to represent a 64-bit quantity.
*/
typedef struct Rand64 {
l_uint32 h; /* higher half */
l_uint32 l; /* lower half */
} Rand64;
/*
** If 'l_uint32' has more than 32 bits, the extra bits do not interfere
** with the 32 initial bits, except in a right shift and comparisons.
** Moreover, the final result has to discard the extra bits.
*/
/* avoid using extra bits when needed */
#define trim32(x) ((x) & 0xffffffffu)
/*
** basic operations on 'Rand64' values
*/
/* build a new Rand64 value */
static Rand64 packI (l_uint32 h, l_uint32 l) {
Rand64 result;
result.h = h;
result.l = l;
return result;
}
/* return i << n */
static Rand64 Ishl (Rand64 i, int n) {
lua_assert(n > 0 && n < 32);
return packI((i.h << n) | (trim32(i.l) >> (32 - n)), i.l << n);
}
/* i1 ^= i2 */
static void Ixor (Rand64 *i1, Rand64 i2) {
i1->h ^= i2.h;
i1->l ^= i2.l;
}
/* return i1 + i2 */
static Rand64 Iadd (Rand64 i1, Rand64 i2) {
Rand64 result = packI(i1.h + i2.h, i1.l + i2.l);
if (trim32(result.l) < trim32(i1.l)) /* carry? */
result.h++;
return result;
}
/* return i * 5 */
static Rand64 times5 (Rand64 i) {
return Iadd(Ishl(i, 2), i); /* i * 5 == (i << 2) + i */
}
/* return i * 9 */
static Rand64 times9 (Rand64 i) {
return Iadd(Ishl(i, 3), i); /* i * 9 == (i << 3) + i */
}
/* return 'i' rotated left 'n' bits */
static Rand64 rotl (Rand64 i, int n) {
lua_assert(n > 0 && n < 32);
return packI((i.h << n) | (trim32(i.l) >> (32 - n)),
(trim32(i.h) >> (32 - n)) | (i.l << n));
}
/* for offsets larger than 32, rotate right by 64 - offset */
static Rand64 rotl1 (Rand64 i, int n) {
lua_assert(n > 32 && n < 64);
n = 64 - n;
return packI((trim32(i.h) >> n) | (i.l << (32 - n)),
(i.h << (32 - n)) | (trim32(i.l) >> n));
}
/*
** implementation of 'xoshiro256**' algorithm on 'Rand64' values
*/
static Rand64 nextrand (Rand64 *state) {
Rand64 res = times9(rotl(times5(state[1]), 7));
Rand64 t = Ishl(state[1], 17);
Ixor(&state[2], state[0]);
Ixor(&state[3], state[1]);
Ixor(&state[1], state[2]);
Ixor(&state[0], state[3]);
Ixor(&state[2], t);
state[3] = rotl1(state[3], 45);
return res;
}
/*
** Converts a 'Rand64' into a float.
*/
/* an unsigned 1 with proper type */
#define UONE ((l_uint32)1)
#if FIGS <= 32
/* 2^(-FIGS) */
#define scaleFIG (l_mathop(0.5) / (UONE << (FIGS - 1)))
/*
** get up to 32 bits from higher half, shifting right to
** throw out the extra bits.
*/
static lua_Number I2d (Rand64 x) {
lua_Number h = (lua_Number)(trim32(x.h) >> (32 - FIGS));
return h * scaleFIG;
}
#else /* 32 < FIGS <= 64 */
/* 2^(-FIGS) = 1.0 / 2^30 / 2^3 / 2^(FIGS-33) */
#define scaleFIG \
(l_mathop(1.0) / (UONE << 30) / l_mathop(8.0) / (UONE << (FIGS - 33)))
/*
** use FIGS - 32 bits from lower half, throwing out the other
** (32 - (FIGS - 32)) = (64 - FIGS) bits
*/
#define shiftLOW (64 - FIGS)
/*
** higher 32 bits go after those (FIGS - 32) bits: shiftHI = 2^(FIGS - 32)
*/
#define shiftHI ((lua_Number)(UONE << (FIGS - 33)) * l_mathop(2.0))
static lua_Number I2d (Rand64 x) {
lua_Number h = (lua_Number)trim32(x.h) * shiftHI;
lua_Number l = (lua_Number)(trim32(x.l) >> shiftLOW);
return (h + l) * scaleFIG;
}
#endif
/* convert a 'Rand64' to a 'lua_Unsigned' */
static lua_Unsigned I2UInt (Rand64 x) {
return (((lua_Unsigned)trim32(x.h) << 31) << 1) | (lua_Unsigned)trim32(x.l);
}
/* convert a 'lua_Unsigned' to a 'Rand64' */
static Rand64 Int2I (lua_Unsigned n) {
return packI((l_uint32)((n >> 31) >> 1), (l_uint32)n);
}
#endif /* } */
/*
** A state uses four 'Rand64' values.
*/
typedef struct {
Rand64 s[4];
} RanState;
/*
** Project the random integer 'ran' into the interval [0, n].
** Because 'ran' has 2^B possible values, the projection can only be
** uniform when the size of the interval is a power of 2 (exact
** division). So, to get a uniform projection into [0, n], we
** first compute 'lim', the smallest Mersenne number not smaller than
** 'n'. We then project 'ran' into the interval [0, lim]. If the result
** is inside [0, n], we are done. Otherwise, we try with another 'ran',
** until we have a result inside the interval.
*/
static lua_Unsigned project (lua_Unsigned ran, lua_Unsigned n,
RanState *state) {
lua_Unsigned lim = n; /* to compute the Mersenne number */
int sh; /* how much to spread bits to the right in 'lim' */
/* spread '1' bits in 'lim' until it becomes a Mersenne number */
for (sh = 1; (lim & (lim + 1)) != 0; sh *= 2)
lim |= (lim >> sh); /* spread '1's to the right */
while ((ran &= lim) > n) /* project 'ran' into [0..lim] and test */
ran = I2UInt(nextrand(state->s)); /* not inside [0..n]? try again */
return ran;
}
static int math_random (lua_State *L) {
lua_Integer low, up;
lua_Unsigned p;
RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
Rand64 rv = nextrand(state->s); /* next pseudo-random value */
/* the `%' avoids the (rare) case of r==1, and is needed also because on
some systems (SunOS!) `rand()' may return a value larger than RAND_MAX */
lua_Number r = (lua_Number)(rand()%RAND_MAX) / (lua_Number)RAND_MAX;
switch (lua_gettop(L)) { /* check number of arguments */
case 0: { /* no arguments */
lua_pushnumber(L, I2d(rv)); /* float between 0 and 1 */
return 1;
lua_pushnumber(L, r); /* Number between 0 and 1 */
break;
}
case 1: { /* only upper limit */
low = 1;
up = luaL_checkinteger(L, 1);
if (up == 0) { /* single 0 as argument? */
lua_pushinteger(L, l_castU2S(I2UInt(rv))); /* full random integer */
return 1;
}
int u = luaL_checkint(L, 1);
luaL_argcheck(L, 1<=u, 1, "interval is empty");
lua_pushnumber(L, (int)floor(r*u)+1); /* int between 1 and `u' */
break;
}
case 2: { /* lower and upper limits */
low = luaL_checkinteger(L, 1);
up = luaL_checkinteger(L, 2);
int l = luaL_checkint(L, 1);
int u = luaL_checkint(L, 2);
luaL_argcheck(L, l<=u, 2, "interval is empty");
lua_pushnumber(L, (int)floor(r*(u-l+1))+l); /* int between `l' and `u' */
break;
}
default: return luaL_error(L, "wrong number of arguments");
}
/* random integer in the interval [low, up] */
luaL_argcheck(L, low <= up, 1, "interval is empty");
/* project random integer into the interval [0, up - low] */
p = project(I2UInt(rv), l_castS2U(up) - l_castS2U(low), state);
lua_pushinteger(L, l_castU2S(p + l_castS2U(low)));
return 1;
}
static void setseed (lua_State *L, Rand64 *state,
lua_Unsigned n1, lua_Unsigned n2) {
int i;
state[0] = Int2I(n1);
state[1] = Int2I(0xff); /* avoid a zero state */
state[2] = Int2I(n2);
state[3] = Int2I(0);
for (i = 0; i < 16; i++)
nextrand(state); /* discard initial values to "spread" seed */
lua_pushinteger(L, l_castU2S(n1));
lua_pushinteger(L, l_castU2S(n2));
}
static int math_randomseed (lua_State *L) {
RanState *state = (RanState *)lua_touserdata(L, lua_upvalueindex(1));
lua_Unsigned n1, n2;
if (lua_isnone(L, 1)) {
n1 = luaL_makeseed(L); /* "random" seed */
n2 = I2UInt(nextrand(state->s)); /* in case seed is not that random... */
}
else {
n1 = l_castS2U(luaL_checkinteger(L, 1));
n2 = l_castS2U(luaL_optinteger(L, 2, 0));
}
setseed(L, state->s, n1, n2);
return 2; /* return seeds */
srand(luaL_checkint(L, 1));
return 0;
}
static const luaL_Reg randfuncs[] = {
{"random", math_random},
{"randomseed", math_randomseed},
{NULL, NULL}
};
/*
** Register the random functions and initialize their state.
*/
static void setrandfunc (lua_State *L) {
RanState *state = (RanState *)lua_newuserdatauv(L, sizeof(RanState), 0);
setseed(L, state->s, luaL_makeseed(L), 0); /* initialize with random seed */
lua_pop(L, 2); /* remove pushed seeds */
luaL_setfuncs(L, randfuncs, 1);
}
/* }================================================================== */
/*
** {==================================================================
** Deprecated functions (for compatibility only)
** ===================================================================
*/
#if defined(LUA_COMPAT_MATHLIB)
static int math_cosh (lua_State *L) {
lua_pushnumber(L, l_mathop(cosh)(luaL_checknumber(L, 1)));
return 1;
}
static int math_sinh (lua_State *L) {
lua_pushnumber(L, l_mathop(sinh)(luaL_checknumber(L, 1)));
return 1;
}
static int math_tanh (lua_State *L) {
lua_pushnumber(L, l_mathop(tanh)(luaL_checknumber(L, 1)));
return 1;
}
static int math_pow (lua_State *L) {
lua_Number x = luaL_checknumber(L, 1);
lua_Number y = luaL_checknumber(L, 2);
lua_pushnumber(L, l_mathop(pow)(x, y));
return 1;
}
static int math_log10 (lua_State *L) {
lua_pushnumber(L, l_mathop(log10)(luaL_checknumber(L, 1)));
return 1;
}
#endif
/* }================================================================== */
static const luaL_Reg mathlib[] = {
static const luaL_reg mathlib[] = {
{"abs", math_abs},
{"acos", math_acos},
{"asin", math_asin},
{"atan", math_atan},
{"ceil", math_ceil},
{"cos", math_cos},
{"deg", math_deg},
{"exp", math_exp},
{"tointeger", math_toint},
{"floor", math_floor},
{"fmod", math_fmod},
{"frexp", math_frexp},
{"ult", math_ult},
{"ldexp", math_ldexp},
{"log", math_log},
{"max", math_max},
{"min", math_min},
{"modf", math_modf},
{"rad", math_rad},
{"sin", math_sin},
{"sqrt", math_sqrt},
{"cos", math_cos},
{"tan", math_tan},
{"type", math_type},
#if defined(LUA_COMPAT_MATHLIB)
{"atan2", math_atan},
{"cosh", math_cosh},
{"sinh", math_sinh},
{"tanh", math_tanh},
{"pow", math_pow},
{"asin", math_asin},
{"acos", math_acos},
{"atan", math_atan},
{"atan2", math_atan2},
{"ceil", math_ceil},
{"floor", math_floor},
{"mod", math_mod},
{"frexp", math_frexp},
{"ldexp", math_ldexp},
{"sqrt", math_sqrt},
{"min", math_min},
{"max", math_max},
{"log", math_log},
{"log10", math_log10},
#endif
/* placeholders */
{"random", NULL},
{"randomseed", NULL},
{"pi", NULL},
{"huge", NULL},
{"maxinteger", NULL},
{"mininteger", NULL},
{"exp", math_exp},
{"deg", math_deg},
{"pow", math_pow},
{"rad", math_rad},
{"random", math_random},
{"randomseed", math_randomseed},
{NULL, NULL}
};
@ -749,17 +233,14 @@ static const luaL_Reg mathlib[] = {
/*
** Open math library
*/
LUAMOD_API int luaopen_math (lua_State *L) {
luaL_newlib(L, mathlib);
LUALIB_API int luaopen_math (lua_State *L) {
luaL_openlib(L, LUA_MATHLIBNAME, mathlib, 0);
lua_pushliteral(L, "pi");
lua_pushnumber(L, PI);
lua_setfield(L, -2, "pi");
lua_pushnumber(L, (lua_Number)HUGE_VAL);
lua_setfield(L, -2, "huge");
lua_pushinteger(L, LUA_MAXINTEGER);
lua_setfield(L, -2, "maxinteger");
lua_pushinteger(L, LUA_MININTEGER);
lua_setfield(L, -2, "mininteger");
setrandfunc(L);
lua_settable(L, -3);
lua_pushliteral(L, "__pow");
lua_pushcfunction(L, math_pow);
lua_settable(L, LUA_GLOBALSINDEX);
return 1;
}

228
lib/lua/lmem.c
View File

@ -1,22 +1,18 @@
/*
** $Id: lmem.c $
** $Id: lmem.c,v 1.61 2002/12/04 17:38:31 roberto Exp $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#define lmem_c
#define LUA_CORE
#include "lprefix.h"
#include <stddef.h>
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
@ -24,192 +20,72 @@
/*
** About the realloc function:
** void *frealloc (void *ud, void *ptr, size_t osize, size_t nsize);
** ('osize' is the old size, 'nsize' is the new size)
**
** - frealloc(ud, p, x, 0) frees the block 'p' and returns NULL.
** Particularly, frealloc(ud, NULL, 0, 0) does nothing,
** which is equivalent to free(NULL) in ISO C.
**
** - frealloc(ud, NULL, x, s) creates a new block of size 's'
** (no matter 'x'). Returns NULL if it cannot create the new block.
**
** - otherwise, frealloc(ud, b, x, y) reallocates the block 'b' from
** size 'x' to size 'y'. Returns NULL if it cannot reallocate the
** block to the new size.
** definition for realloc function. It must assure that l_realloc(NULL,
** 0, x) allocates a new block (ANSI C assures that). (`os' is the old
** block size; some allocators may use that.)
*/
#ifndef l_realloc
#define l_realloc(b,os,s) realloc(b,s)
#endif
/*
** Macro to call the allocation function.
** definition for free function. (`os' is the old block size; some
** allocators may use that.)
*/
#define callfrealloc(g,block,os,ns) ((*g->frealloc)(g->ud, block, os, ns))
/*
** When an allocation fails, it will try again after an emergency
** collection, except when it cannot run a collection. The GC should
** not be called while the state is not fully built, as the collector
** is not yet fully initialized. Also, it should not be called when
** 'gcstopem' is true, because then the interpreter is in the middle of
** a collection step.
*/
#define cantryagain(g) (completestate(g) && !g->gcstopem)
#if defined(EMERGENCYGCTESTS)
/*
** First allocation will fail except when freeing a block (frees never
** fail) and when it cannot try again; this fail will trigger 'tryagain'
** and a full GC cycle at every allocation.
*/
static void *firsttry (global_State *g, void *block, size_t os, size_t ns) {
if (ns > 0 && cantryagain(g))
return NULL; /* fail */
else /* normal allocation */
return callfrealloc(g, block, os, ns);
}
#else
#define firsttry(g,block,os,ns) callfrealloc(g, block, os, ns)
#ifndef l_free
#define l_free(b,os) free(b)
#endif
/*
** {==================================================================
** Functions to allocate/deallocate arrays for the Parser
** ===================================================================
*/
/*
** Minimum size for arrays during parsing, to avoid overhead of
** reallocating to size 1, then 2, and then 4. All these arrays
** will be reallocated to exact sizes or erased when parsing ends.
*/
#define MINSIZEARRAY 4
void *luaM_growaux_ (lua_State *L, void *block, int nelems, int *psize,
unsigned size_elems, int limit, const char *what) {
void *luaM_growaux (lua_State *L, void *block, int *size, int size_elems,
int limit, const char *errormsg) {
void *newblock;
int size = *psize;
if (nelems + 1 <= size) /* does one extra element still fit? */
return block; /* nothing to be done */
if (size >= limit / 2) { /* cannot double it? */
if (l_unlikely(size >= limit)) /* cannot grow even a little? */
luaG_runerror(L, "too many %s (limit is %d)", what, limit);
size = limit; /* still have at least one free place */
int newsize = (*size)*2;
if (newsize < MINSIZEARRAY)
newsize = MINSIZEARRAY; /* minimum size */
else if (*size >= limit/2) { /* cannot double it? */
if (*size < limit - MINSIZEARRAY) /* try something smaller... */
newsize = limit; /* still have at least MINSIZEARRAY free places */
else luaG_runerror(L, errormsg);
}
else {
size *= 2;
if (size < MINSIZEARRAY)
size = MINSIZEARRAY; /* minimum size */
}
lua_assert(nelems + 1 <= size && size <= limit);
/* 'limit' ensures that multiplication will not overflow */
newblock = luaM_saferealloc_(L, block, cast_sizet(*psize) * size_elems,
cast_sizet(size) * size_elems);
*psize = size; /* update only when everything else is OK */
newblock = luaM_realloc(L, block,
cast(lu_mem, *size)*cast(lu_mem, size_elems),
cast(lu_mem, newsize)*cast(lu_mem, size_elems));
*size = newsize; /* update only when everything else is OK */
return newblock;
}
/*
** In prototypes, the size of the array is also its number of
** elements (to save memory). So, if it cannot shrink an array
** to its number of elements, the only option is to raise an
** error.
** generic allocation routine.
*/
void *luaM_shrinkvector_ (lua_State *L, void *block, int *size,
int final_n, unsigned size_elem) {
void *newblock;
size_t oldsize = cast_sizet(*size) * size_elem;
size_t newsize = cast_sizet(final_n) * size_elem;
lua_assert(newsize <= oldsize);
newblock = luaM_saferealloc_(L, block, oldsize, newsize);
*size = final_n;
return newblock;
}
/* }================================================================== */
l_noret luaM_toobig (lua_State *L) {
luaG_runerror(L, "memory allocation error: block too big");
}
/*
** Free memory
*/
void luaM_free_ (lua_State *L, void *block, size_t osize) {
global_State *g = G(L);
lua_assert((osize == 0) == (block == NULL));
callfrealloc(g, block, osize, 0);
g->GCdebt += cast(l_mem, osize);
}
/*
** In case of allocation fail, this function will do an emergency
** collection to free some memory and then try the allocation again.
*/
static void *tryagain (lua_State *L, void *block,
size_t osize, size_t nsize) {
global_State *g = G(L);
if (cantryagain(g)) {
luaC_fullgc(L, 1); /* try to free some memory... */
return callfrealloc(g, block, osize, nsize); /* try again */
}
else return NULL; /* cannot run an emergency collection */
}
/*
** Generic allocation routine.
*/
void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
void *newblock;
global_State *g = G(L);
lua_assert((osize == 0) == (block == NULL));
newblock = firsttry(g, block, osize, nsize);
if (l_unlikely(newblock == NULL && nsize > 0)) {
newblock = tryagain(L, block, osize, nsize);
if (newblock == NULL) /* still no memory? */
return NULL; /* do not update 'GCdebt' */
}
lua_assert((nsize == 0) == (newblock == NULL));
g->GCdebt -= cast(l_mem, nsize) - cast(l_mem, osize);
return newblock;
}
void *luaM_saferealloc_ (lua_State *L, void *block, size_t osize,
size_t nsize) {
void *newblock = luaM_realloc_(L, block, osize, nsize);
if (l_unlikely(newblock == NULL && nsize > 0)) /* allocation failed? */
luaM_error(L);
return newblock;
}
void *luaM_malloc_ (lua_State *L, size_t size, int tag) {
if (size == 0)
return NULL; /* that's all */
else {
global_State *g = G(L);
void *newblock = firsttry(g, NULL, cast_sizet(tag), size);
if (l_unlikely(newblock == NULL)) {
newblock = tryagain(L, NULL, cast_sizet(tag), size);
if (newblock == NULL)
luaM_error(L);
void *luaM_realloc (lua_State *L, void *block, lu_mem oldsize, lu_mem size) {
lua_assert((oldsize == 0) == (block == NULL));
if (size == 0) {
if (block != NULL) {
l_free(block, oldsize);
block = NULL;
}
g->GCdebt -= cast(l_mem, size);
return newblock;
else return NULL; /* avoid `nblocks' computations when oldsize==size==0 */
}
else if (size >= MAX_SIZET)
luaG_runerror(L, "memory allocation error: block too big");
else {
block = l_realloc(block, oldsize, size);
if (block == NULL) {
if (L)
luaD_throw(L, LUA_ERRMEM);
else return NULL; /* error before creating state! */
}
}
if (L) {
lua_assert(G(L) != NULL && G(L)->nblocks > 0);
G(L)->nblocks -= oldsize;
G(L)->nblocks += size;
}
return block;
}

86
lib/lua/lmem.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lmem.h $
** $Id: lmem.h,v 1.26 2002/05/01 20:40:42 roberto Exp $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
@ -13,84 +13,32 @@
#include "llimits.h"
#include "lua.h"
#define luaM_error(L) luaD_throw(L, LUA_ERRMEM)
#define MEMERRMSG "not enough memory"
/*
** This macro tests whether it is safe to multiply 'n' by the size of
** type 't' without overflows. Because 'e' is always constant, it avoids
** the runtime division MAX_SIZET/(e).
** (The macro is somewhat complex to avoid warnings: The 'sizeof'
** comparison avoids a runtime comparison when overflow cannot occur.
** The compiler should be able to optimize the real test by itself, but
** when it does it, it may give a warning about "comparison is always
** false due to limited range of data type"; the +1 tricks the compiler,
** avoiding this warning but also this optimization.)
*/
#define luaM_testsize(n,e) \
(sizeof(n) >= sizeof(size_t) && cast_sizet((n)) + 1 > MAX_SIZET/(e))
void *luaM_realloc (lua_State *L, void *oldblock, lu_mem oldsize, lu_mem size);
#define luaM_checksize(L,n,e) \
(luaM_testsize(n,e) ? luaM_toobig(L) : cast_void(0))
void *luaM_growaux (lua_State *L, void *block, int *size, int size_elem,
int limit, const char *errormsg);
#define luaM_free(L, b, s) luaM_realloc(L, (b), (s), 0)
#define luaM_freelem(L, b) luaM_realloc(L, (b), sizeof(*(b)), 0)
#define luaM_freearray(L, b, n, t) luaM_realloc(L, (b), \
cast(lu_mem, n)*cast(lu_mem, sizeof(t)), 0)
/*
** Computes the minimum between 'n' and 'MAX_SIZET/sizeof(t)', so that
** the result is not larger than 'n' and cannot overflow a 'size_t'
** when multiplied by the size of type 't'. (Assumes that 'n' is an
** 'int' and that 'int' is not larger than 'size_t'.)
*/
#define luaM_limitN(n,t) \
((cast_sizet(n) <= MAX_SIZET/sizeof(t)) ? (n) : \
cast_int((MAX_SIZET/sizeof(t))))
/*
** Arrays of chars do not need any test
*/
#define luaM_reallocvchar(L,b,on,n) \
cast_charp(luaM_saferealloc_(L, (b), (on)*sizeof(char), (n)*sizeof(char)))
#define luaM_freemem(L, b, s) luaM_free_(L, (b), (s))
#define luaM_free(L, b) luaM_free_(L, (b), sizeof(*(b)))
#define luaM_freearray(L, b, n) luaM_free_(L, (b), (n)*sizeof(*(b)))
#define luaM_new(L,t) cast(t*, luaM_malloc_(L, sizeof(t), 0))
#define luaM_newvector(L,n,t) \
cast(t*, luaM_malloc_(L, cast_sizet(n)*sizeof(t), 0))
#define luaM_newvectorchecked(L,n,t) \
(luaM_checksize(L,n,sizeof(t)), luaM_newvector(L,n,t))
#define luaM_newobject(L,tag,s) luaM_malloc_(L, (s), tag)
#define luaM_newblock(L, size) luaM_newvector(L, size, char)
#define luaM_malloc(L, t) luaM_realloc(L, NULL, 0, (t))
#define luaM_new(L, t) cast(t *, luaM_malloc(L, sizeof(t)))
#define luaM_newvector(L, n,t) cast(t *, luaM_malloc(L, \
cast(lu_mem, n)*cast(lu_mem, sizeof(t))))
#define luaM_growvector(L,v,nelems,size,t,limit,e) \
((v)=cast(t *, luaM_growaux_(L,v,nelems,&(size),sizeof(t), \
luaM_limitN(limit,t),e)))
if (((nelems)+1) > (size)) \
((v)=cast(t *, luaM_growaux(L,v,&(size),sizeof(t),limit,e)))
#define luaM_reallocvector(L, v,oldn,n,t) \
(cast(t *, luaM_realloc_(L, v, cast_sizet(oldn) * sizeof(t), \
cast_sizet(n) * sizeof(t))))
((v)=cast(t *, luaM_realloc(L, v,cast(lu_mem, oldn)*cast(lu_mem, sizeof(t)), \
cast(lu_mem, n)*cast(lu_mem, sizeof(t)))))
#define luaM_shrinkvector(L,v,size,fs,t) \
((v)=cast(t *, luaM_shrinkvector_(L, v, &(size), fs, sizeof(t))))
LUAI_FUNC l_noret luaM_toobig (lua_State *L);
/* not to be called directly */
LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize,
size_t size);
LUAI_FUNC void *luaM_saferealloc_ (lua_State *L, void *block, size_t oldsize,
size_t size);
LUAI_FUNC void luaM_free_ (lua_State *L, void *block, size_t osize);
LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int nelems,
int *size, unsigned size_elem, int limit,
const char *what);
LUAI_FUNC void *luaM_shrinkvector_ (lua_State *L, void *block, int *nelem,
int final_n, unsigned size_elem);
LUAI_FUNC void *luaM_malloc_ (lua_State *L, size_t size, int tag);
#endif

871
lib/lua/loadlib.c
View File

@ -1,748 +1,205 @@
/*
** $Id: loadlib.c $
** $Id: loadlib.c,v 1.4 2003/04/07 20:11:53 roberto Exp $
** Dynamic library loader for Lua
** See Copyright Notice in lua.h
**
** This module contains an implementation of loadlib for Unix systems
** that have dlfcn, an implementation for Windows, and a stub for other
** systems.
*
* This Lua library exports a single function, called loadlib, which is
* called from Lua as loadlib(lib,init), where lib is the full name of the
* library to be loaded (including the complete path) and init is the name
* of a function to be called after the library is loaded. Typically, this
* function will register other functions, thus making the complete library
* available to Lua. The init function is *not* automatically called by
* loadlib. Instead, loadlib returns the init function as a Lua function
* that the client can call when it thinks is appropriate. In the case of
* errors, loadlib returns nil and two strings describing the error.
* The first string is supplied by the operating system; it should be
* informative and useful for error messages. The second string is "open",
* "init", or "absent" to identify the error and is meant to be used for
* making decisions without having to look into the first string (whose
* format is system-dependent).
*
* This module contains an implementation of loadlib for Unix systems that
* have dlfcn, an implementation for Windows, and a stub for other systems.
* See the list at the end of this file for some links to available
* implementations of dlfcn and interfaces to other native dynamic loaders
* on top of which loadlib could be implemented.
*
*/
#define loadlib_c
#define LUA_LIB
#include "lprefix.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#include "llimits.h"
#undef LOADLIB
#ifdef USE_DLOPEN
#define LOADLIB
/*
** LUA_CSUBSEP is the character that replaces dots in submodule names
** when searching for a C loader.
** LUA_LSUBSEP is the character that replaces dots in submodule names
** when searching for a Lua loader.
*/
#if !defined(LUA_CSUBSEP)
#define LUA_CSUBSEP LUA_DIRSEP
#endif
#if !defined(LUA_LSUBSEP)
#define LUA_LSUBSEP LUA_DIRSEP
#endif
/* prefix for open functions in C libraries */
#define LUA_POF "luaopen_"
/* separator for open functions in C libraries */
#define LUA_OFSEP "_"
/*
** key for table in the registry that keeps handles
** for all loaded C libraries
*/
static const char *const CLIBS = "_CLIBS";
#define LIB_FAIL "open"
#define setprogdir(L) ((void)0)
/* cast void* to a Lua function */
#define cast_Lfunc(p) cast(lua_CFunction, cast_func(p))
/*
** system-dependent functions
*/
/*
** unload library 'lib'
*/
static void lsys_unloadlib (void *lib);
/*
** load C library in file 'path'. If 'seeglb', load with all names in
** the library global.
** Returns the library; in case of error, returns NULL plus an
** error string in the stack.
*/
static void *lsys_load (lua_State *L, const char *path, int seeglb);
/*
** Try to find a function named 'sym' in library 'lib'.
** Returns the function; in case of error, returns NULL plus an
** error string in the stack.
*/
static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym);
#if defined(LUA_USE_DLOPEN) /* { */
/*
** {========================================================================
** This is an implementation of loadlib based on the dlfcn interface,
** which is available in all POSIX systems.
** =========================================================================
* This is an implementation of loadlib based on the dlfcn interface.
* The dlfcn interface is available in Linux, SunOS, Solaris, IRIX, FreeBSD,
* NetBSD, AIX 4.2, HPUX 11, and probably most other Unix flavors, at least
* as an emulation layer on top of native functions.
*/
#include <dlfcn.h>
static void lsys_unloadlib (void *lib) {
dlclose(lib);
static int loadlib(lua_State *L)
{
const char *path=luaL_checkstring(L,1);
const char *init=luaL_checkstring(L,2);
void *lib=dlopen(path,RTLD_NOW);
if (lib!=NULL)
{
lua_CFunction f=(lua_CFunction) dlsym(lib,init);
if (f!=NULL)
{
lua_pushlightuserdata(L,lib);
lua_pushcclosure(L,f,1);
return 1;
}
}
/* else return appropriate error messages */
lua_pushnil(L);
lua_pushstring(L,dlerror());
lua_pushstring(L,(lib!=NULL) ? "init" : "open");
if (lib!=NULL) dlclose(lib);
return 3;
}
static void *lsys_load (lua_State *L, const char *path, int seeglb) {
void *lib = dlopen(path, RTLD_NOW | (seeglb ? RTLD_GLOBAL : RTLD_LOCAL));
if (l_unlikely(lib == NULL))
lua_pushstring(L, dlerror());
return lib;
}
static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
lua_CFunction f = cast_Lfunc(dlsym(lib, sym));
if (l_unlikely(f == NULL))
lua_pushstring(L, dlerror());
return f;
}
/* }====================================================== */
#endif
#elif defined(LUA_DL_DLL) /* }{ */
/*
** {======================================================================
** This is an implementation of loadlib for Windows using native functions.
** =======================================================================
** In Windows, default is to use dll; otherwise, default is not to use dll
*/
#ifndef USE_DLL
#ifdef _WIN32
#define USE_DLL 1
#else
#define USE_DLL 0
#endif
#endif
#if USE_DLL
#define LOADLIB
/*
* This is an implementation of loadlib for Windows using native functions.
*/
#include <windows.h>
static void pusherror(lua_State *L)
{
int error=GetLastError();
char buffer[128];
if (FormatMessage(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
0, error, 0, buffer, sizeof(buffer), 0))
lua_pushstring(L,buffer);
else
lua_pushfstring(L,"system error %d\n",error);
}
/*
** optional flags for LoadLibraryEx
*/
#if !defined(LUA_LLE_FLAGS)
#define LUA_LLE_FLAGS 0
#endif
#undef setprogdir
/*
** Replace in the path (on the top of the stack) any occurrence
** of LUA_EXEC_DIR with the executable's path.
*/
static void setprogdir (lua_State *L) {
char buff[MAX_PATH + 1];
char *lb;
DWORD nsize = sizeof(buff)/sizeof(char);
DWORD n = GetModuleFileNameA(NULL, buff, nsize); /* get exec. name */
if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
luaL_error(L, "unable to get ModuleFileName");
else {
*lb = '\0'; /* cut name on the last '\\' to get the path */
luaL_gsub(L, lua_tostring(L, -1), LUA_EXEC_DIR, buff);
lua_remove(L, -2); /* remove original string */
static int loadlib(lua_State *L)
{
const char *path=luaL_checkstring(L,1);
const char *init=luaL_checkstring(L,2);
HINSTANCE lib=LoadLibrary(path);
if (lib!=NULL)
{
lua_CFunction f=(lua_CFunction) GetProcAddress(lib,init);
if (f!=NULL)
{
lua_pushlightuserdata(L,lib);
lua_pushcclosure(L,f,1);
return 1;
}
}
lua_pushnil(L);
pusherror(L);
lua_pushstring(L,(lib!=NULL) ? "init" : "open");
if (lib!=NULL) FreeLibrary(lib);
return 3;
}
static void pusherror (lua_State *L) {
int error = GetLastError();
char buffer[128];
if (FormatMessageA(FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_FROM_SYSTEM,
NULL, error, 0, buffer, sizeof(buffer)/sizeof(char), NULL))
lua_pushstring(L, buffer);
else
lua_pushfstring(L, "system error %d\n", error);
}
static void lsys_unloadlib (void *lib) {
FreeLibrary((HMODULE)lib);
}
static void *lsys_load (lua_State *L, const char *path, int seeglb) {
HMODULE lib = LoadLibraryExA(path, NULL, LUA_LLE_FLAGS);
(void)(seeglb); /* not used: symbols are 'global' by default */
if (lib == NULL) pusherror(L);
return lib;
}
static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
lua_CFunction f = cast_Lfunc(GetProcAddress((HMODULE)lib, sym));
if (f == NULL) pusherror(L);
return f;
}
/* }====================================================== */
#else /* }{ */
/*
** {======================================================
** Fallback for other systems
** =======================================================
*/
#undef LIB_FAIL
#define LIB_FAIL "absent"
#define DLMSG "dynamic libraries not enabled; check your Lua installation"
static void lsys_unloadlib (void *lib) {
(void)(lib); /* not used */
}
static void *lsys_load (lua_State *L, const char *path, int seeglb) {
(void)(path); (void)(seeglb); /* not used */
lua_pushliteral(L, DLMSG);
return NULL;
}
static lua_CFunction lsys_sym (lua_State *L, void *lib, const char *sym) {
(void)(lib); (void)(sym); /* not used */
lua_pushliteral(L, DLMSG);
return NULL;
}
/* }====================================================== */
#endif /* } */
/*
** {==================================================================
** Set Paths
** ===================================================================
*/
/*
** LUA_PATH_VAR and LUA_CPATH_VAR are the names of the environment
** variables that Lua check to set its paths.
*/
#if !defined(LUA_PATH_VAR)
#define LUA_PATH_VAR "LUA_PATH"
#endif
#if !defined(LUA_CPATH_VAR)
#define LUA_CPATH_VAR "LUA_CPATH"
#endif
/*
** return registry.LUA_NOENV as a boolean
*/
static int noenv (lua_State *L) {
int b;
lua_getfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
b = lua_toboolean(L, -1);
lua_pop(L, 1); /* remove value */
return b;
}
#ifndef LOADLIB
/* Fallback for other systems */
/*
** Set a path. (If using the default path, assume it is a string
** literal in C and create it as an external string.)
** Those systems support dlopen, so they should have defined USE_DLOPEN.
** The default (no)implementation gives them a special error message.
*/
static void setpath (lua_State *L, const char *fieldname,
const char *envname,
const char *dft) {
const char *dftmark;
const char *nver = lua_pushfstring(L, "%s%s", envname, LUA_VERSUFFIX);
const char *path = getenv(nver); /* try versioned name */
if (path == NULL) /* no versioned environment variable? */
path = getenv(envname); /* try unversioned name */
if (path == NULL || noenv(L)) /* no environment variable? */
lua_pushexternalstring(L, dft, strlen(dft), NULL, NULL); /* use default */
else if ((dftmark = strstr(path, LUA_PATH_SEP LUA_PATH_SEP)) == NULL)
lua_pushstring(L, path); /* nothing to change */
else { /* path contains a ";;": insert default path in its place */
size_t len = strlen(path);
luaL_Buffer b;
luaL_buffinit(L, &b);
if (path < dftmark) { /* is there a prefix before ';;'? */
luaL_addlstring(&b, path, ct_diff2sz(dftmark - path)); /* add it */
luaL_addchar(&b, *LUA_PATH_SEP);
}
luaL_addstring(&b, dft); /* add default */
if (dftmark < path + len - 2) { /* is there a suffix after ';;'? */
luaL_addchar(&b, *LUA_PATH_SEP);
luaL_addlstring(&b, dftmark + 2, ct_diff2sz((path + len - 2) - dftmark));
}
luaL_pushresult(&b);
}
setprogdir(L);
lua_setfield(L, -3, fieldname); /* package[fieldname] = path value */
lua_pop(L, 1); /* pop versioned variable name ('nver') */
#ifdef linux
#define LOADLIB
#endif
#ifdef sun
#define LOADLIB
#endif
#ifdef sgi
#define LOADLIB
#endif
#ifdef BSD
#define LOADLIB
#endif
#ifdef _WIN32
#define LOADLIB
#endif
#ifdef LOADLIB
#undef LOADLIB
#define LOADLIB "`loadlib' not installed (check your Lua configuration)"
#else
#define LOADLIB "`loadlib' not supported"
#endif
static int loadlib(lua_State *L)
{
lua_pushnil(L);
lua_pushliteral(L,LOADLIB);
lua_pushliteral(L,"absent");
return 3;
}
#endif
/* }================================================================== */
LUALIB_API int luaopen_loadlib (lua_State *L)
{
lua_register(L,"loadlib",loadlib);
return 0;
}
/*
** External strings created by DLLs may need the DLL code to be
** deallocated. This implies that a DLL can only be unloaded after all
** its strings were deallocated. To ensure that, we create a 'library
** string' to represent each DLL, and when this string is deallocated
** it closes its corresponding DLL.
** (The string itself is irrelevant; its userdata is the DLL pointer.)
* Here are some links to available implementations of dlfcn and
* interfaces to other native dynamic loaders on top of which loadlib
* could be implemented. Please send contributions and corrections to us.
*
* AIX
* Starting with AIX 4.2, dlfcn is included in the base OS.
* There is also an emulation package available.
* http://www.faqs.org/faqs/aix-faq/part4/section-21.html
*
* HPUX
* HPUX 11 has dlfcn. For HPUX 10 use shl_*.
* http://www.geda.seul.org/mailinglist/geda-dev37/msg00094.html
* http://www.stat.umn.edu/~luke/xls/projects/dlbasics/dlbasics.html
*
* Macintosh, Windows
* http://www.stat.umn.edu/~luke/xls/projects/dlbasics/dlbasics.html
*
* Mac OS X/Darwin
* http://www.opendarwin.org/projects/dlcompat/
*
* GLIB has wrapper code for BeOS, OS2, Unix and Windows
* http://cvs.gnome.org/lxr/source/glib/gmodule/
*
*/
/*
** return registry.CLIBS[path]
*/
static void *checkclib (lua_State *L, const char *path) {
void *plib;
lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
lua_getfield(L, -1, path);
plib = lua_touserdata(L, -1); /* plib = CLIBS[path] */
lua_pop(L, 2); /* pop CLIBS table and 'plib' */
return plib;
}
/*
** Deallocate function for library strings.
** Unload the DLL associated with the string being deallocated.
*/
static void *freelib (void *ud, void *ptr, size_t osize, size_t nsize) {
/* string itself is irrelevant and static */
(void)ptr; (void)osize; (void)nsize;
lsys_unloadlib(ud); /* unload library represented by the string */
return NULL;
}
/*
** Create a library string that, when deallocated, will unload 'plib'
*/
static void createlibstr (lua_State *L, void *plib) {
/* common content for all library strings */
static const char dummy[] = "01234567890";
lua_pushexternalstring(L, dummy, sizeof(dummy) - 1, freelib, plib);
}
/*
** registry.CLIBS[path] = plib -- for queries.
** Also create a reference to strlib, so that the library string will
** only be collected when registry.CLIBS is collected.
*/
static void addtoclib (lua_State *L, const char *path, void *plib) {
lua_getfield(L, LUA_REGISTRYINDEX, CLIBS);
lua_pushlightuserdata(L, plib);
lua_setfield(L, -2, path); /* CLIBS[path] = plib */
createlibstr(L, plib);
luaL_ref(L, -2); /* keep library string in CLIBS */
lua_pop(L, 1); /* pop CLIBS table */
}
/* error codes for 'lookforfunc' */
#define ERRLIB 1
#define ERRFUNC 2
/*
** Look for a C function named 'sym' in a dynamically loaded library
** 'path'.
** First, check whether the library is already loaded; if not, try
** to load it.
** Then, if 'sym' is '*', return true (as library has been loaded).
** Otherwise, look for symbol 'sym' in the library and push a
** C function with that symbol.
** Return 0 with 'true' or a function in the stack; in case of
** errors, return an error code with an error message in the stack.
*/
static int lookforfunc (lua_State *L, const char *path, const char *sym) {
void *reg = checkclib(L, path); /* check loaded C libraries */
if (reg == NULL) { /* must load library? */
reg = lsys_load(L, path, *sym == '*'); /* global symbols if 'sym'=='*' */
if (reg == NULL) return ERRLIB; /* unable to load library */
addtoclib(L, path, reg);
}
if (*sym == '*') { /* loading only library (no function)? */
lua_pushboolean(L, 1); /* return 'true' */
return 0; /* no errors */
}
else {
lua_CFunction f = lsys_sym(L, reg, sym);
if (f == NULL)
return ERRFUNC; /* unable to find function */
lua_pushcfunction(L, f); /* else create new function */
return 0; /* no errors */
}
}
static int ll_loadlib (lua_State *L) {
const char *path = luaL_checkstring(L, 1);
const char *init = luaL_checkstring(L, 2);
int stat = lookforfunc(L, path, init);
if (l_likely(stat == 0)) /* no errors? */
return 1; /* return the loaded function */
else { /* error; error message is on stack top */
luaL_pushfail(L);
lua_insert(L, -2);
lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");
return 3; /* return fail, error message, and where */
}
}
/*
** {======================================================
** 'require' function
** =======================================================
*/
static int readable (const char *filename) {
FILE *f = fopen(filename, "r"); /* try to open file */
if (f == NULL) return 0; /* open failed */
fclose(f);
return 1;
}
/*
** Get the next name in '*path' = 'name1;name2;name3;...', changing
** the ending ';' to '\0' to create a zero-terminated string. Return
** NULL when list ends.
*/
static const char *getnextfilename (char **path, char *end) {
char *sep;
char *name = *path;
if (name == end)
return NULL; /* no more names */
else if (*name == '\0') { /* from previous iteration? */
*name = *LUA_PATH_SEP; /* restore separator */
name++; /* skip it */
}
sep = strchr(name, *LUA_PATH_SEP); /* find next separator */
if (sep == NULL) /* separator not found? */
sep = end; /* name goes until the end */
*sep = '\0'; /* finish file name */
*path = sep; /* will start next search from here */
return name;
}
/*
** Given a path such as ";blabla.so;blublu.so", pushes the string
**
** no file 'blabla.so'
** no file 'blublu.so'
*/
static void pusherrornotfound (lua_State *L, const char *path) {
luaL_Buffer b;
luaL_buffinit(L, &b);
luaL_addstring(&b, "no file '");
luaL_addgsub(&b, path, LUA_PATH_SEP, "'\n\tno file '");
luaL_addstring(&b, "'");
luaL_pushresult(&b);
}
static const char *searchpath (lua_State *L, const char *name,
const char *path,
const char *sep,
const char *dirsep) {
luaL_Buffer buff;
char *pathname; /* path with name inserted */
char *endpathname; /* its end */
const char *filename;
/* separator is non-empty and appears in 'name'? */
if (*sep != '\0' && strchr(name, *sep) != NULL)
name = luaL_gsub(L, name, sep, dirsep); /* replace it by 'dirsep' */
luaL_buffinit(L, &buff);
/* add path to the buffer, replacing marks ('?') with the file name */
luaL_addgsub(&buff, path, LUA_PATH_MARK, name);
luaL_addchar(&buff, '\0');
pathname = luaL_buffaddr(&buff); /* writable list of file names */
endpathname = pathname + luaL_bufflen(&buff) - 1;
while ((filename = getnextfilename(&pathname, endpathname)) != NULL) {
if (readable(filename)) /* does file exist and is readable? */
return lua_pushstring(L, filename); /* save and return name */
}
luaL_pushresult(&buff); /* push path to create error message */
pusherrornotfound(L, lua_tostring(L, -1)); /* create error message */
return NULL; /* not found */
}
static int ll_searchpath (lua_State *L) {
const char *f = searchpath(L, luaL_checkstring(L, 1),
luaL_checkstring(L, 2),
luaL_optstring(L, 3, "."),
luaL_optstring(L, 4, LUA_DIRSEP));
if (f != NULL) return 1;
else { /* error message is on top of the stack */
luaL_pushfail(L);
lua_insert(L, -2);
return 2; /* return fail + error message */
}
}
static const char *findfile (lua_State *L, const char *name,
const char *pname,
const char *dirsep) {
const char *path;
lua_getfield(L, lua_upvalueindex(1), pname);
path = lua_tostring(L, -1);
if (l_unlikely(path == NULL))
luaL_error(L, "'package.%s' must be a string", pname);
return searchpath(L, name, path, ".", dirsep);
}
static int checkload (lua_State *L, int stat, const char *filename) {
if (l_likely(stat)) { /* module loaded successfully? */
lua_pushstring(L, filename); /* will be 2nd argument to module */
return 2; /* return open function and file name */
}
else
return luaL_error(L, "error loading module '%s' from file '%s':\n\t%s",
lua_tostring(L, 1), filename, lua_tostring(L, -1));
}
static int searcher_Lua (lua_State *L) {
const char *filename;
const char *name = luaL_checkstring(L, 1);
filename = findfile(L, name, "path", LUA_LSUBSEP);
if (filename == NULL) return 1; /* module not found in this path */
return checkload(L, (luaL_loadfilex(L, filename, "bt") == LUA_OK), filename);
}
/*
** Try to find a load function for module 'modname' at file 'filename'.
** First, change '.' to '_' in 'modname'; then, if 'modname' has
** the form X-Y (that is, it has an "ignore mark"), build a function
** name "luaopen_X" and look for it. (For compatibility, if that
** fails, it also tries "luaopen_Y".) If there is no ignore mark,
** look for a function named "luaopen_modname".
*/
static int loadfunc (lua_State *L, const char *filename, const char *modname) {
const char *openfunc;
const char *mark;
modname = luaL_gsub(L, modname, ".", LUA_OFSEP);
mark = strchr(modname, *LUA_IGMARK);
if (mark) {
int stat;
openfunc = lua_pushlstring(L, modname, ct_diff2sz(mark - modname));
openfunc = lua_pushfstring(L, LUA_POF"%s", openfunc);
stat = lookforfunc(L, filename, openfunc);
if (stat != ERRFUNC) return stat;
modname = mark + 1; /* else go ahead and try old-style name */
}
openfunc = lua_pushfstring(L, LUA_POF"%s", modname);
return lookforfunc(L, filename, openfunc);
}
static int searcher_C (lua_State *L) {
const char *name = luaL_checkstring(L, 1);
const char *filename = findfile(L, name, "cpath", LUA_CSUBSEP);
if (filename == NULL) return 1; /* module not found in this path */
return checkload(L, (loadfunc(L, filename, name) == 0), filename);
}
static int searcher_Croot (lua_State *L) {
const char *filename;
const char *name = luaL_checkstring(L, 1);
const char *p = strchr(name, '.');
int stat;
if (p == NULL) return 0; /* is root */
lua_pushlstring(L, name, ct_diff2sz(p - name));
filename = findfile(L, lua_tostring(L, -1), "cpath", LUA_CSUBSEP);
if (filename == NULL) return 1; /* root not found */
if ((stat = loadfunc(L, filename, name)) != 0) {
if (stat != ERRFUNC)
return checkload(L, 0, filename); /* real error */
else { /* open function not found */
lua_pushfstring(L, "no module '%s' in file '%s'", name, filename);
return 1;
}
}
lua_pushstring(L, filename); /* will be 2nd argument to module */
return 2;
}
static int searcher_preload (lua_State *L) {
const char *name = luaL_checkstring(L, 1);
lua_getfield(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
if (lua_getfield(L, -1, name) == LUA_TNIL) { /* not found? */
lua_pushfstring(L, "no field package.preload['%s']", name);
return 1;
}
else {
lua_pushliteral(L, ":preload:");
return 2;
}
}
static void findloader (lua_State *L, const char *name) {
int i;
luaL_Buffer msg; /* to build error message */
/* push 'package.searchers' to index 3 in the stack */
if (l_unlikely(lua_getfield(L, lua_upvalueindex(1), "searchers")
!= LUA_TTABLE))
luaL_error(L, "'package.searchers' must be a table");
luaL_buffinit(L, &msg);
luaL_addstring(&msg, "\n\t"); /* error-message prefix for first message */
/* iterate over available searchers to find a loader */
for (i = 1; ; i++) {
if (l_unlikely(lua_rawgeti(L, 3, i) == LUA_TNIL)) { /* no more searchers? */
lua_pop(L, 1); /* remove nil */
luaL_buffsub(&msg, 2); /* remove last prefix */
luaL_pushresult(&msg); /* create error message */
luaL_error(L, "module '%s' not found:%s", name, lua_tostring(L, -1));
}
lua_pushstring(L, name);
lua_call(L, 1, 2); /* call it */
if (lua_isfunction(L, -2)) /* did it find a loader? */
return; /* module loader found */
else if (lua_isstring(L, -2)) { /* searcher returned error message? */
lua_pop(L, 1); /* remove extra return */
luaL_addvalue(&msg); /* concatenate error message */
luaL_addstring(&msg, "\n\t"); /* prefix for next message */
}
else /* no error message */
lua_pop(L, 2); /* remove both returns */
}
}
static int ll_require (lua_State *L) {
const char *name = luaL_checkstring(L, 1);
lua_settop(L, 1); /* LOADED table will be at index 2 */
lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
lua_getfield(L, 2, name); /* LOADED[name] */
if (lua_toboolean(L, -1)) /* is it there? */
return 1; /* package is already loaded */
/* else must load package */
lua_pop(L, 1); /* remove 'getfield' result */
findloader(L, name);
lua_rotate(L, -2, 1); /* function <-> loader data */
lua_pushvalue(L, 1); /* name is 1st argument to module loader */
lua_pushvalue(L, -3); /* loader data is 2nd argument */
/* stack: ...; loader data; loader function; mod. name; loader data */
lua_call(L, 2, 1); /* run loader to load module */
/* stack: ...; loader data; result from loader */
if (!lua_isnil(L, -1)) /* non-nil return? */
lua_setfield(L, 2, name); /* LOADED[name] = returned value */
else
lua_pop(L, 1); /* pop nil */
if (lua_getfield(L, 2, name) == LUA_TNIL) { /* module set no value? */
lua_pushboolean(L, 1); /* use true as result */
lua_copy(L, -1, -2); /* replace loader result */
lua_setfield(L, 2, name); /* LOADED[name] = true */
}
lua_rotate(L, -2, 1); /* loader data <-> module result */
return 2; /* return module result and loader data */
}
/* }====================================================== */
static const luaL_Reg pk_funcs[] = {
{"loadlib", ll_loadlib},
{"searchpath", ll_searchpath},
/* placeholders */
{"preload", NULL},
{"cpath", NULL},
{"path", NULL},
{"searchers", NULL},
{"loaded", NULL},
{NULL, NULL}
};
static const luaL_Reg ll_funcs[] = {
{"require", ll_require},
{NULL, NULL}
};
static void createsearcherstable (lua_State *L) {
static const lua_CFunction searchers[] = {
searcher_preload,
searcher_Lua,
searcher_C,
searcher_Croot,
NULL
};
int i;
/* create 'searchers' table */
lua_createtable(L, sizeof(searchers)/sizeof(searchers[0]) - 1, 0);
/* fill it with predefined searchers */
for (i=0; searchers[i] != NULL; i++) {
lua_pushvalue(L, -2); /* set 'package' as upvalue for all searchers */
lua_pushcclosure(L, searchers[i], 1);
lua_rawseti(L, -2, i+1);
}
lua_setfield(L, -2, "searchers"); /* put it in field 'searchers' */
}
LUAMOD_API int luaopen_package (lua_State *L) {
luaL_getsubtable(L, LUA_REGISTRYINDEX, CLIBS); /* create CLIBS table */
lua_pop(L, 1); /* will not use it now */
luaL_newlib(L, pk_funcs); /* create 'package' table */
createsearcherstable(L);
/* set paths */
setpath(L, "path", LUA_PATH_VAR, LUA_PATH_DEFAULT);
setpath(L, "cpath", LUA_CPATH_VAR, LUA_CPATH_DEFAULT);
/* store config information */
lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATH_SEP "\n" LUA_PATH_MARK "\n"
LUA_EXEC_DIR "\n" LUA_IGMARK "\n");
lua_setfield(L, -2, "config");
/* set field 'loaded' */
luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);
lua_setfield(L, -2, "loaded");
/* set field 'preload' */
luaL_getsubtable(L, LUA_REGISTRYINDEX, LUA_PRELOAD_TABLE);
lua_setfield(L, -2, "preload");
lua_pushglobaltable(L);
lua_pushvalue(L, -2); /* set 'package' as upvalue for next lib */
luaL_setfuncs(L, ll_funcs, 1); /* open lib into global table */
lua_pop(L, 1); /* pop global table */
return 1; /* return 'package' table */
}

777
lib/lua/lobject.c
View File

@ -1,27 +1,18 @@
/*
** $Id: lobject.c $
** $Id: lobject.c,v 1.97 2003/04/03 13:35:34 roberto Exp $
** Some generic functions over Lua objects
** See Copyright Notice in lua.h
*/
#define lobject_c
#define LUA_CORE
#include "lprefix.h"
#include <float.h>
#include <locale.h>
#include <math.h>
#include <ctype.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define lobject_c
#include "lua.h"
#include "lctype.h"
#include "ldebug.h"
#include "ldo.h"
#include "lmem.h"
#include "lobject.h"
@ -30,632 +21,132 @@
#include "lvm.h"
/* function to convert a string to a lua_Number */
#ifndef lua_str2number
#define lua_str2number(s,p) strtod((s), (p))
#endif
const TObject luaO_nilobject = {LUA_TNIL, {NULL}};
/*
** Computes ceil(log2(x)), which is the smallest integer n such that
** x <= (1 << n).
** converts an integer to a "floating point byte", represented as
** (mmmmmxxx), where the real value is (xxx) * 2^(mmmmm)
*/
lu_byte luaO_ceillog2 (unsigned int x) {
static const lu_byte log_2[256] = { /* log_2[i - 1] = ceil(log2(i)) */
0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
int luaO_int2fb (unsigned int x) {
int m = 0; /* mantissa */
while (x >= (1<<3)) {
x = (x+1) >> 1;
m++;
}
return (m << 3) | cast(int, x);
}
int luaO_log2 (unsigned int x) {
static const lu_byte log_8[255] = {
0,
1,1,
2,2,2,2,
3,3,3,3,3,3,3,3,
4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,
5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
};
int l = 0;
x--;
while (x >= 256) { l += 8; x >>= 8; }
return cast_byte(l + log_2[x]);
}
/*
** Encodes 'p'% as a floating-point byte, represented as (eeeexxxx).
** The exponent is represented using excess-7. Mimicking IEEE 754, the
** representation normalizes the number when possible, assuming an extra
** 1 before the mantissa (xxxx) and adding one to the exponent (eeee)
** to signal that. So, the real value is (1xxxx) * 2^(eeee - 7 - 1) if
** eeee != 0, and (xxxx) * 2^-7 otherwise (subnormal numbers).
*/
lu_byte luaO_codeparam (unsigned int p) {
if (p >= (cast(lu_mem, 0x1F) << (0xF - 7 - 1)) * 100u) /* overflow? */
return 0xFF; /* return maximum value */
if (x >= 0x00010000) {
if (x >= 0x01000000) return log_8[((x>>24) & 0xff) - 1]+24;
else return log_8[((x>>16) & 0xff) - 1]+16;
}
else {
p = (cast(l_uint32, p) * 128 + 99) / 100; /* round up the division */
if (p < 0x10) { /* subnormal number? */
/* exponent bits are already zero; nothing else to do */
return cast_byte(p);
}
else { /* p >= 0x10 implies ceil(log2(p + 1)) >= 5 */
/* preserve 5 bits in 'p' */
unsigned log = luaO_ceillog2(p + 1) - 5u;
return cast_byte(((p >> log) - 0x10) | ((log + 1) << 4));
}
if (x >= 0x00000100) return log_8[((x>>8) & 0xff) - 1]+8;
else if (x) return log_8[(x & 0xff) - 1];
return -1; /* special `log' for 0 */
}
}
/*
** Computes 'p' times 'x', where 'p' is a floating-point byte. Roughly,
** we have to multiply 'x' by the mantissa and then shift accordingly to
** the exponent. If the exponent is positive, both the multiplication
** and the shift increase 'x', so we have to care only about overflows.
** For negative exponents, however, multiplying before the shift keeps
** more significant bits, as long as the multiplication does not
** overflow, so we check which order is best.
*/
l_mem luaO_applyparam (lu_byte p, l_mem x) {
int m = p & 0xF; /* mantissa */
int e = (p >> 4); /* exponent */
if (e > 0) { /* normalized? */
e--; /* correct exponent */
m += 0x10; /* correct mantissa; maximum value is 0x1F */
}
e -= 7; /* correct excess-7 */
if (e >= 0) {
if (x < (MAX_LMEM / 0x1F) >> e) /* no overflow? */
return (x * m) << e; /* order doesn't matter here */
else /* real overflow */
return MAX_LMEM;
}
else { /* negative exponent */
e = -e;
if (x < MAX_LMEM / 0x1F) /* multiplication cannot overflow? */
return (x * m) >> e; /* multiplying first gives more precision */
else if ((x >> e) < MAX_LMEM / 0x1F) /* cannot overflow after shift? */
return (x >> e) * m;
else /* real overflow */
return MAX_LMEM;
int luaO_rawequalObj (const TObject *t1, const TObject *t2) {
if (ttype(t1) != ttype(t2)) return 0;
else switch (ttype(t1)) {
case LUA_TNIL:
return 1;
case LUA_TNUMBER:
return nvalue(t1) == nvalue(t2);
case LUA_TBOOLEAN:
return bvalue(t1) == bvalue(t2); /* boolean true must be 1 !! */
case LUA_TLIGHTUSERDATA:
return pvalue(t1) == pvalue(t2);
default:
lua_assert(iscollectable(t1));
return gcvalue(t1) == gcvalue(t2);
}
}
static lua_Integer intarith (lua_State *L, int op, lua_Integer v1,
lua_Integer v2) {
switch (op) {
case LUA_OPADD: return intop(+, v1, v2);
case LUA_OPSUB:return intop(-, v1, v2);
case LUA_OPMUL:return intop(*, v1, v2);
case LUA_OPMOD: return luaV_mod(L, v1, v2);
case LUA_OPIDIV: return luaV_idiv(L, v1, v2);
case LUA_OPBAND: return intop(&, v1, v2);
case LUA_OPBOR: return intop(|, v1, v2);
case LUA_OPBXOR: return intop(^, v1, v2);
case LUA_OPSHL: return luaV_shiftl(v1, v2);
case LUA_OPSHR: return luaV_shiftr(v1, v2);
case LUA_OPUNM: return intop(-, 0, v1);
case LUA_OPBNOT: return intop(^, ~l_castS2U(0), v1);
default: lua_assert(0); return 0;
}
}
static lua_Number numarith (lua_State *L, int op, lua_Number v1,
lua_Number v2) {
switch (op) {
case LUA_OPADD: return luai_numadd(L, v1, v2);
case LUA_OPSUB: return luai_numsub(L, v1, v2);
case LUA_OPMUL: return luai_nummul(L, v1, v2);
case LUA_OPDIV: return luai_numdiv(L, v1, v2);
case LUA_OPPOW: return luai_numpow(L, v1, v2);
case LUA_OPIDIV: return luai_numidiv(L, v1, v2);
case LUA_OPUNM: return luai_numunm(L, v1);
case LUA_OPMOD: return luaV_modf(L, v1, v2);
default: lua_assert(0); return 0;
}
}
int luaO_rawarith (lua_State *L, int op, const TValue *p1, const TValue *p2,
TValue *res) {
switch (op) {
case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR:
case LUA_OPSHL: case LUA_OPSHR:
case LUA_OPBNOT: { /* operate only on integers */
lua_Integer i1; lua_Integer i2;
if (tointegerns(p1, &i1) && tointegerns(p2, &i2)) {
setivalue(res, intarith(L, op, i1, i2));
return 1;
}
else return 0; /* fail */
}
case LUA_OPDIV: case LUA_OPPOW: { /* operate only on floats */
lua_Number n1; lua_Number n2;
if (tonumberns(p1, n1) && tonumberns(p2, n2)) {
setfltvalue(res, numarith(L, op, n1, n2));
return 1;
}
else return 0; /* fail */
}
default: { /* other operations */
lua_Number n1; lua_Number n2;
if (ttisinteger(p1) && ttisinteger(p2)) {
setivalue(res, intarith(L, op, ivalue(p1), ivalue(p2)));
return 1;
}
else if (tonumberns(p1, n1) && tonumberns(p2, n2)) {
setfltvalue(res, numarith(L, op, n1, n2));
return 1;
}
else return 0; /* fail */
}
}
}
void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2,
StkId res) {
if (!luaO_rawarith(L, op, p1, p2, s2v(res))) {
/* could not perform raw operation; try metamethod */
luaT_trybinTM(L, p1, p2, res, cast(TMS, (op - LUA_OPADD) + TM_ADD));
}
}
lu_byte luaO_hexavalue (int c) {
lua_assert(lisxdigit(c));
if (lisdigit(c)) return cast_byte(c - '0');
else return cast_byte((ltolower(c) - 'a') + 10);
}
static int isneg (const char **s) {
if (**s == '-') { (*s)++; return 1; }
else if (**s == '+') (*s)++;
return 0;
}
/*
** {==================================================================
** Lua's implementation for 'lua_strx2number'
** ===================================================================
*/
#if !defined(lua_strx2number)
/* maximum number of significant digits to read (to avoid overflows
even with single floats) */
#define MAXSIGDIG 30
/*
** convert a hexadecimal numeric string to a number, following
** C99 specification for 'strtod'
*/
static lua_Number lua_strx2number (const char *s, char **endptr) {
int dot = lua_getlocaledecpoint();
lua_Number r = l_mathop(0.0); /* result (accumulator) */
int sigdig = 0; /* number of significant digits */
int nosigdig = 0; /* number of non-significant digits */
int e = 0; /* exponent correction */
int neg; /* 1 if number is negative */
int hasdot = 0; /* true after seen a dot */
*endptr = cast_charp(s); /* nothing is valid yet */
while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
neg = isneg(&s); /* check sign */
if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */
return l_mathop(0.0); /* invalid format (no '0x') */
for (s += 2; ; s++) { /* skip '0x' and read numeral */
if (*s == dot) {
if (hasdot) break; /* second dot? stop loop */
else hasdot = 1;
}
else if (lisxdigit(cast_uchar(*s))) {
if (sigdig == 0 && *s == '0') /* non-significant digit (zero)? */
nosigdig++;
else if (++sigdig <= MAXSIGDIG) /* can read it without overflow? */
r = (r * l_mathop(16.0)) + luaO_hexavalue(*s);
else e++; /* too many digits; ignore, but still count for exponent */
if (hasdot) e--; /* decimal digit? correct exponent */
}
else break; /* neither a dot nor a digit */
}
if (nosigdig + sigdig == 0) /* no digits? */
return l_mathop(0.0); /* invalid format */
*endptr = cast_charp(s); /* valid up to here */
e *= 4; /* each digit multiplies/divides value by 2^4 */
if (*s == 'p' || *s == 'P') { /* exponent part? */
int exp1 = 0; /* exponent value */
int neg1; /* exponent sign */
s++; /* skip 'p' */
neg1 = isneg(&s); /* sign */
if (!lisdigit(cast_uchar(*s)))
return l_mathop(0.0); /* invalid; must have at least one digit */
while (lisdigit(cast_uchar(*s))) /* read exponent */
exp1 = exp1 * 10 + *(s++) - '0';
if (neg1) exp1 = -exp1;
e += exp1;
*endptr = cast_charp(s); /* valid up to here */
}
if (neg) r = -r;
return l_mathop(ldexp)(r, e);
}
#endif
/* }====================================================== */
/* maximum length of a numeral to be converted to a number */
#if !defined (L_MAXLENNUM)
#define L_MAXLENNUM 200
#endif
/*
** Convert string 's' to a Lua number (put in 'result'). Return NULL on
** fail or the address of the ending '\0' on success. ('mode' == 'x')
** means a hexadecimal numeral.
*/
static const char *l_str2dloc (const char *s, lua_Number *result, int mode) {
int luaO_str2d (const char *s, lua_Number *result) {
char *endptr;
*result = (mode == 'x') ? lua_strx2number(s, &endptr) /* try to convert */
: lua_str2number(s, &endptr);
if (endptr == s) return NULL; /* nothing recognized? */
while (lisspace(cast_uchar(*endptr))) endptr++; /* skip trailing spaces */
return (*endptr == '\0') ? endptr : NULL; /* OK iff no trailing chars */
}
/*
** Convert string 's' to a Lua number (put in 'result') handling the
** current locale.
** This function accepts both the current locale or a dot as the radix
** mark. If the conversion fails, it may mean number has a dot but
** locale accepts something else. In that case, the code copies 's'
** to a buffer (because 's' is read-only), changes the dot to the
** current locale radix mark, and tries to convert again.
** The variable 'mode' checks for special characters in the string:
** - 'n' means 'inf' or 'nan' (which should be rejected)
** - 'x' means a hexadecimal numeral
** - '.' just optimizes the search for the common case (no special chars)
*/
static const char *l_str2d (const char *s, lua_Number *result) {
const char *endptr;
const char *pmode = strpbrk(s, ".xXnN"); /* look for special chars */
int mode = pmode ? ltolower(cast_uchar(*pmode)) : 0;
if (mode == 'n') /* reject 'inf' and 'nan' */
return NULL;
endptr = l_str2dloc(s, result, mode); /* try to convert */
if (endptr == NULL) { /* failed? may be a different locale */
char buff[L_MAXLENNUM + 1];
const char *pdot = strchr(s, '.');
if (pdot == NULL || strlen(s) > L_MAXLENNUM)
return NULL; /* string too long or no dot; fail */
strcpy(buff, s); /* copy string to buffer */
buff[pdot - s] = lua_getlocaledecpoint(); /* correct decimal point */
endptr = l_str2dloc(buff, result, mode); /* try again */
if (endptr != NULL)
endptr = s + (endptr - buff); /* make relative to 's' */
}
return endptr;
}
#define MAXBY10 cast(lua_Unsigned, LUA_MAXINTEGER / 10)
#define MAXLASTD cast_int(LUA_MAXINTEGER % 10)
static const char *l_str2int (const char *s, lua_Integer *result) {
lua_Unsigned a = 0;
int empty = 1;
int neg;
while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */
neg = isneg(&s);
if (s[0] == '0' &&
(s[1] == 'x' || s[1] == 'X')) { /* hex? */
s += 2; /* skip '0x' */
for (; lisxdigit(cast_uchar(*s)); s++) {
a = a * 16 + luaO_hexavalue(*s);
empty = 0;
}
}
else { /* decimal */
for (; lisdigit(cast_uchar(*s)); s++) {
int d = *s - '0';
if (a >= MAXBY10 && (a > MAXBY10 || d > MAXLASTD + neg)) /* overflow? */
return NULL; /* do not accept it (as integer) */
a = a * 10 + cast_uint(d);
empty = 0;
}
}
while (lisspace(cast_uchar(*s))) s++; /* skip trailing spaces */
if (empty || *s != '\0') return NULL; /* something wrong in the numeral */
else {
*result = l_castU2S((neg) ? 0u - a : a);
return s;
}
}
size_t luaO_str2num (const char *s, TValue *o) {
lua_Integer i; lua_Number n;
const char *e;
if ((e = l_str2int(s, &i)) != NULL) { /* try as an integer */
setivalue(o, i);
}
else if ((e = l_str2d(s, &n)) != NULL) { /* else try as a float */
setfltvalue(o, n);
}
else
return 0; /* conversion failed */
return ct_diff2sz(e - s) + 1; /* success; return string size */
}
int luaO_utf8esc (char *buff, l_uint32 x) {
int n = 1; /* number of bytes put in buffer (backwards) */
lua_assert(x <= 0x7FFFFFFFu);
if (x < 0x80) /* ASCII? */
buff[UTF8BUFFSZ - 1] = cast_char(x);
else { /* need continuation bytes */
unsigned int mfb = 0x3f; /* maximum that fits in first byte */
do { /* add continuation bytes */
buff[UTF8BUFFSZ - (n++)] = cast_char(0x80 | (x & 0x3f));
x >>= 6; /* remove added bits */
mfb >>= 1; /* now there is one less bit available in first byte */
} while (x > mfb); /* still needs continuation byte? */
buff[UTF8BUFFSZ - n] = cast_char((~mfb << 1) | x); /* add first byte */
}
return n;
}
/*
** The size of the buffer for the conversion of a number to a string
** 'LUA_N2SBUFFSZ' must be enough to accommodate both LUA_INTEGER_FMT
** and LUA_NUMBER_FMT. For a long long int, this is 19 digits plus a
** sign and a final '\0', adding to 21. For a long double, it can go to
** a sign, the dot, an exponent letter, an exponent sign, 4 exponent
** digits, the final '\0', plus the significant digits, which are
** approximately the *_DIG attribute.
*/
#if LUA_N2SBUFFSZ < (20 + l_floatatt(DIG))
#error "invalid value for LUA_N2SBUFFSZ"
#endif
/*
** Convert a float to a string, adding it to a buffer. First try with
** a not too large number of digits, to avoid noise (for instance,
** 1.1 going to "1.1000000000000001"). If that lose precision, so
** that reading the result back gives a different number, then do the
** conversion again with extra precision. Moreover, if the numeral looks
** like an integer (without a decimal point or an exponent), add ".0" to
** its end.
*/
static int tostringbuffFloat (lua_Number n, char *buff) {
/* first conversion */
int len = l_sprintf(buff, LUA_N2SBUFFSZ, LUA_NUMBER_FMT,
(LUAI_UACNUMBER)n);
lua_Number check = lua_str2number(buff, NULL); /* read it back */
if (check != n) { /* not enough precision? */
/* convert again with more precision */
len = l_sprintf(buff, LUA_N2SBUFFSZ, LUA_NUMBER_FMT_N,
(LUAI_UACNUMBER)n);
}
/* looks like an integer? */
if (buff[strspn(buff, "-0123456789")] == '\0') {
buff[len++] = lua_getlocaledecpoint();
buff[len++] = '0'; /* adds '.0' to result */
}
return len;
}
/*
** Convert a number object to a string, adding it to a buffer.
*/
unsigned luaO_tostringbuff (const TValue *obj, char *buff) {
int len;
lua_assert(ttisnumber(obj));
if (ttisinteger(obj))
len = lua_integer2str(buff, LUA_N2SBUFFSZ, ivalue(obj));
else
len = tostringbuffFloat(fltvalue(obj), buff);
lua_assert(len < LUA_N2SBUFFSZ);
return cast_uint(len);
}
/*
** Convert a number object to a Lua string, replacing the value at 'obj'
*/
void luaO_tostring (lua_State *L, TValue *obj) {
char buff[LUA_N2SBUFFSZ];
unsigned len = luaO_tostringbuff(obj, buff);
setsvalue(L, obj, luaS_newlstr(L, buff, len));
lua_Number res = lua_str2number(s, &endptr);
if (endptr == s) return 0; /* no conversion */
while (isspace((unsigned char)(*endptr))) endptr++;
if (*endptr != '\0') return 0; /* invalid trailing characters? */
*result = res;
return 1;
}
/*
** {==================================================================
** 'luaO_pushvfstring'
** ===================================================================
*/
/*
** Size for buffer space used by 'luaO_pushvfstring'. It should be
** (LUA_IDSIZE + LUA_N2SBUFFSZ) + a minimal space for basic messages,
** so that 'luaG_addinfo' can work directly on the static buffer.
*/
#define BUFVFS cast_uint(LUA_IDSIZE + LUA_N2SBUFFSZ + 95)
/*
** Buffer used by 'luaO_pushvfstring'. 'err' signals an error while
** building result (memory error [1] or buffer overflow [2]).
*/
typedef struct BuffFS {
lua_State *L;
char *b;
size_t buffsize;
size_t blen; /* length of string in 'buff' */
int err;
char space[BUFVFS]; /* initial buffer */
} BuffFS;
static void initbuff (lua_State *L, BuffFS *buff) {
buff->L = L;
buff->b = buff->space;
buff->buffsize = sizeof(buff->space);
buff->blen = 0;
buff->err = 0;
static void pushstr (lua_State *L, const char *str) {
setsvalue2s(L->top, luaS_new(L, str));
incr_top(L);
}
/*
** Push final result from 'luaO_pushvfstring'. This function may raise
** errors explicitly or through memory errors, so it must run protected.
*/
static void pushbuff (lua_State *L, void *ud) {
BuffFS *buff = cast(BuffFS*, ud);
switch (buff->err) {
case 1: /* memory error */
luaD_throw(L, LUA_ERRMEM);
break;
case 2: /* length overflow: Add "..." at the end of result */
if (buff->buffsize - buff->blen < 3)
strcpy(buff->b + buff->blen - 3, "..."); /* 'blen' must be > 3 */
else { /* there is enough space left for the "..." */
strcpy(buff->b + buff->blen, "...");
buff->blen += 3;
}
/* FALLTHROUGH */
default: { /* no errors, but it can raise one creating the new string */
TString *ts = luaS_newlstr(L, buff->b, buff->blen);
setsvalue2s(L, L->top.p, ts);
L->top.p++;
}
}
}
static const char *clearbuff (BuffFS *buff) {
lua_State *L = buff->L;
const char *res;
if (luaD_rawrunprotected(L, pushbuff, buff) != LUA_OK) /* errors? */
res = NULL; /* error message is on the top of the stack */
else
res = getstr(tsvalue(s2v(L->top.p - 1)));
if (buff->b != buff->space) /* using dynamic buffer? */
luaM_freearray(L, buff->b, buff->buffsize); /* free it */
return res;
}
static void addstr2buff (BuffFS *buff, const char *str, size_t slen) {
size_t left = buff->buffsize - buff->blen; /* space left in the buffer */
if (buff->err) /* do nothing else after an error */
return;
if (slen > left) { /* new string doesn't fit into current buffer? */
if (slen > ((MAX_SIZE/2) - buff->blen)) { /* overflow? */
memcpy(buff->b + buff->blen, str, left); /* copy what it can */
buff->blen = buff->buffsize;
buff->err = 2; /* doesn't add anything else */
return;
}
else {
size_t newsize = buff->buffsize + slen; /* limited to MAX_SIZE/2 */
char *newb =
(buff->b == buff->space) /* still using static space? */
? luaM_reallocvector(buff->L, NULL, 0, newsize, char)
: luaM_reallocvector(buff->L, buff->b, buff->buffsize, newsize,
char);
if (newb == NULL) { /* allocation error? */
buff->err = 1; /* signal a memory error */
return;
}
if (buff->b == buff->space) /* new buffer (not reallocated)? */
memcpy(newb, buff->b, buff->blen); /* copy previous content */
buff->b = newb; /* set new (larger) buffer... */
buff->buffsize = newsize; /* ...and its new size */
}
}
memcpy(buff->b + buff->blen, str, slen); /* copy new content */
buff->blen += slen;
}
/*
** Add a numeral to the buffer.
*/
static void addnum2buff (BuffFS *buff, TValue *num) {
char numbuff[LUA_N2SBUFFSZ];
unsigned len = luaO_tostringbuff(num, numbuff);
addstr2buff(buff, numbuff, len);
}
/*
** this function handles only '%d', '%c', '%f', '%p', '%s', and '%%'
conventional formats, plus Lua-specific '%I' and '%U'
*/
/* this function handles only `%d', `%c', %f, and `%s' formats */
const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {
BuffFS buff; /* holds last part of the result */
const char *e; /* points to next '%' */
initbuff(L, &buff);
while ((e = strchr(fmt, '%')) != NULL) {
addstr2buff(&buff, fmt, ct_diff2sz(e - fmt)); /* add 'fmt' up to '%' */
switch (*(e + 1)) { /* conversion specifier */
case 's': { /* zero-terminated string */
const char *s = va_arg(argp, char *);
if (s == NULL) s = "(null)";
addstr2buff(&buff, s, strlen(s));
int n = 1;
pushstr(L, "");
for (;;) {
const char *e = strchr(fmt, '%');
if (e == NULL) break;
setsvalue2s(L->top, luaS_newlstr(L, fmt, e-fmt));
incr_top(L);
switch (*(e+1)) {
case 's':
pushstr(L, va_arg(argp, char *));
break;
case 'c': {
char buff[2];
buff[0] = cast(char, va_arg(argp, int));
buff[1] = '\0';
pushstr(L, buff);
break;
}
case 'c': { /* an 'int' as a character */
char c = cast_char(va_arg(argp, int));
addstr2buff(&buff, &c, sizeof(char));
case 'd':
setnvalue(L->top, cast(lua_Number, va_arg(argp, int)));
incr_top(L);
break;
}
case 'd': { /* an 'int' */
TValue num;
setivalue(&num, va_arg(argp, int));
addnum2buff(&buff, &num);
case 'f':
setnvalue(L->top, cast(lua_Number, va_arg(argp, l_uacNumber)));
incr_top(L);
break;
}
case 'I': { /* a 'lua_Integer' */
TValue num;
setivalue(&num, cast_Integer(va_arg(argp, l_uacInt)));
addnum2buff(&buff, &num);
case '%':
pushstr(L, "%");
break;
}
case 'f': { /* a 'lua_Number' */
TValue num;
setfltvalue(&num, cast_num(va_arg(argp, l_uacNumber)));
addnum2buff(&buff, &num);
break;
}
case 'p': { /* a pointer */
char bf[LUA_N2SBUFFSZ]; /* enough space for '%p' */
void *p = va_arg(argp, void *);
int len = lua_pointer2str(bf, LUA_N2SBUFFSZ, p);
addstr2buff(&buff, bf, cast_uint(len));
break;
}
case 'U': { /* an 'unsigned long' as a UTF-8 sequence */
char bf[UTF8BUFFSZ];
unsigned long arg = va_arg(argp, unsigned long);
int len = luaO_utf8esc(bf, cast(l_uint32, arg));
addstr2buff(&buff, bf + UTF8BUFFSZ - len, cast_uint(len));
break;
}
case '%': {
addstr2buff(&buff, "%", 1);
break;
}
default: {
addstr2buff(&buff, e, 2); /* keep unknown format in the result */
break;
}
default: lua_assert(0);
}
fmt = e + 2; /* skip '%' and the specifier */
n += 2;
fmt = e+2;
}
addstr2buff(&buff, fmt, strlen(fmt)); /* rest of 'fmt' */
return clearbuff(&buff); /* empty buffer into a new string */
pushstr(L, fmt);
luaV_concat(L, n+1, L->top - L->base - 1);
L->top -= n;
return svalue(L->top - 1);
}
@ -665,54 +156,40 @@ const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) {
va_start(argp, fmt);
msg = luaO_pushvfstring(L, fmt, argp);
va_end(argp);
if (msg == NULL) /* error? */
luaD_throw(L, LUA_ERRMEM);
return msg;
}
/* }================================================================== */
#define RETS "..."
#define PRE "[string \""
#define POS "\"]"
#define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) )
void luaO_chunkid (char *out, const char *source, size_t srclen) {
size_t bufflen = LUA_IDSIZE; /* free space in buffer */
if (*source == '=') { /* 'literal' source */
if (srclen <= bufflen) /* small enough? */
memcpy(out, source + 1, srclen * sizeof(char));
else { /* truncate it */
addstr(out, source + 1, bufflen - 1);
*out = '\0';
}
void luaO_chunkid (char *out, const char *source, int bufflen) {
if (*source == '=') {
strncpy(out, source+1, bufflen); /* remove first char */
out[bufflen-1] = '\0'; /* ensures null termination */
}
else if (*source == '@') { /* file name */
if (srclen <= bufflen) /* small enough? */
memcpy(out, source + 1, srclen * sizeof(char));
else { /* add '...' before rest of name */
addstr(out, RETS, LL(RETS));
bufflen -= LL(RETS);
memcpy(out, source + 1 + srclen - bufflen, bufflen * sizeof(char));
else { /* out = "source", or "...source" */
if (*source == '@') {
int l;
source++; /* skip the `@' */
bufflen -= sizeof(" `...' ");
l = strlen(source);
strcpy(out, "");
if (l>bufflen) {
source += (l-bufflen); /* get last part of file name */
strcat(out, "...");
}
strcat(out, source);
}
}
else { /* string; format as [string "source"] */
const char *nl = strchr(source, '\n'); /* find first new line (if any) */
addstr(out, PRE, LL(PRE)); /* add prefix */
bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */
if (srclen < bufflen && nl == NULL) { /* small one-line source? */
addstr(out, source, srclen); /* keep it */
else { /* out = [string "string"] */
int len = strcspn(source, "\n"); /* stop at first newline */
bufflen -= sizeof(" [string \"...\"] ");
if (len > bufflen) len = bufflen;
strcpy(out, "[string \"");
if (source[len] != '\0') { /* must truncate? */
strncat(out, source, len);
strcat(out, "...");
}
else
strcat(out, source);
strcat(out, "\"]");
}
else {
if (nl != NULL)
srclen = ct_diff2sz(nl - source); /* stop at first newline */
if (srclen > bufflen) srclen = bufflen;
addstr(out, source, srclen);
addstr(out, RETS, LL(RETS));
}
memcpy(out, POS, (LL(POS) + 1) * sizeof(char));
}
}

925
lib/lua/lobject.h
View File

File diff suppressed because it is too large Load Diff

199
lib/lua/lopcodes.c
View File

@ -1,131 +1,102 @@
/*
** $Id: lopcodes.c $
** Opcodes for Lua virtual machine
** $Id: lopcodes.c,v 1.22 2002/12/04 17:38:31 roberto Exp $
** extracted automatically from lopcodes.h by mkprint.lua
** DO NOT EDIT
** See Copyright Notice in lua.h
*/
#define lopcodes_c
#define LUA_CORE
#include "lprefix.h"
#include "lua.h"
#include "lobject.h"
#include "lopcodes.h"
#define opmode(mm,ot,it,t,a,m) \
(((mm) << 7) | ((ot) << 6) | ((it) << 5) | ((t) << 4) | ((a) << 3) | (m))
#ifdef LUA_OPNAMES
/* ORDER OP */
LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = {
/* MM OT IT T A mode opcode */
opmode(0, 0, 0, 0, 1, iABC) /* OP_MOVE */
,opmode(0, 0, 0, 0, 1, iAsBx) /* OP_LOADI */
,opmode(0, 0, 0, 0, 1, iAsBx) /* OP_LOADF */
,opmode(0, 0, 0, 0, 1, iABx) /* OP_LOADK */
,opmode(0, 0, 0, 0, 1, iABx) /* OP_LOADKX */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADFALSE */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_LFALSESKIP */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADTRUE */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_LOADNIL */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETUPVAL */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETUPVAL */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETTABUP */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETTABLE */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETI */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETFIELD */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETTABUP */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETTABLE */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETI */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_SETFIELD */
,opmode(0, 0, 0, 0, 1, ivABC) /* OP_NEWTABLE */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_SELF */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADDI */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADDK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_SUBK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_MULK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_MODK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_POWK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_DIVK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_IDIVK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_BANDK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_BORK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_BXORK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHLI */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHRI */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_ADD */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_SUB */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_MUL */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_MOD */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_POW */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_DIV */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_IDIV */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_BAND */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_BOR */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_BXOR */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHL */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_SHR */
,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBIN */
,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBINI */
,opmode(1, 0, 0, 0, 0, iABC) /* OP_MMBINK */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_UNM */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_BNOT */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_NOT */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_LEN */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_CONCAT */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_CLOSE */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_TBC */
,opmode(0, 0, 0, 0, 0, isJ) /* OP_JMP */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQ */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_LT */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_LE */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQK */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_EQI */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_LTI */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_LEI */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_GTI */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_GEI */
,opmode(0, 0, 0, 1, 0, iABC) /* OP_TEST */
,opmode(0, 0, 0, 1, 1, iABC) /* OP_TESTSET */
,opmode(0, 1, 1, 0, 1, iABC) /* OP_CALL */
,opmode(0, 1, 1, 0, 1, iABC) /* OP_TAILCALL */
,opmode(0, 0, 1, 0, 0, iABC) /* OP_RETURN */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_RETURN0 */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_RETURN1 */
,opmode(0, 0, 0, 0, 1, iABx) /* OP_FORLOOP */
,opmode(0, 0, 0, 0, 1, iABx) /* OP_FORPREP */
,opmode(0, 0, 0, 0, 0, iABx) /* OP_TFORPREP */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_TFORCALL */
,opmode(0, 0, 0, 0, 1, iABx) /* OP_TFORLOOP */
,opmode(0, 0, 1, 0, 0, ivABC) /* OP_SETLIST */
,opmode(0, 0, 0, 0, 1, iABx) /* OP_CLOSURE */
,opmode(0, 1, 0, 0, 1, iABC) /* OP_VARARG */
,opmode(0, 0, 0, 0, 1, iABC) /* OP_GETVARG */
,opmode(0, 0, 0, 0, 0, iABx) /* OP_ERRNNIL */
,opmode(0, 0, 0, 0, 0, iABC) /* OP_VARARGPREP */
,opmode(0, 0, 0, 0, 0, iAx) /* OP_EXTRAARG */
const char *const luaP_opnames[] = {
"MOVE",
"LOADK",
"LOADBOOL",
"LOADNIL",
"GETUPVAL",
"GETGLOBAL",
"GETTABLE",
"SETGLOBAL",
"SETUPVAL",
"SETTABLE",
"NEWTABLE",
"SELF",
"ADD",
"SUB",
"MUL",
"DIV",
"POW",
"UNM",
"NOT",
"CONCAT",
"JMP",
"EQ",
"LT",
"LE",
"TEST",
"CALL",
"TAILCALL",
"RETURN",
"FORLOOP",
"TFORLOOP",
"TFORPREP",
"SETLIST",
"SETLISTO",
"CLOSE",
"CLOSURE"
};
#endif
#define testITMode(m) (luaP_opmodes[m] & (1 << 5))
#define opmode(t,b,bk,ck,sa,k,m) (((t)<<OpModeT) | \
((b)<<OpModeBreg) | ((bk)<<OpModeBrk) | ((ck)<<OpModeCrk) | \
((sa)<<OpModesetA) | ((k)<<OpModeK) | (m))
/*
** Check whether instruction uses top. That happens for OP_VARARGPREP
** and for instructions that use multiple values set by the previous
** instruction.
*/
int luaP_isIT (Instruction i) {
OpCode op = GET_OPCODE(i);
switch (op) {
case OP_SETLIST:
return GETARG_vB(i) == 0;
case OP_VARARGPREP:
return 1;
default:
return testITMode(GET_OPCODE(i)) && GETARG_B(i) == 0;
}
}
const lu_byte luaP_opmodes[NUM_OPCODES] = {
/* T B Bk Ck sA K mode opcode */
opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_MOVE */
,opmode(0, 0, 0, 0, 1, 1, iABx) /* OP_LOADK */
,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_LOADBOOL */
,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_LOADNIL */
,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_GETUPVAL */
,opmode(0, 0, 0, 0, 1, 1, iABx) /* OP_GETGLOBAL */
,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_GETTABLE */
,opmode(0, 0, 0, 0, 0, 1, iABx) /* OP_SETGLOBAL */
,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_SETUPVAL */
,opmode(0, 0, 1, 1, 0, 0, iABC) /* OP_SETTABLE */
,opmode(0, 0, 0, 0, 1, 0, iABC) /* OP_NEWTABLE */
,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_SELF */
,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_ADD */
,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_SUB */
,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_MUL */
,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_DIV */
,opmode(0, 0, 1, 1, 1, 0, iABC) /* OP_POW */
,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_UNM */
,opmode(0, 1, 0, 0, 1, 0, iABC) /* OP_NOT */
,opmode(0, 1, 0, 1, 1, 0, iABC) /* OP_CONCAT */
,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_JMP */
,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_EQ */
,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_LT */
,opmode(1, 0, 1, 1, 0, 0, iABC) /* OP_LE */
,opmode(1, 1, 0, 0, 1, 0, iABC) /* OP_TEST */
,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_CALL */
,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_TAILCALL */
,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_RETURN */
,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_FORLOOP */
,opmode(1, 0, 0, 0, 0, 0, iABC) /* OP_TFORLOOP */
,opmode(0, 0, 0, 0, 0, 0, iAsBx) /* OP_TFORPREP */
,opmode(0, 0, 0, 0, 0, 0, iABx) /* OP_SETLIST */
,opmode(0, 0, 0, 0, 0, 0, iABx) /* OP_SETLISTO */
,opmode(0, 0, 0, 0, 0, 0, iABC) /* OP_CLOSE */
,opmode(0, 0, 0, 0, 1, 0, iABx) /* OP_CLOSURE */
};

484
lib/lua/lopcodes.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lopcodes.h $
** $Id: lopcodes.h,v 1.102 2002/08/21 18:56:09 roberto Exp $
** Opcodes for Lua virtual machine
** See Copyright Notice in lua.h
*/
@ -8,437 +8,231 @@
#define lopcodes_h
#include "llimits.h"
#include "lobject.h"
/*===========================================================================
We assume that instructions are unsigned 32-bit integers.
All instructions have an opcode in the first 7 bits.
Instructions can have the following formats:
We assume that instructions are unsigned numbers.
All instructions have an opcode in the first 6 bits.
Instructions can have the following fields:
`A' : 8 bits
`B' : 9 bits
`C' : 9 bits
`Bx' : 18 bits (`B' and `C' together)
`sBx' : signed Bx
3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
iABC C(8) | B(8) |k| A(8) | Op(7) |
ivABC vC(10) | vB(6) |k| A(8) | Op(7) |
iABx Bx(17) | A(8) | Op(7) |
iAsBx sBx (signed)(17) | A(8) | Op(7) |
iAx Ax(25) | Op(7) |
isJ sJ (signed)(25) | Op(7) |
('v' stands for "variant", 's' for "signed", 'x' for "extended".)
A signed argument is represented in excess K: The represented value is
the written unsigned value minus K, where K is half (rounded down) the
maximum value for the corresponding unsigned argument.
A signed argument is represented in excess K; that is, the number
value is the unsigned value minus K. K is exactly the maximum value
for that argument (so that -max is represented by 0, and +max is
represented by 2*max), which is half the maximum for the corresponding
unsigned argument.
===========================================================================*/
/* basic instruction formats */
enum OpMode {iABC, ivABC, iABx, iAsBx, iAx, isJ};
enum OpMode {iABC, iABx, iAsBx}; /* basic instruction format */
/*
** size and position of opcode arguments.
*/
#define SIZE_C 8
#define SIZE_vC 10
#define SIZE_B 8
#define SIZE_vB 6
#define SIZE_Bx (SIZE_C + SIZE_B + 1)
#define SIZE_C 9
#define SIZE_B 9
#define SIZE_Bx (SIZE_C + SIZE_B)
#define SIZE_A 8
#define SIZE_Ax (SIZE_Bx + SIZE_A)
#define SIZE_sJ (SIZE_Bx + SIZE_A)
#define SIZE_OP 7
#define SIZE_OP 6
#define POS_OP 0
#define POS_A (POS_OP + SIZE_OP)
#define POS_k (POS_A + SIZE_A)
#define POS_B (POS_k + 1)
#define POS_vB (POS_k + 1)
#define POS_C (POS_B + SIZE_B)
#define POS_vC (POS_vB + SIZE_vB)
#define POS_Bx POS_k
#define POS_Ax POS_A
#define POS_sJ POS_A
#define POS_C SIZE_OP
#define POS_B (POS_C + SIZE_C)
#define POS_Bx POS_C
#define POS_A (POS_B + SIZE_B)
/*
** limits for opcode arguments.
** we use (signed) 'int' to manipulate most arguments,
** so they must fit in ints.
** we use (signed) int to manipulate most arguments,
** so they must fit in BITS_INT-1 bits (-1 for sign)
*/
/*
** Check whether type 'int' has at least 'b' + 1 bits.
** 'b' < 32; +1 for the sign bit.
*/
#define L_INTHASBITS(b) ((UINT_MAX >> (b)) >= 1)
#if L_INTHASBITS(SIZE_Bx)
#define MAXARG_Bx ((1<<SIZE_Bx)-1)
#if SIZE_Bx < BITS_INT-1
#define MAXARG_Bx ((1<<SIZE_Bx)-1)
#define MAXARG_sBx (MAXARG_Bx>>1) /* `sBx' is signed */
#else
#define MAXARG_Bx INT_MAX
#define MAXARG_Bx MAX_INT
#define MAXARG_sBx MAX_INT
#endif
#define OFFSET_sBx (MAXARG_Bx>>1) /* 'sBx' is signed */
#define MAXARG_A ((1<<SIZE_A)-1)
#define MAXARG_B ((1<<SIZE_B)-1)
#define MAXARG_C ((1<<SIZE_C)-1)
#if L_INTHASBITS(SIZE_Ax)
#define MAXARG_Ax ((1<<SIZE_Ax)-1)
#else
#define MAXARG_Ax INT_MAX
#endif
/* creates a mask with `n' 1 bits at position `p' */
#define MASK1(n,p) ((~((~(Instruction)0)<<n))<<p)
#if L_INTHASBITS(SIZE_sJ)
#define MAXARG_sJ ((1 << SIZE_sJ) - 1)
#else
#define MAXARG_sJ INT_MAX
#endif
#define OFFSET_sJ (MAXARG_sJ >> 1)
#define MAXARG_A ((1<<SIZE_A)-1)
#define MAXARG_B ((1<<SIZE_B)-1)
#define MAXARG_vB ((1<<SIZE_vB)-1)
#define MAXARG_C ((1<<SIZE_C)-1)
#define MAXARG_vC ((1<<SIZE_vC)-1)
#define OFFSET_sC (MAXARG_C >> 1)
#define int2sC(i) ((i) + OFFSET_sC)
#define sC2int(i) ((i) - OFFSET_sC)
/* creates a mask with 'n' 1 bits at position 'p' */
#define MASK1(n,p) ((~((~(Instruction)0)<<(n)))<<(p))
/* creates a mask with 'n' 0 bits at position 'p' */
/* creates a mask with `n' 0 bits at position `p' */
#define MASK0(n,p) (~MASK1(n,p))
/*
** the following macros help to manipulate instructions
*/
#define GET_OPCODE(i) (cast(OpCode, ((i)>>POS_OP) & MASK1(SIZE_OP,0)))
#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,POS_OP)) | \
((cast_Inst(o)<<POS_OP)&MASK1(SIZE_OP,POS_OP))))
#define GET_OPCODE(i) (cast(OpCode, (i)&MASK1(SIZE_OP,0)))
#define SET_OPCODE(i,o) ((i) = (((i)&MASK0(SIZE_OP,0)) | cast(Instruction, o)))
#define checkopm(i,m) (getOpMode(GET_OPCODE(i)) == m)
#define GETARG_A(i) (cast(int, (i)>>POS_A))
#define SETARG_A(i,u) ((i) = (((i)&MASK0(SIZE_A,POS_A)) | \
((cast(Instruction, u)<<POS_A)&MASK1(SIZE_A,POS_A))))
#define GETARG_B(i) (cast(int, ((i)>>POS_B) & MASK1(SIZE_B,0)))
#define SETARG_B(i,b) ((i) = (((i)&MASK0(SIZE_B,POS_B)) | \
((cast(Instruction, b)<<POS_B)&MASK1(SIZE_B,POS_B))))
#define GETARG_C(i) (cast(int, ((i)>>POS_C) & MASK1(SIZE_C,0)))
#define SETARG_C(i,b) ((i) = (((i)&MASK0(SIZE_C,POS_C)) | \
((cast(Instruction, b)<<POS_C)&MASK1(SIZE_C,POS_C))))
#define GETARG_Bx(i) (cast(int, ((i)>>POS_Bx) & MASK1(SIZE_Bx,0)))
#define SETARG_Bx(i,b) ((i) = (((i)&MASK0(SIZE_Bx,POS_Bx)) | \
((cast(Instruction, b)<<POS_Bx)&MASK1(SIZE_Bx,POS_Bx))))
#define GETARG_sBx(i) (GETARG_Bx(i)-MAXARG_sBx)
#define SETARG_sBx(i,b) SETARG_Bx((i),cast(unsigned int, (b)+MAXARG_sBx))
#define getarg(i,pos,size) (cast_int(((i)>>(pos)) & MASK1(size,0)))
#define setarg(i,v,pos,size) ((i) = (((i)&MASK0(size,pos)) | \
((cast_Inst(v)<<pos)&MASK1(size,pos))))
#define CREATE_ABC(o,a,b,c) (cast(Instruction, o) \
| (cast(Instruction, a)<<POS_A) \
| (cast(Instruction, b)<<POS_B) \
| (cast(Instruction, c)<<POS_C))
#define GETARG_A(i) getarg(i, POS_A, SIZE_A)
#define SETARG_A(i,v) setarg(i, v, POS_A, SIZE_A)
#define GETARG_B(i) \
check_exp(checkopm(i, iABC), getarg(i, POS_B, SIZE_B))
#define GETARG_vB(i) \
check_exp(checkopm(i, ivABC), getarg(i, POS_vB, SIZE_vB))
#define GETARG_sB(i) sC2int(GETARG_B(i))
#define SETARG_B(i,v) setarg(i, v, POS_B, SIZE_B)
#define SETARG_vB(i,v) setarg(i, v, POS_vB, SIZE_vB)
#define GETARG_C(i) \
check_exp(checkopm(i, iABC), getarg(i, POS_C, SIZE_C))
#define GETARG_vC(i) \
check_exp(checkopm(i, ivABC), getarg(i, POS_vC, SIZE_vC))
#define GETARG_sC(i) sC2int(GETARG_C(i))
#define SETARG_C(i,v) setarg(i, v, POS_C, SIZE_C)
#define SETARG_vC(i,v) setarg(i, v, POS_vC, SIZE_vC)
#define TESTARG_k(i) (cast_int(((i) & (1u << POS_k))))
#define GETARG_k(i) getarg(i, POS_k, 1)
#define SETARG_k(i,v) setarg(i, v, POS_k, 1)
#define GETARG_Bx(i) check_exp(checkopm(i, iABx), getarg(i, POS_Bx, SIZE_Bx))
#define SETARG_Bx(i,v) setarg(i, v, POS_Bx, SIZE_Bx)
#define GETARG_Ax(i) check_exp(checkopm(i, iAx), getarg(i, POS_Ax, SIZE_Ax))
#define SETARG_Ax(i,v) setarg(i, v, POS_Ax, SIZE_Ax)
#define GETARG_sBx(i) \
check_exp(checkopm(i, iAsBx), getarg(i, POS_Bx, SIZE_Bx) - OFFSET_sBx)
#define SETARG_sBx(i,b) SETARG_Bx((i),cast_uint((b)+OFFSET_sBx))
#define GETARG_sJ(i) \
check_exp(checkopm(i, isJ), getarg(i, POS_sJ, SIZE_sJ) - OFFSET_sJ)
#define SETARG_sJ(i,j) \
setarg(i, cast_uint((j)+OFFSET_sJ), POS_sJ, SIZE_sJ)
#define CREATE_ABx(o,a,bc) (cast(Instruction, o) \
| (cast(Instruction, a)<<POS_A) \
| (cast(Instruction, bc)<<POS_Bx))
#define CREATE_ABCk(o,a,b,c,k) ((cast_Inst(o)<<POS_OP) \
| (cast_Inst(a)<<POS_A) \
| (cast_Inst(b)<<POS_B) \
| (cast_Inst(c)<<POS_C) \
| (cast_Inst(k)<<POS_k))
#define CREATE_vABCk(o,a,b,c,k) ((cast_Inst(o)<<POS_OP) \
| (cast_Inst(a)<<POS_A) \
| (cast_Inst(b)<<POS_vB) \
| (cast_Inst(c)<<POS_vC) \
| (cast_Inst(k)<<POS_k))
#define CREATE_ABx(o,a,bc) ((cast_Inst(o)<<POS_OP) \
| (cast_Inst(a)<<POS_A) \
| (cast_Inst(bc)<<POS_Bx))
#define CREATE_Ax(o,a) ((cast_Inst(o)<<POS_OP) \
| (cast_Inst(a)<<POS_Ax))
#define CREATE_sJ(o,j,k) ((cast_Inst(o) << POS_OP) \
| (cast_Inst(j) << POS_sJ) \
| (cast_Inst(k) << POS_k))
#if !defined(MAXINDEXRK) /* (for debugging only) */
#define MAXINDEXRK MAXARG_B
#endif
/*
** Maximum size for the stack of a Lua function. It must fit in 8 bits.
** The highest valid register is one less than this value.
** invalid register that fits in 8 bits
*/
#define MAX_FSTACK MAXARG_A
/*
** Invalid register (one more than last valid register).
*/
#define NO_REG MAX_FSTACK
#define NO_REG MAXARG_A
/*
** R[x] - register
** K[x] - constant (in constant table)
** RK(x) == if k(i) then K[x] else R[x]
** R(x) - register
** Kst(x) - constant (in constant table)
** RK(x) == if x < MAXSTACK then R(x) else Kst(x-MAXSTACK)
*/
/*
** Grep "ORDER OP" if you change this enum.
** See "Notes" below for more information about some instructions.
** grep "ORDER OP" if you change these enums
*/
typedef enum {
/*----------------------------------------------------------------------
name args description
name args description
------------------------------------------------------------------------*/
OP_MOVE,/* A B R[A] := R[B] */
OP_LOADI,/* A sBx R[A] := sBx */
OP_LOADF,/* A sBx R[A] := (lua_Number)sBx */
OP_LOADK,/* A Bx R[A] := K[Bx] */
OP_LOADKX,/* A R[A] := K[extra arg] */
OP_LOADFALSE,/* A R[A] := false */
OP_LFALSESKIP,/*A R[A] := false; pc++ */
OP_LOADTRUE,/* A R[A] := true */
OP_LOADNIL,/* A B R[A], R[A+1], ..., R[A+B] := nil */
OP_GETUPVAL,/* A B R[A] := UpValue[B] */
OP_SETUPVAL,/* A B UpValue[B] := R[A] */
OP_MOVE,/* A B R(A) := R(B) */
OP_LOADK,/* A Bx R(A) := Kst(Bx) */
OP_LOADBOOL,/* A B C R(A) := (Bool)B; if (C) PC++ */
OP_LOADNIL,/* A B R(A) := ... := R(B) := nil */
OP_GETUPVAL,/* A B R(A) := UpValue[B] */
OP_GETTABUP,/* A B C R[A] := UpValue[B][K[C]:shortstring] */
OP_GETTABLE,/* A B C R[A] := R[B][R[C]] */
OP_GETI,/* A B C R[A] := R[B][C] */
OP_GETFIELD,/* A B C R[A] := R[B][K[C]:shortstring] */
OP_GETGLOBAL,/* A Bx R(A) := Gbl[Kst(Bx)] */
OP_GETTABLE,/* A B C R(A) := R(B)[RK(C)] */
OP_SETTABUP,/* A B C UpValue[A][K[B]:shortstring] := RK(C) */
OP_SETTABLE,/* A B C R[A][R[B]] := RK(C) */
OP_SETI,/* A B C R[A][B] := RK(C) */
OP_SETFIELD,/* A B C R[A][K[B]:shortstring] := RK(C) */
OP_SETGLOBAL,/* A Bx Gbl[Kst(Bx)] := R(A) */
OP_SETUPVAL,/* A B UpValue[B] := R(A) */
OP_SETTABLE,/* A B C R(A)[RK(B)] := RK(C) */
OP_NEWTABLE,/* A vB vC k R[A] := {} */
OP_NEWTABLE,/* A B C R(A) := {} (size = B,C) */
OP_SELF,/* A B C R[A+1] := R[B]; R[A] := R[B][K[C]:shortstring] */
OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] */
OP_ADDI,/* A B sC R[A] := R[B] + sC */
OP_ADD,/* A B C R(A) := RK(B) + RK(C) */
OP_SUB,/* A B C R(A) := RK(B) - RK(C) */
OP_MUL,/* A B C R(A) := RK(B) * RK(C) */
OP_DIV,/* A B C R(A) := RK(B) / RK(C) */
OP_POW,/* A B C R(A) := RK(B) ^ RK(C) */
OP_UNM,/* A B R(A) := -R(B) */
OP_NOT,/* A B R(A) := not R(B) */
OP_ADDK,/* A B C R[A] := R[B] + K[C]:number */
OP_SUBK,/* A B C R[A] := R[B] - K[C]:number */
OP_MULK,/* A B C R[A] := R[B] * K[C]:number */
OP_MODK,/* A B C R[A] := R[B] % K[C]:number */
OP_POWK,/* A B C R[A] := R[B] ^ K[C]:number */
OP_DIVK,/* A B C R[A] := R[B] / K[C]:number */
OP_IDIVK,/* A B C R[A] := R[B] // K[C]:number */
OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */
OP_BANDK,/* A B C R[A] := R[B] & K[C]:integer */
OP_BORK,/* A B C R[A] := R[B] | K[C]:integer */
OP_BXORK,/* A B C R[A] := R[B] ~ K[C]:integer */
OP_JMP,/* sBx PC += sBx */
OP_SHLI,/* A B sC R[A] := sC << R[B] */
OP_SHRI,/* A B sC R[A] := R[B] >> sC */
OP_EQ,/* A B C if ((RK(B) == RK(C)) ~= A) then pc++ */
OP_LT,/* A B C if ((RK(B) < RK(C)) ~= A) then pc++ */
OP_LE,/* A B C if ((RK(B) <= RK(C)) ~= A) then pc++ */
OP_ADD,/* A B C R[A] := R[B] + R[C] */
OP_SUB,/* A B C R[A] := R[B] - R[C] */
OP_MUL,/* A B C R[A] := R[B] * R[C] */
OP_MOD,/* A B C R[A] := R[B] % R[C] */
OP_POW,/* A B C R[A] := R[B] ^ R[C] */
OP_DIV,/* A B C R[A] := R[B] / R[C] */
OP_IDIV,/* A B C R[A] := R[B] // R[C] */
OP_TEST,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */
OP_BAND,/* A B C R[A] := R[B] & R[C] */
OP_BOR,/* A B C R[A] := R[B] | R[C] */
OP_BXOR,/* A B C R[A] := R[B] ~ R[C] */
OP_SHL,/* A B C R[A] := R[B] << R[C] */
OP_SHR,/* A B C R[A] := R[B] >> R[C] */
OP_CALL,/* A B C R(A), ... ,R(A+C-2) := R(A)(R(A+1), ... ,R(A+B-1)) */
OP_TAILCALL,/* A B C return R(A)(R(A+1), ... ,R(A+B-1)) */
OP_RETURN,/* A B return R(A), ... ,R(A+B-2) (see note) */
OP_MMBIN,/* A B C call C metamethod over R[A] and R[B] */
OP_MMBINI,/* A sB C k call C metamethod over R[A] and sB */
OP_MMBINK,/* A B C k call C metamethod over R[A] and K[B] */
OP_FORLOOP,/* A sBx R(A)+=R(A+2); if R(A) <?= R(A+1) then PC+= sBx */
OP_UNM,/* A B R[A] := -R[B] */
OP_BNOT,/* A B R[A] := ~R[B] */
OP_NOT,/* A B R[A] := not R[B] */
OP_LEN,/* A B R[A] := #R[B] (length operator) */
OP_TFORLOOP,/* A C R(A+2), ... ,R(A+2+C) := R(A)(R(A+1), R(A+2));
if R(A+2) ~= nil then pc++ */
OP_TFORPREP,/* A sBx if type(R(A)) == table then R(A+1):=R(A), R(A):=next;
PC += sBx */
OP_CONCAT,/* A B R[A] := R[A].. ... ..R[A + B - 1] */
OP_SETLIST,/* A Bx R(A)[Bx-Bx%FPF+i] := R(A+i), 1 <= i <= Bx%FPF+1 */
OP_SETLISTO,/* A Bx */
OP_CLOSE,/* A close all upvalues >= R[A] */
OP_TBC,/* A mark variable A "to be closed" */
OP_JMP,/* sJ pc += sJ */
OP_EQ,/* A B k if ((R[A] == R[B]) ~= k) then pc++ */
OP_LT,/* A B k if ((R[A] < R[B]) ~= k) then pc++ */
OP_LE,/* A B k if ((R[A] <= R[B]) ~= k) then pc++ */
OP_EQK,/* A B k if ((R[A] == K[B]) ~= k) then pc++ */
OP_EQI,/* A sB k if ((R[A] == sB) ~= k) then pc++ */
OP_LTI,/* A sB k if ((R[A] < sB) ~= k) then pc++ */
OP_LEI,/* A sB k if ((R[A] <= sB) ~= k) then pc++ */
OP_GTI,/* A sB k if ((R[A] > sB) ~= k) then pc++ */
OP_GEI,/* A sB k if ((R[A] >= sB) ~= k) then pc++ */
OP_TEST,/* A k if (not R[A] == k) then pc++ */
OP_TESTSET,/* A B k if (not R[B] == k) then pc++ else R[A] := R[B] */
OP_CALL,/* A B C R[A], ... ,R[A+C-2] := R[A](R[A+1], ... ,R[A+B-1]) */
OP_TAILCALL,/* A B C k return R[A](R[A+1], ... ,R[A+B-1]) */
OP_RETURN,/* A B C k return R[A], ... ,R[A+B-2] */
OP_RETURN0,/* return */
OP_RETURN1,/* A return R[A] */
OP_FORLOOP,/* A Bx update counters; if loop continues then pc-=Bx; */
OP_FORPREP,/* A Bx <check values and prepare counters>;
if not to run then pc+=Bx+1; */
OP_TFORPREP,/* A Bx create upvalue for R[A + 3]; pc+=Bx */
OP_TFORCALL,/* A C R[A+4], ... ,R[A+3+C] := R[A](R[A+1], R[A+2]); */
OP_TFORLOOP,/* A Bx if R[A+2] ~= nil then { R[A]=R[A+2]; pc -= Bx } */
OP_SETLIST,/* A vB vC k R[A][vC+i] := R[A+i], 1 <= i <= vB */
OP_CLOSURE,/* A Bx R[A] := closure(KPROTO[Bx]) */
OP_VARARG,/* A B C k R[A], ..., R[A+C-2] = varargs */
OP_GETVARG, /* A B C R[A] := R[B][R[C]], R[B] is vararg parameter */
OP_ERRNNIL,/* A Bx raise error if R[A] ~= nil (K[Bx - 1] is global name)*/
OP_VARARGPREP,/* (adjust varargs) */
OP_EXTRAARG/* Ax extra (larger) argument for previous opcode */
OP_CLOSE,/* A close all variables in the stack up to (>=) R(A)*/
OP_CLOSURE/* A Bx R(A) := closure(KPROTO[Bx], R(A), ... ,R(A+n)) */
} OpCode;
#define NUM_OPCODES ((int)(OP_EXTRAARG) + 1)
#define NUM_OPCODES (cast(int, OP_CLOSURE+1))
/*===========================================================================
Notes:
(1) In OP_CALL, if (B == 0) then B = top. C is the number of returns - 1,
and can be 0: OP_CALL then sets `top' to last_result+1, so
next open instruction (OP_CALL, OP_RETURN, OP_SETLIST) may use `top'.
(*) Opcode OP_LFALSESKIP is used to convert a condition to a boolean
value, in a code equivalent to (not cond ? false : true). (It
produces false and skips the next instruction producing true.)
(2) In OP_RETURN, if (B == 0) then return up to `top'
(*) Opcodes OP_MMBIN and variants follow each arithmetic and
bitwise opcode. If the operation succeeds, it skips this next
opcode. Otherwise, this opcode calls the corresponding metamethod.
(*) Opcode OP_TESTSET is used in short-circuit expressions that need
both to jump and to produce a value, such as (a = b or c).
(*) In OP_CALL, if (B == 0) then B = top - A. If (C == 0), then
'top' is set to last_result+1, so next open instruction (OP_CALL,
OP_RETURN*, OP_SETLIST) may use 'top'.
(*) In OP_VARARG, if (C == 0) then use actual number of varargs and
set top (like in OP_CALL with C == 0). 'k' means function has a
vararg table, which is in R[B].
(*) In OP_RETURN, if (B == 0) then return up to 'top'.
(*) In OP_LOADKX and OP_NEWTABLE, the next instruction is always
OP_EXTRAARG.
(*) In OP_SETLIST, if (B == 0) then real B = 'top'; if k, then
real C = EXTRAARG _ C (the bits of EXTRAARG concatenated with the
bits of C).
(*) In OP_NEWTABLE, vB is log2 of the hash size (which is always a
power of 2) plus 1, or zero for size zero. If not k, the array size
is vC. Otherwise, the array size is EXTRAARG _ vC.
(*) In OP_ERRNNIL, (Bx == 0) means index of global name doesn't
fit in Bx. (So, that name is not available for the error message.)
(*) For comparisons, k specifies what condition the test should accept
(true or false).
(*) In OP_MMBINI/OP_MMBINK, k means the arguments were flipped
(the constant is the first operand).
(*) All comparison and test instructions assume that the instruction
being skipped (pc++) is a jump.
(*) In instructions OP_RETURN/OP_TAILCALL, 'k' specifies that the
function builds upvalues, which may need to be closed. C > 0 means
the function has hidden vararg arguments, so that its 'func' must be
corrected before returning; in this case, (C - 1) is its number of
fixed parameters.
(*) In comparisons with an immediate operand, C signals whether the
original operand was a float. (It must be corrected in case of
metamethods.)
(3) For comparisons, B specifies what conditions the test should accept.
(4) All `skips' (pc++) assume that next instruction is a jump
===========================================================================*/
/*
** masks for instruction properties. The format is:
** bits 0-2: op mode
** bit 3: instruction set register A
** bit 4: operator is a test (next instruction must be a jump)
** bit 5: used by 'luaP_isIT'
** bit 6: used by 'luaP_isOT'
** bit 7: instruction is an MM instruction (call a metamethod)
*/
LUAI_DDEC(const lu_byte luaP_opmodes[NUM_OPCODES];)
#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 7))
#define testAMode(m) (luaP_opmodes[m] & (1 << 3))
#define testTMode(m) (luaP_opmodes[m] & (1 << 4))
#define testMMMode(m) (luaP_opmodes[m] & (1 << 7))
** masks for instruction properties
*/
enum OpModeMask {
OpModeBreg = 2, /* B is a register */
OpModeBrk, /* B is a register/constant */
OpModeCrk, /* C is a register/constant */
OpModesetA, /* instruction set register A */
OpModeK, /* Bx is a constant */
OpModeT /* operator is a test */
};
/* Check whether instruction sets top for next instruction, that is,
** it results in multiple values. Used only for tests.
*/
#define luaP_isOT(i) \
(GET_OPCODE(i) == OP_TAILCALL || \
((luaP_opmodes[GET_OPCODE(i)] & (1 << 6)) && GETARG_C(i) == 0))
extern const lu_byte luaP_opmodes[NUM_OPCODES];
#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 3))
#define testOpMode(m, b) (luaP_opmodes[m] & (1 << (b)))
LUAI_FUNC int luaP_isIT (Instruction i);
#ifdef LUA_OPNAMES
extern const char *const luaP_opnames[]; /* opcode names */
#endif
/* number of list items to accumulate before a SETLIST instruction */
/* (must be a power of 2) */
#define LFIELDS_PER_FLUSH 32
#endif

105
lib/lua/lopnames.h
View File

@ -1,105 +0,0 @@
/*
** $Id: lopnames.h $
** Opcode names
** See Copyright Notice in lua.h
*/
#if !defined(lopnames_h)
#define lopnames_h
#include <stddef.h>
/* ORDER OP */
static const char *const opnames[] = {
"MOVE",
"LOADI",
"LOADF",
"LOADK",
"LOADKX",
"LOADFALSE",
"LFALSESKIP",
"LOADTRUE",
"LOADNIL",
"GETUPVAL",
"SETUPVAL",
"GETTABUP",
"GETTABLE",
"GETI",
"GETFIELD",
"SETTABUP",
"SETTABLE",
"SETI",
"SETFIELD",
"NEWTABLE",
"SELF",
"ADDI",
"ADDK",
"SUBK",
"MULK",
"MODK",
"POWK",
"DIVK",
"IDIVK",
"BANDK",
"BORK",
"BXORK",
"SHLI",
"SHRI",
"ADD",
"SUB",
"MUL",
"MOD",
"POW",
"DIV",
"IDIV",
"BAND",
"BOR",
"BXOR",
"SHL",
"SHR",
"MMBIN",
"MMBINI",
"MMBINK",
"UNM",
"BNOT",
"NOT",
"LEN",
"CONCAT",
"CLOSE",
"TBC",
"JMP",
"EQ",
"LT",
"LE",
"EQK",
"EQI",
"LTI",
"LEI",
"GTI",
"GEI",
"TEST",
"TESTSET",
"CALL",
"TAILCALL",
"RETURN",
"RETURN0",
"RETURN1",
"FORLOOP",
"FORPREP",
"TFORPREP",
"TFORCALL",
"TFORLOOP",
"SETLIST",
"CLOSURE",
"VARARG",
"GETVARG",
"ERRNNIL",
"VARARGPREP",
"EXTRAARG",
NULL
};
#endif

432
lib/lua/loslib.c
View File

@ -1,432 +0,0 @@
/*
** $Id: loslib.c $
** Standard Operating System library
** See Copyright Notice in lua.h
*/
#define loslib_c
#define LUA_LIB
#include "lprefix.h"
#include <errno.h>
#include <locale.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#include "llimits.h"
/*
** {==================================================================
** List of valid conversion specifiers for the 'strftime' function;
** options are grouped by length; group of length 2 start with '||'.
** ===================================================================
*/
#if !defined(LUA_STRFTIMEOPTIONS) /* { */
#if defined(LUA_USE_WINDOWS)
#define LUA_STRFTIMEOPTIONS "aAbBcdHIjmMpSUwWxXyYzZ%" \
"||" "#c#x#d#H#I#j#m#M#S#U#w#W#y#Y" /* two-char options */
#elif defined(LUA_USE_C89) /* C89 (only 1-char options) */
#define LUA_STRFTIMEOPTIONS "aAbBcdHIjmMpSUwWxXyYZ%"
#else /* C99 specification */
#define LUA_STRFTIMEOPTIONS "aAbBcCdDeFgGhHIjmMnprRStTuUVwWxXyYzZ%" \
"||" "EcECExEXEyEY" "OdOeOHOIOmOMOSOuOUOVOwOWOy" /* two-char options */
#endif
#endif /* } */
/* }================================================================== */
/*
** {==================================================================
** Configuration for time-related stuff
** ===================================================================
*/
/*
** type to represent time_t in Lua
*/
#if !defined(LUA_NUMTIME) /* { */
#define l_timet lua_Integer
#define l_pushtime(L,t) lua_pushinteger(L,(lua_Integer)(t))
#define l_gettime(L,arg) luaL_checkinteger(L, arg)
#else /* }{ */
#define l_timet lua_Number
#define l_pushtime(L,t) lua_pushnumber(L,(lua_Number)(t))
#define l_gettime(L,arg) luaL_checknumber(L, arg)
#endif /* } */
#if !defined(l_gmtime) /* { */
/*
** By default, Lua uses gmtime/localtime, except when POSIX is available,
** where it uses gmtime_r/localtime_r
*/
#if defined(LUA_USE_POSIX) /* { */
#define l_gmtime(t,r) gmtime_r(t,r)
#define l_localtime(t,r) localtime_r(t,r)
#else /* }{ */
/* ISO C definitions */
#define l_gmtime(t,r) ((void)(r)->tm_sec, gmtime(t))
#define l_localtime(t,r) ((void)(r)->tm_sec, localtime(t))
#endif /* } */
#endif /* } */
/* }================================================================== */
/*
** {==================================================================
** Configuration for 'tmpnam':
** By default, Lua uses tmpnam except when POSIX is available, where
** it uses mkstemp.
** ===================================================================
*/
#if !defined(lua_tmpnam) /* { */
#if defined(LUA_USE_POSIX) /* { */
#include <unistd.h>
#define LUA_TMPNAMBUFSIZE 32
#if !defined(LUA_TMPNAMTEMPLATE)
#define LUA_TMPNAMTEMPLATE "/tmp/lua_XXXXXX"
#endif
#define lua_tmpnam(b,e) { \
strcpy(b, LUA_TMPNAMTEMPLATE); \
e = mkstemp(b); \
if (e != -1) close(e); \
e = (e == -1); }
#else /* }{ */
/* ISO C definitions */
#define LUA_TMPNAMBUFSIZE L_tmpnam
#define lua_tmpnam(b,e) { e = (tmpnam(b) == NULL); }
#endif /* } */
#endif /* } */
/* }================================================================== */
#if !defined(l_system)
#if defined(LUA_USE_IOS)
/* Despite claiming to be ISO C, iOS does not implement 'system'. */
#define l_system(cmd) ((cmd) == NULL ? 0 : -1)
#else
#define l_system(cmd) system(cmd) /* default definition */
#endif
#endif
static int os_execute (lua_State *L) {
const char *cmd = luaL_optstring(L, 1, NULL);
int stat;
errno = 0;
stat = l_system(cmd);
if (cmd != NULL)
return luaL_execresult(L, stat);
else {
lua_pushboolean(L, stat); /* true if there is a shell */
return 1;
}
}
static int os_remove (lua_State *L) {
const char *filename = luaL_checkstring(L, 1);
errno = 0;
return luaL_fileresult(L, remove(filename) == 0, filename);
}
static int os_rename (lua_State *L) {
const char *fromname = luaL_checkstring(L, 1);
const char *toname = luaL_checkstring(L, 2);
errno = 0;
return luaL_fileresult(L, rename(fromname, toname) == 0, NULL);
}
static int os_tmpname (lua_State *L) {
char buff[LUA_TMPNAMBUFSIZE];
int err;
lua_tmpnam(buff, err);
if (l_unlikely(err))
return luaL_error(L, "unable to generate a unique filename");
lua_pushstring(L, buff);
return 1;
}
static int os_getenv (lua_State *L) {
lua_pushstring(L, getenv(luaL_checkstring(L, 1))); /* if NULL push nil */
return 1;
}
static int os_clock (lua_State *L) {
lua_pushnumber(L, ((lua_Number)clock())/(lua_Number)CLOCKS_PER_SEC);
return 1;
}
/*
** {======================================================
** Time/Date operations
** { year=%Y, month=%m, day=%d, hour=%H, min=%M, sec=%S,
** wday=%w+1, yday=%j, isdst=? }
** =======================================================
*/
/*
** About the overflow check: an overflow cannot occur when time
** is represented by a lua_Integer, because either lua_Integer is
** large enough to represent all int fields or it is not large enough
** to represent a time that cause a field to overflow. However, if
** times are represented as doubles and lua_Integer is int, then the
** time 0x1.e1853b0d184f6p+55 would cause an overflow when adding 1900
** to compute the year.
*/
static void setfield (lua_State *L, const char *key, int value, int delta) {
#if (defined(LUA_NUMTIME) && LUA_MAXINTEGER <= INT_MAX)
if (l_unlikely(value > LUA_MAXINTEGER - delta))
luaL_error(L, "field '%s' is out-of-bound", key);
#endif
lua_pushinteger(L, (lua_Integer)value + delta);
lua_setfield(L, -2, key);
}
static void setboolfield (lua_State *L, const char *key, int value) {
if (value < 0) /* undefined? */
return; /* does not set field */
lua_pushboolean(L, value);
lua_setfield(L, -2, key);
}
/*
** Set all fields from structure 'tm' in the table on top of the stack
*/
static void setallfields (lua_State *L, struct tm *stm) {
setfield(L, "year", stm->tm_year, 1900);
setfield(L, "month", stm->tm_mon, 1);
setfield(L, "day", stm->tm_mday, 0);
setfield(L, "hour", stm->tm_hour, 0);
setfield(L, "min", stm->tm_min, 0);
setfield(L, "sec", stm->tm_sec, 0);
setfield(L, "yday", stm->tm_yday, 1);
setfield(L, "wday", stm->tm_wday, 1);
setboolfield(L, "isdst", stm->tm_isdst);
}
static int getboolfield (lua_State *L, const char *key) {
int res;
res = (lua_getfield(L, -1, key) == LUA_TNIL) ? -1 : lua_toboolean(L, -1);
lua_pop(L, 1);
return res;
}
static int getfield (lua_State *L, const char *key, int d, int delta) {
int isnum;
int t = lua_getfield(L, -1, key); /* get field and its type */
lua_Integer res = lua_tointegerx(L, -1, &isnum);
if (!isnum) { /* field is not an integer? */
if (l_unlikely(t != LUA_TNIL)) /* some other value? */
return luaL_error(L, "field '%s' is not an integer", key);
else if (l_unlikely(d < 0)) /* absent field; no default? */
return luaL_error(L, "field '%s' missing in date table", key);
res = d;
}
else {
if (!(res >= 0 ? res - delta <= INT_MAX : INT_MIN + delta <= res))
return luaL_error(L, "field '%s' is out-of-bound", key);
res -= delta;
}
lua_pop(L, 1);
return (int)res;
}
static const char *checkoption (lua_State *L, const char *conv,
size_t convlen, char *buff) {
const char *option = LUA_STRFTIMEOPTIONS;
unsigned oplen = 1; /* length of options being checked */
for (; *option != '\0' && oplen <= convlen; option += oplen) {
if (*option == '|') /* next block? */
oplen++; /* will check options with next length (+1) */
else if (memcmp(conv, option, oplen) == 0) { /* match? */
memcpy(buff, conv, oplen); /* copy valid option to buffer */
buff[oplen] = '\0';
return conv + oplen; /* return next item */
}
}
luaL_argerror(L, 1,
lua_pushfstring(L, "invalid conversion specifier '%%%s'", conv));
return conv; /* to avoid warnings */
}
static time_t l_checktime (lua_State *L, int arg) {
l_timet t = l_gettime(L, arg);
luaL_argcheck(L, (time_t)t == t, arg, "time out-of-bounds");
return (time_t)t;
}
/* maximum size for an individual 'strftime' item */
#define SIZETIMEFMT 250
static int os_date (lua_State *L) {
size_t slen;
const char *s = luaL_optlstring(L, 1, "%c", &slen);
time_t t = luaL_opt(L, l_checktime, 2, time(NULL));
const char *se = s + slen; /* 's' end */
struct tm tmr, *stm;
if (*s == '!') { /* UTC? */
stm = l_gmtime(&t, &tmr);
s++; /* skip '!' */
}
else
stm = l_localtime(&t, &tmr);
if (stm == NULL) /* invalid date? */
return luaL_error(L,
"date result cannot be represented in this installation");
if (strcmp(s, "*t") == 0) {
lua_createtable(L, 0, 9); /* 9 = number of fields */
setallfields(L, stm);
}
else {
char cc[4]; /* buffer for individual conversion specifiers */
luaL_Buffer b;
cc[0] = '%';
luaL_buffinit(L, &b);
while (s < se) {
if (*s != '%') /* not a conversion specifier? */
luaL_addchar(&b, *s++);
else {
size_t reslen;
char *buff = luaL_prepbuffsize(&b, SIZETIMEFMT);
s++; /* skip '%' */
/* copy specifier to 'cc' */
s = checkoption(L, s, ct_diff2sz(se - s), cc + 1);
reslen = strftime(buff, SIZETIMEFMT, cc, stm);
luaL_addsize(&b, reslen);
}
}
luaL_pushresult(&b);
}
return 1;
}
static int os_time (lua_State *L) {
time_t t;
if (lua_isnoneornil(L, 1)) /* called without args? */
t = time(NULL); /* get current time */
else {
struct tm ts;
luaL_checktype(L, 1, LUA_TTABLE);
lua_settop(L, 1); /* make sure table is at the top */
ts.tm_year = getfield(L, "year", -1, 1900);
ts.tm_mon = getfield(L, "month", -1, 1);
ts.tm_mday = getfield(L, "day", -1, 0);
ts.tm_hour = getfield(L, "hour", 12, 0);
ts.tm_min = getfield(L, "min", 0, 0);
ts.tm_sec = getfield(L, "sec", 0, 0);
ts.tm_isdst = getboolfield(L, "isdst");
t = mktime(&ts);
setallfields(L, &ts); /* update fields with normalized values */
}
if (t != (time_t)(l_timet)t || t == (time_t)(-1))
return luaL_error(L,
"time result cannot be represented in this installation");
l_pushtime(L, t);
return 1;
}
static int os_difftime (lua_State *L) {
time_t t1 = l_checktime(L, 1);
time_t t2 = l_checktime(L, 2);
lua_pushnumber(L, (lua_Number)difftime(t1, t2));
return 1;
}
/* }====================================================== */
static int os_setlocale (lua_State *L) {
static const int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,
LC_NUMERIC, LC_TIME};
static const char *const catnames[] = {"all", "collate", "ctype", "monetary",
"numeric", "time", NULL};
const char *l = luaL_optstring(L, 1, NULL);
int op = luaL_checkoption(L, 2, "all", catnames);
lua_pushstring(L, setlocale(cat[op], l));
return 1;
}
static int os_exit (lua_State *L) {
int status;
if (lua_isboolean(L, 1))
status = (lua_toboolean(L, 1) ? EXIT_SUCCESS : EXIT_FAILURE);
else
status = (int)luaL_optinteger(L, 1, EXIT_SUCCESS);
if (lua_toboolean(L, 2))
lua_close(L);
if (L) exit(status); /* 'if' to avoid warnings for unreachable 'return' */
return 0;
}
static const luaL_Reg syslib[] = {
{"clock", os_clock},
{"date", os_date},
{"difftime", os_difftime},
{"execute", os_execute},
{"exit", os_exit},
{"getenv", os_getenv},
{"remove", os_remove},
{"rename", os_rename},
{"setlocale", os_setlocale},
{"time", os_time},
{"tmpname", os_tmpname},
{NULL, NULL}
};
/* }====================================================== */
LUAMOD_API int luaopen_os (lua_State *L) {
luaL_newlib(L, syslib);
return 1;
}

2148
lib/lua/lparser.c
View File

File diff suppressed because it is too large Load Diff

190
lib/lua/lparser.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lparser.h $
** $Id: lparser.h,v 1.47 2003/02/11 10:46:24 roberto Exp $
** Lua Parser
** See Copyright Notice in lua.h
*/
@ -9,189 +9,63 @@
#include "llimits.h"
#include "lobject.h"
#include "ltable.h"
#include "lzio.h"
/*
** Expression and variable descriptor.
** Code generation for variables and expressions can be delayed to allow
** optimizations; An 'expdesc' structure describes a potentially-delayed
** variable/expression. It has a description of its "main" value plus a
** list of conditional jumps that can also produce its value (generated
** by short-circuit operators 'and'/'or').
** Expression descriptor
*/
/* kinds of variables/expressions */
typedef enum {
VVOID, /* when 'expdesc' describes the last expression of a list,
this kind means an empty list (so, no expression) */
VNIL, /* constant nil */
VTRUE, /* constant true */
VFALSE, /* constant false */
VK, /* constant in 'k'; info = index of constant in 'k' */
VKFLT, /* floating constant; nval = numerical float value */
VKINT, /* integer constant; ival = numerical integer value */
VKSTR, /* string constant; strval = TString address;
(string is fixed by the scanner) */
VNONRELOC, /* expression has its value in a fixed register;
info = result register */
VLOCAL, /* local variable; var.ridx = register index;
var.vidx = relative index in 'actvar.arr' */
VVARGVAR, /* vararg parameter; var.ridx = register index;
var.vidx = relative index in 'actvar.arr' */
VGLOBAL, /* global variable;
info = relative index in 'actvar.arr' (or -1 for
implicit declaration) */
VUPVAL, /* upvalue variable; info = index of upvalue in 'upvalues' */
VCONST, /* compile-time <const> variable;
info = absolute index in 'actvar.arr' */
VINDEXED, /* indexed variable;
ind.t = table register;
ind.idx = key's R index;
ind.ro = true if it represents a read-only global;
ind.keystr = if key is a string, index in 'k' of that string;
-1 if key is not a string */
VVARGIND, /* indexed vararg parameter;
ind.* as in VINDEXED */
VINDEXUP, /* indexed upvalue;
ind.idx = key's K index;
ind.* as in VINDEXED */
VINDEXI, /* indexed variable with constant integer;
ind.t = table register;
ind.idx = key's value */
VINDEXSTR, /* indexed variable with literal string;
ind.idx = key's K index;
ind.* as in VINDEXED */
VJMP, /* expression is a test/comparison;
info = pc of corresponding jump instruction */
VRELOC, /* expression can put result in any register;
info = instruction pc */
VCALL, /* expression is a function call; info = instruction pc */
VVARARG /* vararg expression; info = instruction pc */
VVOID, /* no value */
VNIL,
VTRUE,
VFALSE,
VK, /* info = index of constant in `k' */
VLOCAL, /* info = local register */
VUPVAL, /* info = index of upvalue in `upvalues' */
VGLOBAL, /* info = index of table; aux = index of global name in `k' */
VINDEXED, /* info = table register; aux = index register (or `k') */
VJMP, /* info = instruction pc */
VRELOCABLE, /* info = instruction pc */
VNONRELOC, /* info = result register */
VCALL /* info = result register */
} expkind;
#define vkisvar(k) (VLOCAL <= (k) && (k) <= VINDEXSTR)
#define vkisindexed(k) (VINDEXED <= (k) && (k) <= VINDEXSTR)
typedef struct expdesc {
expkind k;
union {
lua_Integer ival; /* for VKINT */
lua_Number nval; /* for VKFLT */
TString *strval; /* for VKSTR */
int info; /* for generic use */
struct { /* for indexed variables */
short idx; /* index (R or "long" K) */
lu_byte t; /* table (register or upvalue) */
lu_byte ro; /* true if variable is read-only */
int keystr; /* index in 'k' of string key, or -1 if not a string */
} ind;
struct { /* for local variables */
lu_byte ridx; /* register holding the variable */
short vidx; /* index in 'actvar.arr' */
} var;
} u;
int t; /* patch list of 'exit when true' */
int f; /* patch list of 'exit when false' */
int info, aux;
int t; /* patch list of `exit when true' */
int f; /* patch list of `exit when false' */
} expdesc;
/* kinds of variables */
#define VDKREG 0 /* regular local */
#define RDKCONST 1 /* local constant */
#define RDKVAVAR 2 /* vararg parameter */
#define RDKTOCLOSE 3 /* to-be-closed */
#define RDKCTC 4 /* local compile-time constant */
#define GDKREG 5 /* regular global */
#define GDKCONST 6 /* global constant */
/* variables that live in registers */
#define varinreg(v) ((v)->vd.kind <= RDKTOCLOSE)
/* test for global variables */
#define varglobal(v) ((v)->vd.kind >= GDKREG)
/* description of an active variable */
typedef union Vardesc {
struct {
TValuefields; /* constant value (if it is a compile-time constant) */
lu_byte kind;
lu_byte ridx; /* register holding the variable */
short pidx; /* index of the variable in the Proto's 'locvars' array */
TString *name; /* variable name */
} vd;
TValue k; /* constant value (if any) */
} Vardesc;
/* description of pending goto statements and label statements */
typedef struct Labeldesc {
TString *name; /* label identifier */
int pc; /* position in code */
int line; /* line where it appeared */
short nactvar; /* number of active variables in that position */
lu_byte close; /* true for goto that escapes upvalues */
} Labeldesc;
/* list of labels or gotos */
typedef struct Labellist {
Labeldesc *arr; /* array */
int n; /* number of entries in use */
int size; /* array size */
} Labellist;
/* dynamic structures used by the parser */
typedef struct Dyndata {
struct { /* list of all active local variables */
Vardesc *arr;
int n;
int size;
} actvar;
Labellist gt; /* list of pending gotos */
Labellist label; /* list of active labels */
} Dyndata;
/* control of blocks */
struct BlockCnt; /* defined in lparser.c */
/* state needed to generate code for a given function */
typedef struct FuncState {
Proto *f; /* current function header */
Table *h; /* table to find (and reuse) elements in `k' */
struct FuncState *prev; /* enclosing function */
struct LexState *ls; /* lexical state */
struct lua_State *L; /* copy of the Lua state */
struct BlockCnt *bl; /* chain of current blocks */
Table *kcache; /* cache for reusing constants */
int pc; /* next position to code (equivalent to 'ncode') */
int lasttarget; /* 'label' of last 'jump label' */
int previousline; /* last line that was saved in 'lineinfo' */
int nk; /* number of elements in 'k' */
int np; /* number of elements in 'p' */
int nabslineinfo; /* number of elements in 'abslineinfo' */
int firstlocal; /* index of first local var (in Dyndata array) */
int firstlabel; /* index of first label (in 'dyd->label->arr') */
short ndebugvars; /* number of elements in 'f->locvars' */
short nactvar; /* number of active variable declarations */
lu_byte nups; /* number of upvalues */
lu_byte freereg; /* first free register */
lu_byte iwthabs; /* instructions issued since last absolute line info */
lu_byte needclose; /* function needs to close upvalues when returning */
int pc; /* next position to code (equivalent to `ncode') */
int lasttarget; /* `pc' of last `jump target' */
int jpc; /* list of pending jumps to `pc' */
int freereg; /* first free register */
int nk; /* number of elements in `k' */
int np; /* number of elements in `p' */
int nlocvars; /* number of elements in `locvars' */
int nactvar; /* number of active local variables */
expdesc upvalues[MAXUPVALUES]; /* upvalues */
int actvar[MAXVARS]; /* declared-variable stack */
} FuncState;
LUAI_FUNC lu_byte luaY_nvarstack (FuncState *fs);
LUAI_FUNC void luaY_checklimit (FuncState *fs, int v, int l,
const char *what);
LUAI_FUNC LClosure *luaY_parser (lua_State *L, ZIO *z, Table *anchor,
Mbuffer *buff, Dyndata *dyd,
const char *name, int firstchar);
Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff);
#endif

45
lib/lua/lprefix.h
View File

@ -1,45 +0,0 @@
/*
** $Id: lprefix.h $
** Definitions for Lua code that must come before any other header file
** See Copyright Notice in lua.h
*/
#ifndef lprefix_h
#define lprefix_h
/*
** Allows POSIX/XSI stuff
*/
#if !defined(LUA_USE_C89) /* { */
#if !defined(_XOPEN_SOURCE)
#define _XOPEN_SOURCE 600
#elif _XOPEN_SOURCE == 0
#undef _XOPEN_SOURCE /* use -D_XOPEN_SOURCE=0 to undefine it */
#endif
/*
** Allows manipulation of large files in gcc and some other compilers
*/
#if !defined(LUA_32BITS) && !defined(_FILE_OFFSET_BITS)
#define _LARGEFILE_SOURCE 1
#define _FILE_OFFSET_BITS 64
#endif
#endif /* } */
/*
** Windows stuff
*/
#if defined(_WIN32) /* { */
#if !defined(_CRT_SECURE_NO_WARNINGS)
#define _CRT_SECURE_NO_WARNINGS /* avoid warnings about ISO C functions */
#endif
#endif /* } */
#endif

469
lib/lua/lstate.c
View File

@ -1,21 +1,16 @@
/*
** $Id: lstate.c $
** $Id: lstate.c,v 1.123 2003/04/03 13:35:34 roberto Exp $
** Global State
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#define lstate_c
#define LUA_CORE
#include "lprefix.h"
#include <stddef.h>
#include <string.h>
#include "lua.h"
#include "lapi.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
@ -28,398 +23,198 @@
#include "ltm.h"
/*
** macro to allow the inclusion of user information in Lua state
*/
#ifndef LUA_USERSTATE
#define EXTRASPACE 0
#else
union UEXTRASPACE {L_Umaxalign a; LUA_USERSTATE b;};
#define EXTRASPACE (sizeof(union UEXTRASPACE))
#endif
#define fromstate(L) (cast(LX *, cast(lu_byte *, (L)) - offsetof(LX, l)))
/*
** these macros allow user-specific actions when a thread is
** created/deleted
** you can change this function through the official API:
** call `lua_setpanicf'
*/
#if !defined(luai_userstateopen)
#define luai_userstateopen(L) ((void)L)
#endif
#if !defined(luai_userstateclose)
#define luai_userstateclose(L) ((void)L)
#endif
#if !defined(luai_userstatethread)
#define luai_userstatethread(L,L1) ((void)L)
#endif
#if !defined(luai_userstatefree)
#define luai_userstatefree(L,L1) ((void)L)
#endif
/*
** set GCdebt to a new value keeping the real number of allocated
** objects (GCtotalobjs - GCdebt) invariant and avoiding overflows in
** 'GCtotalobjs'.
*/
void luaE_setdebt (global_State *g, l_mem debt) {
l_mem tb = gettotalbytes(g);
lua_assert(tb > 0);
if (debt > MAX_LMEM - tb)
debt = MAX_LMEM - tb; /* will make GCtotalbytes == MAX_LMEM */
g->GCtotalbytes = tb + debt;
g->GCdebt = debt;
static int default_panic (lua_State *L) {
UNUSED(L);
return 0;
}
CallInfo *luaE_extendCI (lua_State *L, int err) {
CallInfo *ci;
ci = luaM_reallocvector(L, NULL, 0, 1, CallInfo);
if (l_unlikely(ci == NULL)) { /* allocation failed? */
if (err)
luaM_error(L); /* raise the error */
return NULL; /* else only report it */
}
ci->next = L->ci->next;
ci->previous = L->ci;
L->ci->next = ci;
if (ci->next)
ci->next->previous = ci;
ci->u.l.trap = 0;
L->nci++;
return ci;
}
/*
** free all CallInfo structures not in use by a thread
*/
static void freeCI (lua_State *L) {
CallInfo *ci = L->ci;
CallInfo *next = ci->next;
ci->next = NULL;
while ((ci = next) != NULL) {
next = ci->next;
luaM_free(L, ci);
L->nci--;
static lua_State *mallocstate (lua_State *L) {
lu_byte *block = (lu_byte *)luaM_malloc(L, sizeof(lua_State) + EXTRASPACE);
if (block == NULL) return NULL;
else {
block += EXTRASPACE;
return cast(lua_State *, block);
}
}
/*
** free half of the CallInfo structures not in use by a thread,
** keeping the first one.
*/
void luaE_shrinkCI (lua_State *L) {
CallInfo *ci = L->ci->next; /* first free CallInfo */
CallInfo *next;
if (ci == NULL)
return; /* no extra elements */
while ((next = ci->next) != NULL) { /* two extra elements? */
CallInfo *next2 = next->next; /* next's next */
ci->next = next2; /* remove next from the list */
L->nci--;
luaM_free(L, next); /* free next */
if (next2 == NULL)
break; /* no more elements */
else {
next2->previous = ci;
ci = next2; /* continue */
}
}
}
/*
** Called when 'getCcalls(L)' larger or equal to LUAI_MAXCCALLS.
** If equal, raises an overflow error. If value is larger than
** LUAI_MAXCCALLS (which means it is handling an overflow) but
** not much larger, does not report an error (to allow overflow
** handling to work).
*/
void luaE_checkcstack (lua_State *L) {
if (getCcalls(L) == LUAI_MAXCCALLS)
luaG_runerror(L, "C stack overflow");
else if (getCcalls(L) >= (LUAI_MAXCCALLS / 10 * 11))
luaD_errerr(L); /* error while handling stack error */
}
LUAI_FUNC void luaE_incCstack (lua_State *L) {
L->nCcalls++;
if (l_unlikely(getCcalls(L) >= LUAI_MAXCCALLS))
luaE_checkcstack(L);
}
static void resetCI (lua_State *L) {
CallInfo *ci = L->ci = &L->base_ci;
ci->func.p = L->stack.p;
setnilvalue2s(ci->func.p); /* 'function' entry for basic 'ci' */
ci->top.p = ci->func.p + 1 + LUA_MINSTACK; /* +1 for 'function' entry */
ci->u.c.k = NULL;
ci->callstatus = CIST_C;
L->status = LUA_OK;
L->errfunc = 0; /* stack unwind can "throw away" the error function */
static void freestate (lua_State *L, lua_State *L1) {
luaM_free(L, cast(lu_byte *, L1) - EXTRASPACE,
sizeof(lua_State) + EXTRASPACE);
}
static void stack_init (lua_State *L1, lua_State *L) {
int i;
/* initialize stack array */
L1->stack.p = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, StackValue);
L1->tbclist.p = L1->stack.p;
for (i = 0; i < BASIC_STACK_SIZE + EXTRA_STACK; i++)
setnilvalue2s(L1->stack.p + i); /* erase new stack */
L1->stack_last.p = L1->stack.p + BASIC_STACK_SIZE;
/* initialize first ci */
resetCI(L1);
L1->top.p = L1->stack.p + 1; /* +1 for 'function' entry */
L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, TObject);
L1->stacksize = BASIC_STACK_SIZE + EXTRA_STACK;
L1->top = L1->stack;
L1->stack_last = L1->stack+(L1->stacksize - EXTRA_STACK)-1;
L1->base_ci = luaM_newvector(L, BASIC_CI_SIZE, CallInfo);
L1->ci = L1->base_ci;
L1->ci->state = CI_C; /* not a Lua function */
setnilvalue(L1->top++); /* `function' entry for this `ci' */
L1->base = L1->ci->base = L1->top;
L1->ci->top = L1->top + LUA_MINSTACK;
L1->size_ci = BASIC_CI_SIZE;
L1->end_ci = L1->base_ci + L1->size_ci;
}
static void freestack (lua_State *L) {
if (L->stack.p == NULL)
return; /* stack not completely built yet */
L->ci = &L->base_ci; /* free the entire 'ci' list */
freeCI(L);
lua_assert(L->nci == 0);
/* free stack */
luaM_freearray(L, L->stack.p, cast_sizet(stacksize(L) + EXTRA_STACK));
static void freestack (lua_State *L, lua_State *L1) {
luaM_freearray(L, L1->base_ci, L1->size_ci, CallInfo);
luaM_freearray(L, L1->stack, L1->stacksize, TObject);
}
/*
** Create registry table and its predefined values
*/
static void init_registry (lua_State *L, global_State *g) {
/* create registry */
TValue aux;
Table *registry = luaH_new(L);
sethvalue(L, &g->l_registry, registry);
luaH_resize(L, registry, LUA_RIDX_LAST, 0);
/* registry[1] = false */
setbfvalue(&aux);
luaH_setint(L, registry, 1, &aux);
/* registry[LUA_RIDX_MAINTHREAD] = L */
setthvalue(L, &aux, L);
luaH_setint(L, registry, LUA_RIDX_MAINTHREAD, &aux);
/* registry[LUA_RIDX_GLOBALS] = new table (table of globals) */
sethvalue(L, &aux, luaH_new(L));
luaH_setint(L, registry, LUA_RIDX_GLOBALS, &aux);
}
/*
** open parts of the state that may cause memory-allocation errors.
** open parts that may cause memory-allocation errors
*/
static void f_luaopen (lua_State *L, void *ud) {
global_State *g = G(L);
/* create a new global state */
global_State *g = luaM_new(NULL, global_State);
UNUSED(ud);
if (g == NULL) luaD_throw(L, LUA_ERRMEM);
L->l_G = g;
g->mainthread = L;
g->GCthreshold = 0; /* mark it as unfinished state */
g->strt.size = 0;
g->strt.nuse = 0;
g->strt.hash = NULL;
setnilvalue(defaultmeta(L));
setnilvalue(registry(L));
luaZ_initbuffer(L, &g->buff);
g->panic = default_panic;
g->rootgc = NULL;
g->rootudata = NULL;
g->tmudata = NULL;
setnilvalue(gkey(g->dummynode));
setnilvalue(gval(g->dummynode));
g->dummynode->next = NULL;
g->nblocks = sizeof(lua_State) + sizeof(global_State);
stack_init(L, L); /* init stack */
init_registry(L, g);
luaS_init(L);
/* create default meta table with a dummy table, and then close the loop */
defaultmeta(L)->tt = LUA_TTABLE;
sethvalue(defaultmeta(L), luaH_new(L, 0, 0));
hvalue(defaultmeta(L))->metatable = hvalue(defaultmeta(L));
sethvalue(gt(L), luaH_new(L, 0, 4)); /* table of globals */
sethvalue(registry(L), luaH_new(L, 4, 4)); /* registry */
luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */
luaT_init(L);
luaX_init(L);
g->gcstp = 0; /* allow gc */
setnilvalue(&g->nilvalue); /* now state is complete */
luai_userstateopen(L);
luaS_fix(luaS_newliteral(L, MEMERRMSG));
g->GCthreshold = 4*G(L)->nblocks;
}
/*
** preinitialize a thread with consistent values without allocating
** any memory (to avoid errors)
*/
static void preinit_thread (lua_State *L, global_State *g) {
G(L) = g;
L->stack.p = NULL;
L->ci = NULL;
L->nci = 0;
L->twups = L; /* thread has no upvalues */
L->nCcalls = 0;
static void preinit_state (lua_State *L) {
L->stack = NULL;
L->stacksize = 0;
L->errorJmp = NULL;
L->hook = NULL;
L->hookmask = 0;
L->hookmask = L->hookinit = 0;
L->basehookcount = 0;
L->allowhook = 1;
resethookcount(L);
L->openupval = NULL;
L->status = LUA_OK;
L->size_ci = 0;
L->nCcalls = 0;
L->base_ci = L->ci = NULL;
L->errfunc = 0;
L->oldpc = 0;
L->base_ci.previous = L->base_ci.next = NULL;
}
lu_mem luaE_threadsize (lua_State *L) {
lu_mem sz = cast(lu_mem, sizeof(LX))
+ cast_uint(L->nci) * sizeof(CallInfo);
if (L->stack.p != NULL)
sz += cast_uint(stacksize(L) + EXTRA_STACK) * sizeof(StackValue);
return sz;
setnilvalue(gt(L));
}
static void close_state (lua_State *L) {
global_State *g = G(L);
if (!completestate(g)) /* closing a partially built state? */
luaC_freeallobjects(L); /* just collect its objects */
else { /* closing a fully built state */
resetCI(L);
luaD_closeprotected(L, 1, LUA_OK); /* close all upvalues */
L->top.p = L->stack.p + 1; /* empty the stack to run finalizers */
luaC_freeallobjects(L); /* collect all objects */
luai_userstateclose(L);
luaF_close(L, L->stack); /* close all upvalues for this thread */
if (G(L)) { /* close global state */
luaC_sweep(L, 1); /* collect all elements */
lua_assert(G(L)->rootgc == NULL);
lua_assert(G(L)->rootudata == NULL);
luaS_freeall(L);
luaZ_freebuffer(L, &G(L)->buff);
}
luaM_freearray(L, G(L)->strt.hash, cast_sizet(G(L)->strt.size));
freestack(L);
lua_assert(gettotalbytes(g) == sizeof(global_State));
(*g->frealloc)(g->ud, g, sizeof(global_State), 0); /* free main block */
freestack(L, L);
if (G(L)) {
lua_assert(G(L)->nblocks == sizeof(lua_State) + sizeof(global_State));
luaM_freelem(NULL, G(L));
}
freestate(NULL, L);
}
LUA_API lua_State *lua_newthread (lua_State *L) {
global_State *g = G(L);
GCObject *o;
lua_State *L1;
lua_lock(L);
luaC_checkGC(L);
/* create new thread */
o = luaC_newobjdt(L, LUA_TTHREAD, sizeof(LX), offsetof(LX, l));
L1 = gco2th(o);
/* anchor it on L stack */
setthvalue2s(L, L->top.p, L1);
api_incr_top(L);
preinit_thread(L1, g);
L1->hookmask = L->hookmask;
L1->basehookcount = L->basehookcount;
L1->hook = L->hook;
resethookcount(L1);
/* initialize L1 extra space */
memcpy(lua_getextraspace(L1), lua_getextraspace(mainthread(g)),
LUA_EXTRASPACE);
luai_userstatethread(L, L1);
lua_State *luaE_newthread (lua_State *L) {
lua_State *L1 = mallocstate(L);
luaC_link(L, valtogco(L1), LUA_TTHREAD);
preinit_state(L1);
L1->l_G = L->l_G;
stack_init(L1, L); /* init stack */
lua_unlock(L);
setobj2n(gt(L1), gt(L)); /* share table of globals */
return L1;
}
void luaE_freethread (lua_State *L, lua_State *L1) {
LX *l = fromstate(L1);
luaF_closeupval(L1, L1->stack.p); /* close all upvalues */
luaF_close(L1, L1->stack); /* close all upvalues for this thread */
lua_assert(L1->openupval == NULL);
luai_userstatefree(L, L1);
freestack(L1);
luaM_free(L, l);
freestack(L, L1);
freestate(L, L1);
}
TStatus luaE_resetthread (lua_State *L, TStatus status) {
resetCI(L);
if (status == LUA_YIELD)
status = LUA_OK;
status = luaD_closeprotected(L, 1, status);
if (status != LUA_OK) /* errors? */
luaD_seterrorobj(L, status, L->stack.p + 1);
else
L->top.p = L->stack.p + 1;
luaD_reallocstack(L, cast_int(L->ci->top.p - L->stack.p), 0);
return status;
}
LUA_API int lua_closethread (lua_State *L, lua_State *from) {
TStatus status;
lua_lock(L);
L->nCcalls = (from) ? getCcalls(from) : 0;
status = luaE_resetthread(L, L->status);
if (L == from) /* closing itself? */
luaD_throwbaselevel(L, status);
lua_unlock(L);
return APIstatus(status);
}
LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud, unsigned seed) {
int i;
lua_State *L;
global_State *g = cast(global_State*,
(*f)(ud, NULL, LUA_TTHREAD, sizeof(global_State)));
if (g == NULL) return NULL;
L = &g->mainth.l;
L->tt = LUA_VTHREAD;
g->currentwhite = bitmask(WHITE0BIT);
L->marked = luaC_white(g);
preinit_thread(L, g);
g->allgc = obj2gco(L); /* by now, only object is the main thread */
L->next = NULL;
incnny(L); /* main thread is always non yieldable */
g->frealloc = f;
g->ud = ud;
g->warnf = NULL;
g->ud_warn = NULL;
g->seed = seed;
g->gcstp = GCSTPGC; /* no GC while building state */
g->strt.size = g->strt.nuse = 0;
g->strt.hash = NULL;
setnilvalue(&g->l_registry);
g->panic = NULL;
g->gcstate = GCSpause;
g->gckind = KGC_INC;
g->gcstopem = 0;
g->gcemergency = 0;
g->finobj = g->tobefnz = g->fixedgc = NULL;
g->firstold1 = g->survival = g->old1 = g->reallyold = NULL;
g->finobjsur = g->finobjold1 = g->finobjrold = NULL;
g->sweepgc = NULL;
g->gray = g->grayagain = NULL;
g->weak = g->ephemeron = g->allweak = NULL;
g->twups = NULL;
g->GCtotalbytes = sizeof(global_State);
g->GCmarked = 0;
g->GCdebt = 0;
setivalue(&g->nilvalue, 0); /* to signal that state is not yet built */
setgcparam(g, PAUSE, LUAI_GCPAUSE);
setgcparam(g, STEPMUL, LUAI_GCMUL);
setgcparam(g, STEPSIZE, LUAI_GCSTEPSIZE);
setgcparam(g, MINORMUL, LUAI_GENMINORMUL);
setgcparam(g, MINORMAJOR, LUAI_MINORMAJOR);
setgcparam(g, MAJORMINOR, LUAI_MAJORMINOR);
for (i=0; i < LUA_NUMTYPES; i++) g->mt[i] = NULL;
if (luaD_rawrunprotected(L, f_luaopen, NULL) != LUA_OK) {
/* memory allocation error: free partial state */
close_state(L);
L = NULL;
LUA_API lua_State *lua_open (void) {
lua_State *L = mallocstate(NULL);
if (L) { /* allocation OK? */
L->tt = LUA_TTHREAD;
L->marked = 0;
L->next = L->gclist = NULL;
preinit_state(L);
L->l_G = NULL;
if (luaD_rawrunprotected(L, f_luaopen, NULL) != 0) {
/* memory allocation error: free partial state */
close_state(L);
L = NULL;
}
}
lua_userstateopen(L);
return L;
}
static void callallgcTM (lua_State *L, void *ud) {
UNUSED(ud);
luaC_callGCTM(L); /* call GC metamethods for all udata */
}
LUA_API void lua_close (lua_State *L) {
lua_lock(L);
L = mainthread(G(L)); /* only the main thread can be closed */
L = G(L)->mainthread; /* only the main thread can be closed */
luaF_close(L, L->stack); /* close all upvalues for this thread */
luaC_separateudata(L); /* separate udata that have GC metamethods */
L->errfunc = 0; /* no error function during GC metamethods */
do { /* repeat until no more errors */
L->ci = L->base_ci;
L->base = L->top = L->ci->base;
L->nCcalls = 0;
} while (luaD_rawrunprotected(L, callallgcTM, NULL) != 0);
lua_assert(G(L)->tmudata == NULL);
close_state(L);
}
void luaE_warning (lua_State *L, const char *msg, int tocont) {
lua_WarnFunction wf = G(L)->warnf;
if (wf != NULL)
wf(G(L)->ud_warn, msg, tocont);
}
/*
** Generate a warning from an error message
*/
void luaE_warnerror (lua_State *L, const char *where) {
TValue *errobj = s2v(L->top.p - 1); /* error object */
const char *msg = (ttisstring(errobj))
? getstr(tsvalue(errobj))
: "error object is not a string";
/* produce warning "error in %s (%s)" (where, msg) */
luaE_warning(L, "error in ", 1);
luaE_warning(L, where, 1);
luaE_warning(L, " (", 1);
luaE_warning(L, msg, 1);
luaE_warning(L, ")", 0);
}

484
lib/lua/lstate.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lstate.h $
** $Id: lstate.h,v 1.109 2003/02/27 11:52:30 roberto Exp $
** Global State
** See Copyright Notice in lua.h
*/
@ -9,443 +9,187 @@
#include "lua.h"
/* Some header files included here need this definition */
typedef struct CallInfo CallInfo;
#include "lobject.h"
#include "ltm.h"
#include "lzio.h"
/*
** Some notes about garbage-collected objects: All objects in Lua must
** be kept somehow accessible until being freed, so all objects always
** belong to one (and only one) of these lists, using field 'next' of
** the 'CommonHeader' for the link:
**
** 'allgc': all objects not marked for finalization;
** 'finobj': all objects marked for finalization;
** 'tobefnz': all objects ready to be finalized;
** 'fixedgc': all objects that are not to be collected (currently
** only small strings, such as reserved words).
**
** For the generational collector, some of these lists have marks for
** generations. Each mark points to the first element in the list for
** that particular generation; that generation goes until the next mark.
**
** 'allgc' -> 'survival': new objects;
** 'survival' -> 'old': objects that survived one collection;
** 'old1' -> 'reallyold': objects that became old in last collection;
** 'reallyold' -> NULL: objects old for more than one cycle.
**
** 'finobj' -> 'finobjsur': new objects marked for finalization;
** 'finobjsur' -> 'finobjold1': survived """";
** 'finobjold1' -> 'finobjrold': just old """";
** 'finobjrold' -> NULL: really old """".
**
** All lists can contain elements older than their main ages, due
** to 'luaC_checkfinalizer' and 'udata2finalize', which move
** objects between the normal lists and the "marked for finalization"
** lists. Moreover, barriers can age young objects in young lists as
** OLD0, which then become OLD1. However, a list never contains
** elements younger than their main ages.
**
** The generational collector also uses a pointer 'firstold1', which
** points to the first OLD1 object in the list. It is used to optimize
** 'markold'. (Potentially OLD1 objects can be anywhere between 'allgc'
** and 'reallyold', but often the list has no OLD1 objects or they are
** after 'old1'.) Note the difference between it and 'old1':
** 'firstold1': no OLD1 objects before this point; there can be all
** ages after it.
** 'old1': no objects younger than OLD1 after this point.
** macros for thread synchronization inside Lua core machine:
** all accesses to the global state and to global objects are synchronized.
** Because threads can read the stack of other threads
** (when running garbage collection),
** a thread must also synchronize any write-access to its own stack.
** Unsynchronized accesses are allowed only when reading its own stack,
** or when reading immutable fields from global objects
** (such as string values and udata values).
*/
#ifndef lua_lock
#define lua_lock(L) ((void) 0)
#endif
/*
** Moreover, there is another set of lists that control gray objects.
** These lists are linked by fields 'gclist'. (All objects that
** can become gray have such a field. The field is not the same
** in all objects, but it always has this name.) Any gray object
** must belong to one of these lists, and all objects in these lists
** must be gray (with two exceptions explained below):
**
** 'gray': regular gray objects, still waiting to be visited.
** 'grayagain': objects that must be revisited at the atomic phase.
** That includes
** - black objects got in a write barrier;
** - all kinds of weak tables during propagation phase;
** - all threads.
** 'weak': tables with weak values to be cleared;
** 'ephemeron': ephemeron tables with white->white entries;
** 'allweak': tables with weak keys and/or weak values to be cleared.
**
** The exceptions to that "gray rule" are:
** - TOUCHED2 objects in generational mode stay in a gray list (because
** they must be visited again at the end of the cycle), but they are
** marked black because assignments to them must activate barriers (to
** move them back to TOUCHED1).
** - Open upvalues are kept gray to avoid barriers, but they stay out
** of gray lists. (They don't even have a 'gclist' field.)
*/
#ifndef lua_unlock
#define lua_unlock(L) ((void) 0)
#endif
/*
** About 'nCcalls': This count has two parts: the lower 16 bits counts
** the number of recursive invocations in the C stack; the higher
** 16 bits counts the number of non-yieldable calls in the stack.
** (They are together so that we can change and save both with one
** instruction.)
*/
/* true if this thread does not have non-yieldable calls in the stack */
#define yieldable(L) (((L)->nCcalls & 0xffff0000) == 0)
/* real number of C calls */
#define getCcalls(L) ((L)->nCcalls & 0xffff)
/* Increment the number of non-yieldable calls */
#define incnny(L) ((L)->nCcalls += 0x10000)
/* Decrement the number of non-yieldable calls */
#define decnny(L) ((L)->nCcalls -= 0x10000)
/* Non-yieldable call increment */
#define nyci (0x10000 | 1)
#ifndef lua_userstateopen
#define lua_userstateopen(l)
#endif
struct lua_longjmp; /* defined in ldo.c */
/*
** Atomic type (relative to signals) to better ensure that 'lua_sethook'
** is thread safe
*/
#if !defined(l_signalT)
#include <signal.h>
#define l_signalT sig_atomic_t
#endif
/* default meta table (both for tables and udata) */
#define defaultmeta(L) (&G(L)->_defaultmeta)
/* table of globals */
#define gt(L) (&L->_gt)
/* registry */
#define registry(L) (&G(L)->_registry)
/*
** Extra stack space to handle TM calls and some other extras. This
** space is not included in 'stack_last'. It is used only to avoid stack
** checks, either because the element will be promptly popped or because
** there will be a stack check soon after the push. Function frames
** never use this extra space, so it does not need to be kept clean.
*/
/* extra stack space to handle TM calls and some other extras */
#define EXTRA_STACK 5
/*
** Size of cache for strings in the API. 'N' is the number of
** sets (better be a prime) and "M" is the size of each set.
** (M == 1 makes a direct cache.)
*/
#if !defined(STRCACHE_N)
#define STRCACHE_N 53
#define STRCACHE_M 2
#endif
#define BASIC_CI_SIZE 8
#define BASIC_STACK_SIZE (2*LUA_MINSTACK)
#define stacksize(th) cast_int((th)->stack_last.p - (th)->stack.p)
/* kinds of Garbage Collection */
#define KGC_INC 0 /* incremental gc */
#define KGC_GENMINOR 1 /* generational gc in minor (regular) mode */
#define KGC_GENMAJOR 2 /* generational in major mode */
typedef struct stringtable {
TString **hash; /* array of buckets (linked lists of strings) */
int nuse; /* number of elements */
int size; /* number of buckets */
GCObject **hash;
ls_nstr nuse; /* number of elements */
int size;
} stringtable;
/*
** Information about a call.
** About union 'u':
** - field 'l' is used only for Lua functions;
** - field 'c' is used only for C functions.
** About union 'u2':
** - field 'funcidx' is used only by C functions while doing a
** protected call;
** - field 'nyield' is used only while a function is "doing" an
** yield (from the yield until the next resume);
** - field 'nres' is used only while closing tbc variables when
** returning from a function;
** informations about a call
*/
struct CallInfo {
StkIdRel func; /* function index in the stack */
StkIdRel top; /* top for this function */
struct CallInfo *previous, *next; /* dynamic call link */
typedef struct CallInfo {
StkId base; /* base for called function */
StkId top; /* top for this function */
int state; /* bit fields; see below */
union {
struct { /* only for Lua functions */
struct { /* for Lua functions */
const Instruction *savedpc;
volatile l_signalT trap; /* function is tracing lines/counts */
int nextraargs; /* # of extra arguments in vararg functions */
const Instruction **pc; /* points to `pc' variable in `luaV_execute' */
int tailcalls; /* number of tail calls lost under this entry */
} l;
struct { /* only for C functions */
lua_KFunction k; /* continuation in case of yields */
ptrdiff_t old_errfunc;
lua_KContext ctx; /* context info. in case of yields */
struct { /* for C functions */
int dummy; /* just to avoid an empty struct */
} c;
} u;
union {
int funcidx; /* called-function index */
int nyield; /* number of values yielded */
int nres; /* number of values returned */
} u2;
l_uint32 callstatus;
};
} CallInfo;
/*
** Maximum expected number of results from a function
** (must fit in CIST_NRESULTS).
** bit fields for `CallInfo.state'
*/
#define MAXRESULTS 250
#define CI_C (1<<0) /* 1 if function is a C function */
/* 1 if (Lua) function has an active `luaV_execute' running it */
#define CI_HASFRAME (1<<1)
/* 1 if Lua function is calling another Lua function (and therefore its
`pc' is being used by the other, and therefore CI_SAVEDPC is 1 too) */
#define CI_CALLING (1<<2)
#define CI_SAVEDPC (1<<3) /* 1 if `savedpc' is updated */
#define CI_YIELD (1<<4) /* 1 if thread is suspended */
#define ci_func(ci) (clvalue((ci)->base - 1))
/*
** Bits in CallInfo status
*/
/* bits 0-7 are the expected number of results from this function + 1 */
#define CIST_NRESULTS 0xffu
/* bits 8-11 count call metamethods (and their extra arguments) */
#define CIST_CCMT 8 /* the offset, not the mask */
#define MAX_CCMT (0xfu << CIST_CCMT)
/* Bits 12-14 are used for CIST_RECST (see below) */
#define CIST_RECST 12 /* the offset, not the mask */
/* call is running a C function (still in first 16 bits) */
#define CIST_C (1u << (CIST_RECST + 3))
/* call is on a fresh "luaV_execute" frame */
#define CIST_FRESH (cast(l_uint32, CIST_C) << 1)
/* function is closing tbc variables */
#define CIST_CLSRET (CIST_FRESH << 1)
/* function has tbc variables to close */
#define CIST_TBC (CIST_CLSRET << 1)
/* original value of 'allowhook' */
#define CIST_OAH (CIST_TBC << 1)
/* call is running a debug hook */
#define CIST_HOOKED (CIST_OAH << 1)
/* doing a yieldable protected call */
#define CIST_YPCALL (CIST_HOOKED << 1)
/* call was tail called */
#define CIST_TAIL (CIST_YPCALL << 1)
/* last hook called yielded */
#define CIST_HOOKYIELD (CIST_TAIL << 1)
/* function "called" a finalizer */
#define CIST_FIN (CIST_HOOKYIELD << 1)
#define get_nresults(cs) (cast_int((cs) & CIST_NRESULTS) - 1)
/*
** Field CIST_RECST stores the "recover status", used to keep the error
** status while closing to-be-closed variables in coroutines, so that
** Lua can correctly resume after an yield from a __close method called
** because of an error. (Three bits are enough for error status.)
*/
#define getcistrecst(ci) (((ci)->callstatus >> CIST_RECST) & 7)
#define setcistrecst(ci,st) \
check_exp(((st) & 7) == (st), /* status must fit in three bits */ \
((ci)->callstatus = ((ci)->callstatus & ~(7u << CIST_RECST)) \
| (cast(l_uint32, st) << CIST_RECST)))
/* active function is a Lua function */
#define isLua(ci) (!((ci)->callstatus & CIST_C))
/* call is running Lua code (not a hook) */
#define isLuacode(ci) (!((ci)->callstatus & (CIST_C | CIST_HOOKED)))
#define setoah(ci,v) \
((ci)->callstatus = ((v) ? (ci)->callstatus | CIST_OAH \
: (ci)->callstatus & ~CIST_OAH))
#define getoah(ci) (((ci)->callstatus & CIST_OAH) ? 1 : 0)
/*
** 'per thread' state
*/
struct lua_State {
CommonHeader;
lu_byte allowhook;
TStatus status;
StkIdRel top; /* first free slot in the stack */
struct global_State *l_G;
CallInfo *ci; /* call info for current function */
StkIdRel stack_last; /* end of stack (last element + 1) */
StkIdRel stack; /* stack base */
UpVal *openupval; /* list of open upvalues in this stack */
StkIdRel tbclist; /* list of to-be-closed variables */
GCObject *gclist;
struct lua_State *twups; /* list of threads with open upvalues */
struct lua_longjmp *errorJmp; /* current error recover point */
CallInfo base_ci; /* CallInfo for first level (C host) */
volatile lua_Hook hook;
ptrdiff_t errfunc; /* current error handling function (stack index) */
l_uint32 nCcalls; /* number of nested non-yieldable or C calls */
int oldpc; /* last pc traced */
int nci; /* number of items in 'ci' list */
int basehookcount;
int hookcount;
volatile l_signalT hookmask;
struct { /* info about transferred values (for call/return hooks) */
int ftransfer; /* offset of first value transferred */
int ntransfer; /* number of values transferred */
} transferinfo;
};
/*
** thread state + extra space
*/
typedef struct LX {
lu_byte extra_[LUA_EXTRASPACE];
lua_State l;
} LX;
/*
** 'global state', shared by all threads of this state
** `global state', shared by all threads of this state
*/
typedef struct global_State {
lua_Alloc frealloc; /* function to reallocate memory */
void *ud; /* auxiliary data to 'frealloc' */
l_mem GCtotalbytes; /* number of bytes currently allocated + debt */
l_mem GCdebt; /* bytes counted but not yet allocated */
l_mem GCmarked; /* number of objects marked in a GC cycle */
l_mem GCmajorminor; /* auxiliary counter to control major-minor shifts */
stringtable strt; /* hash table for strings */
TValue l_registry;
TValue nilvalue; /* a nil value */
unsigned int seed; /* randomized seed for hashes */
lu_byte gcparams[LUA_GCPN];
lu_byte currentwhite;
lu_byte gcstate; /* state of garbage collector */
lu_byte gckind; /* kind of GC running */
lu_byte gcstopem; /* stops emergency collections */
lu_byte gcstp; /* control whether GC is running */
lu_byte gcemergency; /* true if this is an emergency collection */
GCObject *allgc; /* list of all collectable objects */
GCObject **sweepgc; /* current position of sweep in list */
GCObject *finobj; /* list of collectable objects with finalizers */
GCObject *gray; /* list of gray objects */
GCObject *grayagain; /* list of objects to be traversed atomically */
GCObject *weak; /* list of tables with weak values */
GCObject *ephemeron; /* list of ephemeron tables (weak keys) */
GCObject *allweak; /* list of all-weak tables */
GCObject *tobefnz; /* list of userdata to be GC */
GCObject *fixedgc; /* list of objects not to be collected */
/* fields for generational collector */
GCObject *survival; /* start of objects that survived one GC cycle */
GCObject *old1; /* start of old1 objects */
GCObject *reallyold; /* objects more than one cycle old ("really old") */
GCObject *firstold1; /* first OLD1 object in the list (if any) */
GCObject *finobjsur; /* list of survival objects with finalizers */
GCObject *finobjold1; /* list of old1 objects with finalizers */
GCObject *finobjrold; /* list of really old objects with finalizers */
struct lua_State *twups; /* list of threads with open upvalues */
GCObject *rootgc; /* list of (almost) all collectable objects */
GCObject *rootudata; /* (separated) list of all userdata */
GCObject *tmudata; /* list of userdata to be GC */
Mbuffer buff; /* temporary buffer for string concatentation */
lu_mem GCthreshold;
lu_mem nblocks; /* number of `bytes' currently allocated */
lua_CFunction panic; /* to be called in unprotected errors */
TString *memerrmsg; /* message for memory-allocation errors */
TObject _registry;
TObject _defaultmeta;
struct lua_State *mainthread;
Node dummynode[1]; /* common node array for all empty tables */
TString *tmname[TM_N]; /* array with tag-method names */
struct Table *mt[LUA_NUMTYPES]; /* metatables for basic types */
TString *strcache[STRCACHE_N][STRCACHE_M]; /* cache for strings in API */
lua_WarnFunction warnf; /* warning function */
void *ud_warn; /* auxiliary data to 'warnf' */
LX mainth; /* main thread of this state */
} global_State;
#define G(L) (L->l_G)
#define mainthread(G) (&(G)->mainth.l)
/*
** 'g->nilvalue' being a nil value flags that the state was completely
** build.
** `per thread' state
*/
#define completestate(g) ttisnil(&g->nilvalue)
struct lua_State {
CommonHeader;
StkId top; /* first free slot in the stack */
StkId base; /* base of current function */
global_State *l_G;
CallInfo *ci; /* call info for current function */
StkId stack_last; /* last free slot in the stack */
StkId stack; /* stack base */
int stacksize;
CallInfo *end_ci; /* points after end of ci array*/
CallInfo *base_ci; /* array of CallInfo's */
unsigned short size_ci; /* size of array `base_ci' */
unsigned short nCcalls; /* number of nested C calls */
lu_byte hookmask;
lu_byte allowhook;
lu_byte hookinit;
int basehookcount;
int hookcount;
lua_Hook hook;
TObject _gt; /* table of globals */
GCObject *openupval; /* list of open upvalues in this stack */
GCObject *gclist;
struct lua_longjmp *errorJmp; /* current error recover point */
ptrdiff_t errfunc; /* current error handling function (stack index) */
};
#define G(L) (L->l_G)
/*
** Union of all collectable objects
** ISO C99, 6.5.2.3 p.5:
** "if a union contains several structures that share a common initial
** sequence [...], and if the union object currently contains one
** of these structures, it is permitted to inspect the common initial
** part of any of them anywhere that a declaration of the complete type
** of the union is visible."
*/
union GCUnion {
GCObject gc; /* common header */
struct TString ts;
struct Udata u;
union GCObject {
GCheader gch;
union TString ts;
union Udata u;
union Closure cl;
struct Table h;
struct Proto p;
struct UpVal uv;
struct lua_State th; /* thread */
struct UpVal upv;
};
/* macros to convert a GCObject into a specific value
** ISO C99, 6.3.2.2 p.7:
** "A pointer to an object or incomplete type may be converted to a
** pointer to a different object or incomplete type. If the resulting
** pointer is not correctly aligned for the pointed-to type, the
** behavior is undefined. Otherwise, when converted back again, the
** result shall compare equal to the original pointer."
*/
#define gco2(v,T,o) check_exp((o)->tt == v, cast(T*, o))
#define gco2nv(t,T,o) check_exp(novariant((o)->tt) == t, cast(T*, o))
#define gco2ts(o) gco2nv(LUA_TSTRING, TString, o)
#define gco2u(o) gco2(LUA_VUSERDATA, Udata, o)
#define gco2lcl(o) (&gco2(LUA_VLCL, Closure, o)->l)
#define gco2ccl(o) (&gco2(LUA_VCCL, Closure, o)->c)
#define gco2cl(o) gco2nv(LUA_TFUNCTION, Closure, o)
#define gco2t(o) gco2(LUA_VTABLE, Table, o)
#define gco2p(o) gco2(LUA_VPROTO, Proto, o)
#define gco2th(o) gco2(LUA_VTHREAD, lua_State, o)
#define gco2upv(o) gco2(LUA_VUPVAL, UpVal, o)
/* macros to convert a GCObject into a specific value */
#define gcotots(o) check_exp((o)->gch.tt == LUA_TSTRING, &((o)->ts))
#define gcotou(o) check_exp((o)->gch.tt == LUA_TUSERDATA, &((o)->u))
#define gcotocl(o) check_exp((o)->gch.tt == LUA_TFUNCTION, &((o)->cl))
#define gcotoh(o) check_exp((o)->gch.tt == LUA_TTABLE, &((o)->h))
#define gcotop(o) check_exp((o)->gch.tt == LUA_TPROTO, &((o)->p))
#define gcotouv(o) check_exp((o)->gch.tt == LUA_TUPVAL, &((o)->uv))
#define ngcotouv(o) \
check_exp((o) == NULL || (o)->gch.tt == LUA_TUPVAL, &((o)->uv))
#define gcototh(o) check_exp((o)->gch.tt == LUA_TTHREAD, &((o)->th))
/* macro to convert any value into a GCObject */
#define valtogco(v) (cast(GCObject *, (v)))
/*
** macro to convert a Lua object into a GCObject
*/
#define obj2gco(v) \
check_exp(novariant((v)->tt) >= LUA_TSTRING, cast(GCObject*, v))
/* actual number of total memory allocated */
#define gettotalbytes(g) ((g)->GCtotalbytes - (g)->GCdebt)
LUAI_FUNC void luaE_setdebt (global_State *g, l_mem debt);
LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1);
LUAI_FUNC lu_mem luaE_threadsize (lua_State *L);
LUAI_FUNC CallInfo *luaE_extendCI (lua_State *L, int err);
LUAI_FUNC void luaE_shrinkCI (lua_State *L);
LUAI_FUNC void luaE_checkcstack (lua_State *L);
LUAI_FUNC void luaE_incCstack (lua_State *L);
LUAI_FUNC void luaE_warning (lua_State *L, const char *msg, int tocont);
LUAI_FUNC void luaE_warnerror (lua_State *L, const char *where);
LUAI_FUNC TStatus luaE_resetthread (lua_State *L, TStatus status);
lua_State *luaE_newthread (lua_State *L);
void luaE_freethread (lua_State *L, lua_State *L1);
#endif

383
lib/lua/lstring.c
View File

@ -1,353 +1,102 @@
/*
** $Id: lstring.c $
** $Id: lstring.c,v 1.78 2002/12/04 17:38:31 roberto Exp $
** String table (keeps all strings handled by Lua)
** See Copyright Notice in lua.h
*/
#define lstring_c
#define LUA_CORE
#include "lprefix.h"
#include <string.h>
#define lstring_c
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
/*
** Maximum size for string table.
*/
#define MAXSTRTB cast_int(luaM_limitN(INT_MAX, TString*))
/*
** Initial size for the string table (must be power of 2).
** The Lua core alone registers ~50 strings (reserved words +
** metaevent keys + a few others). Libraries would typically add
** a few dozens more.
*/
#if !defined(MINSTRTABSIZE)
#define MINSTRTABSIZE 128
#endif
/*
** generic equality for strings
*/
int luaS_eqstr (TString *a, TString *b) {
size_t len1, len2;
const char *s1 = getlstr(a, len1);
const char *s2 = getlstr(b, len2);
return ((len1 == len2) && /* equal length and ... */
(memcmp(s1, s2, len1) == 0)); /* equal contents */
void luaS_freeall (lua_State *L) {
lua_assert(G(L)->strt.nuse==0);
luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size, TString *);
}
static unsigned luaS_hash (const char *str, size_t l, unsigned seed) {
unsigned int h = seed ^ cast_uint(l);
for (; l > 0; l--)
h ^= ((h<<5) + (h>>2) + cast_byte(str[l - 1]));
return h;
}
unsigned luaS_hashlongstr (TString *ts) {
lua_assert(ts->tt == LUA_VLNGSTR);
if (ts->extra == 0) { /* no hash? */
size_t len = ts->u.lnglen;
ts->hash = luaS_hash(getlngstr(ts), len, ts->hash);
ts->extra = 1; /* now it has its hash */
}
return ts->hash;
}
static void tablerehash (TString **vect, int osize, int nsize) {
void luaS_resize (lua_State *L, int newsize) {
GCObject **newhash = luaM_newvector(L, newsize, GCObject *);
stringtable *tb = &G(L)->strt;
int i;
for (i = osize; i < nsize; i++) /* clear new elements */
vect[i] = NULL;
for (i = 0; i < osize; i++) { /* rehash old part of the array */
TString *p = vect[i];
vect[i] = NULL;
while (p) { /* for each string in the list */
TString *hnext = p->u.hnext; /* save next */
unsigned int h = lmod(p->hash, nsize); /* new position */
p->u.hnext = vect[h]; /* chain it into array */
vect[h] = p;
p = hnext;
for (i=0; i<newsize; i++) newhash[i] = NULL;
/* rehash */
for (i=0; i<tb->size; i++) {
GCObject *p = tb->hash[i];
while (p) { /* for each node in the list */
GCObject *next = p->gch.next; /* save next */
lu_hash h = gcotots(p)->tsv.hash;
int h1 = lmod(h, newsize); /* new position */
lua_assert(cast(int, h%newsize) == lmod(h, newsize));
p->gch.next = newhash[h1]; /* chain it */
newhash[h1] = p;
p = next;
}
}
luaM_freearray(L, tb->hash, tb->size, TString *);
tb->size = newsize;
tb->hash = newhash;
}
/*
** Resize the string table. If allocation fails, keep the current size.
** (This can degrade performance, but any non-zero size should work
** correctly.)
*/
void luaS_resize (lua_State *L, int nsize) {
stringtable *tb = &G(L)->strt;
int osize = tb->size;
TString **newvect;
if (nsize < osize) /* shrinking table? */
tablerehash(tb->hash, osize, nsize); /* depopulate shrinking part */
newvect = luaM_reallocvector(L, tb->hash, osize, nsize, TString*);
if (l_unlikely(newvect == NULL)) { /* reallocation failed? */
if (nsize < osize) /* was it shrinking table? */
tablerehash(tb->hash, nsize, osize); /* restore to original size */
/* leave table as it was */
}
else { /* allocation succeeded */
tb->hash = newvect;
tb->size = nsize;
if (nsize > osize)
tablerehash(newvect, osize, nsize); /* rehash for new size */
}
}
/*
** Clear API string cache. (Entries cannot be empty, so fill them with
** a non-collectable string.)
*/
void luaS_clearcache (global_State *g) {
int i, j;
for (i = 0; i < STRCACHE_N; i++)
for (j = 0; j < STRCACHE_M; j++) {
if (iswhite(g->strcache[i][j])) /* will entry be collected? */
g->strcache[i][j] = g->memerrmsg; /* replace it with something fixed */
}
}
/*
** Initialize the string table and the string cache
*/
void luaS_init (lua_State *L) {
global_State *g = G(L);
int i, j;
stringtable *tb = &G(L)->strt;
tb->hash = luaM_newvector(L, MINSTRTABSIZE, TString*);
tablerehash(tb->hash, 0, MINSTRTABSIZE); /* clear array */
tb->size = MINSTRTABSIZE;
/* pre-create memory-error message */
g->memerrmsg = luaS_newliteral(L, MEMERRMSG);
luaC_fix(L, obj2gco(g->memerrmsg)); /* it should never be collected */
for (i = 0; i < STRCACHE_N; i++) /* fill cache with valid strings */
for (j = 0; j < STRCACHE_M; j++)
g->strcache[i][j] = g->memerrmsg;
}
size_t luaS_sizelngstr (size_t len, int kind) {
switch (kind) {
case LSTRREG: /* regular long string */
/* don't need 'falloc'/'ud', but need space for content */
return offsetof(TString, falloc) + (len + 1) * sizeof(char);
case LSTRFIX: /* fixed external long string */
/* don't need 'falloc'/'ud' */
return offsetof(TString, falloc);
default: /* external long string with deallocation */
lua_assert(kind == LSTRMEM);
return sizeof(TString);
}
}
/*
** creates a new string object
*/
static TString *createstrobj (lua_State *L, size_t totalsize, lu_byte tag,
unsigned h) {
TString *ts;
GCObject *o;
o = luaC_newobj(L, tag, totalsize);
ts = gco2ts(o);
ts->hash = h;
ts->extra = 0;
return ts;
}
TString *luaS_createlngstrobj (lua_State *L, size_t l) {
size_t totalsize = luaS_sizelngstr(l, LSTRREG);
TString *ts = createstrobj(L, totalsize, LUA_VLNGSTR, G(L)->seed);
ts->u.lnglen = l;
ts->shrlen = LSTRREG; /* signals that it is a regular long string */
ts->contents = cast_charp(ts) + offsetof(TString, falloc);
ts->contents[l] = '\0'; /* ending 0 */
return ts;
}
void luaS_remove (lua_State *L, TString *ts) {
stringtable *tb = &G(L)->strt;
TString **p = &tb->hash[lmod(ts->hash, tb->size)];
while (*p != ts) /* find previous element */
p = &(*p)->u.hnext;
*p = (*p)->u.hnext; /* remove element from its list */
tb->nuse--;
}
static void growstrtab (lua_State *L, stringtable *tb) {
if (l_unlikely(tb->nuse == INT_MAX)) { /* too many strings? */
luaC_fullgc(L, 1); /* try to free some... */
if (tb->nuse == INT_MAX) /* still too many? */
luaM_error(L); /* cannot even create a message... */
}
if (tb->size <= MAXSTRTB / 2) /* can grow string table? */
luaS_resize(L, tb->size * 2);
}
/*
** Checks whether short string exists and reuses it or creates a new one.
*/
static TString *internshrstr (lua_State *L, const char *str, size_t l) {
TString *ts;
global_State *g = G(L);
stringtable *tb = &g->strt;
unsigned int h = luaS_hash(str, l, g->seed);
TString **list = &tb->hash[lmod(h, tb->size)];
lua_assert(str != NULL); /* otherwise 'memcmp'/'memcpy' are undefined */
for (ts = *list; ts != NULL; ts = ts->u.hnext) {
if (l == cast_uint(ts->shrlen) &&
(memcmp(str, getshrstr(ts), l * sizeof(char)) == 0)) {
/* found! */
if (isdead(g, ts)) /* dead (but not collected yet)? */
changewhite(ts); /* resurrect it */
return ts;
}
}
/* else must create a new string */
if (tb->nuse >= tb->size) { /* need to grow string table? */
growstrtab(L, tb);
list = &tb->hash[lmod(h, tb->size)]; /* rehash with new size */
}
ts = createstrobj(L, sizestrshr(l), LUA_VSHRSTR, h);
ts->shrlen = cast(ls_byte, l);
getshrstr(ts)[l] = '\0'; /* ending 0 */
memcpy(getshrstr(ts), str, l * sizeof(char));
ts->u.hnext = *list;
*list = ts;
static TString *newlstr (lua_State *L, const char *str, size_t l, lu_hash h) {
TString *ts = cast(TString *, luaM_malloc(L, sizestring(l)));
stringtable *tb;
ts->tsv.len = l;
ts->tsv.hash = h;
ts->tsv.marked = 0;
ts->tsv.tt = LUA_TSTRING;
ts->tsv.reserved = 0;
memcpy(ts+1, str, l*sizeof(char));
((char *)(ts+1))[l] = '\0'; /* ending 0 */
tb = &G(L)->strt;
h = lmod(h, tb->size);
ts->tsv.next = tb->hash[h]; /* chain new entry */
tb->hash[h] = valtogco(ts);
tb->nuse++;
if (tb->nuse > cast(ls_nstr, tb->size) && tb->size <= MAX_INT/2)
luaS_resize(L, tb->size*2); /* too crowded */
return ts;
}
/*
** new string (with explicit length)
*/
TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
if (l <= LUAI_MAXSHORTLEN) /* short string? */
return internshrstr(L, str, l);
else {
TString *ts;
if (l_unlikely(l * sizeof(char) >= (MAX_SIZE - sizeof(TString))))
luaM_toobig(L);
ts = luaS_createlngstrobj(L, l);
memcpy(getlngstr(ts), str, l * sizeof(char));
return ts;
}
}
/*
** Create or reuse a zero-terminated string, first checking in the
** cache (using the string address as a key). The cache can contain
** only zero-terminated strings, so it is safe to use 'strcmp' to
** check hits.
*/
TString *luaS_new (lua_State *L, const char *str) {
unsigned int i = point2uint(str) % STRCACHE_N; /* hash */
int j;
TString **p = G(L)->strcache[i];
for (j = 0; j < STRCACHE_M; j++) {
if (strcmp(str, getstr(p[j])) == 0) /* hit? */
return p[j]; /* that is it */
}
/* normal route */
for (j = STRCACHE_M - 1; j > 0; j--)
p[j] = p[j - 1]; /* move out last element */
/* new element is first in the list */
p[0] = luaS_newlstr(L, str, strlen(str));
return p[0];
}
Udata *luaS_newudata (lua_State *L, size_t s, unsigned short nuvalue) {
Udata *u;
int i;
GCObject *o;
if (l_unlikely(s > MAX_SIZE - udatamemoffset(nuvalue)))
luaM_toobig(L);
o = luaC_newobj(L, LUA_VUSERDATA, sizeudata(nuvalue, s));
u = gco2u(o);
u->len = s;
u->nuvalue = nuvalue;
u->metatable = NULL;
for (i = 0; i < nuvalue; i++)
setnilvalue(&u->uv[i].uv);
lu_hash h = (lu_hash)l; /* seed */
size_t step = (l>>5)+1; /* if string is too long, don't hash all its chars */
size_t l1;
for (l1=l; l1>=step; l1-=step) /* compute hash */
h = h ^ ((h<<5)+(h>>2)+(unsigned char)(str[l1-1]));
for (o = G(L)->strt.hash[lmod(h, G(L)->strt.size)];
o != NULL;
o = o->gch.next) {
TString *ts = gcotots(o);
if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0))
return ts;
}
return newlstr(L, str, l, h); /* not found */
}
Udata *luaS_newudata (lua_State *L, size_t s) {
Udata *u;
u = cast(Udata *, luaM_malloc(L, sizeudata(s)));
u->uv.marked = (1<<1); /* is not finalized */
u->uv.tt = LUA_TUSERDATA;
u->uv.len = s;
u->uv.metatable = hvalue(defaultmeta(L));
/* chain it on udata list */
u->uv.next = G(L)->rootudata;
G(L)->rootudata = valtogco(u);
return u;
}
struct NewExt {
ls_byte kind;
const char *s;
size_t len;
TString *ts; /* output */
};
static void f_newext (lua_State *L, void *ud) {
struct NewExt *ne = cast(struct NewExt *, ud);
size_t size = luaS_sizelngstr(0, ne->kind);
ne->ts = createstrobj(L, size, LUA_VLNGSTR, G(L)->seed);
}
TString *luaS_newextlstr (lua_State *L,
const char *s, size_t len, lua_Alloc falloc, void *ud) {
struct NewExt ne;
if (!falloc) {
ne.kind = LSTRFIX;
f_newext(L, &ne); /* just create header */
}
else {
ne.kind = LSTRMEM;
if (luaD_rawrunprotected(L, f_newext, &ne) != LUA_OK) { /* mem. error? */
(*falloc)(ud, cast_voidp(s), len + 1, 0); /* free external string */
luaM_error(L); /* re-raise memory error */
}
ne.ts->falloc = falloc;
ne.ts->ud = ud;
}
ne.ts->shrlen = ne.kind;
ne.ts->u.lnglen = len;
ne.ts->contents = cast_charp(s);
return ne.ts;
}
/*
** Normalize an external string: If it is short, internalize it.
*/
TString *luaS_normstr (lua_State *L, TString *ts) {
size_t len = ts->u.lnglen;
if (len > LUAI_MAXSHORTLEN)
return ts; /* long string; keep the original */
else {
const char *str = getlngstr(ts);
return internshrstr(L, str, len);
}
}

62
lib/lua/lstring.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lstring.h $
** $Id: lstring.h,v 1.37 2002/08/16 14:45:55 roberto Exp $
** String table (keep all strings handled by Lua)
** See Copyright Notice in lua.h
*/
@ -7,67 +7,27 @@
#ifndef lstring_h
#define lstring_h
#include "lgc.h"
#include "lobject.h"
#include "lstate.h"
/*
** Memory-allocation error message must be preallocated (it cannot
** be created after memory is exhausted)
*/
#define MEMERRMSG "not enough memory"
#define sizestring(l) (cast(lu_mem, sizeof(union TString))+ \
(cast(lu_mem, l)+1)*sizeof(char))
/*
** Maximum length for short strings, that is, strings that are
** internalized. (Cannot be smaller than reserved words or tags for
** metamethods, as these strings must be internalized;
** #("function") = 8, #("__newindex") = 10.)
*/
#if !defined(LUAI_MAXSHORTLEN)
#define LUAI_MAXSHORTLEN 40
#endif
/*
** Size of a short TString: Size of the header plus space for the string
** itself (including final '\0').
*/
#define sizestrshr(l) \
(offsetof(TString, contents) + ((l) + 1) * sizeof(char))
#define sizeudata(l) (cast(lu_mem, sizeof(union Udata))+(l))
#define luaS_new(L, s) (luaS_newlstr(L, s, strlen(s)))
#define luaS_newliteral(L, s) (luaS_newlstr(L, "" s, \
(sizeof(s)/sizeof(char))-1))
#define luaS_fix(s) ((s)->tsv.marked |= (1<<4))
/*
** test whether a string is a reserved word
*/
#define isreserved(s) (strisshr(s) && (s)->extra > 0)
void luaS_resize (lua_State *L, int newsize);
Udata *luaS_newudata (lua_State *L, size_t s);
void luaS_freeall (lua_State *L);
TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
/*
** equality for short strings, which are always internalized
*/
#define eqshrstr(a,b) check_exp((a)->tt == LUA_VSHRSTR, (a) == (b))
LUAI_FUNC unsigned luaS_hashlongstr (TString *ts);
LUAI_FUNC int luaS_eqstr (TString *a, TString *b);
LUAI_FUNC void luaS_resize (lua_State *L, int newsize);
LUAI_FUNC void luaS_clearcache (global_State *g);
LUAI_FUNC void luaS_init (lua_State *L);
LUAI_FUNC void luaS_remove (lua_State *L, TString *ts);
LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s,
unsigned short nuvalue);
LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
LUAI_FUNC TString *luaS_new (lua_State *L, const char *str);
LUAI_FUNC TString *luaS_createlngstrobj (lua_State *L, size_t l);
LUAI_FUNC TString *luaS_newextlstr (lua_State *L,
const char *s, size_t len, lua_Alloc falloc, void *ud);
LUAI_FUNC size_t luaS_sizelngstr (size_t len, int kind);
LUAI_FUNC TString *luaS_normstr (lua_State *L, TString *ts);
#endif

1866
lib/lua/lstrlib.c
View File

File diff suppressed because it is too large Load Diff

1526
lib/lua/ltable.c
View File

File diff suppressed because it is too large Load Diff

177
lib/lua/ltable.h
View File

@ -1,5 +1,5 @@
/*
** $Id: ltable.h $
** $Id: ltable.h,v 1.44 2003/03/18 12:50:04 roberto Exp $
** Lua tables (hash)
** See Copyright Notice in lua.h
*/
@ -11,174 +11,21 @@
#define gnode(t,i) (&(t)->node[i])
#define gkey(n) (&(n)->i_key)
#define gval(n) (&(n)->i_val)
#define gnext(n) ((n)->u.next)
/*
** Clear all bits of fast-access metamethods, which means that the table
** may have any of these metamethods. (First access that fails after the
** clearing will set the bit again.)
*/
#define invalidateTMcache(t) ((t)->flags &= cast_byte(~maskflags))
const TObject *luaH_getnum (Table *t, int key);
TObject *luaH_setnum (lua_State *L, Table *t, int key);
const TObject *luaH_getstr (Table *t, TString *key);
const TObject *luaH_get (Table *t, const TObject *key);
TObject *luaH_set (lua_State *L, Table *t, const TObject *key);
Table *luaH_new (lua_State *L, int narray, int lnhash);
void luaH_free (lua_State *L, Table *t);
int luaH_next (lua_State *L, Table *t, StkId key);
/*
** Bit BITDUMMY set in 'flags' means the table is using the dummy node
** for its hash part.
*/
#define BITDUMMY (1 << 6)
#define NOTBITDUMMY cast_byte(~BITDUMMY)
#define isdummy(t) ((t)->flags & BITDUMMY)
#define setnodummy(t) ((t)->flags &= NOTBITDUMMY)
#define setdummy(t) ((t)->flags |= BITDUMMY)
/* allocated size for hash nodes */
#define allocsizenode(t) (isdummy(t) ? 0 : sizenode(t))
/* returns the Node, given the value of a table entry */
#define nodefromval(v) cast(Node *, (v))
#define luaH_fastgeti(t,k,res,tag) \
{ Table *h = t; lua_Unsigned u = l_castS2U(k) - 1u; \
if ((u < h->asize)) { \
tag = *getArrTag(h, u); \
if (!tagisempty(tag)) { farr2val(h, u, tag, res); }} \
else { tag = luaH_getint(h, (k), res); }}
#define luaH_fastseti(t,k,val,hres) \
{ Table *h = t; lua_Unsigned u = l_castS2U(k) - 1u; \
if ((u < h->asize)) { \
lu_byte *tag = getArrTag(h, u); \
if (checknoTM(h->metatable, TM_NEWINDEX) || !tagisempty(*tag)) \
{ fval2arr(h, u, tag, val); hres = HOK; } \
else hres = ~cast_int(u); } \
else { hres = luaH_psetint(h, k, val); }}
/* results from pset */
#define HOK 0
#define HNOTFOUND 1
#define HNOTATABLE 2
#define HFIRSTNODE 3
/*
** 'luaH_get*' operations set 'res', unless the value is absent, and
** return the tag of the result.
** The 'luaH_pset*' (pre-set) operations set the given value and return
** HOK, unless the original value is absent. In that case, if the key
** is really absent, they return HNOTFOUND. Otherwise, if there is a
** slot with that key but with no value, 'luaH_pset*' return an encoding
** of where the key is (usually called 'hres'). (pset cannot set that
** value because there might be a metamethod.) If the slot is in the
** hash part, the encoding is (HFIRSTNODE + hash index); if the slot is
** in the array part, the encoding is (~array index), a negative value.
** The value HNOTATABLE is used by the fast macros to signal that the
** value being indexed is not a table.
** (The size for the array part is limited by the maximum power of two
** that fits in an unsigned integer; that is INT_MAX+1. So, the C-index
** ranges from 0, which encodes to -1, to INT_MAX, which encodes to
** INT_MIN. The size of the hash part is limited by the maximum power of
** two that fits in a signed integer; that is (INT_MAX+1)/2. So, it is
** safe to add HFIRSTNODE to any index there.)
*/
/*
** The array part of a table is represented by an inverted array of
** values followed by an array of tags, to avoid wasting space with
** padding. In between them there is an unsigned int, explained later.
** The 'array' pointer points between the two arrays, so that values are
** indexed with negative indices and tags with non-negative indices.
Values Tags
--------------------------------------------------------
... | Value 1 | Value 0 |unsigned|0|1|...
--------------------------------------------------------
^ t->array
** All accesses to 't->array' should be through the macros 'getArrTag'
** and 'getArrVal'.
*/
/* Computes the address of the tag for the abstract C-index 'k' */
#define getArrTag(t,k) (cast(lu_byte*, (t)->array) + sizeof(unsigned) + (k))
/* Computes the address of the value for the abstract C-index 'k' */
#define getArrVal(t,k) ((t)->array - 1 - (k))
/*
** The unsigned between the two arrays is used as a hint for #t;
** see luaH_getn. It is stored there to avoid wasting space in
** the structure Table for tables with no array part.
*/
#define lenhint(t) cast(unsigned*, (t)->array)
/*
** Move TValues to/from arrays, using C indices
*/
#define arr2obj(h,k,val) \
((val)->tt_ = *getArrTag(h,(k)), (val)->value_ = *getArrVal(h,(k)))
#define obj2arr(h,k,val) \
(*getArrTag(h,(k)) = (val)->tt_, *getArrVal(h,(k)) = (val)->value_)
/*
** Often, we need to check the tag of a value before moving it. The
** following macros also move TValues to/from arrays, but receive the
** precomputed tag value or address as an extra argument.
*/
#define farr2val(h,k,tag,res) \
((res)->tt_ = tag, (res)->value_ = *getArrVal(h,(k)))
#define fval2arr(h,k,tag,val) \
(*tag = (val)->tt_, *getArrVal(h,(k)) = (val)->value_)
LUAI_FUNC lu_byte luaH_get (Table *t, const TValue *key, TValue *res);
LUAI_FUNC lu_byte luaH_getshortstr (Table *t, TString *key, TValue *res);
LUAI_FUNC lu_byte luaH_getstr (Table *t, TString *key, TValue *res);
LUAI_FUNC lu_byte luaH_getint (Table *t, lua_Integer key, TValue *res);
/* Special get for metamethods */
LUAI_FUNC const TValue *luaH_Hgetshortstr (Table *t, TString *key);
LUAI_FUNC int luaH_psetint (Table *t, lua_Integer key, TValue *val);
LUAI_FUNC int luaH_psetshortstr (Table *t, TString *key, TValue *val);
LUAI_FUNC int luaH_psetstr (Table *t, TString *key, TValue *val);
LUAI_FUNC int luaH_pset (Table *t, const TValue *key, TValue *val);
LUAI_FUNC void luaH_setint (lua_State *L, Table *t, lua_Integer key,
TValue *value);
LUAI_FUNC void luaH_set (lua_State *L, Table *t, const TValue *key,
TValue *value);
LUAI_FUNC void luaH_finishset (lua_State *L, Table *t, const TValue *key,
TValue *value, int hres);
LUAI_FUNC Table *luaH_new (lua_State *L);
LUAI_FUNC void luaH_resize (lua_State *L, Table *t, unsigned nasize,
unsigned nhsize);
LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, unsigned nasize);
LUAI_FUNC lu_mem luaH_size (Table *t);
LUAI_FUNC void luaH_free (lua_State *L, Table *t);
LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key);
LUAI_FUNC lua_Unsigned luaH_getn (lua_State *L, Table *t);
#if defined(LUA_DEBUG)
LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key);
#endif
/* exported only for debugging */
Node *luaH_mainposition (const Table *t, const TObject *key);
#endif

525
lib/lua/ltablib.c
View File

@ -1,429 +1,250 @@
/*
** $Id: ltablib.c $
** $Id: ltablib.c,v 1.21 2003/04/03 13:35:34 roberto Exp $
** Library for Table Manipulation
** See Copyright Notice in lua.h
*/
#define ltablib_c
#define LUA_LIB
#include "lprefix.h"
#include <limits.h>
#include <stddef.h>
#include <string.h>
#define ltablib_c
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#include "llimits.h"
/*
** Operations that an object must define to mimic a table
** (some functions only need some of them)
*/
#define TAB_R 1 /* read */
#define TAB_W 2 /* write */
#define TAB_L 4 /* length */
#define TAB_RW (TAB_R | TAB_W) /* read/write */
#define aux_getn(L,n) (luaL_checktype(L, n, LUA_TTABLE), luaL_getn(L, n))
#define aux_getn(L,n,w) (checktab(L, n, (w) | TAB_L), luaL_len(L, n))
static int checkfield (lua_State *L, const char *key, int n) {
lua_pushstring(L, key);
return (lua_rawget(L, -n) != LUA_TNIL);
}
/*
** Check that 'arg' either is a table or can behave like one (that is,
** has a metatable with the required metamethods).
*/
static void checktab (lua_State *L, int arg, int what) {
int tp = lua_type(L, arg);
if (tp != LUA_TTABLE) { /* is it not a table? */
int n = 1; /* number of elements to pop */
if (lua_getmetatable(L, arg) && /* must have metatable */
(!(what & TAB_R) || checkfield(L, "__index", ++n)) &&
(!(what & TAB_W) || checkfield(L, "__newindex", ++n)) &&
(!(what & TAB_L) || /* strings don't need '__len' to have a length */
tp == LUA_TSTRING || checkfield(L, "__len", ++n))) {
lua_pop(L, n); /* pop metatable and tested metamethods */
}
else
luaL_checktype(L, arg, LUA_TTABLE); /* force an error */
static int luaB_foreachi (lua_State *L) {
int i;
int n = aux_getn(L, 1);
luaL_checktype(L, 2, LUA_TFUNCTION);
for (i=1; i<=n; i++) {
lua_pushvalue(L, 2); /* function */
lua_pushnumber(L, (lua_Number)i); /* 1st argument */
lua_rawgeti(L, 1, i); /* 2nd argument */
lua_call(L, 2, 1);
if (!lua_isnil(L, -1))
return 1;
lua_pop(L, 1); /* remove nil result */
}
}
static int tcreate (lua_State *L) {
lua_Unsigned sizeseq = (lua_Unsigned)luaL_checkinteger(L, 1);
lua_Unsigned sizerest = (lua_Unsigned)luaL_optinteger(L, 2, 0);
luaL_argcheck(L, sizeseq <= cast_uint(INT_MAX), 1, "out of range");
luaL_argcheck(L, sizerest <= cast_uint(INT_MAX), 2, "out of range");
lua_createtable(L, cast_int(sizeseq), cast_int(sizerest));
return 1;
}
static int tinsert (lua_State *L) {
lua_Integer pos; /* where to insert new element */
lua_Integer e = aux_getn(L, 1, TAB_RW);
e = luaL_intop(+, e, 1); /* first empty element */
switch (lua_gettop(L)) {
case 2: { /* called with only 2 arguments */
pos = e; /* insert new element at the end */
break;
}
case 3: {
lua_Integer i;
pos = luaL_checkinteger(L, 2); /* 2nd argument is the position */
/* check whether 'pos' is in [1, e] */
luaL_argcheck(L, (lua_Unsigned)pos - 1u < (lua_Unsigned)e, 2,
"position out of bounds");
for (i = e; i > pos; i--) { /* move up elements */
lua_geti(L, 1, i - 1);
lua_seti(L, 1, i); /* t[i] = t[i - 1] */
}
break;
}
default: {
return luaL_error(L, "wrong number of arguments to 'insert'");
}
}
lua_seti(L, 1, pos); /* t[pos] = v */
return 0;
}
static int tremove (lua_State *L) {
lua_Integer size = aux_getn(L, 1, TAB_RW);
lua_Integer pos = luaL_optinteger(L, 2, size);
if (pos != size) /* validate 'pos' if given */
/* check whether 'pos' is in [1, size + 1] */
luaL_argcheck(L, (lua_Unsigned)pos - 1u <= (lua_Unsigned)size, 2,
"position out of bounds");
lua_geti(L, 1, pos); /* result = t[pos] */
for ( ; pos < size; pos++) {
lua_geti(L, 1, pos + 1);
lua_seti(L, 1, pos); /* t[pos] = t[pos + 1] */
static int luaB_foreach (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
luaL_checktype(L, 2, LUA_TFUNCTION);
lua_pushnil(L); /* first key */
for (;;) {
if (lua_next(L, 1) == 0)
return 0;
lua_pushvalue(L, 2); /* function */
lua_pushvalue(L, -3); /* key */
lua_pushvalue(L, -3); /* value */
lua_call(L, 2, 1);
if (!lua_isnil(L, -1))
return 1;
lua_pop(L, 2); /* remove value and result */
}
}
static int luaB_getn (lua_State *L) {
lua_pushnumber(L, (lua_Number)aux_getn(L, 1));
return 1;
}
static int luaB_setn (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
luaL_setn(L, 1, luaL_checkint(L, 2));
return 0;
}
static int luaB_tinsert (lua_State *L) {
int v = lua_gettop(L); /* number of arguments */
int n = aux_getn(L, 1) + 1;
int pos; /* where to insert new element */
if (v == 2) /* called with only 2 arguments */
pos = n; /* insert new element at the end */
else {
pos = luaL_checkint(L, 2); /* 2nd argument is the position */
if (pos > n) n = pos; /* `grow' array if necessary */
v = 3; /* function may be called with more than 3 args */
}
luaL_setn(L, 1, n); /* new size */
while (--n >= pos) { /* move up elements */
lua_rawgeti(L, 1, n);
lua_rawseti(L, 1, n+1); /* t[n+1] = t[n] */
}
lua_pushvalue(L, v);
lua_rawseti(L, 1, pos); /* t[pos] = v */
return 0;
}
static int luaB_tremove (lua_State *L) {
int n = aux_getn(L, 1);
int pos = luaL_optint(L, 2, n);
if (n <= 0) return 0; /* table is `empty' */
luaL_setn(L, 1, n-1); /* t.n = n-1 */
lua_rawgeti(L, 1, pos); /* result = t[pos] */
for ( ;pos<n; pos++) {
lua_rawgeti(L, 1, pos+1);
lua_rawseti(L, 1, pos); /* t[pos] = t[pos+1] */
}
lua_pushnil(L);
lua_seti(L, 1, pos); /* remove entry t[pos] */
lua_rawseti(L, 1, n); /* t[n] = nil */
return 1;
}
/*
** Copy elements (1[f], ..., 1[e]) into (tt[t], tt[t+1], ...). Whenever
** possible, copy in increasing order, which is better for rehashing.
** "possible" means destination after original range, or smaller
** than origin, or copying to another table.
*/
static int tmove (lua_State *L) {
lua_Integer f = luaL_checkinteger(L, 2);
lua_Integer e = luaL_checkinteger(L, 3);
lua_Integer t = luaL_checkinteger(L, 4);
int tt = !lua_isnoneornil(L, 5) ? 5 : 1; /* destination table */
checktab(L, 1, TAB_R);
checktab(L, tt, TAB_W);
if (e >= f) { /* otherwise, nothing to move */
lua_Integer n, i;
luaL_argcheck(L, f > 0 || e < LUA_MAXINTEGER + f, 3,
"too many elements to move");
n = e - f + 1; /* number of elements to move */
luaL_argcheck(L, t <= LUA_MAXINTEGER - n + 1, 4,
"destination wrap around");
if (t > e || t <= f || (tt != 1 && !lua_compare(L, 1, tt, LUA_OPEQ))) {
for (i = 0; i < n; i++) {
lua_geti(L, 1, f + i);
lua_seti(L, tt, t + i);
}
}
else {
for (i = n - 1; i >= 0; i--) {
lua_geti(L, 1, f + i);
lua_seti(L, tt, t + i);
}
}
}
lua_pushvalue(L, tt); /* return destination table */
return 1;
}
static void addfield (lua_State *L, luaL_Buffer *b, lua_Integer i) {
lua_geti(L, 1, i);
if (l_unlikely(!lua_isstring(L, -1)))
luaL_error(L, "invalid value (%s) at index %I in table for 'concat'",
luaL_typename(L, -1), (LUAI_UACINT)i);
luaL_addvalue(b);
}
static int tconcat (lua_State *L) {
static int str_concat (lua_State *L) {
luaL_Buffer b;
lua_Integer last = aux_getn(L, 1, TAB_R);
size_t lsep;
const char *sep = luaL_optlstring(L, 2, "", &lsep);
lua_Integer i = luaL_optinteger(L, 3, 1);
last = luaL_optinteger(L, 4, last);
int i = luaL_optint(L, 3, 1);
int n = luaL_optint(L, 4, 0);
luaL_checktype(L, 1, LUA_TTABLE);
if (n == 0) n = luaL_getn(L, 1);
luaL_buffinit(L, &b);
for (; i < last; i++) {
addfield(L, &b, i);
luaL_addlstring(&b, sep, lsep);
for (; i <= n; i++) {
lua_rawgeti(L, 1, i);
luaL_argcheck(L, lua_isstring(L, -1), 1, "table contains non-strings");
luaL_addvalue(&b);
if (i != n)
luaL_addlstring(&b, sep, lsep);
}
if (i == last) /* add last value (if interval was not empty) */
addfield(L, &b, i);
luaL_pushresult(&b);
return 1;
}
/*
** {======================================================
** Pack/unpack
** =======================================================
*/
static int tpack (lua_State *L) {
int i;
int n = lua_gettop(L); /* number of elements to pack */
lua_createtable(L, n, 1); /* create result table */
lua_insert(L, 1); /* put it at index 1 */
for (i = n; i >= 1; i--) /* assign elements */
lua_seti(L, 1, i);
lua_pushinteger(L, n);
lua_setfield(L, 1, "n"); /* t.n = number of elements */
return 1; /* return table */
}
static int tunpack (lua_State *L) {
lua_Unsigned n;
lua_Integer len = aux_getn(L, 1, TAB_R);
lua_Integer i = luaL_optinteger(L, 2, 1);
lua_Integer e = luaL_opt(L, luaL_checkinteger, 3, len);
if (i > e) return 0; /* empty range */
n = l_castS2U(e) - l_castS2U(i); /* number of elements minus 1 */
if (l_unlikely(n >= (unsigned int)INT_MAX ||
!lua_checkstack(L, (int)(++n))))
return luaL_error(L, "too many results to unpack");
for (; i < e; i++) { /* push arg[i..e - 1] (to avoid overflows) */
lua_geti(L, 1, i);
}
lua_geti(L, 1, e); /* push last element */
return (int)n;
}
/* }====================================================== */
/*
** {======================================================
** Quicksort
** (based on 'Algorithms in MODULA-3', Robert Sedgewick;
** (based on `Algorithms in MODULA-3', Robert Sedgewick;
** Addison-Wesley, 1993.)
** =======================================================
*/
/*
** Type for array indices. These indices are always limited by INT_MAX,
** so it is safe to cast them to lua_Integer even for Lua 32 bits.
*/
typedef unsigned int IdxT;
/* Versions of lua_seti/lua_geti specialized for IdxT */
#define geti(L,idt,idx) lua_geti(L, idt, l_castU2S(idx))
#define seti(L,idt,idx) lua_seti(L, idt, l_castU2S(idx))
/*
** Produce a "random" 'unsigned int' to randomize pivot choice. This
** macro is used only when 'sort' detects a big imbalance in the result
** of a partition. (If you don't want/need this "randomness", ~0 is a
** good choice.)
*/
#if !defined(l_randomizePivot)
#define l_randomizePivot(L) luaL_makeseed(L)
#endif /* } */
/* arrays larger than 'RANLIMIT' may use randomized pivots */
#define RANLIMIT 100u
static void set2 (lua_State *L, IdxT i, IdxT j) {
seti(L, 1, i);
seti(L, 1, j);
static void set2 (lua_State *L, int i, int j) {
lua_rawseti(L, 1, i);
lua_rawseti(L, 1, j);
}
/*
** Return true iff value at stack index 'a' is less than the value at
** index 'b' (according to the order of the sort).
*/
static int sort_comp (lua_State *L, int a, int b) {
if (lua_isnil(L, 2)) /* no function? */
return lua_compare(L, a, b, LUA_OPLT); /* a < b */
else { /* function */
if (!lua_isnil(L, 2)) { /* function? */
int res;
lua_pushvalue(L, 2); /* push function */
lua_pushvalue(L, 2);
lua_pushvalue(L, a-1); /* -1 to compensate function */
lua_pushvalue(L, b-2); /* -2 to compensate function and 'a' */
lua_call(L, 2, 1); /* call function */
res = lua_toboolean(L, -1); /* get result */
lua_pop(L, 1); /* pop result */
lua_pushvalue(L, b-2); /* -2 to compensate function and `a' */
lua_call(L, 2, 1);
res = lua_toboolean(L, -1);
lua_pop(L, 1);
return res;
}
else /* a < b? */
return lua_lessthan(L, a, b);
}
/*
** Does the partition: Pivot P is at the top of the stack.
** precondition: a[lo] <= P == a[up-1] <= a[up],
** so it only needs to do the partition from lo + 1 to up - 2.
** Pos-condition: a[lo .. i - 1] <= a[i] == P <= a[i + 1 .. up]
** returns 'i'.
*/
static IdxT partition (lua_State *L, IdxT lo, IdxT up) {
IdxT i = lo; /* will be incremented before first use */
IdxT j = up - 1; /* will be decremented before first use */
/* loop invariant: a[lo .. i] <= P <= a[j .. up] */
for (;;) {
/* next loop: repeat ++i while a[i] < P */
while ((void)geti(L, 1, ++i), sort_comp(L, -1, -2)) {
if (l_unlikely(i == up - 1)) /* a[up - 1] < P == a[up - 1] */
luaL_error(L, "invalid order function for sorting");
lua_pop(L, 1); /* remove a[i] */
}
/* after the loop, a[i] >= P and a[lo .. i - 1] < P (a) */
/* next loop: repeat --j while P < a[j] */
while ((void)geti(L, 1, --j), sort_comp(L, -3, -1)) {
if (l_unlikely(j < i)) /* j <= i - 1 and a[j] > P, contradicts (a) */
luaL_error(L, "invalid order function for sorting");
lua_pop(L, 1); /* remove a[j] */
}
/* after the loop, a[j] <= P and a[j + 1 .. up] >= P */
if (j < i) { /* no elements out of place? */
/* a[lo .. i - 1] <= P <= a[j + 1 .. i .. up] */
lua_pop(L, 1); /* pop a[j] */
/* swap pivot (a[up - 1]) with a[i] to satisfy pos-condition */
set2(L, up - 1, i);
return i;
}
/* otherwise, swap a[i] - a[j] to restore invariant and repeat */
set2(L, i, j);
}
}
/*
** Choose an element in the middle (2nd-3th quarters) of [lo,up]
** "randomized" by 'rnd'
*/
static IdxT choosePivot (IdxT lo, IdxT up, unsigned int rnd) {
IdxT r4 = (up - lo) / 4; /* range/4 */
IdxT p = (rnd ^ lo ^ up) % (r4 * 2) + (lo + r4);
lua_assert(lo + r4 <= p && p <= up - r4);
return p;
}
/*
** Quicksort algorithm (recursive function)
*/
static void auxsort (lua_State *L, IdxT lo, IdxT up, unsigned rnd) {
while (lo < up) { /* loop for tail recursion */
IdxT p; /* Pivot index */
IdxT n; /* to be used later */
/* sort elements 'lo', 'p', and 'up' */
geti(L, 1, lo);
geti(L, 1, up);
if (sort_comp(L, -1, -2)) /* a[up] < a[lo]? */
set2(L, lo, up); /* swap a[lo] - a[up] */
static void auxsort (lua_State *L, int l, int u) {
while (l < u) { /* for tail recursion */
int i, j;
/* sort elements a[l], a[(l+u)/2] and a[u] */
lua_rawgeti(L, 1, l);
lua_rawgeti(L, 1, u);
if (sort_comp(L, -1, -2)) /* a[u] < a[l]? */
set2(L, l, u); /* swap a[l] - a[u] */
else
lua_pop(L, 2); /* remove both values */
if (up - lo == 1) /* only 2 elements? */
return; /* already sorted */
if (up - lo < RANLIMIT || rnd == 0) /* small interval or no randomize? */
p = (lo + up)/2; /* middle element is a good pivot */
else /* for larger intervals, it is worth a random pivot */
p = choosePivot(lo, up, rnd);
geti(L, 1, p);
geti(L, 1, lo);
if (sort_comp(L, -2, -1)) /* a[p] < a[lo]? */
set2(L, p, lo); /* swap a[p] - a[lo] */
lua_pop(L, 2);
if (u-l == 1) break; /* only 2 elements */
i = (l+u)/2;
lua_rawgeti(L, 1, i);
lua_rawgeti(L, 1, l);
if (sort_comp(L, -2, -1)) /* a[i]<a[l]? */
set2(L, i, l);
else {
lua_pop(L, 1); /* remove a[lo] */
geti(L, 1, up);
if (sort_comp(L, -1, -2)) /* a[up] < a[p]? */
set2(L, p, up); /* swap a[up] - a[p] */
lua_pop(L, 1); /* remove a[l] */
lua_rawgeti(L, 1, u);
if (sort_comp(L, -1, -2)) /* a[u]<a[i]? */
set2(L, i, u);
else
lua_pop(L, 2);
}
if (up - lo == 2) /* only 3 elements? */
return; /* already sorted */
geti(L, 1, p); /* get middle element (Pivot) */
lua_pushvalue(L, -1); /* push Pivot */
geti(L, 1, up - 1); /* push a[up - 1] */
set2(L, p, up - 1); /* swap Pivot (a[p]) with a[up - 1] */
p = partition(L, lo, up);
/* a[lo .. p - 1] <= a[p] == P <= a[p + 1 .. up] */
if (p - lo < up - p) { /* lower interval is smaller? */
auxsort(L, lo, p - 1, rnd); /* call recursively for lower interval */
n = p - lo; /* size of smaller interval */
lo = p + 1; /* tail call for [p + 1 .. up] (upper interval) */
if (u-l == 2) break; /* only 3 elements */
lua_rawgeti(L, 1, i); /* Pivot */
lua_pushvalue(L, -1);
lua_rawgeti(L, 1, u-1);
set2(L, i, u-1);
/* a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */
i = l; j = u-1;
for (;;) { /* invariant: a[l..i] <= P <= a[j..u] */
/* repeat ++i until a[i] >= P */
while (lua_rawgeti(L, 1, ++i), sort_comp(L, -1, -2)) {
if (i>u) luaL_error(L, "invalid order function for sorting");
lua_pop(L, 1); /* remove a[i] */
}
/* repeat --j until a[j] <= P */
while (lua_rawgeti(L, 1, --j), sort_comp(L, -3, -1)) {
if (j<l) luaL_error(L, "invalid order function for sorting");
lua_pop(L, 1); /* remove a[j] */
}
if (j<i) {
lua_pop(L, 3); /* pop pivot, a[i], a[j] */
break;
}
set2(L, i, j);
}
lua_rawgeti(L, 1, u-1);
lua_rawgeti(L, 1, i);
set2(L, u-1, i); /* swap pivot (a[u-1]) with a[i] */
/* a[l..i-1] <= a[i] == P <= a[i+1..u] */
/* adjust so that smaller half is in [j..i] and larger one in [l..u] */
if (i-l < u-i) {
j=l; i=i-1; l=i+2;
}
else {
auxsort(L, p + 1, up, rnd); /* call recursively for upper interval */
n = up - p; /* size of smaller interval */
up = p - 1; /* tail call for [lo .. p - 1] (lower interval) */
j=i+1; i=u; u=j-2;
}
if ((up - lo) / 128 > n) /* partition too imbalanced? */
rnd = l_randomizePivot(L); /* try a new randomization */
} /* tail call auxsort(L, lo, up, rnd) */
auxsort(L, j, i); /* call recursively the smaller one */
} /* repeat the routine for the larger one */
}
static int sort (lua_State *L) {
lua_Integer n = aux_getn(L, 1, TAB_RW);
if (n > 1) { /* non-trivial interval? */
luaL_argcheck(L, n < INT_MAX, 1, "array too big");
if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */
luaL_checktype(L, 2, LUA_TFUNCTION); /* must be a function */
lua_settop(L, 2); /* make sure there are two arguments */
auxsort(L, 1, (IdxT)n, 0);
}
static int luaB_sort (lua_State *L) {
int n = aux_getn(L, 1);
luaL_checkstack(L, 40, ""); /* assume array is smaller than 2^40 */
if (!lua_isnoneornil(L, 2)) /* is there a 2nd argument? */
luaL_checktype(L, 2, LUA_TFUNCTION);
lua_settop(L, 2); /* make sure there is two arguments */
auxsort(L, 1, n);
return 0;
}
/* }====================================================== */
static const luaL_Reg tab_funcs[] = {
{"concat", tconcat},
{"create", tcreate},
{"insert", tinsert},
{"pack", tpack},
{"unpack", tunpack},
{"remove", tremove},
{"move", tmove},
{"sort", sort},
static const luaL_reg tab_funcs[] = {
{"concat", str_concat},
{"foreach", luaB_foreach},
{"foreachi", luaB_foreachi},
{"getn", luaB_getn},
{"setn", luaB_setn},
{"sort", luaB_sort},
{"insert", luaB_tinsert},
{"remove", luaB_tremove},
{NULL, NULL}
};
LUAMOD_API int luaopen_table (lua_State *L) {
luaL_newlib(L, tab_funcs);
LUALIB_API int luaopen_table (lua_State *L) {
luaL_openlib(L, LUA_TABLIBNAME, tab_funcs, 0);
return 1;
}

852
lib/lua/ltests.c Normal file
View File

@ -0,0 +1,852 @@
/*
** $Id: ltests.c,v 1.158 2003/04/07 14:35:00 roberto Exp $
** Internal Module for Debugging of the Lua Implementation
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define ltests_c
#include "lua.h"
#include "lapi.h"
#include "lauxlib.h"
#include "lcode.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lmem.h"
#include "lopcodes.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "lualib.h"
/*
** The whole module only makes sense with LUA_DEBUG on
*/
#ifdef LUA_DEBUG
#define lua_pushintegral(L,i) lua_pushnumber(L, cast(lua_Number, (i)))
static lua_State *lua_state = NULL;
int islocked = 0;
#define func_at(L,k) (L->ci->base+(k) - 1)
static void setnameval (lua_State *L, const char *name, int val) {
lua_pushstring(L, name);
lua_pushintegral(L, val);
lua_settable(L, -3);
}
/*
** {======================================================================
** Controlled version for realloc.
** =======================================================================
*/
#define MARK 0x55 /* 01010101 (a nice pattern) */
#ifndef EXTERNMEMCHECK
/* full memory check */
#define HEADER (sizeof(L_Umaxalign)) /* ensures maximum alignment for HEADER */
#define MARKSIZE 16 /* size of marks after each block */
#define blockhead(b) (cast(char *, b) - HEADER)
#define setsize(newblock, size) (*cast(size_t *, newblock) = size)
#define checkblocksize(b, size) (size == (*cast(size_t *, blockhead(b))))
#define fillmem(mem,size) memset(mem, -MARK, size)
#else
/* external memory check: don't do it twice */
#define HEADER 0
#define MARKSIZE 0
#define blockhead(b) (b)
#define setsize(newblock, size) /* empty */
#define checkblocksize(b,size) (1)
#define fillmem(mem,size) /* empty */
#endif
unsigned long memdebug_numblocks = 0;
unsigned long memdebug_total = 0;
unsigned long memdebug_maxmem = 0;
unsigned long memdebug_memlimit = ULONG_MAX;
static void *checkblock (void *block, size_t size) {
void *b = blockhead(block);
int i;
for (i=0;i<MARKSIZE;i++)
lua_assert(*(cast(char *, b)+HEADER+size+i) == MARK+i); /* corrupted block? */
return b;
}
static void freeblock (void *block, size_t size) {
if (block) {
lua_assert(checkblocksize(block, size));
block = checkblock(block, size);
fillmem(block, size+HEADER+MARKSIZE); /* erase block */
free(block); /* free original block */
memdebug_numblocks--;
memdebug_total -= size;
}
}
void *debug_realloc (void *block, size_t oldsize, size_t size) {
lua_assert(oldsize == 0 || checkblocksize(block, oldsize));
/* ISO does not specify what realloc(NULL, 0) does */
lua_assert(block != NULL || size > 0);
if (size == 0) {
freeblock(block, oldsize);
return NULL;
}
else if (size > oldsize && memdebug_total+size-oldsize > memdebug_memlimit)
return NULL; /* to test memory allocation errors */
else {
void *newblock;
int i;
size_t realsize = HEADER+size+MARKSIZE;
size_t commonsize = (oldsize < size) ? oldsize : size;
if (realsize < size) return NULL; /* overflow! */
newblock = malloc(realsize); /* alloc a new block */
if (newblock == NULL) return NULL;
if (block) {
memcpy(cast(char *, newblock)+HEADER, block, commonsize);
freeblock(block, oldsize); /* erase (and check) old copy */
}
/* initialize new part of the block with something `weird' */
fillmem(cast(char *, newblock)+HEADER+commonsize, size-commonsize);
memdebug_total += size;
if (memdebug_total > memdebug_maxmem)
memdebug_maxmem = memdebug_total;
memdebug_numblocks++;
setsize(newblock, size);
for (i=0;i<MARKSIZE;i++)
*(cast(char *, newblock)+HEADER+size+i) = cast(char, MARK+i);
return cast(char *, newblock)+HEADER;
}
}
/* }====================================================================== */
/*
** {======================================================
** Disassembler
** =======================================================
*/
static char *buildop (Proto *p, int pc, char *buff) {
Instruction i = p->code[pc];
OpCode o = GET_OPCODE(i);
const char *name = luaP_opnames[o];
int line = getline(p, pc);
sprintf(buff, "(%4d) %4d - ", line, pc);
switch (getOpMode(o)) {
case iABC:
sprintf(buff+strlen(buff), "%-12s%4d %4d %4d", name,
GETARG_A(i), GETARG_B(i), GETARG_C(i));
break;
case iABx:
sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i), GETARG_Bx(i));
break;
case iAsBx:
sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i), GETARG_sBx(i));
break;
}
return buff;
}
#if 0
void luaI_printcode (Proto *pt, int size) {
int pc;
for (pc=0; pc<size; pc++) {
char buff[100];
printf("%s\n", buildop(pt, pc, buff));
}
printf("-------\n");
}
#endif
static int listcode (lua_State *L) {
int pc;
Proto *p;
luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
1, "Lua function expected");
p = clvalue(func_at(L, 1))->l.p;
lua_newtable(L);
setnameval(L, "maxstack", p->maxstacksize);
setnameval(L, "numparams", p->numparams);
for (pc=0; pc<p->sizecode; pc++) {
char buff[100];
lua_pushintegral(L, pc+1);
lua_pushstring(L, buildop(p, pc, buff));
lua_settable(L, -3);
}
return 1;
}
static int listk (lua_State *L) {
Proto *p;
int i;
luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
1, "Lua function expected");
p = clvalue(func_at(L, 1))->l.p;
lua_newtable(L);
for (i=0; i<p->sizek; i++) {
lua_pushintegral(L, i+1);
luaA_pushobject(L, p->k+i);
lua_settable(L, -3);
}
return 1;
}
static int listlocals (lua_State *L) {
Proto *p;
int pc = luaL_checkint(L, 2) - 1;
int i = 0;
const char *name;
luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
1, "Lua function expected");
p = clvalue(func_at(L, 1))->l.p;
while ((name = luaF_getlocalname(p, ++i, pc)) != NULL)
lua_pushstring(L, name);
return i-1;
}
/* }====================================================== */
static int get_limits (lua_State *L) {
lua_newtable(L);
setnameval(L, "BITS_INT", BITS_INT);
setnameval(L, "LFPF", LFIELDS_PER_FLUSH);
setnameval(L, "MAXVARS", MAXVARS);
setnameval(L, "MAXPARAMS", MAXPARAMS);
setnameval(L, "MAXSTACK", MAXSTACK);
setnameval(L, "MAXUPVALUES", MAXUPVALUES);
return 1;
}
static int mem_query (lua_State *L) {
if (lua_isnone(L, 1)) {
lua_pushintegral(L, memdebug_total);
lua_pushintegral(L, memdebug_numblocks);
lua_pushintegral(L, memdebug_maxmem);
return 3;
}
else {
memdebug_memlimit = luaL_checkint(L, 1);
return 0;
}
}
static int hash_query (lua_State *L) {
if (lua_isnone(L, 2)) {
luaL_argcheck(L, lua_type(L, 1) == LUA_TSTRING, 1, "string expected");
lua_pushintegral(L, tsvalue(func_at(L, 1))->tsv.hash);
}
else {
TObject *o = func_at(L, 1);
Table *t;
luaL_checktype(L, 2, LUA_TTABLE);
t = hvalue(func_at(L, 2));
lua_pushintegral(L, luaH_mainposition(t, o) - t->node);
}
return 1;
}
static int stacklevel (lua_State *L) {
unsigned long a = 0;
lua_pushintegral(L, (int)(L->top - L->stack));
lua_pushintegral(L, (int)(L->stack_last - L->stack));
lua_pushintegral(L, (int)(L->ci - L->base_ci));
lua_pushintegral(L, (int)(L->end_ci - L->base_ci));
lua_pushintegral(L, (unsigned long)&a);
return 5;
}
static int table_query (lua_State *L) {
const Table *t;
int i = luaL_optint(L, 2, -1);
luaL_checktype(L, 1, LUA_TTABLE);
t = hvalue(func_at(L, 1));
if (i == -1) {
lua_pushintegral(L, t->sizearray);
lua_pushintegral(L, sizenode(t));
lua_pushintegral(L, t->firstfree - t->node);
}
else if (i < t->sizearray) {
lua_pushintegral(L, i);
luaA_pushobject(L, &t->array[i]);
lua_pushnil(L);
}
else if ((i -= t->sizearray) < sizenode(t)) {
if (!ttisnil(gval(gnode(t, i))) ||
ttisnil(gkey(gnode(t, i))) ||
ttisnumber(gkey(gnode(t, i)))) {
luaA_pushobject(L, gkey(gnode(t, i)));
}
else
lua_pushstring(L, "<undef>");
luaA_pushobject(L, gval(gnode(t, i)));
if (t->node[i].next)
lua_pushintegral(L, t->node[i].next - t->node);
else
lua_pushnil(L);
}
return 3;
}
static int string_query (lua_State *L) {
stringtable *tb = &G(L)->strt;
int s = luaL_optint(L, 2, 0) - 1;
if (s==-1) {
lua_pushintegral(L ,tb->nuse);
lua_pushintegral(L ,tb->size);
return 2;
}
else if (s < tb->size) {
GCObject *ts;
int n = 0;
for (ts = tb->hash[s]; ts; ts = ts->gch.next) {
setsvalue2s(L->top, gcotots(ts));
incr_top(L);
n++;
}
return n;
}
return 0;
}
static int tref (lua_State *L) {
int level = lua_gettop(L);
int lock = luaL_optint(L, 2, 1);
luaL_checkany(L, 1);
lua_pushvalue(L, 1);
lua_pushintegral(L, lua_ref(L, lock));
assert(lua_gettop(L) == level+1); /* +1 for result */
return 1;
}
static int getref (lua_State *L) {
int level = lua_gettop(L);
lua_getref(L, luaL_checkint(L, 1));
assert(lua_gettop(L) == level+1);
return 1;
}
static int unref (lua_State *L) {
int level = lua_gettop(L);
lua_unref(L, luaL_checkint(L, 1));
assert(lua_gettop(L) == level);
return 0;
}
static int metatable (lua_State *L) {
luaL_checkany(L, 1);
if (lua_isnone(L, 2)) {
if (lua_getmetatable(L, 1) == 0)
lua_pushnil(L);
}
else {
lua_settop(L, 2);
luaL_checktype(L, 2, LUA_TTABLE);
lua_setmetatable(L, 1);
}
return 1;
}
static int upvalue (lua_State *L) {
int n = luaL_checkint(L, 2);
luaL_checktype(L, 1, LUA_TFUNCTION);
if (lua_isnone(L, 3)) {
const char *name = lua_getupvalue(L, 1, n);
if (name == NULL) return 0;
lua_pushstring(L, name);
return 2;
}
else {
const char *name = lua_setupvalue(L, 1, n);
lua_pushstring(L, name);
return 1;
}
}
static int newuserdata (lua_State *L) {
size_t size = luaL_checkint(L, 1);
char *p = cast(char *, lua_newuserdata(L, size));
while (size--) *p++ = '\0';
return 1;
}
static int pushuserdata (lua_State *L) {
lua_pushlightuserdata(L, cast(void *, luaL_checkint(L, 1)));
return 1;
}
static int udataval (lua_State *L) {
lua_pushintegral(L, cast(int, lua_touserdata(L, 1)));
return 1;
}
static int doonnewstack (lua_State *L) {
lua_State *L1 = lua_newthread(L);
size_t l;
const char *s = luaL_checklstring(L, 1, &l);
int status = luaL_loadbuffer(L1, s, l, s);
if (status == 0)
status = lua_pcall(L1, 0, 0, 0);
lua_pushintegral(L, status);
return 1;
}
static int s2d (lua_State *L) {
lua_pushnumber(L, *cast(const double *, luaL_checkstring(L, 1)));
return 1;
}
static int d2s (lua_State *L) {
double d = luaL_checknumber(L, 1);
lua_pushlstring(L, cast(char *, &d), sizeof(d));
return 1;
}
static int newstate (lua_State *L) {
lua_State *L1 = lua_open();
if (L1) {
lua_userstateopen(L1); /* init lock */
lua_pushintegral(L, (unsigned long)L1);
}
else
lua_pushnil(L);
return 1;
}
static int loadlib (lua_State *L) {
static const luaL_reg libs[] = {
{"mathlibopen", luaopen_math},
{"strlibopen", luaopen_string},
{"iolibopen", luaopen_io},
{"tablibopen", luaopen_table},
{"dblibopen", luaopen_debug},
{"baselibopen", luaopen_base},
{NULL, NULL}
};
lua_State *L1 = cast(lua_State *,
cast(unsigned long, luaL_checknumber(L, 1)));
lua_pushvalue(L1, LUA_GLOBALSINDEX);
luaL_openlib(L1, NULL, libs, 0);
return 0;
}
static int closestate (lua_State *L) {
lua_State *L1 = cast(lua_State *, cast(unsigned long, luaL_checknumber(L, 1)));
lua_close(L1);
lua_unlock(L); /* close cannot unlock that */
return 0;
}
static int doremote (lua_State *L) {
lua_State *L1 = cast(lua_State *,cast(unsigned long,luaL_checknumber(L, 1)));
size_t lcode;
const char *code = luaL_checklstring(L, 2, &lcode);
int status;
lua_settop(L1, 0);
status = luaL_loadbuffer(L1, code, lcode, code);
if (status == 0)
status = lua_pcall(L1, 0, LUA_MULTRET, 0);
if (status != 0) {
lua_pushnil(L);
lua_pushintegral(L, status);
lua_pushstring(L, lua_tostring(L1, -1));
return 3;
}
else {
int i = 0;
while (!lua_isnone(L1, ++i))
lua_pushstring(L, lua_tostring(L1, i));
lua_pop(L1, i-1);
return i-1;
}
}
static int log2_aux (lua_State *L) {
lua_pushintegral(L, luaO_log2(luaL_checkint(L, 1)));
return 1;
}
static int int2fb_aux (lua_State *L) {
int b = luaO_int2fb(luaL_checkint(L, 1));
lua_pushintegral(L, b);
lua_pushintegral(L, fb2int(b));
return 2;
}
static int test_do (lua_State *L) {
const char *p = luaL_checkstring(L, 1);
if (*p == '@')
lua_dofile(L, p+1);
else
lua_dostring(L, p);
return lua_gettop(L);
}
/*
** {======================================================
** function to test the API with C. It interprets a kind of assembler
** language with calls to the API, so the test can be driven by Lua code
** =======================================================
*/
static const char *const delimits = " \t\n,;";
static void skip (const char **pc) {
while (**pc != '\0' && strchr(delimits, **pc)) (*pc)++;
}
static int getnum_aux (lua_State *L, const char **pc) {
int res = 0;
int sig = 1;
skip(pc);
if (**pc == '.') {
res = cast(int, lua_tonumber(L, -1));
lua_pop(L, 1);
(*pc)++;
return res;
}
else if (**pc == '-') {
sig = -1;
(*pc)++;
}
while (isdigit(cast(int, **pc))) res = res*10 + (*(*pc)++) - '0';
return sig*res;
}
static const char *getname_aux (char *buff, const char **pc) {
int i = 0;
skip(pc);
while (**pc != '\0' && !strchr(delimits, **pc))
buff[i++] = *(*pc)++;
buff[i] = '\0';
return buff;
}
#define EQ(s1) (strcmp(s1, inst) == 0)
#define getnum (getnum_aux(L, &pc))
#define getname (getname_aux(buff, &pc))
static int testC (lua_State *L) {
char buff[30];
const char *pc = luaL_checkstring(L, 1);
for (;;) {
const char *inst = getname;
if EQ("") return 0;
else if EQ("isnumber") {
lua_pushintegral(L, lua_isnumber(L, getnum));
}
else if EQ("isstring") {
lua_pushintegral(L, lua_isstring(L, getnum));
}
else if EQ("istable") {
lua_pushintegral(L, lua_istable(L, getnum));
}
else if EQ("iscfunction") {
lua_pushintegral(L, lua_iscfunction(L, getnum));
}
else if EQ("isfunction") {
lua_pushintegral(L, lua_isfunction(L, getnum));
}
else if EQ("isuserdata") {
lua_pushintegral(L, lua_isuserdata(L, getnum));
}
else if EQ("isudataval") {
lua_pushintegral(L, lua_islightuserdata(L, getnum));
}
else if EQ("isnil") {
lua_pushintegral(L, lua_isnil(L, getnum));
}
else if EQ("isnull") {
lua_pushintegral(L, lua_isnone(L, getnum));
}
else if EQ("tonumber") {
lua_pushnumber(L, lua_tonumber(L, getnum));
}
else if EQ("tostring") {
const char *s = lua_tostring(L, getnum);
lua_pushstring(L, s);
}
else if EQ("strlen") {
lua_pushintegral(L, lua_strlen(L, getnum));
}
else if EQ("tocfunction") {
lua_pushcfunction(L, lua_tocfunction(L, getnum));
}
else if EQ("return") {
return getnum;
}
else if EQ("gettop") {
lua_pushintegral(L, lua_gettop(L));
}
else if EQ("settop") {
lua_settop(L, getnum);
}
else if EQ("pop") {
lua_pop(L, getnum);
}
else if EQ("pushnum") {
lua_pushintegral(L, getnum);
}
else if EQ("pushnil") {
lua_pushnil(L);
}
else if EQ("pushbool") {
lua_pushboolean(L, getnum);
}
else if EQ("tobool") {
lua_pushintegral(L, lua_toboolean(L, getnum));
}
else if EQ("pushvalue") {
lua_pushvalue(L, getnum);
}
else if EQ("pushcclosure") {
lua_pushcclosure(L, testC, getnum);
}
else if EQ("pushupvalues") {
lua_pushupvalues(L);
}
else if EQ("remove") {
lua_remove(L, getnum);
}
else if EQ("insert") {
lua_insert(L, getnum);
}
else if EQ("replace") {
lua_replace(L, getnum);
}
else if EQ("gettable") {
lua_gettable(L, getnum);
}
else if EQ("settable") {
lua_settable(L, getnum);
}
else if EQ("next") {
lua_next(L, -2);
}
else if EQ("concat") {
lua_concat(L, getnum);
}
else if EQ("lessthan") {
int a = getnum;
lua_pushboolean(L, lua_lessthan(L, a, getnum));
}
else if EQ("equal") {
int a = getnum;
lua_pushboolean(L, lua_equal(L, a, getnum));
}
else if EQ("rawcall") {
int narg = getnum;
int nres = getnum;
lua_call(L, narg, nres);
}
else if EQ("call") {
int narg = getnum;
int nres = getnum;
lua_pcall(L, narg, nres, 0);
}
else if EQ("loadstring") {
size_t sl;
const char *s = luaL_checklstring(L, getnum, &sl);
luaL_loadbuffer(L, s, sl, s);
}
else if EQ("loadfile") {
luaL_loadfile(L, luaL_checkstring(L, getnum));
}
else if EQ("setmetatable") {
lua_setmetatable(L, getnum);
}
else if EQ("getmetatable") {
if (lua_getmetatable(L, getnum) == 0)
lua_pushnil(L);
}
else if EQ("type") {
lua_pushstring(L, lua_typename(L, lua_type(L, getnum)));
}
else if EQ("getn") {
int i = getnum;
lua_pushintegral(L, luaL_getn(L, i));
}
else if EQ("setn") {
int i = getnum;
int n = cast(int, lua_tonumber(L, -1));
luaL_setn(L, i, n);
lua_pop(L, 1);
}
else luaL_error(L, "unknown instruction %s", buff);
}
return 0;
}
/* }====================================================== */
/*
** {======================================================
** tests for yield inside hooks
** =======================================================
*/
static void yieldf (lua_State *L, lua_Debug *ar) {
lua_yield(L, 0);
}
static int setyhook (lua_State *L) {
if (lua_isnoneornil(L, 1))
lua_sethook(L, NULL, 0, 0); /* turn off hooks */
else {
const char *smask = luaL_checkstring(L, 1);
int count = luaL_optint(L, 2, 0);
int mask = 0;
if (strchr(smask, 'l')) mask |= LUA_MASKLINE;
if (count > 0) mask |= LUA_MASKCOUNT;
lua_sethook(L, yieldf, mask, count);
}
return 0;
}
static int coresume (lua_State *L) {
int status;
lua_State *co = lua_tothread(L, 1);
luaL_argcheck(L, co, 1, "coroutine expected");
status = lua_resume(co, 0);
if (status != 0) {
lua_pushboolean(L, 0);
lua_insert(L, -2);
return 2; /* return false + error message */
}
else {
lua_pushboolean(L, 1);
return 1;
}
}
/* }====================================================== */
static const struct luaL_reg tests_funcs[] = {
{"hash", hash_query},
{"limits", get_limits},
{"listcode", listcode},
{"listk", listk},
{"listlocals", listlocals},
{"loadlib", loadlib},
{"stacklevel", stacklevel},
{"querystr", string_query},
{"querytab", table_query},
{"doit", test_do},
{"testC", testC},
{"ref", tref},
{"getref", getref},
{"unref", unref},
{"d2s", d2s},
{"s2d", s2d},
{"metatable", metatable},
{"upvalue", upvalue},
{"newuserdata", newuserdata},
{"pushuserdata", pushuserdata},
{"udataval", udataval},
{"doonnewstack", doonnewstack},
{"newstate", newstate},
{"closestate", closestate},
{"doremote", doremote},
{"log2", log2_aux},
{"int2fb", int2fb_aux},
{"totalmem", mem_query},
{"resume", coresume},
{"setyhook", setyhook},
{NULL, NULL}
};
static void fim (void) {
if (!islocked)
lua_close(lua_state);
lua_assert(memdebug_numblocks == 0);
lua_assert(memdebug_total == 0);
}
static int l_panic (lua_State *L) {
UNUSED(L);
fprintf(stderr, "unable to recover; exiting\n");
return 0;
}
int luaB_opentests (lua_State *L) {
lua_atpanic(L, l_panic);
lua_userstateopen(L); /* init lock */
lua_state = L; /* keep first state to be opened */
luaL_openlib(L, "T", tests_funcs, 0);
atexit(fim);
return 0;
}
#undef main
int main (int argc, char *argv[]) {
char *limit = getenv("MEMLIMIT");
if (limit)
memdebug_memlimit = strtoul(limit, NULL, 10);
l_main(argc, argv);
return 0;
}
#endif

334
lib/lua/ltm.c
View File

@ -1,54 +1,42 @@
/*
** $Id: ltm.c $
** $Id: ltm.c,v 1.106 2003/04/03 13:35:34 roberto Exp $
** Tag methods
** See Copyright Notice in lua.h
*/
#define ltm_c
#define LUA_CORE
#include "lprefix.h"
#include <string.h>
#define ltm_c
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lgc.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lvm.h"
static const char udatatypename[] = "userdata";
LUAI_DDEF const char *const luaT_typenames_[LUA_TOTALTYPES] = {
"no value",
"nil", "boolean", udatatypename, "number",
"string", "table", "function", udatatypename, "thread",
"upvalue", "proto" /* these last cases are used for tests only */
const char *const luaT_typenames[] = {
"nil", "boolean", "userdata", "number",
"string", "table", "function", "userdata", "thread"
};
void luaT_init (lua_State *L) {
static const char *const luaT_eventname[] = { /* ORDER TM */
"__index", "__newindex",
"__gc", "__mode", "__len", "__eq",
"__add", "__sub", "__mul", "__mod", "__pow",
"__div", "__idiv",
"__band", "__bor", "__bxor", "__shl", "__shr",
"__unm", "__bnot", "__lt", "__le",
"__concat", "__call", "__close"
"__gc", "__mode", "__eq",
"__add", "__sub", "__mul", "__div",
"__pow", "__unm", "__lt", "__le",
"__concat", "__call"
};
int i;
for (i=0; i<TM_N; i++) {
G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]);
luaC_fix(L, obj2gco(G(L)->tmname[i])); /* never collect these names */
luaS_fix(G(L)->tmname[i]); /* never collect these names */
}
}
@ -57,308 +45,26 @@ void luaT_init (lua_State *L) {
** function to be used with macro "fasttm": optimized for absence of
** tag methods
*/
const TValue *luaT_gettm (Table *events, TMS event, TString *ename) {
const TValue *tm = luaH_Hgetshortstr(events, ename);
const TObject *luaT_gettm (Table *events, TMS event, TString *ename) {
const TObject *tm = luaH_getstr(events, ename);
lua_assert(event <= TM_EQ);
if (notm(tm)) { /* no tag method? */
events->flags |= cast_byte(1u<<event); /* cache this fact */
if (ttisnil(tm)) { /* no tag method? */
events->flags |= cast(lu_byte, 1u<<event); /* cache this fact */
return NULL;
}
else return tm;
}
const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o, TMS event) {
Table *mt;
const TObject *luaT_gettmbyobj (lua_State *L, const TObject *o, TMS event) {
TString *ename = G(L)->tmname[event];
switch (ttype(o)) {
case LUA_TTABLE:
mt = hvalue(o)->metatable;
break;
return luaH_getstr(hvalue(o)->metatable, ename);
case LUA_TUSERDATA:
mt = uvalue(o)->metatable;
break;
return luaH_getstr(uvalue(o)->uv.metatable, ename);
default:
mt = G(L)->mt[ttype(o)];
}
return (mt ? luaH_Hgetshortstr(mt, G(L)->tmname[event]) : &G(L)->nilvalue);
}
/*
** Return the name of the type of an object. For tables and userdata
** with metatable, use their '__name' metafield, if present.
*/
const char *luaT_objtypename (lua_State *L, const TValue *o) {
Table *mt;
if ((ttistable(o) && (mt = hvalue(o)->metatable) != NULL) ||
(ttisfulluserdata(o) && (mt = uvalue(o)->metatable) != NULL)) {
const TValue *name = luaH_Hgetshortstr(mt, luaS_new(L, "__name"));
if (ttisstring(name)) /* is '__name' a string? */
return getstr(tsvalue(name)); /* use it as type name */
}
return ttypename(ttype(o)); /* else use standard type name */
}
void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
const TValue *p2, const TValue *p3) {
StkId func = L->top.p;
setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */
setobj2s(L, func + 1, p1); /* 1st argument */
setobj2s(L, func + 2, p2); /* 2nd argument */
setobj2s(L, func + 3, p3); /* 3rd argument */
L->top.p = func + 4;
/* metamethod may yield only when called from Lua code */
if (isLuacode(L->ci))
luaD_call(L, func, 0);
else
luaD_callnoyield(L, func, 0);
}
lu_byte luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1,
const TValue *p2, StkId res) {
ptrdiff_t result = savestack(L, res);
StkId func = L->top.p;
setobj2s(L, func, f); /* push function (assume EXTRA_STACK) */
setobj2s(L, func + 1, p1); /* 1st argument */
setobj2s(L, func + 2, p2); /* 2nd argument */
L->top.p += 3;
/* metamethod may yield only when called from Lua code */
if (isLuacode(L->ci))
luaD_call(L, func, 1);
else
luaD_callnoyield(L, func, 1);
res = restorestack(L, result);
setobjs2s(L, res, --L->top.p); /* move result to its place */
return ttypetag(s2v(res)); /* return tag of the result */
}
static int callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
StkId res, TMS event) {
const TValue *tm = luaT_gettmbyobj(L, p1, event); /* try first operand */
if (notm(tm))
tm = luaT_gettmbyobj(L, p2, event); /* try second operand */
if (notm(tm))
return -1; /* tag method not found */
else /* call tag method and return the tag of the result */
return luaT_callTMres(L, tm, p1, p2, res);
}
void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
StkId res, TMS event) {
if (l_unlikely(callbinTM(L, p1, p2, res, event) < 0)) {
switch (event) {
case TM_BAND: case TM_BOR: case TM_BXOR:
case TM_SHL: case TM_SHR: case TM_BNOT: {
if (ttisnumber(p1) && ttisnumber(p2))
luaG_tointerror(L, p1, p2);
else
luaG_opinterror(L, p1, p2, "perform bitwise operation on");
}
/* calls never return, but to avoid warnings: *//* FALLTHROUGH */
default:
luaG_opinterror(L, p1, p2, "perform arithmetic on");
}
return &luaO_nilobject;
}
}
/*
** The use of 'p1' after 'callbinTM' is safe because, when a tag
** method is not found, 'callbinTM' cannot change the stack.
*/
void luaT_tryconcatTM (lua_State *L) {
StkId p1 = L->top.p - 2; /* first argument */
if (l_unlikely(callbinTM(L, s2v(p1), s2v(p1 + 1), p1, TM_CONCAT) < 0))
luaG_concaterror(L, s2v(p1), s2v(p1 + 1));
}
void luaT_trybinassocTM (lua_State *L, const TValue *p1, const TValue *p2,
int flip, StkId res, TMS event) {
if (flip)
luaT_trybinTM(L, p2, p1, res, event);
else
luaT_trybinTM(L, p1, p2, res, event);
}
void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
int flip, StkId res, TMS event) {
TValue aux;
setivalue(&aux, i2);
luaT_trybinassocTM(L, p1, &aux, flip, res, event);
}
/*
** Calls an order tag method.
*/
int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,
TMS event) {
int tag = callbinTM(L, p1, p2, L->top.p, event); /* try original event */
if (tag >= 0) /* found tag method? */
return !tagisfalse(tag);
luaG_ordererror(L, p1, p2); /* no metamethod found */
return 0; /* to avoid warnings */
}
int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
int flip, int isfloat, TMS event) {
TValue aux; const TValue *p2;
if (isfloat) {
setfltvalue(&aux, cast_num(v2));
}
else
setivalue(&aux, v2);
if (flip) { /* arguments were exchanged? */
p2 = p1; p1 = &aux; /* correct them */
}
else
p2 = &aux;
return luaT_callorderTM(L, p1, p2, event);
}
/*
** Create a vararg table at the top of the stack, with 'n' elements
** starting at 'f'.
*/
static void createvarargtab (lua_State *L, StkId f, int n) {
int i;
TValue key, value;
Table *t = luaH_new(L);
sethvalue(L, s2v(L->top.p), t);
L->top.p++;
luaH_resize(L, t, cast_uint(n), 1);
setsvalue(L, &key, luaS_new(L, "n")); /* key is "n" */
setivalue(&value, n); /* value is n */
/* No need to anchor the key: Due to the resize, the next operation
cannot trigger a garbage collection */
luaH_set(L, t, &key, &value); /* t.n = n */
for (i = 0; i < n; i++)
luaH_setint(L, t, i + 1, s2v(f + i));
luaC_checkGC(L);
}
/*
** initial stack: func arg1 ... argn extra1 ...
** ^ ci->func ^ L->top
** final stack: func nil ... nil extra1 ... func arg1 ... argn
** ^ ci->func
*/
static void buildhiddenargs (lua_State *L, CallInfo *ci, const Proto *p,
int totalargs, int nfixparams, int nextra) {
int i;
ci->u.l.nextraargs = nextra;
luaD_checkstack(L, p->maxstacksize + 1);
/* copy function to the top of the stack, after extra arguments */
setobjs2s(L, L->top.p++, ci->func.p);
/* move fixed parameters to after the copied function */
for (i = 1; i <= nfixparams; i++) {
setobjs2s(L, L->top.p++, ci->func.p + i);
setnilvalue2s(ci->func.p + i); /* erase original parameter (for GC) */
}
ci->func.p += totalargs + 1; /* 'func' now lives after hidden arguments */
ci->top.p += totalargs + 1;
}
void luaT_adjustvarargs (lua_State *L, CallInfo *ci, const Proto *p) {
int totalargs = cast_int(L->top.p - ci->func.p) - 1;
int nfixparams = p->numparams;
int nextra = totalargs - nfixparams; /* number of extra arguments */
if (p->flag & PF_VATAB) { /* does it need a vararg table? */
lua_assert(!(p->flag & PF_VAHID));
createvarargtab(L, ci->func.p + nfixparams + 1, nextra);
/* move table to proper place (last parameter) */
setobjs2s(L, ci->func.p + nfixparams + 1, L->top.p - 1);
}
else { /* no table */
lua_assert(p->flag & PF_VAHID);
buildhiddenargs(L, ci, p, totalargs, nfixparams, nextra);
/* set vararg parameter to nil */
setnilvalue2s(ci->func.p + nfixparams + 1);
lua_assert(L->top.p <= ci->top.p && ci->top.p <= L->stack_last.p);
}
}
void luaT_getvararg (CallInfo *ci, StkId ra, TValue *rc) {
int nextra = ci->u.l.nextraargs;
lua_Integer n;
if (tointegerns(rc, &n)) { /* integral value? */
if (l_castS2U(n) - 1 < cast_uint(nextra)) {
StkId slot = ci->func.p - nextra + cast_int(n) - 1;
setobjs2s(((lua_State*)NULL), ra, slot);
return;
}
}
else if (ttisstring(rc)) { /* string value? */
size_t len;
const char *s = getlstr(tsvalue(rc), len);
if (len == 1 && s[0] == 'n') { /* key is "n"? */
setivalue(s2v(ra), nextra);
return;
}
}
setnilvalue2s(ra); /* else produce nil */
}
/*
** Get the number of extra arguments in a vararg function. If vararg
** table has been optimized away, that number is in the call info.
** Otherwise, get the field 'n' from the vararg table and check that it
** has a proper value (non-negative integer not larger than the stack
** limit).
*/
static int getnumargs (lua_State *L, CallInfo *ci, Table *h) {
if (h == NULL) /* no vararg table? */
return ci->u.l.nextraargs;
else {
TValue res;
if (luaH_getshortstr(h, luaS_new(L, "n"), &res) != LUA_VNUMINT ||
l_castS2U(ivalue(&res)) > cast_uint(INT_MAX/2))
luaG_runerror(L, "vararg table has no proper 'n'");
return cast_int(ivalue(&res));
}
}
/*
** Get 'wanted' vararg arguments and put them in 'where'. 'vatab' is
** the register of the vararg table or -1 if there is no vararg table.
*/
void luaT_getvarargs (lua_State *L, CallInfo *ci, StkId where, int wanted,
int vatab) {
Table *h = (vatab < 0) ? NULL : hvalue(s2v(ci->func.p + vatab + 1));
int nargs = getnumargs(L, ci, h); /* number of available vararg args. */
int i, touse; /* 'touse' is minimum between 'wanted' and 'nargs' */
if (wanted < 0) {
touse = wanted = nargs; /* get all extra arguments available */
checkstackp(L, nargs, where); /* ensure stack space */
L->top.p = where + nargs; /* next instruction will need top */
}
else
touse = (nargs > wanted) ? wanted : nargs;
if (h == NULL) { /* no vararg table? */
for (i = 0; i < touse; i++) /* get vararg values from the stack */
setobjs2s(L, where + i, ci->func.p - nargs + i);
}
else { /* get vararg values from vararg table */
for (i = 0; i < touse; i++) {
lu_byte tag = luaH_getint(h, i + 1, s2v(where + i));
if (tagisempty(tag))
setnilvalue2s(where + i);
}
}
for (; i < wanted; i++) /* complete required results with nil */
setnilvalue2s(where + i);
}

80
lib/lua/ltm.h
View File

@ -1,5 +1,5 @@
/*
** $Id: ltm.h $
** $Id: ltm.h,v 1.41 2002/11/14 11:51:50 roberto Exp $
** Tag methods
** See Copyright Notice in lua.h
*/
@ -13,93 +13,39 @@
/*
* WARNING: if you change the order of this enumeration,
* grep "ORDER TM" and "ORDER OP"
* grep "ORDER TM"
*/
typedef enum {
TM_INDEX,
TM_NEWINDEX,
TM_GC,
TM_MODE,
TM_LEN,
TM_EQ, /* last tag method with fast access */
TM_EQ, /* last tag method with `fast' access */
TM_ADD,
TM_SUB,
TM_MUL,
TM_MOD,
TM_POW,
TM_DIV,
TM_IDIV,
TM_BAND,
TM_BOR,
TM_BXOR,
TM_SHL,
TM_SHR,
TM_POW,
TM_UNM,
TM_BNOT,
TM_LT,
TM_LE,
TM_CONCAT,
TM_CALL,
TM_CLOSE,
TM_N /* number of elements in the enum */
} TMS;
/*
** Mask with 1 in all fast-access methods. A 1 in any of these bits
** in the flag of a (meta)table means the metatable does not have the
** corresponding metamethod field. (Bit 6 of the flag indicates that
** the table is using the dummy node.)
*/
#define maskflags cast_byte(~(~0u << (TM_EQ + 1)))
#define gfasttm(g,et,e) \
(((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e]))
#define fasttm(l,et,e) gfasttm(G(l), et, e)
/*
** Test whether there is no tagmethod.
** (Because tagmethods use raw accesses, the result may be an "empty" nil.)
*/
#define notm(tm) ttisnil(tm)
#define checknoTM(mt,e) ((mt) == NULL || (mt)->flags & (1u<<(e)))
#define gfasttm(g,mt,e) \
(checknoTM(mt, e) ? NULL : luaT_gettm(mt, e, (g)->tmname[e]))
#define fasttm(l,mt,e) gfasttm(G(l), mt, e)
#define ttypename(x) luaT_typenames_[(x) + 1]
LUAI_DDEC(const char *const luaT_typenames_[LUA_TOTALTYPES];)
LUAI_FUNC const char *luaT_objtypename (lua_State *L, const TValue *o);
LUAI_FUNC const TValue *luaT_gettm (Table *events, TMS event, TString *ename);
LUAI_FUNC const TValue *luaT_gettmbyobj (lua_State *L, const TValue *o,
TMS event);
LUAI_FUNC void luaT_init (lua_State *L);
LUAI_FUNC void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
const TValue *p2, const TValue *p3);
LUAI_FUNC lu_byte luaT_callTMres (lua_State *L, const TValue *f,
const TValue *p1, const TValue *p2, StkId p3);
LUAI_FUNC void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
StkId res, TMS event);
LUAI_FUNC void luaT_tryconcatTM (lua_State *L);
LUAI_FUNC void luaT_trybinassocTM (lua_State *L, const TValue *p1,
const TValue *p2, int inv, StkId res, TMS event);
LUAI_FUNC void luaT_trybiniTM (lua_State *L, const TValue *p1, lua_Integer i2,
int inv, StkId res, TMS event);
LUAI_FUNC int luaT_callorderTM (lua_State *L, const TValue *p1,
const TValue *p2, TMS event);
LUAI_FUNC int luaT_callorderiTM (lua_State *L, const TValue *p1, int v2,
int inv, int isfloat, TMS event);
LUAI_FUNC void luaT_adjustvarargs (lua_State *L, struct CallInfo *ci,
const Proto *p);
LUAI_FUNC void luaT_getvararg (CallInfo *ci, StkId ra, TValue *rc);
LUAI_FUNC void luaT_getvarargs (lua_State *L, struct CallInfo *ci, StkId where,
int wanted, int vatab);
const TObject *luaT_gettm (Table *events, TMS event, TString *ename);
const TObject *luaT_gettmbyobj (lua_State *L, const TObject *o, TMS event);
void luaT_init (lua_State *L);
extern const char *const luaT_typenames[];
#endif

794
lib/lua/lua.c
View File

@ -1,794 +0,0 @@
/*
** $Id: lua.c $
** Lua stand-alone interpreter
** See Copyright Notice in lua.h
*/
#define lua_c
#include "lprefix.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <signal.h>
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#include "llimits.h"
#if !defined(LUA_PROGNAME)
#define LUA_PROGNAME "lua"
#endif
#if !defined(LUA_INIT_VAR)
#define LUA_INIT_VAR "LUA_INIT"
#endif
/* Name of the environment variable with the name of the readline library */
#if !defined(LUA_RLLIB_VAR)
#define LUA_RLLIB_VAR "LUA_READLINELIB"
#endif
#define LUA_INITVARVERSION LUA_INIT_VAR LUA_VERSUFFIX
static lua_State *globalL = NULL;
static const char *progname = LUA_PROGNAME;
#if defined(LUA_USE_POSIX) /* { */
/*
** Use 'sigaction' when available.
*/
static void setsignal (int sig, void (*handler)(int)) {
struct sigaction sa;
sa.sa_handler = handler;
sa.sa_flags = 0;
sigemptyset(&sa.sa_mask); /* do not mask any signal */
sigaction(sig, &sa, NULL);
}
#else /* }{ */
#define setsignal signal
#endif /* } */
/*
** Hook set by signal function to stop the interpreter.
*/
static void lstop (lua_State *L, lua_Debug *ar) {
(void)ar; /* unused arg. */
lua_sethook(L, NULL, 0, 0); /* reset hook */
luaL_error(L, "interrupted!");
}
/*
** Function to be called at a C signal. Because a C signal cannot
** just change a Lua state (as there is no proper synchronization),
** this function only sets a hook that, when called, will stop the
** interpreter.
*/
static void laction (int i) {
int flag = LUA_MASKCALL | LUA_MASKRET | LUA_MASKLINE | LUA_MASKCOUNT;
setsignal(i, SIG_DFL); /* if another SIGINT happens, terminate process */
lua_sethook(globalL, lstop, flag, 1);
}
static void print_usage (const char *badoption) {
lua_writestringerror("%s: ", progname);
if (badoption[1] == 'e' || badoption[1] == 'l')
lua_writestringerror("'%s' needs argument\n", badoption);
else
lua_writestringerror("unrecognized option '%s'\n", badoption);
lua_writestringerror(
"usage: %s [options] [script [args]]\n"
"Available options are:\n"
" -e stat execute string 'stat'\n"
" -i enter interactive mode after executing 'script'\n"
" -l mod require library 'mod' into global 'mod'\n"
" -l g=mod require library 'mod' into global 'g'\n"
" -v show version information\n"
" -E ignore environment variables\n"
" -W turn warnings on\n"
" -- stop handling options\n"
" - stop handling options and execute stdin\n"
,
progname);
}
/*
** Prints an error message, adding the program name in front of it
** (if present)
*/
static void l_message (const char *pname, const char *msg) {
if (pname) lua_writestringerror("%s: ", pname);
lua_writestringerror("%s\n", msg);
}
/*
** Check whether 'status' is not OK and, if so, prints the error
** message on the top of the stack.
*/
static int report (lua_State *L, int status) {
if (status != LUA_OK) {
const char *msg = lua_tostring(L, -1);
if (msg == NULL)
msg = "(error message not a string)";
l_message(progname, msg);
lua_pop(L, 1); /* remove message */
}
return status;
}
/*
** Message handler used to run all chunks
*/
static int msghandler (lua_State *L) {
const char *msg = lua_tostring(L, 1);
if (msg == NULL) { /* is error object not a string? */
if (luaL_callmeta(L, 1, "__tostring") && /* does it have a metamethod */
lua_type(L, -1) == LUA_TSTRING) /* that produces a string? */
return 1; /* that is the message */
else
msg = lua_pushfstring(L, "(error object is a %s value)",
luaL_typename(L, 1));
}
luaL_traceback(L, L, msg, 1); /* append a standard traceback */
return 1; /* return the traceback */
}
/*
** Interface to 'lua_pcall', which sets appropriate message function
** and C-signal handler. Used to run all chunks.
*/
static int docall (lua_State *L, int narg, int nres) {
int status;
int base = lua_gettop(L) - narg; /* function index */
lua_pushcfunction(L, msghandler); /* push message handler */
lua_insert(L, base); /* put it under function and args */
globalL = L; /* to be available to 'laction' */
setsignal(SIGINT, laction); /* set C-signal handler */
status = lua_pcall(L, narg, nres, base);
setsignal(SIGINT, SIG_DFL); /* reset C-signal handler */
lua_remove(L, base); /* remove message handler from the stack */
return status;
}
static void print_version (void) {
lua_writestring(LUA_COPYRIGHT, strlen(LUA_COPYRIGHT));
lua_writeline();
}
/*
** Create the 'arg' table, which stores all arguments from the
** command line ('argv'). It should be aligned so that, at index 0,
** it has 'argv[script]', which is the script name. The arguments
** to the script (everything after 'script') go to positive indices;
** other arguments (before the script name) go to negative indices.
** If there is no script name, assume interpreter's name as base.
** (If there is no interpreter's name either, 'script' is -1, so
** table sizes are zero.)
*/
static void createargtable (lua_State *L, char **argv, int argc, int script) {
int i, narg;
narg = argc - (script + 1); /* number of positive indices */
lua_createtable(L, narg, script + 1);
for (i = 0; i < argc; i++) {
lua_pushstring(L, argv[i]);
lua_rawseti(L, -2, i - script);
}
lua_setglobal(L, "arg");
}
static int dochunk (lua_State *L, int status) {
if (status == LUA_OK) status = docall(L, 0, 0);
return report(L, status);
}
static int dofile (lua_State *L, const char *name) {
return dochunk(L, luaL_loadfilex(L, name, "bt"));
}
static int dostring (lua_State *L, const char *s, const char *name) {
return dochunk(L, luaL_loadbufferx(L, s, strlen(s), name, "t"));
}
/*
** Receives 'globname[=modname]' and runs 'globname = require(modname)'.
** If there is no explicit modname and globname contains a '-', cut
** the suffix after '-' (the "version") to make the global name.
*/
static int dolibrary (lua_State *L, char *globname) {
int status;
char *suffix = NULL;
char *modname = strchr(globname, '=');
if (modname == NULL) { /* no explicit name? */
modname = globname; /* module name is equal to global name */
suffix = strchr(modname, *LUA_IGMARK); /* look for a suffix mark */
}
else {
*modname = '\0'; /* global name ends here */
modname++; /* module name starts after the '=' */
}
lua_getglobal(L, "require");
lua_pushstring(L, modname);
status = docall(L, 1, 1); /* call 'require(modname)' */
if (status == LUA_OK) {
if (suffix != NULL) /* is there a suffix mark? */
*suffix = '\0'; /* remove suffix from global name */
lua_setglobal(L, globname); /* globname = require(modname) */
}
return report(L, status);
}
/*
** Push on the stack the contents of table 'arg' from 1 to #arg
*/
static int pushargs (lua_State *L) {
int i, n;
if (lua_getglobal(L, "arg") != LUA_TTABLE)
luaL_error(L, "'arg' is not a table");
n = (int)luaL_len(L, -1);
luaL_checkstack(L, n + 3, "too many arguments to script");
for (i = 1; i <= n; i++)
lua_rawgeti(L, -i, i);
lua_remove(L, -i); /* remove table from the stack */
return n;
}
static int handle_script (lua_State *L, char **argv) {
int status;
const char *fname = argv[0];
if (strcmp(fname, "-") == 0 && strcmp(argv[-1], "--") != 0)
fname = NULL; /* stdin */
status = luaL_loadfilex(L, fname, "bt");
if (status == LUA_OK) {
int n = pushargs(L); /* push arguments to script */
status = docall(L, n, LUA_MULTRET);
}
return report(L, status);
}
/* bits of various argument indicators in 'args' */
#define has_error 1 /* bad option */
#define has_i 2 /* -i */
#define has_v 4 /* -v */
#define has_e 8 /* -e */
#define has_E 16 /* -E */
/*
** Traverses all arguments from 'argv', returning a mask with those
** needed before running any Lua code or an error code if it finds any
** invalid argument. In case of error, 'first' is the index of the bad
** argument. Otherwise, 'first' is -1 if there is no program name,
** 0 if there is no script name, or the index of the script name.
*/
static int collectargs (char **argv, int *first) {
int args = 0;
int i;
if (argv[0] != NULL) { /* is there a program name? */
if (argv[0][0]) /* not empty? */
progname = argv[0]; /* save it */
}
else { /* no program name */
*first = -1;
return 0;
}
for (i = 1; argv[i] != NULL; i++) { /* handle arguments */
*first = i;
if (argv[i][0] != '-') /* not an option? */
return args; /* stop handling options */
switch (argv[i][1]) { /* else check option */
case '-': /* '--' */
if (argv[i][2] != '\0') /* extra characters after '--'? */
return has_error; /* invalid option */
/* if there is a script name, it comes after '--' */
*first = (argv[i + 1] != NULL) ? i + 1 : 0;
return args;
case '\0': /* '-' */
return args; /* script "name" is '-' */
case 'E':
if (argv[i][2] != '\0') /* extra characters? */
return has_error; /* invalid option */
args |= has_E;
break;
case 'W':
if (argv[i][2] != '\0') /* extra characters? */
return has_error; /* invalid option */
break;
case 'i':
args |= has_i; /* (-i implies -v) *//* FALLTHROUGH */
case 'v':
if (argv[i][2] != '\0') /* extra characters? */
return has_error; /* invalid option */
args |= has_v;
break;
case 'e':
args |= has_e; /* FALLTHROUGH */
case 'l': /* both options need an argument */
if (argv[i][2] == '\0') { /* no concatenated argument? */
i++; /* try next 'argv' */
if (argv[i] == NULL || argv[i][0] == '-')
return has_error; /* no next argument or it is another option */
}
break;
default: /* invalid option */
return has_error;
}
}
*first = 0; /* no script name */
return args;
}
/*
** Processes options 'e' and 'l', which involve running Lua code, and
** 'W', which also affects the state.
** Returns 0 if some code raises an error.
*/
static int runargs (lua_State *L, char **argv, int n) {
int i;
lua_warning(L, "@off", 0); /* by default, Lua stand-alone has warnings off */
for (i = 1; i < n; i++) {
int option = argv[i][1];
lua_assert(argv[i][0] == '-'); /* already checked */
switch (option) {
case 'e': case 'l': {
int status;
char *extra = argv[i] + 2; /* both options need an argument */
if (*extra == '\0') extra = argv[++i];
lua_assert(extra != NULL);
status = (option == 'e')
? dostring(L, extra, "=(command line)")
: dolibrary(L, extra);
if (status != LUA_OK) return 0;
break;
}
case 'W':
lua_warning(L, "@on", 0); /* warnings on */
break;
}
}
return 1;
}
static char *(*l_getenv)(const char *name);
/* Function to ignore environment variables, used by option -E */
static char *no_getenv (const char *name) {
UNUSED(name);
return NULL;
}
static int handle_luainit (lua_State *L) {
const char *name = "=" LUA_INITVARVERSION;
const char *init = l_getenv(name + 1);
if (init == NULL) {
name = "=" LUA_INIT_VAR;
init = l_getenv(name + 1); /* try alternative name */
}
if (init == NULL) return LUA_OK;
else if (init[0] == '@')
return dofile(L, init+1);
else
return dostring(L, init, name);
}
/*
** {==================================================================
** Read-Eval-Print Loop (REPL)
** ===================================================================
*/
#if !defined(LUA_PROMPT)
#define LUA_PROMPT "> "
#define LUA_PROMPT2 ">> "
#endif
#if !defined(LUA_MAXINPUT)
#define LUA_MAXINPUT 512
#endif
/*
** lua_stdin_is_tty detects whether the standard input is a 'tty' (that
** is, whether we're running lua interactively).
*/
#if !defined(lua_stdin_is_tty) /* { */
#if defined(LUA_USE_POSIX) /* { */
#include <unistd.h>
#define lua_stdin_is_tty() isatty(0)
#elif defined(LUA_USE_WINDOWS) /* }{ */
#include <io.h>
#include <windows.h>
#define lua_stdin_is_tty() _isatty(_fileno(stdin))
#else /* }{ */
/* ISO C definition */
#define lua_stdin_is_tty() 1 /* assume stdin is a tty */
#endif /* } */
#endif /* } */
/*
** * lua_initreadline initializes the readline system.
** * lua_readline defines how to show a prompt and then read a line from
** the standard input.
** * lua_saveline defines how to "save" a read line in a "history".
** * lua_freeline defines how to free a line read by lua_readline.
*/
#if !defined(lua_readline) /* { */
/* Otherwise, all previously listed functions should be defined. */
#if defined(LUA_USE_READLINE) /* { */
/* Lua will be linked with '-lreadline' */
#include <readline/readline.h>
#include <readline/history.h>
#define lua_initreadline(L) ((void)L, rl_readline_name="lua")
#define lua_readline(buff,prompt) ((void)buff, readline(prompt))
#define lua_saveline(line) add_history(line)
#define lua_freeline(line) free(line)
#else /* }{ */
/* use dynamically loaded readline (or nothing) */
/* pointer to 'readline' function (if any) */
typedef char *(*l_readlineT) (const char *prompt);
static l_readlineT l_readline = NULL;
/* pointer to 'add_history' function (if any) */
typedef void (*l_addhistT) (const char *string);
static l_addhistT l_addhist = NULL;
static char *lua_readline (char *buff, const char *prompt) {
if (l_readline != NULL) /* is there a 'readline'? */
return (*l_readline)(prompt); /* use it */
else { /* emulate 'readline' over 'buff' */
fputs(prompt, stdout);
fflush(stdout); /* show prompt */
return fgets(buff, LUA_MAXINPUT, stdin); /* read line */
}
}
static void lua_saveline (const char *line) {
if (l_addhist != NULL) /* is there an 'add_history'? */
(*l_addhist)(line); /* use it */
/* else nothing to be done */
}
static void lua_freeline (char *line) {
if (l_readline != NULL) /* is there a 'readline'? */
free(line); /* free line created by it */
/* else 'lua_readline' used an automatic buffer; nothing to free */
}
#if defined(LUA_USE_DLOPEN) && defined(LUA_READLINELIB) /* { */
/* try to load 'readline' dynamically */
#include <dlfcn.h>
static void lua_initreadline (lua_State *L) {
const char *rllib = l_getenv(LUA_RLLIB_VAR); /* name of readline library */
void *lib; /* library handle */
if (rllib == NULL) /* no environment variable? */
rllib = LUA_READLINELIB; /* use default name */
lib = dlopen(rllib, RTLD_NOW | RTLD_LOCAL);
if (lib != NULL) {
const char **name = cast(const char**, dlsym(lib, "rl_readline_name"));
if (name != NULL)
*name = "lua";
l_readline = cast(l_readlineT, cast_func(dlsym(lib, "readline")));
l_addhist = cast(l_addhistT, cast_func(dlsym(lib, "add_history")));
if (l_readline != NULL) /* could load readline function? */
return; /* everything ok */
/* else emit a warning */
}
lua_warning(L, "unable to load readline library '", 1);
lua_warning(L, rllib, 1);
lua_warning(L, "'", 0);
}
#else /* }{ */
/* no dlopen or LUA_READLINELIB undefined */
/* Leave pointers with NULL */
#define lua_initreadline(L) ((void)L)
#endif /* } */
#endif /* } */
#endif /* } */
/*
** Return the string to be used as a prompt by the interpreter. Leave
** the string (or nil, if using the default value) on the stack, to keep
** it anchored.
*/
static const char *get_prompt (lua_State *L, int firstline) {
if (lua_getglobal(L, firstline ? "_PROMPT" : "_PROMPT2") == LUA_TNIL)
return (firstline ? LUA_PROMPT : LUA_PROMPT2); /* use the default */
else { /* apply 'tostring' over the value */
const char *p = luaL_tolstring(L, -1, NULL);
lua_remove(L, -2); /* remove original value */
return p;
}
}
/* mark in error messages for incomplete statements */
#define EOFMARK "<eof>"
#define marklen (sizeof(EOFMARK)/sizeof(char) - 1)
/*
** Check whether 'status' signals a syntax error and the error
** message at the top of the stack ends with the above mark for
** incomplete statements.
*/
static int incomplete (lua_State *L, int status) {
if (status == LUA_ERRSYNTAX) {
size_t lmsg;
const char *msg = lua_tolstring(L, -1, &lmsg);
if (lmsg >= marklen && strcmp(msg + lmsg - marklen, EOFMARK) == 0)
return 1;
}
return 0; /* else... */
}
/*
** Prompt the user, read a line, and push it into the Lua stack.
*/
static int pushline (lua_State *L, int firstline) {
char buffer[LUA_MAXINPUT];
size_t l;
const char *prmt = get_prompt(L, firstline);
char *b = lua_readline(buffer, prmt);
lua_pop(L, 1); /* remove prompt */
if (b == NULL)
return 0; /* no input */
l = strlen(b);
if (l > 0 && b[l-1] == '\n') /* line ends with newline? */
b[--l] = '\0'; /* remove it */
lua_pushlstring(L, b, l);
lua_freeline(b);
return 1;
}
/*
** Try to compile line on the stack as 'return <line>;'; on return, stack
** has either compiled chunk or original line (if compilation failed).
*/
static int addreturn (lua_State *L) {
const char *line = lua_tostring(L, -1); /* original line */
const char *retline = lua_pushfstring(L, "return %s;", line);
int status = luaL_loadbufferx(L, retline, strlen(retline), "=stdin", "t");
if (status == LUA_OK)
lua_remove(L, -2); /* remove modified line */
else
lua_pop(L, 2); /* pop result from 'luaL_loadbufferx' and modified line */
return status;
}
static void checklocal (const char *line) {
static const size_t szloc = sizeof("local") - 1;
static const char space[] = " \t";
line += strspn(line, space); /* skip spaces */
if (strncmp(line, "local", szloc) == 0 && /* "local"? */
strchr(space, *(line + szloc)) != NULL) { /* followed by a space? */
lua_writestringerror("%s\n",
"warning: locals do not survive across lines in interactive mode");
}
}
/*
** Read multiple lines until a complete Lua statement or an error not
** for an incomplete statement. Start with first line already read in
** the stack.
*/
static int multiline (lua_State *L) {
size_t len;
const char *line = lua_tolstring(L, 1, &len); /* get first line */
checklocal(line);
for (;;) { /* repeat until gets a complete statement */
int status = luaL_loadbufferx(L, line, len, "=stdin", "t"); /* try it */
if (!incomplete(L, status) || !pushline(L, 0))
return status; /* should not or cannot try to add continuation line */
lua_remove(L, -2); /* remove error message (from incomplete line) */
lua_pushliteral(L, "\n"); /* add newline... */
lua_insert(L, -2); /* ...between the two lines */
lua_concat(L, 3); /* join them */
line = lua_tolstring(L, 1, &len); /* get what is has */
}
}
/*
** Read a line and try to load (compile) it first as an expression (by
** adding "return " in front of it) and second as a statement. Return
** the final status of load/call with the resulting function (if any)
** in the top of the stack.
*/
static int loadline (lua_State *L) {
const char *line;
int status;
lua_settop(L, 0);
if (!pushline(L, 1))
return -1; /* no input */
if ((status = addreturn(L)) != LUA_OK) /* 'return ...' did not work? */
status = multiline(L); /* try as command, maybe with continuation lines */
line = lua_tostring(L, 1);
if (line[0] != '\0') /* non empty? */
lua_saveline(line); /* keep history */
lua_remove(L, 1); /* remove line from the stack */
lua_assert(lua_gettop(L) == 1);
return status;
}
/*
** Prints (calling the Lua 'print' function) any values on the stack
*/
static void l_print (lua_State *L) {
int n = lua_gettop(L);
if (n > 0) { /* any result to be printed? */
luaL_checkstack(L, LUA_MINSTACK, "too many results to print");
lua_getglobal(L, "print");
lua_insert(L, 1);
if (lua_pcall(L, n, 0, 0) != LUA_OK)
l_message(progname, lua_pushfstring(L, "error calling 'print' (%s)",
lua_tostring(L, -1)));
}
}
/*
** Do the REPL: repeatedly read (load) a line, evaluate (call) it, and
** print any results.
*/
static void doREPL (lua_State *L) {
int status;
const char *oldprogname = progname;
progname = NULL; /* no 'progname' on errors in interactive mode */
lua_initreadline(L);
while ((status = loadline(L)) != -1) {
if (status == LUA_OK)
status = docall(L, 0, LUA_MULTRET);
if (status == LUA_OK) l_print(L);
else report(L, status);
}
lua_settop(L, 0); /* clear stack */
lua_writeline();
progname = oldprogname;
}
/* }================================================================== */
#if !defined(luai_openlibs)
#if defined(LUA_NODEBUGLIB)
/* With this option, code must require the debug library before using it */
#define luai_openlibs(L) luaL_openselectedlibs(L, ~LUA_DBLIBK, LUA_DBLIBK)
#else
/* The default is to open all standard libraries */
#define luai_openlibs(L) luaL_openselectedlibs(L, ~0, 0)
#endif
#endif
/*
** Main body of stand-alone interpreter (to be called in protected mode).
** Reads the options and handles them all.
*/
static int pmain (lua_State *L) {
int argc = (int)lua_tointeger(L, 1);
char **argv = (char **)lua_touserdata(L, 2);
int script;
int args = collectargs(argv, &script);
int optlim = (script > 0) ? script : argc; /* first argv not an option */
luaL_checkversion(L); /* check that interpreter has correct version */
if (args == has_error) { /* bad arg? */
print_usage(argv[script]); /* 'script' has index of bad arg. */
return 0;
}
if (args & has_v) /* option '-v'? */
print_version();
if (args & has_E) { /* option '-E'? */
l_getenv = &no_getenv; /* program will ignore environment variables */
lua_pushboolean(L, 1); /* signal for libraries to ignore env. vars. */
lua_setfield(L, LUA_REGISTRYINDEX, "LUA_NOENV");
}
else
l_getenv = &getenv;
luai_openlibs(L); /* open standard libraries */
createargtable(L, argv, argc, script); /* create table 'arg' */
lua_gc(L, LUA_GCRESTART); /* start GC... */
lua_gc(L, LUA_GCGEN); /* ...in generational mode */
if (handle_luainit(L) != LUA_OK) /* run LUA_INIT */
return 0; /* error running LUA_INIT */
if (!runargs(L, argv, optlim)) /* execute arguments -e, -l, and -W */
return 0; /* something failed */
if (script > 0) { /* execute main script (if there is one) */
if (handle_script(L, argv + script) != LUA_OK)
return 0; /* interrupt in case of error */
}
if (args & has_i) /* -i option? */
doREPL(L); /* do read-eval-print loop */
else if (script < 1 && !(args & (has_e | has_v))) { /* no active option? */
if (lua_stdin_is_tty()) { /* running in interactive mode? */
print_version();
doREPL(L); /* do read-eval-print loop */
}
else dofile(L, NULL); /* executes stdin as a file */
}
lua_pushboolean(L, 1); /* signal no errors */
return 1;
}
int main (int argc, char **argv) {
int status, result;
lua_State *L = luaL_newstate(); /* create state */
if (L == NULL) {
l_message(argv[0], "cannot create state: not enough memory");
return EXIT_FAILURE;
}
lua_gc(L, LUA_GCSTOP); /* stop GC while building state */
lua_pushcfunction(L, &pmain); /* to call 'pmain' in protected mode */
lua_pushinteger(L, argc); /* 1st argument */
lua_pushlightuserdata(L, argv); /* 2nd argument */
status = lua_pcall(L, 2, 1, 0); /* do the call */
result = lua_toboolean(L, -1); /* get result */
report(L, status);
lua_close(L);
return (result && status == LUA_OK) ? EXIT_SUCCESS : EXIT_FAILURE;
}

554
lib/lua/lua.h
View File

@ -1,7 +1,8 @@
/*
** $Id: lua.h $
** Lua - A Scripting Language
** Lua.org, PUC-Rio, Brazil (www.lua.org)
** $Id: lua.h,v 1.175c 2003/03/18 12:31:39 roberto Exp $
** Lua - An Extensible Extension Language
** Tecgraf: Computer Graphics Technology Group, PUC-Rio, Brazil
** http://www.lua.org mailto:info@lua.org
** See Copyright Notice at the end of this file
*/
@ -13,41 +14,27 @@
#include <stddef.h>
#define LUA_COPYRIGHT LUA_RELEASE " Copyright (C) 1994-2026 Lua.org, PUC-Rio"
#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo, W. Celes"
#define LUA_VERSION "Lua 5.0.3"
#define LUA_COPYRIGHT "Copyright (C) 1994-2006 Tecgraf, PUC-Rio"
#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo & W. Celes"
#define LUA_VERSION_MAJOR_N 5
#define LUA_VERSION_MINOR_N 5
#define LUA_VERSION_RELEASE_N 1
#define LUA_VERSION_NUM (LUA_VERSION_MAJOR_N * 100 + LUA_VERSION_MINOR_N)
#define LUA_VERSION_RELEASE_NUM (LUA_VERSION_NUM * 100 + LUA_VERSION_RELEASE_N)
#include "luaconf.h"
/* mark for precompiled code ('<esc>Lua') */
#define LUA_SIGNATURE "\x1bLua"
/* option for multiple returns in 'lua_pcall' and 'lua_call' */
/* option for multiple returns in `lua_pcall' and `lua_call' */
#define LUA_MULTRET (-1)
/*
** Pseudo-indices
** (The stack size is limited to INT_MAX/2; we keep some free empty
** space after that to help overflow detection.)
** pseudo-indices
*/
#define LUA_REGISTRYINDEX (-(INT_MAX/2 + 1000))
#define lua_upvalueindex(i) (LUA_REGISTRYINDEX - (i))
#define LUA_REGISTRYINDEX (-10000)
#define LUA_GLOBALSINDEX (-10001)
#define lua_upvalueindex(i) (LUA_GLOBALSINDEX-(i))
/* thread status */
#define LUA_OK 0
#define LUA_YIELD 1
#define LUA_ERRRUN 2
/* error codes for `lua_load' and `lua_pcall' */
#define LUA_ERRRUN 1
#define LUA_ERRFILE 2
#define LUA_ERRSYNTAX 3
#define LUA_ERRMEM 4
#define LUA_ERRERR 5
@ -55,391 +42,265 @@
typedef struct lua_State lua_State;
typedef int (*lua_CFunction) (lua_State *L);
/*
** functions that read/write blocks when loading/dumping Lua chunks
*/
typedef const char * (*lua_Chunkreader) (lua_State *L, void *ud, size_t *sz);
typedef int (*lua_Chunkwriter) (lua_State *L, const void* p,
size_t sz, void* ud);
/*
** basic types
*/
#define LUA_TNONE (-1)
#define LUA_TNONE (-1)
#define LUA_TNIL 0
#define LUA_TBOOLEAN 1
#define LUA_TNIL 0
#define LUA_TBOOLEAN 1
#define LUA_TLIGHTUSERDATA 2
#define LUA_TNUMBER 3
#define LUA_TSTRING 4
#define LUA_TTABLE 5
#define LUA_TFUNCTION 6
#define LUA_TUSERDATA 7
#define LUA_TTHREAD 8
#define LUA_NUMTYPES 9
#define LUA_TNUMBER 3
#define LUA_TSTRING 4
#define LUA_TTABLE 5
#define LUA_TFUNCTION 6
#define LUA_TUSERDATA 7
#define LUA_TTHREAD 8
/* minimum Lua stack available to a C function */
#define LUA_MINSTACK 20
/* predefined values in the registry */
/* index 1 is reserved for the reference mechanism */
#define LUA_RIDX_GLOBALS 2
#define LUA_RIDX_MAINTHREAD 3
#define LUA_RIDX_LAST 3
/* type of numbers in Lua */
typedef LUA_NUMBER lua_Number;
/* type for integer functions */
typedef LUA_INTEGER lua_Integer;
/* unsigned integer type */
typedef LUA_UNSIGNED lua_Unsigned;
/* type for continuation-function contexts */
typedef LUA_KCONTEXT lua_KContext;
/*
** Type for C functions registered with Lua
*/
typedef int (*lua_CFunction) (lua_State *L);
/*
** Type for continuation functions
*/
typedef int (*lua_KFunction) (lua_State *L, int status, lua_KContext ctx);
/*
** Type for functions that read/write blocks when loading/dumping Lua chunks
*/
typedef const char * (*lua_Reader) (lua_State *L, void *ud, size_t *sz);
typedef int (*lua_Writer) (lua_State *L, const void *p, size_t sz, void *ud);
/*
** Type for memory-allocation functions
*/
typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize);
/*
** Type for warning functions
*/
typedef void (*lua_WarnFunction) (void *ud, const char *msg, int tocont);
/*
** Type used by the debug API to collect debug information
*/
typedef struct lua_Debug lua_Debug;
/*
** Functions to be called by the debugger in specific events
*/
typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);
/*
** generic extra include file
*/
#if defined(LUA_USER_H)
#ifdef LUA_USER_H
#include LUA_USER_H
#endif
/*
** RCS ident string
*/
extern const char lua_ident[];
/* type of numbers in Lua */
#ifndef LUA_NUMBER
typedef double lua_Number;
#else
typedef LUA_NUMBER lua_Number;
#endif
/* mark for all API functions */
#ifndef LUA_API
#define LUA_API extern
#endif
/*
** state manipulation
*/
LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud, unsigned seed);
LUA_API void (lua_close) (lua_State *L);
LUA_API lua_State *(lua_newthread) (lua_State *L);
LUA_API int (lua_closethread) (lua_State *L, lua_State *from);
LUA_API lua_State *lua_open (void);
LUA_API void lua_close (lua_State *L);
LUA_API lua_State *lua_newthread (lua_State *L);
LUA_API lua_CFunction (lua_atpanic) (lua_State *L, lua_CFunction panicf);
LUA_API lua_Number (lua_version) (lua_State *L);
LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf);
/*
** basic stack manipulation
*/
LUA_API int (lua_absindex) (lua_State *L, int idx);
LUA_API int (lua_gettop) (lua_State *L);
LUA_API void (lua_settop) (lua_State *L, int idx);
LUA_API void (lua_pushvalue) (lua_State *L, int idx);
LUA_API void (lua_rotate) (lua_State *L, int idx, int n);
LUA_API void (lua_copy) (lua_State *L, int fromidx, int toidx);
LUA_API int (lua_checkstack) (lua_State *L, int n);
LUA_API int lua_gettop (lua_State *L);
LUA_API void lua_settop (lua_State *L, int idx);
LUA_API void lua_pushvalue (lua_State *L, int idx);
LUA_API void lua_remove (lua_State *L, int idx);
LUA_API void lua_insert (lua_State *L, int idx);
LUA_API void lua_replace (lua_State *L, int idx);
LUA_API int lua_checkstack (lua_State *L, int sz);
LUA_API void (lua_xmove) (lua_State *from, lua_State *to, int n);
LUA_API void lua_xmove (lua_State *from, lua_State *to, int n);
/*
** access functions (stack -> C)
*/
LUA_API int (lua_isnumber) (lua_State *L, int idx);
LUA_API int (lua_isstring) (lua_State *L, int idx);
LUA_API int (lua_iscfunction) (lua_State *L, int idx);
LUA_API int (lua_isinteger) (lua_State *L, int idx);
LUA_API int (lua_isuserdata) (lua_State *L, int idx);
LUA_API int (lua_type) (lua_State *L, int idx);
LUA_API const char *(lua_typename) (lua_State *L, int tp);
LUA_API int lua_isnumber (lua_State *L, int idx);
LUA_API int lua_isstring (lua_State *L, int idx);
LUA_API int lua_iscfunction (lua_State *L, int idx);
LUA_API int lua_isuserdata (lua_State *L, int idx);
LUA_API int lua_type (lua_State *L, int idx);
LUA_API const char *lua_typename (lua_State *L, int tp);
LUA_API lua_Number (lua_tonumberx) (lua_State *L, int idx, int *isnum);
LUA_API lua_Integer (lua_tointegerx) (lua_State *L, int idx, int *isnum);
LUA_API int (lua_toboolean) (lua_State *L, int idx);
LUA_API const char *(lua_tolstring) (lua_State *L, int idx, size_t *len);
LUA_API lua_Unsigned (lua_rawlen) (lua_State *L, int idx);
LUA_API lua_CFunction (lua_tocfunction) (lua_State *L, int idx);
LUA_API void *(lua_touserdata) (lua_State *L, int idx);
LUA_API lua_State *(lua_tothread) (lua_State *L, int idx);
LUA_API const void *(lua_topointer) (lua_State *L, int idx);
LUA_API int lua_equal (lua_State *L, int idx1, int idx2);
LUA_API int lua_rawequal (lua_State *L, int idx1, int idx2);
LUA_API int lua_lessthan (lua_State *L, int idx1, int idx2);
/*
** Comparison and arithmetic functions
*/
#define LUA_OPADD 0 /* ORDER TM, ORDER OP */
#define LUA_OPSUB 1
#define LUA_OPMUL 2
#define LUA_OPMOD 3
#define LUA_OPPOW 4
#define LUA_OPDIV 5
#define LUA_OPIDIV 6
#define LUA_OPBAND 7
#define LUA_OPBOR 8
#define LUA_OPBXOR 9
#define LUA_OPSHL 10
#define LUA_OPSHR 11
#define LUA_OPUNM 12
#define LUA_OPBNOT 13
LUA_API void (lua_arith) (lua_State *L, int op);
#define LUA_OPEQ 0
#define LUA_OPLT 1
#define LUA_OPLE 2
LUA_API int (lua_rawequal) (lua_State *L, int idx1, int idx2);
LUA_API int (lua_compare) (lua_State *L, int idx1, int idx2, int op);
LUA_API lua_Number lua_tonumber (lua_State *L, int idx);
LUA_API int lua_toboolean (lua_State *L, int idx);
LUA_API const char *lua_tostring (lua_State *L, int idx);
LUA_API size_t lua_strlen (lua_State *L, int idx);
LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx);
LUA_API void *lua_touserdata (lua_State *L, int idx);
LUA_API lua_State *lua_tothread (lua_State *L, int idx);
LUA_API const void *lua_topointer (lua_State *L, int idx);
/*
** push functions (C -> stack)
*/
LUA_API void (lua_pushnil) (lua_State *L);
LUA_API void (lua_pushnumber) (lua_State *L, lua_Number n);
LUA_API void (lua_pushinteger) (lua_State *L, lua_Integer n);
LUA_API const char *(lua_pushlstring) (lua_State *L, const char *s, size_t len);
LUA_API const char *(lua_pushexternalstring) (lua_State *L,
const char *s, size_t len, lua_Alloc falloc, void *ud);
LUA_API const char *(lua_pushstring) (lua_State *L, const char *s);
LUA_API const char *(lua_pushvfstring) (lua_State *L, const char *fmt,
va_list argp);
LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...);
LUA_API void (lua_pushcclosure) (lua_State *L, lua_CFunction fn, int n);
LUA_API void (lua_pushboolean) (lua_State *L, int b);
LUA_API void (lua_pushlightuserdata) (lua_State *L, void *p);
LUA_API int (lua_pushthread) (lua_State *L);
LUA_API void lua_pushnil (lua_State *L);
LUA_API void lua_pushnumber (lua_State *L, lua_Number n);
LUA_API void lua_pushlstring (lua_State *L, const char *s, size_t l);
LUA_API void lua_pushstring (lua_State *L, const char *s);
LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt,
va_list argp);
LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...);
LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n);
LUA_API void lua_pushboolean (lua_State *L, int b);
LUA_API void lua_pushlightuserdata (lua_State *L, void *p);
/*
** get functions (Lua -> stack)
*/
LUA_API int (lua_getglobal) (lua_State *L, const char *name);
LUA_API int (lua_gettable) (lua_State *L, int idx);
LUA_API int (lua_getfield) (lua_State *L, int idx, const char *k);
LUA_API int (lua_geti) (lua_State *L, int idx, lua_Integer n);
LUA_API int (lua_rawget) (lua_State *L, int idx);
LUA_API int (lua_rawgeti) (lua_State *L, int idx, lua_Integer n);
LUA_API int (lua_rawgetp) (lua_State *L, int idx, const void *p);
LUA_API void (lua_createtable) (lua_State *L, int narr, int nrec);
LUA_API void *(lua_newuserdatauv) (lua_State *L, size_t sz, int nuvalue);
LUA_API int (lua_getmetatable) (lua_State *L, int objindex);
LUA_API int (lua_getiuservalue) (lua_State *L, int idx, int n);
LUA_API void lua_gettable (lua_State *L, int idx);
LUA_API void lua_rawget (lua_State *L, int idx);
LUA_API void lua_rawgeti (lua_State *L, int idx, int n);
LUA_API void lua_newtable (lua_State *L);
LUA_API void *lua_newuserdata (lua_State *L, size_t sz);
LUA_API int lua_getmetatable (lua_State *L, int objindex);
LUA_API void lua_getfenv (lua_State *L, int idx);
/*
** set functions (stack -> Lua)
*/
LUA_API void (lua_setglobal) (lua_State *L, const char *name);
LUA_API void (lua_settable) (lua_State *L, int idx);
LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k);
LUA_API void (lua_seti) (lua_State *L, int idx, lua_Integer n);
LUA_API void (lua_rawset) (lua_State *L, int idx);
LUA_API void (lua_rawseti) (lua_State *L, int idx, lua_Integer n);
LUA_API void (lua_rawsetp) (lua_State *L, int idx, const void *p);
LUA_API int (lua_setmetatable) (lua_State *L, int objindex);
LUA_API int (lua_setiuservalue) (lua_State *L, int idx, int n);
LUA_API void lua_settable (lua_State *L, int idx);
LUA_API void lua_rawset (lua_State *L, int idx);
LUA_API void lua_rawseti (lua_State *L, int idx, int n);
LUA_API int lua_setmetatable (lua_State *L, int objindex);
LUA_API int lua_setfenv (lua_State *L, int idx);
/*
** 'load' and 'call' functions (load and run Lua code)
** `load' and `call' functions (load and run Lua code)
*/
LUA_API void (lua_callk) (lua_State *L, int nargs, int nresults,
lua_KContext ctx, lua_KFunction k);
#define lua_call(L,n,r) lua_callk(L, (n), (r), 0, NULL)
LUA_API void lua_call (lua_State *L, int nargs, int nresults);
LUA_API int lua_pcall (lua_State *L, int nargs, int nresults, int errfunc);
LUA_API int lua_cpcall (lua_State *L, lua_CFunction func, void *ud);
LUA_API int lua_load (lua_State *L, lua_Chunkreader reader, void *dt,
const char *chunkname);
LUA_API int (lua_pcallk) (lua_State *L, int nargs, int nresults, int errfunc,
lua_KContext ctx, lua_KFunction k);
#define lua_pcall(L,n,r,f) lua_pcallk(L, (n), (r), (f), 0, NULL)
LUA_API int (lua_load) (lua_State *L, lua_Reader reader, void *dt,
const char *chunkname, const char *mode);
LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data, int strip);
LUA_API int lua_dump (lua_State *L, lua_Chunkwriter writer, void *data);
/*
** coroutine functions
*/
LUA_API int (lua_yieldk) (lua_State *L, int nresults, lua_KContext ctx,
lua_KFunction k);
LUA_API int (lua_resume) (lua_State *L, lua_State *from, int narg,
int *nres);
LUA_API int (lua_status) (lua_State *L);
LUA_API int (lua_isyieldable) (lua_State *L);
#define lua_yield(L,n) lua_yieldk(L, (n), 0, NULL)
LUA_API int lua_yield (lua_State *L, int nresults);
LUA_API int lua_resume (lua_State *L, int narg);
/*
** Warning-related functions
** garbage-collection functions
*/
LUA_API void (lua_setwarnf) (lua_State *L, lua_WarnFunction f, void *ud);
LUA_API void (lua_warning) (lua_State *L, const char *msg, int tocont);
/*
** garbage-collection options
*/
#define LUA_GCSTOP 0
#define LUA_GCRESTART 1
#define LUA_GCCOLLECT 2
#define LUA_GCCOUNT 3
#define LUA_GCCOUNTB 4
#define LUA_GCSTEP 5
#define LUA_GCISRUNNING 6
#define LUA_GCGEN 7
#define LUA_GCINC 8
#define LUA_GCPARAM 9
/*
** garbage-collection parameters
*/
/* parameters for generational mode */
#define LUA_GCPMINORMUL 0 /* control minor collections */
#define LUA_GCPMAJORMINOR 1 /* control shift major->minor */
#define LUA_GCPMINORMAJOR 2 /* control shift minor->major */
/* parameters for incremental mode */
#define LUA_GCPPAUSE 3 /* size of pause between successive GCs */
#define LUA_GCPSTEPMUL 4 /* GC "speed" */
#define LUA_GCPSTEPSIZE 5 /* GC granularity */
/* number of parameters */
#define LUA_GCPN 6
LUA_API int (lua_gc) (lua_State *L, int what, ...);
LUA_API int lua_getgcthreshold (lua_State *L);
LUA_API int lua_getgccount (lua_State *L);
LUA_API void lua_setgcthreshold (lua_State *L, int newthreshold);
/*
** miscellaneous functions
*/
LUA_API int (lua_error) (lua_State *L);
LUA_API const char *lua_version (void);
LUA_API int (lua_next) (lua_State *L, int idx);
LUA_API int lua_error (lua_State *L);
LUA_API void (lua_concat) (lua_State *L, int n);
LUA_API void (lua_len) (lua_State *L, int idx);
LUA_API int lua_next (lua_State *L, int idx);
#define LUA_N2SBUFFSZ 64
LUA_API unsigned (lua_numbertocstring) (lua_State *L, int idx, char *buff);
LUA_API size_t (lua_stringtonumber) (lua_State *L, const char *s);
LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud);
LUA_API void (lua_setallocf) (lua_State *L, lua_Alloc f, void *ud);
LUA_API void (lua_toclose) (lua_State *L, int idx);
LUA_API void (lua_closeslot) (lua_State *L, int idx);
LUA_API void lua_concat (lua_State *L, int n);
/*
** {==============================================================
/*
** ===============================================================
** some useful macros
** ===============================================================
*/
#define lua_getextraspace(L) ((void *)((char *)(L) - LUA_EXTRASPACE))
#define lua_boxpointer(L,u) \
(*(void **)(lua_newuserdata(L, sizeof(void *))) = (u))
#define lua_tonumber(L,i) lua_tonumberx(L,(i),NULL)
#define lua_tointeger(L,i) lua_tointegerx(L,(i),NULL)
#define lua_unboxpointer(L,i) (*(void **)(lua_touserdata(L, i)))
#define lua_pop(L,n) lua_settop(L, -(n)-1)
#define lua_newtable(L) lua_createtable(L, 0, 0)
#define lua_register(L,n,f) \
(lua_pushstring(L, n), \
lua_pushcfunction(L, f), \
lua_settable(L, LUA_GLOBALSINDEX))
#define lua_register(L,n,f) (lua_pushcfunction(L, (f)), lua_setglobal(L, (n)))
#define lua_pushcfunction(L,f) lua_pushcclosure(L, f, 0)
#define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0)
#define lua_isfunction(L,n) (lua_type(L,n) == LUA_TFUNCTION)
#define lua_istable(L,n) (lua_type(L,n) == LUA_TTABLE)
#define lua_islightuserdata(L,n) (lua_type(L,n) == LUA_TLIGHTUSERDATA)
#define lua_isnil(L,n) (lua_type(L,n) == LUA_TNIL)
#define lua_isboolean(L,n) (lua_type(L,n) == LUA_TBOOLEAN)
#define lua_isnone(L,n) (lua_type(L,n) == LUA_TNONE)
#define lua_isnoneornil(L, n) (lua_type(L,n) <= 0)
#define lua_isfunction(L,n) (lua_type(L, (n)) == LUA_TFUNCTION)
#define lua_istable(L,n) (lua_type(L, (n)) == LUA_TTABLE)
#define lua_islightuserdata(L,n) (lua_type(L, (n)) == LUA_TLIGHTUSERDATA)
#define lua_isnil(L,n) (lua_type(L, (n)) == LUA_TNIL)
#define lua_isboolean(L,n) (lua_type(L, (n)) == LUA_TBOOLEAN)
#define lua_isthread(L,n) (lua_type(L, (n)) == LUA_TTHREAD)
#define lua_isnone(L,n) (lua_type(L, (n)) == LUA_TNONE)
#define lua_isnoneornil(L, n) (lua_type(L, (n)) <= 0)
#define lua_pushliteral(L, s) \
lua_pushlstring(L, "" s, (sizeof(s)/sizeof(char))-1)
#define lua_pushliteral(L, s) lua_pushstring(L, "" s)
#define lua_pushglobaltable(L) \
((void)lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS))
#define lua_tostring(L,i) lua_tolstring(L, (i), NULL)
#define lua_insert(L,idx) lua_rotate(L, (idx), 1)
#define lua_remove(L,idx) (lua_rotate(L, (idx), -1), lua_pop(L, 1))
#define lua_replace(L,idx) (lua_copy(L, -1, (idx)), lua_pop(L, 1))
/* }============================================================== */
/*
** {==============================================================
** compatibility macros
** ===============================================================
** compatibility macros and functions
*/
#define lua_newuserdata(L,s) lua_newuserdatauv(L,s,1)
#define lua_getuservalue(L,idx) lua_getiuservalue(L,idx,1)
#define lua_setuservalue(L,idx) lua_setiuservalue(L,idx,1)
#define lua_resetthread(L) lua_closethread(L,NULL)
LUA_API int lua_pushupvalues (lua_State *L);
#define lua_getregistry(L) lua_pushvalue(L, LUA_REGISTRYINDEX)
#define lua_setglobal(L,s) \
(lua_pushstring(L, s), lua_insert(L, -2), lua_settable(L, LUA_GLOBALSINDEX))
#define lua_getglobal(L,s) \
(lua_pushstring(L, s), lua_gettable(L, LUA_GLOBALSINDEX))
/* compatibility with ref system */
/* pre-defined references */
#define LUA_NOREF (-2)
#define LUA_REFNIL (-1)
#define lua_ref(L,lock) ((lock) ? luaL_ref(L, LUA_REGISTRYINDEX) : \
(lua_pushstring(L, "unlocked references are obsolete"), lua_error(L), 0))
#define lua_unref(L,ref) luaL_unref(L, LUA_REGISTRYINDEX, (ref))
#define lua_getref(L,ref) lua_rawgeti(L, LUA_REGISTRYINDEX, ref)
/*
** {======================================================================
** useful definitions for Lua kernel and libraries
** =======================================================================
*/
/* formats for Lua numbers */
#ifndef LUA_NUMBER_SCAN
#define LUA_NUMBER_SCAN "%lf"
#endif
#ifndef LUA_NUMBER_FMT
#define LUA_NUMBER_FMT "%.14g"
#endif
/* }====================================================================== */
/* }============================================================== */
/*
** {======================================================================
@ -455,7 +316,7 @@ LUA_API void (lua_closeslot) (lua_State *L, int idx);
#define LUA_HOOKRET 1
#define LUA_HOOKLINE 2
#define LUA_HOOKCOUNT 3
#define LUA_HOOKTAILCALL 4
#define LUA_HOOKTAILRET 4
/*
@ -466,62 +327,45 @@ LUA_API void (lua_closeslot) (lua_State *L, int idx);
#define LUA_MASKLINE (1 << LUA_HOOKLINE)
#define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT)
typedef struct lua_Debug lua_Debug; /* activation record */
LUA_API int (lua_getstack) (lua_State *L, int level, lua_Debug *ar);
LUA_API int (lua_getinfo) (lua_State *L, const char *what, lua_Debug *ar);
LUA_API const char *(lua_getlocal) (lua_State *L, const lua_Debug *ar, int n);
LUA_API const char *(lua_setlocal) (lua_State *L, const lua_Debug *ar, int n);
LUA_API const char *(lua_getupvalue) (lua_State *L, int funcindex, int n);
LUA_API const char *(lua_setupvalue) (lua_State *L, int funcindex, int n);
typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);
LUA_API void *(lua_upvalueid) (lua_State *L, int fidx, int n);
LUA_API void (lua_upvaluejoin) (lua_State *L, int fidx1, int n1,
int fidx2, int n2);
LUA_API void (lua_sethook) (lua_State *L, lua_Hook func, int mask, int count);
LUA_API lua_Hook (lua_gethook) (lua_State *L);
LUA_API int (lua_gethookmask) (lua_State *L);
LUA_API int (lua_gethookcount) (lua_State *L);
LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar);
LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar);
LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n);
LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n);
LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n);
LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n);
LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count);
LUA_API lua_Hook lua_gethook (lua_State *L);
LUA_API int lua_gethookmask (lua_State *L);
LUA_API int lua_gethookcount (lua_State *L);
#define LUA_IDSIZE 60
struct lua_Debug {
int event;
const char *name; /* (n) */
const char *namewhat; /* (n) 'global', 'local', 'field', 'method' */
const char *what; /* (S) 'Lua', 'C', 'main', 'tail' */
const char *namewhat; /* (n) `global', `local', `field', `method' */
const char *what; /* (S) `Lua', `C', `main', `tail' */
const char *source; /* (S) */
size_t srclen; /* (S) */
int currentline; /* (l) */
int nups; /* (u) number of upvalues */
int linedefined; /* (S) */
int lastlinedefined; /* (S) */
unsigned char nups; /* (u) number of upvalues */
unsigned char nparams;/* (u) number of parameters */
char isvararg; /* (u) */
unsigned char extraargs; /* (t) number of extra arguments */
char istailcall; /* (t) */
int ftransfer; /* (r) index of first value transferred */
int ntransfer; /* (r) number of transferred values */
char short_src[LUA_IDSIZE]; /* (S) */
/* private part */
struct CallInfo *i_ci; /* active function */
int i_ci; /* active function */
};
/* }====================================================================== */
#define LUAI_TOSTRAUX(x) #x
#define LUAI_TOSTR(x) LUAI_TOSTRAUX(x)
#define LUA_VERSION_MAJOR LUAI_TOSTR(LUA_VERSION_MAJOR_N)
#define LUA_VERSION_MINOR LUAI_TOSTR(LUA_VERSION_MINOR_N)
#define LUA_VERSION_RELEASE LUAI_TOSTR(LUA_VERSION_RELEASE_N)
#define LUA_VERSION "Lua " LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
#define LUA_RELEASE LUA_VERSION "." LUA_VERSION_RELEASE
/******************************************************************************
* Copyright (C) 1994-2026 Lua.org, PUC-Rio.
* Copyright (C) 1994-2006 Tecgraf, PUC-Rio. All rights reserved.
*
* Permission is hereby granted, free of charge, to any person obtaining
* a copy of this software and associated documentation files (the

10
lib/lua/lua.hpp
View File

@ -1,10 +0,0 @@
// lua.hpp
// Lua header files for C++
// 'extern "C" not supplied automatically in lua.h and other headers
// because Lua also compiles as C++
extern "C" {
#include "lua.h"
#include "lualib.h"
#include "lauxlib.h"
}

733
lib/lua/luac.c
View File

@ -1,733 +0,0 @@
/*
** $Id: luac.c $
** Lua compiler (saves bytecodes to files; also lists bytecodes)
** See Copyright Notice in lua.h
*/
#define luac_c
#define LUA_CORE
#include "lprefix.h"
#include <ctype.h>
#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "lua.h"
#include "lauxlib.h"
#include "lapi.h"
#include "ldebug.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lopnames.h"
#include "lstate.h"
#include "lundump.h"
static void PrintFunction(const Proto* f, int full);
#define luaU_print PrintFunction
#define PROGNAME "luac" /* default program name */
#define OUTPUT PROGNAME ".out" /* default output file */
static int listing=0; /* list bytecodes? */
static int dumping=1; /* dump bytecodes? */
static int stripping=0; /* strip debug information? */
static char Output[]={ OUTPUT }; /* default output file name */
static const char* output=Output; /* actual output file name */
static const char* progname=PROGNAME; /* actual program name */
static TString **tmname;
static void fatal(const char* message)
{
fprintf(stderr,"%s: %s\n",progname,message);
exit(EXIT_FAILURE);
}
static void cannot(const char* what)
{
fprintf(stderr,"%s: cannot %s %s: %s\n",progname,what,output,strerror(errno));
exit(EXIT_FAILURE);
}
static void usage(const char* message)
{
if (*message=='-')
fprintf(stderr,"%s: unrecognized option '%s'\n",progname,message);
else
fprintf(stderr,"%s: %s\n",progname,message);
fprintf(stderr,
"usage: %s [options] [filenames]\n"
"Available options are:\n"
" -l list (use -l -l for full listing)\n"
" -o name output to file 'name' (default is \"%s\")\n"
" -p parse only\n"
" -s strip debug information\n"
" -v show version information\n"
" -- stop handling options\n"
" - stop handling options and process stdin\n"
,progname,Output);
exit(EXIT_FAILURE);
}
#define IS(s) (strcmp(argv[i],s)==0)
static int doargs(int argc, char* argv[])
{
int i;
int version=0;
if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0];
for (i=1; i<argc; i++)
{
if (*argv[i]!='-') /* end of options; keep it */
break;
else if (IS("--")) /* end of options; skip it */
{
++i;
if (version) ++version;
break;
}
else if (IS("-")) /* end of options; use stdin */
break;
else if (IS("-l")) /* list */
++listing;
else if (IS("-o")) /* output file */
{
output=argv[++i];
if (output==NULL || *output==0 || (*output=='-' && output[1]!=0))
usage("'-o' needs argument");
if (IS("-")) output=NULL;
}
else if (IS("-p")) /* parse only */
dumping=0;
else if (IS("-s")) /* strip debug information */
stripping=1;
else if (IS("-v")) /* show version */
++version;
else /* unknown option */
usage(argv[i]);
}
if (i==argc && (listing || !dumping))
{
dumping=0;
argv[--i]=Output;
}
if (version)
{
printf("%s\n",LUA_COPYRIGHT);
if (version==argc-1) exit(EXIT_SUCCESS);
}
return i;
}
#define FUNCTION "(function()end)();\n"
static const char* reader(lua_State* L, void* ud, size_t* size)
{
UNUSED(L);
if ((*(int*)ud)--)
{
*size=sizeof(FUNCTION)-1;
return FUNCTION;
}
else
{
*size=0;
return NULL;
}
}
#define toproto(L,i) getproto(s2v(L->top.p+(i)))
static const Proto* combine(lua_State* L, int n)
{
if (n==1)
return toproto(L,-1);
else
{
Proto* f;
int i=n;
if (lua_load(L,reader,&i,"=(" PROGNAME ")",NULL)!=LUA_OK) fatal(lua_tostring(L,-1));
f=toproto(L,-1);
for (i=0; i<n; i++)
{
f->p[i]=toproto(L,i-n-1);
if (f->p[i]->sizeupvalues>0) f->p[i]->upvalues[0].instack=0;
}
return f;
}
}
static int writer(lua_State* L, const void* p, size_t size, void* u)
{
UNUSED(L);
return (fwrite(p,size,1,(FILE*)u)!=1) && (size!=0);
}
static int pmain(lua_State* L)
{
int argc=(int)lua_tointeger(L,1);
char** argv=(char**)lua_touserdata(L,2);
const Proto* f;
int i;
tmname=G(L)->tmname;
if (!lua_checkstack(L,argc)) fatal("too many input files");
for (i=0; i<argc; i++)
{
const char* filename=IS("-") ? NULL : argv[i];
if (luaL_loadfile(L,filename)!=LUA_OK) fatal(lua_tostring(L,-1));
}
f=combine(L,argc);
if (listing) luaU_print(f,listing>1);
if (dumping)
{
FILE* D= (output==NULL) ? stdout : fopen(output,"wb");
if (D==NULL) cannot("open");
lua_lock(L);
luaU_dump(L,f,writer,D,stripping);
lua_unlock(L);
if (ferror(D)) cannot("write");
if (fclose(D)) cannot("close");
}
return 0;
}
int main(int argc, char* argv[])
{
lua_State* L;
int i=doargs(argc,argv);
argc-=i; argv+=i;
if (argc<=0) usage("no input files given");
L=luaL_newstate();
if (L==NULL) fatal("cannot create state: not enough memory");
lua_pushcfunction(L,&pmain);
lua_pushinteger(L,argc);
lua_pushlightuserdata(L,argv);
if (lua_pcall(L,2,0,0)!=LUA_OK) fatal(lua_tostring(L,-1));
lua_close(L);
return EXIT_SUCCESS;
}
/*
** print bytecodes
*/
#define UPVALNAME(x) ((f->upvalues[x].name) ? getstr(f->upvalues[x].name) : "-")
#define VOID(p) ((const void*)(p))
#define eventname(i) (getstr(tmname[i]))
static void PrintString(const TString* ts)
{
const char* s=getstr(ts);
size_t i,n=tsslen(ts);
printf("\"");
for (i=0; i<n; i++)
{
int c=(int)(unsigned char)s[i];
switch (c)
{
case '"':
printf("\\\"");
break;
case '\\':
printf("\\\\");
break;
case '\a':
printf("\\a");
break;
case '\b':
printf("\\b");
break;
case '\f':
printf("\\f");
break;
case '\n':
printf("\\n");
break;
case '\r':
printf("\\r");
break;
case '\t':
printf("\\t");
break;
case '\v':
printf("\\v");
break;
default:
if (isprint(c)) printf("%c",c); else printf("\\%03d",c);
break;
}
}
printf("\"");
}
static void PrintType(const Proto* f, int i)
{
const TValue* o=&f->k[i];
switch (ttypetag(o))
{
case LUA_VNIL:
printf("N");
break;
case LUA_VFALSE:
case LUA_VTRUE:
printf("B");
break;
case LUA_VNUMFLT:
printf("F");
break;
case LUA_VNUMINT:
printf("I");
break;
case LUA_VSHRSTR:
case LUA_VLNGSTR:
printf("S");
break;
default: /* cannot happen */
printf("?%d",ttypetag(o));
break;
}
printf("\t");
}
static void PrintConstant(const Proto* f, int i)
{
const TValue* o=&f->k[i];
switch (ttypetag(o))
{
case LUA_VNIL:
printf("nil");
break;
case LUA_VFALSE:
printf("false");
break;
case LUA_VTRUE:
printf("true");
break;
case LUA_VNUMFLT:
{
char buff[100];
sprintf(buff,LUA_NUMBER_FMT,fltvalue(o));
printf("%s",buff);
if (buff[strspn(buff,"-0123456789")]=='\0') printf(".0");
break;
}
case LUA_VNUMINT:
printf(LUA_INTEGER_FMT,ivalue(o));
break;
case LUA_VSHRSTR:
case LUA_VLNGSTR:
PrintString(tsvalue(o));
break;
default: /* cannot happen */
printf("?%d",ttypetag(o));
break;
}
}
#define COMMENT "\t; "
#define EXTRAARG GETARG_Ax(code[pc+1])
#define EXTRAARGC (EXTRAARG*(MAXARG_C+1))
#define ISK (isk ? "k" : "")
static void PrintCode(const Proto* f)
{
const Instruction* code=f->code;
int pc,n=f->sizecode;
for (pc=0; pc<n; pc++)
{
Instruction i=code[pc];
OpCode o=GET_OPCODE(i);
int a=GETARG_A(i);
int b=GETARG_B(i);
int c=GETARG_C(i);
int ax=GETARG_Ax(i);
int bx=GETARG_Bx(i);
int sb=GETARG_sB(i);
int sc=GETARG_sC(i);
int vb=GETARG_vB(i);
int vc=GETARG_vC(i);
int sbx=GETARG_sBx(i);
int isk=GETARG_k(i);
int line=luaG_getfuncline(f,pc);
printf("\t%d\t",pc+1);
if (line>0) printf("[%d]\t",line); else printf("[-]\t");
printf("%-9s\t",opnames[o]);
switch (o)
{
case OP_MOVE:
printf("%d %d",a,b);
break;
case OP_LOADI:
printf("%d %d",a,sbx);
break;
case OP_LOADF:
printf("%d %d",a,sbx);
break;
case OP_LOADK:
printf("%d %d",a,bx);
printf(COMMENT); PrintConstant(f,bx);
break;
case OP_LOADKX:
printf("%d",a);
printf(COMMENT); PrintConstant(f,EXTRAARG);
break;
case OP_LOADFALSE:
printf("%d",a);
break;
case OP_LFALSESKIP:
printf("%d",a);
break;
case OP_LOADTRUE:
printf("%d",a);
break;
case OP_LOADNIL:
printf("%d %d",a,b);
printf(COMMENT "%d out",b+1);
break;
case OP_GETUPVAL:
printf("%d %d",a,b);
printf(COMMENT "%s",UPVALNAME(b));
break;
case OP_SETUPVAL:
printf("%d %d",a,b);
printf(COMMENT "%s",UPVALNAME(b));
break;
case OP_GETTABUP:
printf("%d %d %d",a,b,c);
printf(COMMENT "%s",UPVALNAME(b));
printf(" "); PrintConstant(f,c);
break;
case OP_GETTABLE:
printf("%d %d %d",a,b,c);
break;
case OP_GETI:
printf("%d %d %d",a,b,c);
break;
case OP_GETFIELD:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_SETTABUP:
printf("%d %d %d%s",a,b,c,ISK);
printf(COMMENT "%s",UPVALNAME(a));
printf(" "); PrintConstant(f,b);
if (isk) { printf(" "); PrintConstant(f,c); }
break;
case OP_SETTABLE:
printf("%d %d %d%s",a,b,c,ISK);
if (isk) { printf(COMMENT); PrintConstant(f,c); }
break;
case OP_SETI:
printf("%d %d %d%s",a,b,c,ISK);
if (isk) { printf(COMMENT); PrintConstant(f,c); }
break;
case OP_SETFIELD:
printf("%d %d %d%s",a,b,c,ISK);
printf(COMMENT); PrintConstant(f,b);
if (isk) { printf(" "); PrintConstant(f,c); }
break;
case OP_NEWTABLE:
printf("%d %d %d%s",a,vb,vc,ISK);
printf(COMMENT "%d",vc+EXTRAARGC);
break;
case OP_SELF:
printf("%d %d %d%s",a,b,c,ISK);
if (isk) { printf(COMMENT); PrintConstant(f,c); }
break;
case OP_ADDI:
printf("%d %d %d",a,b,sc);
break;
case OP_ADDK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_SUBK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_MULK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_MODK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_POWK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_DIVK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_IDIVK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_BANDK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_BORK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_BXORK:
printf("%d %d %d",a,b,c);
printf(COMMENT); PrintConstant(f,c);
break;
case OP_SHLI:
printf("%d %d %d",a,b,sc);
break;
case OP_SHRI:
printf("%d %d %d",a,b,sc);
break;
case OP_ADD:
printf("%d %d %d",a,b,c);
break;
case OP_SUB:
printf("%d %d %d",a,b,c);
break;
case OP_MUL:
printf("%d %d %d",a,b,c);
break;
case OP_MOD:
printf("%d %d %d",a,b,c);
break;
case OP_POW:
printf("%d %d %d",a,b,c);
break;
case OP_DIV:
printf("%d %d %d",a,b,c);
break;
case OP_IDIV:
printf("%d %d %d",a,b,c);
break;
case OP_BAND:
printf("%d %d %d",a,b,c);
break;
case OP_BOR:
printf("%d %d %d",a,b,c);
break;
case OP_BXOR:
printf("%d %d %d",a,b,c);
break;
case OP_SHL:
printf("%d %d %d",a,b,c);
break;
case OP_SHR:
printf("%d %d %d",a,b,c);
break;
case OP_MMBIN:
printf("%d %d %d",a,b,c);
printf(COMMENT "%s",eventname(c));
break;
case OP_MMBINI:
printf("%d %d %d %d",a,sb,c,isk);
printf(COMMENT "%s",eventname(c));
if (isk) printf(" flip");
break;
case OP_MMBINK:
printf("%d %d %d %d",a,b,c,isk);
printf(COMMENT "%s ",eventname(c)); PrintConstant(f,b);
if (isk) printf(" flip");
break;
case OP_UNM:
printf("%d %d",a,b);
break;
case OP_BNOT:
printf("%d %d",a,b);
break;
case OP_NOT:
printf("%d %d",a,b);
break;
case OP_LEN:
printf("%d %d",a,b);
break;
case OP_CONCAT:
printf("%d %d",a,b);
break;
case OP_CLOSE:
printf("%d",a);
break;
case OP_TBC:
printf("%d",a);
break;
case OP_JMP:
printf("%d",GETARG_sJ(i));
printf(COMMENT "to %d",GETARG_sJ(i)+pc+2);
break;
case OP_EQ:
printf("%d %d %d",a,b,isk);
break;
case OP_LT:
printf("%d %d %d",a,b,isk);
break;
case OP_LE:
printf("%d %d %d",a,b,isk);
break;
case OP_EQK:
printf("%d %d %d",a,b,isk);
printf(COMMENT); PrintConstant(f,b);
break;
case OP_EQI:
printf("%d %d %d",a,sb,isk);
break;
case OP_LTI:
printf("%d %d %d",a,sb,isk);
break;
case OP_LEI:
printf("%d %d %d",a,sb,isk);
break;
case OP_GTI:
printf("%d %d %d",a,sb,isk);
break;
case OP_GEI:
printf("%d %d %d",a,sb,isk);
break;
case OP_TEST:
printf("%d %d",a,isk);
break;
case OP_TESTSET:
printf("%d %d %d",a,b,isk);
break;
case OP_CALL:
printf("%d %d %d",a,b,c);
printf(COMMENT);
if (b==0) printf("all in "); else printf("%d in ",b-1);
if (c==0) printf("all out"); else printf("%d out",c-1);
break;
case OP_TAILCALL:
printf("%d %d %d%s",a,b,c,ISK);
printf(COMMENT "%d in",b-1);
break;
case OP_RETURN:
printf("%d %d %d%s",a,b,c,ISK);
printf(COMMENT);
if (b==0) printf("all out"); else printf("%d out",b-1);
break;
case OP_RETURN0:
break;
case OP_RETURN1:
printf("%d",a);
break;
case OP_FORLOOP:
printf("%d %d",a,bx);
printf(COMMENT "to %d",pc-bx+2);
break;
case OP_FORPREP:
printf("%d %d",a,bx);
printf(COMMENT "exit to %d",pc+bx+3);
break;
case OP_TFORPREP:
printf("%d %d",a,bx);
printf(COMMENT "to %d",pc+bx+2);
break;
case OP_TFORCALL:
printf("%d %d",a,c);
break;
case OP_TFORLOOP:
printf("%d %d",a,bx);
printf(COMMENT "to %d",pc-bx+2);
break;
case OP_SETLIST:
printf("%d %d %d%s",a,vb,vc,ISK);
if (isk) printf(COMMENT "%d",c+EXTRAARGC);
break;
case OP_CLOSURE:
printf("%d %d",a,bx);
printf(COMMENT "%p",VOID(f->p[bx]));
break;
case OP_VARARG:
printf("%d %d %d%s",a,b,c,ISK);
printf(COMMENT);
if (c==0) printf("all out"); else printf("%d out",c-1);
break;
case OP_GETVARG:
printf("%d %d %d",a,b,c);
break;
case OP_ERRNNIL:
printf("%d %d",a,bx);
printf(COMMENT);
if (bx==0) printf("?"); else PrintConstant(f,bx-1);
break;
case OP_VARARGPREP:
printf("%d",a);
break;
case OP_EXTRAARG:
printf("%d",ax);
break;
#if 0
default:
printf("%d %d %d",a,b,c);
printf(COMMENT "not handled");
break;
#endif
}
printf("\n");
}
}
#define SS(x) ((x==1)?"":"s")
#define S(x) (int)(x),SS(x)
static void PrintHeader(const Proto* f)
{
const char* s=f->source ? getstr(f->source) : "=?";
if (*s=='@' || *s=='=')
s++;
else if (*s==LUA_SIGNATURE[0])
s="(bstring)";
else
s="(string)";
printf("\n%s <%s:%d,%d> (%d instruction%s at %p)\n",
(f->linedefined==0)?"main":"function",s,
f->linedefined,f->lastlinedefined,
S(f->sizecode),VOID(f));
printf("%d%s param%s, %d slot%s, %d upvalue%s, ",
(int)(f->numparams),isvararg(f)?"+":"",SS(f->numparams),
S(f->maxstacksize),S(f->sizeupvalues));
printf("%d local%s, %d constant%s, %d function%s\n",
S(f->sizelocvars),S(f->sizek),S(f->sizep));
}
static void PrintDebug(const Proto* f)
{
int i,n;
n=f->sizek;
printf("constants (%d) for %p:\n",n,VOID(f));
for (i=0; i<n; i++)
{
printf("\t%d\t",i);
PrintType(f,i);
PrintConstant(f,i);
printf("\n");
}
n=f->sizelocvars;
printf("locals (%d) for %p:\n",n,VOID(f));
for (i=0; i<n; i++)
{
printf("\t%d\t%s\t%d\t%d\n",
i,getstr(f->locvars[i].varname),f->locvars[i].startpc+1,f->locvars[i].endpc+1);
}
n=f->sizeupvalues;
printf("upvalues (%d) for %p:\n",n,VOID(f));
for (i=0; i<n; i++)
{
printf("\t%d\t%s\t%d\t%d\n",
i,UPVALNAME(i),f->upvalues[i].instack,f->upvalues[i].idx);
}
}
static void PrintFunction(const Proto* f, int full)
{
int i,n=f->sizep;
PrintHeader(f);
PrintCode(f);
if (full) PrintDebug(f);
for (i=0; i<n; i++) PrintFunction(f->p[i],full);
}

756
lib/lua/luaconf.h
View File

@ -1,756 +0,0 @@
/*
** $Id: luaconf.h $
** Configuration file for Lua
** See Copyright Notice in lua.h
*/
#ifndef luaconf_h
#define luaconf_h
#include <limits.h>
#include <stddef.h>
/*
** ===================================================================
** General Configuration File for Lua
**
** Some definitions here can be changed externally, through the compiler
** (e.g., with '-D' options): They are commented out or protected
** by '#if !defined' guards. However, several other definitions
** should be changed directly here, either because they affect the
** Lua ABI (by making the changes here, you ensure that all software
** connected to Lua, such as C libraries, will be compiled with the same
** configuration); or because they are seldom changed.
**
** Search for "@@" to find all configurable definitions.
** ===================================================================
*/
/*
** {====================================================================
** System Configuration: macros to adapt (if needed) Lua to some
** particular platform, for instance restricting it to C89.
** =====================================================================
*/
/*
@@ LUA_USE_C89 controls the use of non-ISO-C89 features.
** Define it if you want Lua to avoid the use of a few C99 features
** or Windows-specific features on Windows.
*/
/* #define LUA_USE_C89 */
/*
** By default, Lua on Windows use (some) specific Windows features
*/
#if !defined(LUA_USE_C89) && defined(_WIN32) && !defined(_WIN32_WCE)
#define LUA_USE_WINDOWS /* enable goodies for regular Windows */
#endif
#if defined(LUA_USE_WINDOWS)
#define LUA_DL_DLL /* enable support for DLL */
#define LUA_USE_C89 /* broadly, Windows is C89 */
#endif
/*
** When POSIX DLL ('LUA_USE_DLOPEN') is enabled, the Lua stand-alone
** application will try to dynamically link a 'readline' facility
** for its REPL. In that case, LUA_READLINELIB is the name of the
** library it will look for those facilities. If lua.c cannot open
** the specified library, it will generate a warning and then run
** without 'readline'. If that macro is not defined, lua.c will not
** use 'readline'.
*/
#if defined(LUA_USE_LINUX)
#define LUA_USE_POSIX
#define LUA_USE_DLOPEN /* needs an extra library: -ldl */
#if !defined(LUA_READLINELIB)
#define LUA_READLINELIB "libreadline.so"
#endif
#endif
#if defined(LUA_USE_MACOSX)
#define LUA_USE_POSIX
#define LUA_USE_DLOPEN /* macOS does not need -ldl */
#define LUA_USE_READLINE /* needs an extra library: -lreadline */
#endif
#if defined(LUA_USE_IOS)
#define LUA_USE_POSIX
#define LUA_USE_DLOPEN
#endif
#if defined(LUA_USE_C89) && defined(LUA_USE_POSIX)
#error "POSIX is not compatible with C89"
#endif
/*
@@ LUAI_IS32INT is true iff 'int' has (at least) 32 bits.
*/
#define LUAI_IS32INT ((UINT_MAX >> 30) >= 3)
/* }================================================================== */
/*
** {==================================================================
** Configuration for Number types. These options should not be
** set externally, because any other code connected to Lua must
** use the same configuration.
** ===================================================================
*/
/*
@@ LUA_INT_TYPE defines the type for Lua integers.
@@ LUA_FLOAT_TYPE defines the type for Lua floats.
** Lua should work fine with any mix of these options supported
** by your C compiler. The usual configurations are 64-bit integers
** and 'double' (the default), 32-bit integers and 'float' (for
** restricted platforms), and 'long'/'double' (for C compilers not
** compliant with C99, which may not have support for 'long long').
*/
/* predefined options for LUA_INT_TYPE */
#define LUA_INT_INT 1
#define LUA_INT_LONG 2
#define LUA_INT_LONGLONG 3
/* predefined options for LUA_FLOAT_TYPE */
#define LUA_FLOAT_FLOAT 1
#define LUA_FLOAT_DOUBLE 2
#define LUA_FLOAT_LONGDOUBLE 3
/* Default configuration ('long long' and 'double', for 64-bit Lua) */
#define LUA_INT_DEFAULT LUA_INT_LONGLONG
#define LUA_FLOAT_DEFAULT LUA_FLOAT_DOUBLE
/*
@@ LUA_32BITS enables Lua with 32-bit integers and 32-bit floats.
*/
/* #define LUA_32BITS */
/*
@@ LUA_C89_NUMBERS ensures that Lua uses the largest types available for
** C89 ('long' and 'double'); Windows always has '__int64', so it does
** not need to use this case.
*/
#if defined(LUA_USE_C89) && !defined(LUA_USE_WINDOWS)
#define LUA_C89_NUMBERS 1
#else
#define LUA_C89_NUMBERS 0
#endif
#if defined(LUA_32BITS) /* { */
/*
** 32-bit integers and 'float'
*/
#if LUAI_IS32INT /* use 'int' if big enough */
#define LUA_INT_TYPE LUA_INT_INT
#else /* otherwise use 'long' */
#define LUA_INT_TYPE LUA_INT_LONG
#endif
#define LUA_FLOAT_TYPE LUA_FLOAT_FLOAT
#elif LUA_C89_NUMBERS /* }{ */
/*
** largest types available for C89 ('long' and 'double')
*/
#define LUA_INT_TYPE LUA_INT_LONG
#define LUA_FLOAT_TYPE LUA_FLOAT_DOUBLE
#else /* }{ */
/* use defaults */
#define LUA_INT_TYPE LUA_INT_DEFAULT
#define LUA_FLOAT_TYPE LUA_FLOAT_DEFAULT
#endif /* } */
/* }================================================================== */
/*
** {==================================================================
** Configuration for Paths.
** ===================================================================
*/
/*
** LUA_PATH_SEP is the character that separates templates in a path.
** LUA_PATH_MARK is the string that marks the substitution points in a
** template.
** LUA_EXEC_DIR in a Windows path is replaced by the executable's
** directory.
*/
#define LUA_PATH_SEP ";"
#define LUA_PATH_MARK "?"
#define LUA_EXEC_DIR "!"
/*
@@ LUA_PATH_DEFAULT is the default path that Lua uses to look for
** Lua libraries.
@@ LUA_CPATH_DEFAULT is the default path that Lua uses to look for
** C libraries.
** CHANGE them if your machine has a non-conventional directory
** hierarchy or if you want to install your libraries in
** non-conventional directories.
*/
#define LUA_VDIR LUA_VERSION_MAJOR "." LUA_VERSION_MINOR
#if defined(_WIN32) /* { */
/*
** In Windows, any exclamation mark ('!') in the path is replaced by the
** path of the directory of the executable file of the current process.
*/
#define LUA_LDIR "!\\lua\\"
#define LUA_CDIR "!\\"
#define LUA_SHRDIR "!\\..\\share\\lua\\" LUA_VDIR "\\"
#if !defined(LUA_PATH_DEFAULT)
#define LUA_PATH_DEFAULT \
LUA_LDIR "?.lua;" LUA_LDIR "?\\init.lua;" \
LUA_CDIR "?.lua;" LUA_CDIR "?\\init.lua;" \
LUA_SHRDIR "?.lua;" LUA_SHRDIR "?\\init.lua;" \
".\\?.lua;" ".\\?\\init.lua"
#endif
#if !defined(LUA_CPATH_DEFAULT)
#define LUA_CPATH_DEFAULT \
LUA_CDIR "?.dll;" \
LUA_CDIR "..\\lib\\lua\\" LUA_VDIR "\\?.dll;" \
LUA_CDIR "loadall.dll;" ".\\?.dll"
#endif
#else /* }{ */
#define LUA_ROOT "/usr/local/"
#define LUA_LDIR LUA_ROOT "share/lua/" LUA_VDIR "/"
#define LUA_CDIR LUA_ROOT "lib/lua/" LUA_VDIR "/"
#if !defined(LUA_PATH_DEFAULT)
#define LUA_PATH_DEFAULT \
LUA_LDIR "?.lua;" LUA_LDIR "?/init.lua;" \
LUA_CDIR "?.lua;" LUA_CDIR "?/init.lua;" \
"./?.lua;" "./?/init.lua"
#endif
#if !defined(LUA_CPATH_DEFAULT)
#define LUA_CPATH_DEFAULT \
LUA_CDIR "?.so;" LUA_CDIR "loadall.so;" "./?.so"
#endif
#endif /* } */
/*
@@ LUA_DIRSEP is the directory separator (for submodules).
** CHANGE it if your machine does not use "/" as the directory separator
** and is not Windows. (On Windows Lua automatically uses "\".)
*/
#if !defined(LUA_DIRSEP)
#if defined(_WIN32)
#define LUA_DIRSEP "\\"
#else
#define LUA_DIRSEP "/"
#endif
#endif
/*
** LUA_IGMARK is a mark to ignore all after it when building the
** module name (e.g., used to build the luaopen_ function name).
** Typically, the suffix after the mark is the module version,
** as in "mod-v1.2.so".
*/
#define LUA_IGMARK "-"
/* }================================================================== */
/*
** {==================================================================
** Marks for exported symbols in the C code
** ===================================================================
*/
/*
@@ LUA_API is a mark for all core API functions.
@@ LUALIB_API is a mark for all auxiliary library functions.
@@ LUAMOD_API is a mark for all standard library opening functions.
** CHANGE them if you need to define those functions in some special way.
** For instance, if you want to create one Windows DLL with the core and
** the libraries, you may want to use the following definition (define
** LUA_BUILD_AS_DLL to get it).
*/
#if defined(LUA_BUILD_AS_DLL) /* { */
#if defined(LUA_CORE) || defined(LUA_LIB) /* { */
#define LUA_API __declspec(dllexport)
#else /* }{ */
#define LUA_API __declspec(dllimport)
#endif /* } */
#else /* }{ */
#define LUA_API extern
#endif /* } */
/*
** More often than not the libs go together with the core.
*/
#define LUALIB_API LUA_API
#if defined(__cplusplus)
/* Lua uses the "C name" when calling open functions */
#define LUAMOD_API extern "C"
#else
#define LUAMOD_API LUA_API
#endif
/* }================================================================== */
/*
** {==================================================================
** Compatibility with previous versions
** ===================================================================
*/
/*
@@ LUA_COMPAT_GLOBAL avoids 'global' being a reserved word
*/
#if !defined(LUA_COMPAT_GLOBAL)
#define LUA_COMPAT_GLOBAL 1
#endif
/*
@@ LUA_COMPAT_MATHLIB controls the presence of several deprecated
** functions in the mathematical library.
** (These functions were already officially removed in 5.3;
** nevertheless they are still available here.)
*/
/* #define LUA_COMPAT_MATHLIB */
/*
@@ The following macros supply trivial compatibility for some
** changes in the API. The macros themselves document how to
** change your code to avoid using them.
** (Once more, these macros were officially removed in 5.3, but they are
** still available here.)
*/
#define lua_strlen(L,i) lua_rawlen(L, (i))
#define lua_objlen(L,i) lua_rawlen(L, (i))
#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)
#define lua_lessthan(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPLT)
/* }================================================================== */
/*
** {==================================================================
** Configuration for Numbers (low-level part).
** Change these definitions if no predefined LUA_FLOAT_* / LUA_INT_*
** satisfy your needs.
** ===================================================================
*/
/*
@@ LUAI_UACNUMBER is the result of a 'default argument promotion'
@@ over a floating number.
@@ l_floatatt(x) corrects float attribute 'x' to the proper float type
** by prefixing it with one of FLT/DBL/LDBL.
@@ LUA_NUMBER_FRMLEN is the length modifier for writing floats.
@@ LUA_NUMBER_FMT is the format for writing floats with the maximum
** number of digits that respects tostring(tonumber(numeral)) == numeral.
** (That would be floor(log10(2^n)), where n is the number of bits in
** the float mantissa.)
@@ LUA_NUMBER_FMT_N is the format for writing floats with the minimum
** number of digits that ensures tonumber(tostring(number)) == number.
** (That would be LUA_NUMBER_FMT+2.)
@@ l_mathop allows the addition of an 'l' or 'f' to all math operations.
@@ l_floor takes the floor of a float.
@@ lua_str2number converts a decimal numeral to a number.
*/
/* The following definition is good for most cases here */
#define l_floor(x) (l_mathop(floor)(x))
/* now the variable definitions */
#if LUA_FLOAT_TYPE == LUA_FLOAT_FLOAT /* { single float */
#define LUA_NUMBER float
#define l_floatatt(n) (FLT_##n)
#define LUAI_UACNUMBER double
#define LUA_NUMBER_FRMLEN ""
#define LUA_NUMBER_FMT "%.7g"
#define LUA_NUMBER_FMT_N "%.9g"
#define l_mathop(op) op##f
#define lua_str2number(s,p) strtof((s), (p))
#elif LUA_FLOAT_TYPE == LUA_FLOAT_LONGDOUBLE /* }{ long double */
#define LUA_NUMBER long double
#define l_floatatt(n) (LDBL_##n)
#define LUAI_UACNUMBER long double
#define LUA_NUMBER_FRMLEN "L"
#define LUA_NUMBER_FMT "%.19Lg"
#define LUA_NUMBER_FMT_N "%.21Lg"
#define l_mathop(op) op##l
#define lua_str2number(s,p) strtold((s), (p))
#elif LUA_FLOAT_TYPE == LUA_FLOAT_DOUBLE /* }{ double */
#define LUA_NUMBER double
#define l_floatatt(n) (DBL_##n)
#define LUAI_UACNUMBER double
#define LUA_NUMBER_FRMLEN ""
#define LUA_NUMBER_FMT "%.15g"
#define LUA_NUMBER_FMT_N "%.17g"
#define l_mathop(op) op
#define lua_str2number(s,p) strtod((s), (p))
#else /* }{ */
#error "numeric float type not defined"
#endif /* } */
/*
@@ LUA_UNSIGNED is the unsigned version of LUA_INTEGER.
@@ LUAI_UACINT is the result of a 'default argument promotion'
@@ over a LUA_INTEGER.
@@ LUA_INTEGER_FRMLEN is the length modifier for reading/writing integers.
@@ LUA_INTEGER_FMT is the format for writing integers.
@@ LUA_MAXINTEGER is the maximum value for a LUA_INTEGER.
@@ LUA_MININTEGER is the minimum value for a LUA_INTEGER.
@@ LUA_MAXUNSIGNED is the maximum value for a LUA_UNSIGNED.
@@ lua_integer2str converts an integer to a string.
*/
/* The following definitions are good for most cases here */
#define LUA_INTEGER_FMT "%" LUA_INTEGER_FRMLEN "d"
#define LUAI_UACINT LUA_INTEGER
#define lua_integer2str(s,sz,n) \
l_sprintf((s), sz, LUA_INTEGER_FMT, (LUAI_UACINT)(n))
/*
** use LUAI_UACINT here to avoid problems with promotions (which
** can turn a comparison between unsigneds into a signed comparison)
*/
#define LUA_UNSIGNED unsigned LUAI_UACINT
/* now the variable definitions */
#if LUA_INT_TYPE == LUA_INT_INT /* { int */
#define LUA_INTEGER int
#define LUA_INTEGER_FRMLEN ""
#define LUA_MAXINTEGER INT_MAX
#define LUA_MININTEGER INT_MIN
#define LUA_MAXUNSIGNED UINT_MAX
#elif LUA_INT_TYPE == LUA_INT_LONG /* }{ long */
#define LUA_INTEGER long
#define LUA_INTEGER_FRMLEN "l"
#define LUA_MAXINTEGER LONG_MAX
#define LUA_MININTEGER LONG_MIN
#define LUA_MAXUNSIGNED ULONG_MAX
#elif LUA_INT_TYPE == LUA_INT_LONGLONG /* }{ long long */
/* use presence of macro LLONG_MAX as proxy for C99 compliance */
#if defined(LLONG_MAX) /* { */
/* use ISO C99 stuff */
#define LUA_INTEGER long long
#define LUA_INTEGER_FRMLEN "ll"
#define LUA_MAXINTEGER LLONG_MAX
#define LUA_MININTEGER LLONG_MIN
#define LUA_MAXUNSIGNED ULLONG_MAX
#elif defined(LUA_USE_WINDOWS) /* }{ */
/* in Windows, can use specific Windows types */
#define LUA_INTEGER __int64
#define LUA_INTEGER_FRMLEN "I64"
#define LUA_MAXINTEGER _I64_MAX
#define LUA_MININTEGER _I64_MIN
#define LUA_MAXUNSIGNED _UI64_MAX
#else /* }{ */
#error "Compiler does not support 'long long'. Use option '-DLUA_32BITS' \
or '-DLUA_C89_NUMBERS' (see file 'luaconf.h' for details)"
#endif /* } */
#else /* }{ */
#error "numeric integer type not defined"
#endif /* } */
/* }================================================================== */
/*
** {==================================================================
** Dependencies with C99 and other C details
** ===================================================================
*/
/*
@@ l_sprintf is equivalent to 'snprintf' or 'sprintf' in C89.
** (All uses in Lua have only one format item.)
*/
#if !defined(LUA_USE_C89)
#define l_sprintf(s,sz,f,i) snprintf(s,sz,f,i)
#else
#define l_sprintf(s,sz,f,i) ((void)(sz), sprintf(s,f,i))
#endif
/*
@@ lua_strx2number converts a hexadecimal numeral to a number.
** In C99, 'strtod' does that conversion. Otherwise, you can
** leave 'lua_strx2number' undefined and Lua will provide its own
** implementation.
*/
#if !defined(LUA_USE_C89)
#define lua_strx2number(s,p) lua_str2number(s,p)
#endif
/*
@@ lua_pointer2str converts a pointer to a readable string in a
** non-specified way.
*/
#define lua_pointer2str(buff,sz,p) l_sprintf(buff,sz,"%p",p)
/*
@@ lua_number2strx converts a float to a hexadecimal numeral.
** In C99, 'sprintf' (with format specifiers '%a'/'%A') does that.
** Otherwise, you can leave 'lua_number2strx' undefined and Lua will
** provide its own implementation.
*/
#if !defined(LUA_USE_C89)
#define lua_number2strx(L,b,sz,f,n) \
((void)L, l_sprintf(b,sz,f,(LUAI_UACNUMBER)(n)))
#endif
/*
** 'strtof' and 'opf' variants for math functions are not valid in
** C89. Otherwise, the macro 'HUGE_VALF' is a good proxy for testing the
** availability of these variants. ('math.h' is already included in
** all files that use these macros.)
*/
#if defined(LUA_USE_C89) || (defined(HUGE_VAL) && !defined(HUGE_VALF))
#undef l_mathop /* variants not available */
#undef lua_str2number
#define l_mathop(op) (lua_Number)op /* no variant */
#define lua_str2number(s,p) ((lua_Number)strtod((s), (p)))
#endif
/*
@@ LUA_KCONTEXT is the type of the context ('ctx') for continuation
** functions. It must be a numerical type; Lua will use 'intptr_t' if
** available, otherwise it will use 'ptrdiff_t' (the nearest thing to
** 'intptr_t' in C89)
*/
#define LUA_KCONTEXT ptrdiff_t
#if !defined(LUA_USE_C89) && defined(__STDC_VERSION__) && \
__STDC_VERSION__ >= 199901L
#include <stdint.h>
#if defined(INTPTR_MAX) /* even in C99 this type is optional */
#undef LUA_KCONTEXT
#define LUA_KCONTEXT intptr_t
#endif
#endif
/*
@@ lua_getlocaledecpoint gets the locale "radix character" (decimal point).
** Change that if you do not want to use C locales. (Code using this
** macro must include the header 'locale.h'.)
*/
#if !defined(lua_getlocaledecpoint)
#define lua_getlocaledecpoint() (localeconv()->decimal_point[0])
#endif
/*
** macros to improve jump prediction, used mostly for error handling
** and debug facilities. (Some macros in the Lua API use these macros.
** Define LUA_NOBUILTIN if you do not want '__builtin_expect' in your
** code.)
*/
#if !defined(luai_likely)
#if !defined(LUA_NOBUILTIN) && defined(__GNUC__) && (__GNUC__ >= 3)
#define luai_likely(x) (__builtin_expect(((x) != 0), 1))
#define luai_unlikely(x) (__builtin_expect(((x) != 0), 0))
#else
#define luai_likely(x) (x)
#define luai_unlikely(x) (x)
#endif
#endif
/* }================================================================== */
/*
** {==================================================================
** Language Variations
** =====================================================================
*/
/*
@@ LUA_NOCVTN2S/LUA_NOCVTS2N control how Lua performs some
** coercions. Define LUA_NOCVTN2S to turn off automatic coercion from
** numbers to strings. Define LUA_NOCVTS2N to turn off automatic
** coercion from strings to numbers.
*/
/* #define LUA_NOCVTN2S */
/* #define LUA_NOCVTS2N */
/*
@@ LUA_USE_APICHECK turns on several consistency checks on the C API.
** Define it as a help when debugging C code.
*/
/* #define LUA_USE_APICHECK */
/* }================================================================== */
/*
** {==================================================================
** Macros that affect the API and must be stable (that is, must be the
** same when you compile Lua and when you compile code that links to
** Lua).
** =====================================================================
*/
/*
@@ LUA_EXTRASPACE defines the size of a raw memory area associated with
** a Lua state with very fast access.
** CHANGE it if you need a different size.
*/
#define LUA_EXTRASPACE (272)
/*
@@ LUA_IDSIZE gives the maximum size for the description of the source
** of a function in debug information.
** CHANGE it if you want a different size.
*/
#define LUA_IDSIZE 60
/*
@@ LUAL_BUFFERSIZE is the initial buffer size used by the lauxlib
** buffer system.
*/
#define LUAL_BUFFERSIZE ((int)(16 * sizeof(void*) * sizeof(lua_Number)))
/*
@@ LUAI_MAXALIGN defines fields that ensure proper alignment for
** memory areas offered by Lua (e.g., userdata memory).
** Add fields to it if you need alignment for non-ISO objects.
*/
#if defined(LLONG_MAX)
/* use ISO C99 stuff */
#define LUAI_MAXALIGN long double u; void *s; long long l
#else
/* use only C89 stuff */
#define LUAI_MAXALIGN lua_Number n; double u; void *s; lua_Integer i; long l
#endif
/* }================================================================== */
/* =================================================================== */
/*
** Local configuration. You can use this space to add your redefinitions
** without modifying the main part of the file.
*/
#endif

73
lib/lua/lualib.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lualib.h $
** $Id: lualib.h,v 1.28 2003/03/18 12:24:26 roberto Exp $
** Lua standard libraries
** See Copyright Notice in lua.h
*/
@ -11,55 +11,46 @@
#include "lua.h"
/* version suffix for environment variable names */
#define LUA_VERSUFFIX "_" LUA_VERSION_MAJOR "_" LUA_VERSION_MINOR
#define LUA_GLIBK 1
LUAMOD_API int (luaopen_base) (lua_State *L);
#define LUA_LOADLIBNAME "package"
#define LUA_LOADLIBK (LUA_GLIBK << 1)
LUAMOD_API int (luaopen_package) (lua_State *L);
#ifndef LUALIB_API
#define LUALIB_API LUA_API
#endif
#define LUA_COLIBNAME "coroutine"
#define LUA_COLIBK (LUA_LOADLIBK << 1)
LUAMOD_API int (luaopen_coroutine) (lua_State *L);
#define LUA_DBLIBNAME "debug"
#define LUA_DBLIBK (LUA_COLIBK << 1)
LUAMOD_API int (luaopen_debug) (lua_State *L);
#define LUA_IOLIBNAME "io"
#define LUA_IOLIBK (LUA_DBLIBK << 1)
LUAMOD_API int (luaopen_io) (lua_State *L);
#define LUA_MATHLIBNAME "math"
#define LUA_MATHLIBK (LUA_IOLIBK << 1)
LUAMOD_API int (luaopen_math) (lua_State *L);
#define LUA_OSLIBNAME "os"
#define LUA_OSLIBK (LUA_MATHLIBK << 1)
LUAMOD_API int (luaopen_os) (lua_State *L);
#define LUA_STRLIBNAME "string"
#define LUA_STRLIBK (LUA_OSLIBK << 1)
LUAMOD_API int (luaopen_string) (lua_State *L);
LUALIB_API int luaopen_base (lua_State *L);
#define LUA_TABLIBNAME "table"
#define LUA_TABLIBK (LUA_STRLIBK << 1)
LUAMOD_API int (luaopen_table) (lua_State *L);
LUALIB_API int luaopen_table (lua_State *L);
#define LUA_UTF8LIBNAME "utf8"
#define LUA_UTF8LIBK (LUA_TABLIBK << 1)
LUAMOD_API int (luaopen_utf8) (lua_State *L);
#define LUA_IOLIBNAME "io"
#define LUA_OSLIBNAME "os"
LUALIB_API int luaopen_io (lua_State *L);
#define LUA_STRLIBNAME "string"
LUALIB_API int luaopen_string (lua_State *L);
#define LUA_MATHLIBNAME "math"
LUALIB_API int luaopen_math (lua_State *L);
#define LUA_DBLIBNAME "debug"
LUALIB_API int luaopen_debug (lua_State *L);
/* open selected libraries */
LUALIB_API void (luaL_openselectedlibs) (lua_State *L, int load, int preload);
LUALIB_API int luaopen_loadlib (lua_State *L);
/* open all libraries */
#define luaL_openlibs(L) luaL_openselectedlibs(L, ~0, 0)
/* to help testing the libraries */
#ifndef lua_assert
#define lua_assert(c) /* empty */
#endif
/* compatibility code */
#define lua_baselibopen luaopen_base
#define lua_tablibopen luaopen_table
#define lua_iolibopen luaopen_io
#define lua_strlibopen luaopen_string
#define lua_mathlibopen luaopen_math
#define lua_dblibopen luaopen_debug
#endif

649
lib/lua/lundump.c
View File

@ -1,421 +1,286 @@
/*
** $Id: lundump.c $
** load precompiled Lua chunks
** $Id: lundump.c,v 1.49 2003/04/07 20:34:20 lhf Exp $
** load pre-compiled Lua chunks
** See Copyright Notice in lua.h
*/
#define lundump_c
#define LUA_CORE
#include "lprefix.h"
#include <limits.h>
#include <string.h>
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lmem.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lstring.h"
#include "ltable.h"
#include "lundump.h"
#include "lzio.h"
#if !defined(luai_verifycode)
#define luai_verifycode(L,f) /* empty */
#endif
#define LoadByte (lu_byte) ezgetc
typedef struct {
lua_State *L;
ZIO *Z;
const char *name;
Table *h; /* list for string reuse */
size_t offset; /* current position relative to beginning of dump */
lua_Unsigned nstr; /* number of strings in the list */
lu_byte fixed; /* dump is fixed in memory */
lua_State* L;
ZIO* Z;
Mbuffer* b;
int swap;
const char* name;
} LoadState;
static l_noret error (LoadState *S, const char *why) {
luaO_pushfstring(S->L, "%s: bad binary format (%s)", S->name, why);
luaD_throw(S->L, LUA_ERRSYNTAX);
static void unexpectedEOZ (LoadState* S)
{
luaG_runerror(S->L,"unexpected end of file in %s",S->name);
}
static int ezgetc (LoadState* S)
{
int c=zgetc(S->Z);
if (c==EOZ) unexpectedEOZ(S);
return c;
}
static void ezread (LoadState* S, void* b, int n)
{
int r=luaZ_read(S->Z,b,n);
if (r!=0) unexpectedEOZ(S);
}
static void LoadBlock (LoadState* S, void* b, size_t size)
{
if (S->swap)
{
char* p=(char*) b+size-1;
int n=size;
while (n--) *p--=(char)ezgetc(S);
}
else
ezread(S,b,size);
}
static void LoadVector (LoadState* S, void* b, int m, size_t size)
{
if (S->swap)
{
char* q=(char*) b;
while (m--)
{
char* p=q+size-1;
int n=size;
while (n--) *p--=(char)ezgetc(S);
q+=size;
}
}
else
ezread(S,b,m*size);
}
static int LoadInt (LoadState* S)
{
int x;
LoadBlock(S,&x,sizeof(x));
if (x<0) luaG_runerror(S->L,"bad integer in %s",S->name);
return x;
}
static size_t LoadSize (LoadState* S)
{
size_t x;
LoadBlock(S,&x,sizeof(x));
return x;
}
static lua_Number LoadNumber (LoadState* S)
{
lua_Number x;
LoadBlock(S,&x,sizeof(x));
return x;
}
static TString* LoadString (LoadState* S)
{
size_t size=LoadSize(S);
if (size==0)
return NULL;
else
{
char* s=luaZ_openspace(S->L,S->b,size);
ezread(S,s,size);
return luaS_newlstr(S->L,s,size-1); /* remove trailing '\0' */
}
}
static void LoadCode (LoadState* S, Proto* f)
{
int size=LoadInt(S);
f->code=luaM_newvector(S->L,size,Instruction);
f->sizecode=size;
LoadVector(S,f->code,size,sizeof(*f->code));
}
static void LoadLocals (LoadState* S, Proto* f)
{
int i,n;
n=LoadInt(S);
f->locvars=luaM_newvector(S->L,n,LocVar);
f->sizelocvars=n;
for (i=0; i<n; i++)
{
f->locvars[i].varname=LoadString(S);
f->locvars[i].startpc=LoadInt(S);
f->locvars[i].endpc=LoadInt(S);
}
}
static void LoadLines (LoadState* S, Proto* f)
{
int size=LoadInt(S);
f->lineinfo=luaM_newvector(S->L,size,int);
f->sizelineinfo=size;
LoadVector(S,f->lineinfo,size,sizeof(*f->lineinfo));
}
static void LoadUpvalues (LoadState* S, Proto* f)
{
int i,n;
n=LoadInt(S);
if (n!=0 && n!=f->nups)
luaG_runerror(S->L,"bad nupvalues in %s: read %d; expected %d",
S->name,n,f->nups);
f->upvalues=luaM_newvector(S->L,n,TString*);
f->sizeupvalues=n;
for (i=0; i<n; i++) f->upvalues[i]=LoadString(S);
}
static Proto* LoadFunction (LoadState* S, TString* p);
static void LoadConstants (LoadState* S, Proto* f)
{
int i,n;
n=LoadInt(S);
f->k=luaM_newvector(S->L,n,TObject);
f->sizek=n;
for (i=0; i<n; i++)
{
TObject* o=&f->k[i];
int t=LoadByte(S);
switch (t)
{
case LUA_TNUMBER:
setnvalue(o,LoadNumber(S));
break;
case LUA_TSTRING:
setsvalue2n(o,LoadString(S));
break;
case LUA_TNIL:
setnilvalue(o);
break;
default:
luaG_runerror(S->L,"bad constant type (%d) in %s",t,S->name);
break;
}
}
n=LoadInt(S);
f->p=luaM_newvector(S->L,n,Proto*);
f->sizep=n;
for (i=0; i<n; i++) f->p[i]=LoadFunction(S,f->source);
}
static Proto* LoadFunction (LoadState* S, TString* p)
{
Proto* f=luaF_newproto(S->L);
f->source=LoadString(S); if (f->source==NULL) f->source=p;
f->lineDefined=LoadInt(S);
f->nups=LoadByte(S);
f->numparams=LoadByte(S);
f->is_vararg=LoadByte(S);
f->maxstacksize=LoadByte(S);
LoadLines(S,f);
LoadLocals(S,f);
LoadUpvalues(S,f);
LoadConstants(S,f);
LoadCode(S,f);
#ifndef TRUST_BINARIES
if (!luaG_checkcode(f)) luaG_runerror(S->L,"bad code in %s",S->name);
#endif
return f;
}
static void LoadSignature (LoadState* S)
{
const char* s=LUA_SIGNATURE;
while (*s!=0 && ezgetc(S)==*s)
++s;
if (*s!=0) luaG_runerror(S->L,"bad signature in %s",S->name);
}
static void TestSize (LoadState* S, int s, const char* what)
{
int r=LoadByte(S);
if (r!=s)
luaG_runerror(S->L,"virtual machine mismatch in %s: "
"size of %s is %d but read %d",S->name,what,s,r);
}
#define TESTSIZE(s,w) TestSize(S,s,w)
#define V(v) v/16,v%16
static void LoadHeader (LoadState* S)
{
int version;
lua_Number x,tx=TEST_NUMBER;
LoadSignature(S);
version=LoadByte(S);
if (version>VERSION)
luaG_runerror(S->L,"%s too new: "
"read version %d.%d; expected at most %d.%d",
S->name,V(version),V(VERSION));
if (version<VERSION0) /* check last major change */
luaG_runerror(S->L,"%s too old: "
"read version %d.%d; expected at least %d.%d",
S->name,V(version),V(VERSION0));
S->swap=(luaU_endianness()!=LoadByte(S)); /* need to swap bytes? */
TESTSIZE(sizeof(int),"int");
TESTSIZE(sizeof(size_t), "size_t");
TESTSIZE(sizeof(Instruction), "Instruction");
TESTSIZE(SIZE_OP, "OP");
TESTSIZE(SIZE_A, "A");
TESTSIZE(SIZE_B, "B");
TESTSIZE(SIZE_C, "C");
TESTSIZE(sizeof(lua_Number), "number");
x=LoadNumber(S);
if ((long)x!=(long)tx) /* disregard errors in last bits of fraction */
luaG_runerror(S->L,"unknown number format in %s",S->name);
}
static Proto* LoadChunk (LoadState* S)
{
LoadHeader(S);
return LoadFunction(S,NULL);
}
/*
** All high-level loads go through loadVector; you can change it to
** adapt to the endianness of the input
** load precompiled chunk
*/
#define loadVector(S,b,n) loadBlock(S,b,cast_sizet(n)*sizeof((b)[0]))
static void loadBlock (LoadState *S, void *b, size_t size) {
if (luaZ_read(S->Z, b, size) != 0)
error(S, "truncated chunk");
S->offset += size;
Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff)
{
LoadState S;
const char* s=zname(Z);
if (*s=='@' || *s=='=')
S.name=s+1;
else if (*s==LUA_SIGNATURE[0])
S.name="binary string";
else
S.name=s;
S.L=L;
S.Z=Z;
S.b=buff;
return LoadChunk(&S);
}
static void loadAlign (LoadState *S, unsigned align) {
unsigned padding = align - cast_uint(S->offset % align);
if (padding < align) { /* (padding == align) means no padding */
lua_Integer paddingContent;
loadBlock(S, &paddingContent, padding);
lua_assert(S->offset % align == 0);
}
}
#define getaddr(S,n,t) cast(t *, getaddr_(S,cast_sizet(n) * sizeof(t)))
static const void *getaddr_ (LoadState *S, size_t size) {
const void *block = luaZ_getaddr(S->Z, size);
S->offset += size;
if (block == NULL)
error(S, "truncated fixed buffer");
return block;
}
#define loadVar(S,x) loadVector(S,&x,1)
static lu_byte loadByte (LoadState *S) {
int b = zgetc(S->Z);
if (b == EOZ)
error(S, "truncated chunk");
S->offset++;
return cast_byte(b);
}
static lua_Unsigned loadVarint (LoadState *S, lua_Unsigned limit) {
lua_Unsigned x = 0;
int b;
limit >>= 7;
do {
b = loadByte(S);
if (x > limit)
error(S, "integer overflow");
x = (x << 7) | (b & 0x7f);
} while ((b & 0x80) != 0);
return x;
}
static size_t loadSize (LoadState *S) {
return cast_sizet(loadVarint(S, MAX_SIZE));
}
static int loadInt (LoadState *S) {
return cast_int(loadVarint(S, cast_sizet(INT_MAX)));
}
static lua_Number loadNumber (LoadState *S) {
lua_Number x;
loadVar(S, x);
return x;
}
static lua_Integer loadInteger (LoadState *S) {
lua_Unsigned cx = loadVarint(S, LUA_MAXUNSIGNED);
/* decode unsigned to signed */
if ((cx & 1) != 0)
return l_castU2S(~(cx >> 1));
else
return l_castU2S(cx >> 1);
}
/*
** Load a nullable string into slot 'sl' from prototype 'p'. The
** assignment to the slot and the barrier must be performed before any
** possible GC activity, to anchor the string. (Both 'loadVector' and
** 'luaH_setint' can call the GC.)
** find byte order
*/
static void loadString (LoadState *S, Proto *p, TString **sl) {
lua_State *L = S->L;
TString *ts;
TValue sv;
size_t size = loadSize(S);
if (size == 0) { /* previously saved string? */
lua_Unsigned idx = loadVarint(S, LUA_MAXUNSIGNED); /* get its index */
TValue stv;
if (idx == 0) { /* no string? */
lua_assert(*sl == NULL); /* must be prefilled */
return;
}
if (novariant(luaH_getint(S->h, l_castU2S(idx), &stv)) != LUA_TSTRING)
error(S, "invalid string index");
*sl = ts = tsvalue(&stv); /* get its value */
luaC_objbarrier(L, p, ts);
return; /* do not save it again */
}
else if ((size -= 1) <= LUAI_MAXSHORTLEN) { /* short string? */
char buff[LUAI_MAXSHORTLEN + 1]; /* extra space for '\0' */
loadVector(S, buff, size + 1); /* load string into buffer */
*sl = ts = luaS_newlstr(L, buff, size); /* create string */
luaC_objbarrier(L, p, ts);
}
else if (S->fixed) { /* for a fixed buffer, use a fixed string */
const char *s = getaddr(S, size + 1, char); /* get content address */
*sl = ts = luaS_newextlstr(L, s, size, NULL, NULL);
luaC_objbarrier(L, p, ts);
}
else { /* create internal copy */
*sl = ts = luaS_createlngstrobj(L, size); /* create string */
luaC_objbarrier(L, p, ts);
loadVector(S, getlngstr(ts), size + 1); /* load directly in final place */
}
/* add string to list of saved strings */
S->nstr++;
setsvalue(L, &sv, ts);
luaH_setint(L, S->h, l_castU2S(S->nstr), &sv);
luaC_objbarrierback(L, obj2gco(S->h), ts);
int luaU_endianness (void)
{
int x=1;
return *(char*)&x;
}
static void loadCode (LoadState *S, Proto *f) {
int n = loadInt(S);
loadAlign(S, sizeof(f->code[0]));
if (S->fixed) {
f->code = getaddr(S, n, Instruction);
f->sizecode = n;
}
else {
f->code = luaM_newvectorchecked(S->L, n, Instruction);
f->sizecode = n;
loadVector(S, f->code, n);
}
}
static void loadFunction(LoadState *S, Proto *f);
static void loadConstants (LoadState *S, Proto *f) {
int i;
int n = loadInt(S);
f->k = luaM_newvectorchecked(S->L, n, TValue);
f->sizek = n;
for (i = 0; i < n; i++)
setnilvalue(&f->k[i]);
for (i = 0; i < n; i++) {
TValue *o = &f->k[i];
int t = loadByte(S);
switch (t) {
case LUA_VNIL:
setnilvalue(o);
break;
case LUA_VFALSE:
setbfvalue(o);
break;
case LUA_VTRUE:
setbtvalue(o);
break;
case LUA_VNUMFLT:
setfltvalue(o, loadNumber(S));
break;
case LUA_VNUMINT:
setivalue(o, loadInteger(S));
break;
case LUA_VSHRSTR:
case LUA_VLNGSTR: {
lua_assert(f->source == NULL);
loadString(S, f, &f->source); /* use 'source' to anchor string */
if (f->source == NULL)
error(S, "bad format for constant string");
setsvalue2n(S->L, o, f->source); /* save it in the right place */
f->source = NULL;
break;
}
default: error(S, "invalid constant");
}
}
}
static void loadProtos (LoadState *S, Proto *f) {
int i;
int n = loadInt(S);
f->p = luaM_newvectorchecked(S->L, n, Proto *);
f->sizep = n;
for (i = 0; i < n; i++)
f->p[i] = NULL;
for (i = 0; i < n; i++) {
f->p[i] = luaF_newproto(S->L);
luaC_objbarrier(S->L, f, f->p[i]);
loadFunction(S, f->p[i]);
}
}
/*
** Load the upvalues for a function. The names must be filled first,
** because the filling of the other fields can raise read errors and
** the creation of the error message can call an emergency collection;
** in that case all prototypes must be consistent for the GC.
*/
static void loadUpvalues (LoadState *S, Proto *f) {
int i;
int n = loadInt(S);
f->upvalues = luaM_newvectorchecked(S->L, n, Upvaldesc);
f->sizeupvalues = n;
for (i = 0; i < n; i++) /* make array valid for GC */
f->upvalues[i].name = NULL;
for (i = 0; i < n; i++) { /* following calls can raise errors */
f->upvalues[i].instack = loadByte(S);
f->upvalues[i].idx = loadByte(S);
f->upvalues[i].kind = loadByte(S);
}
}
static void loadDebug (LoadState *S, Proto *f) {
int i;
int n = loadInt(S);
if (S->fixed) {
f->lineinfo = getaddr(S, n, ls_byte);
f->sizelineinfo = n;
}
else {
f->lineinfo = luaM_newvectorchecked(S->L, n, ls_byte);
f->sizelineinfo = n;
loadVector(S, f->lineinfo, n);
}
n = loadInt(S);
if (n > 0) {
loadAlign(S, sizeof(int));
if (S->fixed) {
f->abslineinfo = getaddr(S, n, AbsLineInfo);
f->sizeabslineinfo = n;
}
else {
f->abslineinfo = luaM_newvectorchecked(S->L, n, AbsLineInfo);
f->sizeabslineinfo = n;
loadVector(S, f->abslineinfo, n);
}
}
n = loadInt(S);
f->locvars = luaM_newvectorchecked(S->L, n, LocVar);
f->sizelocvars = n;
for (i = 0; i < n; i++)
f->locvars[i].varname = NULL;
for (i = 0; i < n; i++) {
loadString(S, f, &f->locvars[i].varname);
f->locvars[i].startpc = loadInt(S);
f->locvars[i].endpc = loadInt(S);
}
n = loadInt(S);
if (n != 0) /* does it have debug information? */
n = f->sizeupvalues; /* must be this many */
for (i = 0; i < n; i++)
loadString(S, f, &f->upvalues[i].name);
}
static void loadFunction (LoadState *S, Proto *f) {
f->linedefined = loadInt(S);
f->lastlinedefined = loadInt(S);
f->numparams = loadByte(S);
/* get only the meaningful flags */
f->flag = cast_byte(loadByte(S) & ~PF_FIXED);
if (S->fixed)
f->flag |= PF_FIXED; /* signal that code is fixed */
f->maxstacksize = loadByte(S);
loadCode(S, f);
loadConstants(S, f);
loadUpvalues(S, f);
loadProtos(S, f);
loadString(S, f, &f->source);
loadDebug(S, f);
}
static void checkliteral (LoadState *S, const char *s, const char *msg) {
char buff[sizeof(LUA_SIGNATURE) + sizeof(LUAC_DATA)]; /* larger than both */
size_t len = strlen(s);
loadVector(S, buff, len);
if (memcmp(s, buff, len) != 0)
error(S, msg);
}
static l_noret numerror (LoadState *S, const char *what, const char *tname) {
const char *msg = luaO_pushfstring(S->L, "%s %s mismatch", tname, what);
error(S, msg);
}
static void checknumsize (LoadState *S, int size, const char *tname) {
if (size != loadByte(S))
numerror(S, "size", tname);
}
static void checknumformat (LoadState *S, int eq, const char *tname) {
if (!eq)
numerror(S, "format", tname);
}
#define checknum(S,tvar,value,tname) \
{ tvar i; checknumsize(S, sizeof(i), tname); \
loadVar(S, i); \
checknumformat(S, i == value, tname); }
static void checkHeader (LoadState *S) {
/* skip 1st char (already read and checked) */
checkliteral(S, &LUA_SIGNATURE[1], "not a binary chunk");
if (loadByte(S) != LUAC_VERSION)
error(S, "version mismatch");
if (loadByte(S) != LUAC_FORMAT)
error(S, "format mismatch");
checkliteral(S, LUAC_DATA, "corrupted chunk");
checknum(S, int, LUAC_INT, "int");
checknum(S, Instruction, LUAC_INST, "instruction");
checknum(S, lua_Integer, LUAC_INT, "Lua integer");
checknum(S, lua_Number, LUAC_NUM, "Lua number");
}
/*
** Load precompiled chunk.
*/
LClosure *luaU_undump (lua_State *L, ZIO *Z, Table *anchor, const char *name,
int fixed) {
LoadState S;
LClosure *cl;
if (*name == '@' || *name == '=')
name = name + 1;
else if (*name == LUA_SIGNATURE[0])
name = "binary string";
S.name = name;
S.L = L;
S.Z = Z;
S.fixed = cast_byte(fixed);
S.offset = 1; /* fist byte was already read */
checkHeader(&S);
S.h = anchor;
S.nstr = 0;
cl = luaF_newLclosure(L, loadByte(&S));
luaD_anchorobj(L, anchor, obj2gco(cl));
cl->p = luaF_newproto(L);
luaC_objbarrier(L, cl, cl->p);
loadFunction(&S, cl->p);
if (cl->nupvalues != cl->p->sizeupvalues)
error(&S, "corrupted chunk");
luai_verifycode(L, cl->p);
return cl;
}

44
lib/lua/lundump.h
View File

@ -1,40 +1,34 @@
/*
** $Id: lundump.h $
** load precompiled Lua chunks
** $Id: lundump.h,v 1.30 2003/04/07 20:34:20 lhf Exp $
** load pre-compiled Lua chunks
** See Copyright Notice in lua.h
*/
#ifndef lundump_h
#define lundump_h
#include <limits.h>
#include "llimits.h"
#include "lobject.h"
#include "lzio.h"
/* data to catch conversion errors */
#define LUAC_DATA "\x19\x93\r\n\x1a\n"
#define LUAC_INT -0x5678
#define LUAC_INST 0x12345678
#define LUAC_NUM cast_num(-370.5)
/*
** Encode major-minor version in one byte, one nibble for each
*/
#define LUAC_VERSION (LUA_VERSION_MAJOR_N*16+LUA_VERSION_MINOR_N)
#define LUAC_FORMAT 0 /* this is the official format */
/* load one chunk; from lundump.c */
LUAI_FUNC LClosure* luaU_undump (lua_State* L, ZIO* Z, Table *anchor,
const char* name, int fixed);
Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff);
/* find byte order; from lundump.c */
int luaU_endianness (void);
/* dump one chunk; from ldump.c */
LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w,
void* data, int strip);
void luaU_dump (lua_State* L, const Proto* Main, lua_Chunkwriter w, void* data);
/* print one chunk; from print.c */
void luaU_print (const Proto* Main);
/* definitions for headers of binary files */
#define LUA_SIGNATURE "\033Lua" /* binary files start with "<esc>Lua" */
#define VERSION 0x50 /* last format change was in 5.0 */
#define VERSION0 0x50 /* last major change was in 5.0 */
/* a multiple of PI for testing native format */
/* multiplying by 1E7 gives non-trivial integer values */
#define TEST_NUMBER ((lua_Number)3.14159265358979323846E7)
#endif

294
lib/lua/lutf8lib.c
View File

@ -1,294 +0,0 @@
/*
** $Id: lutf8lib.c $
** Standard library for UTF-8 manipulation
** See Copyright Notice in lua.h
*/
#define lutf8lib_c
#define LUA_LIB
#include "lprefix.h"
#include <limits.h>
#include <stdlib.h>
#include <string.h>
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#include "llimits.h"
#define MAXUNICODE 0x10FFFFu
#define MAXUTF 0x7FFFFFFFu
#define MSGInvalid "invalid UTF-8 code"
#define iscont(c) (((c) & 0xC0) == 0x80)
#define iscontp(p) iscont(*(p))
/* from strlib */
/* translate a relative string position: negative means back from end */
static lua_Integer u_posrelat (lua_Integer pos, size_t len) {
if (pos >= 0) return pos;
else if (0u - (size_t)pos > len) return 0;
else return (lua_Integer)len + pos + 1;
}
/*
** Decode one UTF-8 sequence, returning NULL if byte sequence is
** invalid. The array 'limits' stores the minimum value for each
** sequence length, to check for overlong representations. Its first
** entry forces an error for non-ASCII bytes with no continuation
** bytes (count == 0).
*/
static const char *utf8_decode (const char *s, l_uint32 *val, int strict) {
static const l_uint32 limits[] =
{~(l_uint32)0, 0x80, 0x800, 0x10000u, 0x200000u, 0x4000000u};
unsigned int c = (unsigned char)s[0];
l_uint32 res = 0; /* final result */
if (c < 0x80) /* ASCII? */
res = c;
else if (c >= 0xfe) /* c >= 1111 1110b ? */
return NULL; /* would need six or more continuation bytes */
else {
int count = 0; /* to count number of continuation bytes */
for (; c & 0x40; c <<= 1) { /* while it needs continuation bytes... */
unsigned int cc = (unsigned char)s[++count]; /* read next byte */
if (!iscont(cc)) /* not a continuation byte? */
return NULL; /* invalid byte sequence */
res = (res << 6) | (cc & 0x3F); /* add lower 6 bits from cont. byte */
}
lua_assert(count <= 5);
res |= ((l_uint32)(c & 0x7F) << (count * 5)); /* add first byte */
if (res > MAXUTF || res < limits[count])
return NULL; /* invalid byte sequence */
s += count; /* skip continuation bytes read */
}
if (strict) {
/* check for invalid code points; too large or surrogates */
if (res > MAXUNICODE || (0xD800u <= res && res <= 0xDFFFu))
return NULL;
}
if (val) *val = res;
return s + 1; /* +1 to include first byte */
}
/*
** utf8len(s [, i [, j [, lax]]]) --> number of characters that
** start in the range [i,j], or nil + current position if 's' is not
** well formed in that interval
*/
static int utflen (lua_State *L) {
lua_Integer n = 0; /* counter for the number of characters */
size_t len; /* string length in bytes */
const char *s = luaL_checklstring(L, 1, &len);
lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);
lua_Integer posj = u_posrelat(luaL_optinteger(L, 3, -1), len);
int lax = lua_toboolean(L, 4);
luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 2,
"initial position out of bounds");
luaL_argcheck(L, --posj < (lua_Integer)len, 3,
"final position out of bounds");
while (posi <= posj) {
const char *s1 = utf8_decode(s + posi, NULL, !lax);
if (s1 == NULL) { /* conversion error? */
luaL_pushfail(L); /* return fail ... */
lua_pushinteger(L, posi + 1); /* ... and current position */
return 2;
}
posi = ct_diff2S(s1 - s);
n++;
}
lua_pushinteger(L, n);
return 1;
}
/*
** codepoint(s, [i, [j [, lax]]]) -> returns codepoints for all
** characters that start in the range [i,j]
*/
static int codepoint (lua_State *L) {
size_t len;
const char *s = luaL_checklstring(L, 1, &len);
lua_Integer posi = u_posrelat(luaL_optinteger(L, 2, 1), len);
lua_Integer pose = u_posrelat(luaL_optinteger(L, 3, posi), len);
int lax = lua_toboolean(L, 4);
int n;
const char *se;
luaL_argcheck(L, posi >= 1, 2, "out of bounds");
luaL_argcheck(L, pose <= (lua_Integer)len, 3, "out of bounds");
if (posi > pose) return 0; /* empty interval; return no values */
if (pose - posi >= INT_MAX) /* (lua_Integer -> int) overflow? */
return luaL_error(L, "string slice too long");
n = (int)(pose - posi) + 1; /* upper bound for number of returns */
luaL_checkstack(L, n, "string slice too long");
n = 0; /* count the number of returns */
se = s + pose; /* string end */
for (s += posi - 1; s < se;) {
l_uint32 code;
s = utf8_decode(s, &code, !lax);
if (s == NULL)
return luaL_error(L, MSGInvalid);
lua_pushinteger(L, l_castU2S(code));
n++;
}
return n;
}
static void pushutfchar (lua_State *L, int arg) {
lua_Unsigned code = (lua_Unsigned)luaL_checkinteger(L, arg);
luaL_argcheck(L, code <= MAXUTF, arg, "value out of range");
lua_pushfstring(L, "%U", cast(unsigned long, code));
}
/*
** utfchar(n1, n2, ...) -> char(n1)..char(n2)...
*/
static int utfchar (lua_State *L) {
int n = lua_gettop(L); /* number of arguments */
if (n == 1) /* optimize common case of single char */
pushutfchar(L, 1);
else {
int i;
luaL_Buffer b;
luaL_buffinit(L, &b);
for (i = 1; i <= n; i++) {
pushutfchar(L, i);
luaL_addvalue(&b);
}
luaL_pushresult(&b);
}
return 1;
}
/*
** offset(s, n, [i]) -> indices where n-th character counting from
** position 'i' starts and ends; 0 means character at 'i'.
*/
static int byteoffset (lua_State *L) {
size_t len;
const char *s = luaL_checklstring(L, 1, &len);
lua_Integer n = luaL_checkinteger(L, 2);
lua_Integer posi = (n >= 0) ? 1 : cast_st2S(len) + 1;
posi = u_posrelat(luaL_optinteger(L, 3, posi), len);
luaL_argcheck(L, 1 <= posi && --posi <= (lua_Integer)len, 3,
"position out of bounds");
if (n == 0) {
/* find beginning of current byte sequence */
while (posi > 0 && iscontp(s + posi)) posi--;
}
else {
if (iscontp(s + posi))
return luaL_error(L, "initial position is a continuation byte");
if (n < 0) {
while (n < 0 && posi > 0) { /* move back */
do { /* find beginning of previous character */
posi--;
} while (posi > 0 && iscontp(s + posi));
n++;
}
}
else {
n--; /* do not move for 1st character */
while (n > 0 && posi < (lua_Integer)len) {
do { /* find beginning of next character */
posi++;
} while (iscontp(s + posi)); /* (cannot pass final '\0') */
n--;
}
}
}
if (n != 0) { /* did not find given character? */
luaL_pushfail(L);
return 1;
}
lua_pushinteger(L, posi + 1); /* initial position */
if ((s[posi] & 0x80) != 0) { /* multi-byte character? */
if (iscont(s[posi]))
return luaL_error(L, "initial position is a continuation byte");
while (iscontp(s + posi + 1))
posi++; /* skip to last continuation byte */
}
/* else one-byte character: final position is the initial one */
lua_pushinteger(L, posi + 1); /* 'posi' now is the final position */
return 2;
}
static int iter_aux (lua_State *L, int strict) {
size_t len;
const char *s = luaL_checklstring(L, 1, &len);
lua_Unsigned n = (lua_Unsigned)lua_tointeger(L, 2);
if (n < len) {
while (iscontp(s + n)) n++; /* go to next character */
}
if (n >= len) /* (also handles original 'n' being negative) */
return 0; /* no more codepoints */
else {
l_uint32 code;
const char *next = utf8_decode(s + n, &code, strict);
if (next == NULL || iscontp(next))
return luaL_error(L, MSGInvalid);
lua_pushinteger(L, l_castU2S(n + 1));
lua_pushinteger(L, l_castU2S(code));
return 2;
}
}
static int iter_auxstrict (lua_State *L) {
return iter_aux(L, 1);
}
static int iter_auxlax (lua_State *L) {
return iter_aux(L, 0);
}
static int iter_codes (lua_State *L) {
int lax = lua_toboolean(L, 2);
const char *s = luaL_checkstring(L, 1);
luaL_argcheck(L, !iscontp(s), 1, MSGInvalid);
lua_pushcfunction(L, lax ? iter_auxlax : iter_auxstrict);
lua_pushvalue(L, 1);
lua_pushinteger(L, 0);
return 3;
}
/* pattern to match a single UTF-8 character */
#define UTF8PATT "[\0-\x7F\xC2-\xFD][\x80-\xBF]*"
static const luaL_Reg funcs[] = {
{"offset", byteoffset},
{"codepoint", codepoint},
{"char", utfchar},
{"len", utflen},
{"codes", iter_codes},
/* placeholders */
{"charpattern", NULL},
{NULL, NULL}
};
LUAMOD_API int luaopen_utf8 (lua_State *L) {
luaL_newlib(L, funcs);
lua_pushlstring(L, UTF8PATT, sizeof(UTF8PATT)/sizeof(char) - 1);
lua_setfield(L, -2, "charpattern");
return 1;
}

2485
lib/lua/lvm.c
View File

File diff suppressed because it is too large Load Diff

135
lib/lua/lvm.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lvm.h $
** $Id: lvm.h,v 1.47 2002/11/14 16:16:21 roberto Exp $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
@ -13,124 +13,23 @@
#include "ltm.h"
#if !defined(LUA_NOCVTN2S)
#define cvt2str(o) ttisnumber(o)
#else
#define cvt2str(o) 0 /* no conversion from numbers to strings */
#endif
#define tostring(L,o) ((ttype(o) == LUA_TSTRING) || (luaV_tostring(L, o)))
#define tonumber(o,n) (ttype(o) == LUA_TNUMBER || \
(((o) = luaV_tonumber(o,n)) != NULL))
#define equalobj(L,o1,o2) \
(ttype(o1) == ttype(o2) && luaV_equalval(L, o1, o2))
#if !defined(LUA_NOCVTS2N)
#define cvt2num(o) ttisstring(o)
#else
#define cvt2num(o) 0 /* no conversion from strings to numbers */
#endif
/*
** You can define LUA_FLOORN2I if you want to convert floats to integers
** by flooring them (instead of raising an error if they are not
** integral values)
*/
#if !defined(LUA_FLOORN2I)
#define LUA_FLOORN2I F2Ieq
#endif
/*
** Rounding modes for float->integer coercion
*/
typedef enum {
F2Ieq, /* no rounding; accepts only integral values */
F2Ifloor, /* takes the floor of the number */
F2Iceil /* takes the ceiling of the number */
} F2Imod;
/* convert an object to a float (including string coercion) */
#define tonumber(o,n) \
(ttisfloat(o) ? (*(n) = fltvalue(o), 1) : luaV_tonumber_(o,n))
/* convert an object to a float (without string coercion) */
#define tonumberns(o,n) \
(ttisfloat(o) ? ((n) = fltvalue(o), 1) : \
(ttisinteger(o) ? ((n) = cast_num(ivalue(o)), 1) : 0))
/* convert an object to an integer (including string coercion) */
#define tointeger(o,i) \
(l_likely(ttisinteger(o)) ? (*(i) = ivalue(o), 1) \
: luaV_tointeger(o,i,LUA_FLOORN2I))
/* convert an object to an integer (without string coercion) */
#define tointegerns(o,i) \
(l_likely(ttisinteger(o)) ? (*(i) = ivalue(o), 1) \
: luaV_tointegerns(o,i,LUA_FLOORN2I))
#define intop(op,v1,v2) l_castU2S(l_castS2U(v1) op l_castS2U(v2))
#define luaV_rawequalobj(t1,t2) luaV_equalobj(NULL,t1,t2)
/*
** fast track for 'gettable'
*/
#define luaV_fastget(t,k,res,f, tag) \
(tag = (!ttistable(t) ? LUA_VNOTABLE : f(hvalue(t), k, res)))
/*
** Special case of 'luaV_fastget' for integers, inlining the fast case
** of 'luaH_getint'.
*/
#define luaV_fastgeti(t,k,res,tag) \
if (!ttistable(t)) tag = LUA_VNOTABLE; \
else { luaH_fastgeti(hvalue(t), k, res, tag); }
#define luaV_fastset(t,k,val,hres,f) \
(hres = (!ttistable(t) ? HNOTATABLE : f(hvalue(t), k, val)))
#define luaV_fastseti(t,k,val,hres) \
if (!ttistable(t)) hres = HNOTATABLE; \
else { luaH_fastseti(hvalue(t), k, val, hres); }
/*
** Finish a fast set operation (when fast set succeeds).
*/
#define luaV_finishfastset(L,t,v) luaC_barrierback(L, gcvalue(t), v)
/*
** Shift right is the same as shift left with a negative 'y'
*/
#define luaV_shiftr(x,y) luaV_shiftl(x,intop(-, 0, y))
LUAI_FUNC int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2);
LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r);
LUAI_FUNC int luaV_lessequal (lua_State *L, const TValue *l, const TValue *r);
LUAI_FUNC int luaV_tonumber_ (const TValue *obj, lua_Number *n);
LUAI_FUNC int luaV_tointeger (const TValue *obj, lua_Integer *p, F2Imod mode);
LUAI_FUNC int luaV_tointegerns (const TValue *obj, lua_Integer *p,
F2Imod mode);
LUAI_FUNC int luaV_flttointeger (lua_Number n, lua_Integer *p, F2Imod mode);
LUAI_FUNC lu_byte luaV_finishget (lua_State *L, const TValue *t, TValue *key,
StkId val, lu_byte tag);
LUAI_FUNC void luaV_finishset (lua_State *L, const TValue *t, TValue *key,
TValue *val, int aux);
LUAI_FUNC void luaV_finishOp (lua_State *L);
LUAI_FUNC void luaV_execute (lua_State *L, CallInfo *ci);
LUAI_FUNC void luaV_concat (lua_State *L, int total);
LUAI_FUNC lua_Integer luaV_idiv (lua_State *L, lua_Integer x, lua_Integer y);
LUAI_FUNC lua_Integer luaV_mod (lua_State *L, lua_Integer x, lua_Integer y);
LUAI_FUNC lua_Number luaV_modf (lua_State *L, lua_Number x, lua_Number y);
LUAI_FUNC lua_Integer luaV_shiftl (lua_Integer x, lua_Integer y);
LUAI_FUNC void luaV_objlen (lua_State *L, StkId ra, const TValue *rb);
int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r);
int luaV_equalval (lua_State *L, const TObject *t1, const TObject *t2);
const TObject *luaV_tonumber (const TObject *obj, TObject *n);
int luaV_tostring (lua_State *L, StkId obj);
const TObject *luaV_gettable (lua_State *L, const TObject *t, TObject *key,
int loop);
void luaV_settable (lua_State *L, const TObject *t, TObject *key, StkId val);
StkId luaV_execute (lua_State *L);
void luaV_concat (lua_State *L, int total, int last);
#endif

86
lib/lua/lzio.c
View File

@ -1,70 +1,63 @@
/*
** $Id: lzio.c $
** Buffered streams
** $Id: lzio.c,v 1.24 2003/03/20 16:00:56 roberto Exp $
** a generic input stream interface
** See Copyright Notice in lua.h
*/
#define lzio_c
#define LUA_CORE
#include "lprefix.h"
#include <string.h>
#define lzio_c
#include "lua.h"
#include "lapi.h"
#include "llimits.h"
#include "lmem.h"
#include "lstate.h"
#include "lzio.h"
int luaZ_fill (ZIO *z) {
size_t size;
lua_State *L = z->L;
const char *buff;
lua_unlock(L);
buff = z->reader(L, z->data, &size);
lua_lock(L);
if (buff == NULL || size == 0)
return EOZ;
z->n = size - 1; /* discount char being returned */
const char *buff = z->reader(NULL, z->data, &size);
if (buff == NULL || size == 0) return EOZ;
z->n = size - 1;
z->p = buff;
return cast_uchar(*(z->p++));
return char2int(*(z->p++));
}
void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) {
z->L = L;
int luaZ_lookahead (ZIO *z) {
if (z->n == 0) {
int c = luaZ_fill(z);
if (c == EOZ) return c;
z->n++;
z->p--;
}
return char2int(*z->p);
}
void luaZ_init (ZIO *z, lua_Chunkreader reader, void *data, const char *name) {
z->reader = reader;
z->data = data;
z->name = name;
z->n = 0;
z->p = NULL;
}
/* --------------------------------------------------------------- read --- */
static int checkbuffer (ZIO *z) {
if (z->n == 0) { /* no bytes in buffer? */
if (luaZ_fill(z) == EOZ) /* try to read more */
return 0; /* no more input */
else {
z->n++; /* luaZ_fill consumed first byte; put it back */
z->p--;
}
}
return 1; /* now buffer has something */
}
size_t luaZ_read (ZIO *z, void *b, size_t n) {
while (n) {
size_t m;
if (!checkbuffer(z))
return n; /* no more input; return number of missing bytes */
if (z->n == 0) {
if (luaZ_fill(z) == EOZ)
return n; /* return number of missing bytes */
else {
++z->n; /* filbuf removed first byte; put back it */
--z->p;
}
}
m = (n <= z->n) ? n : z->n; /* min. between n and z->n */
memcpy(b, z->p, m);
z->n -= m;
@ -75,15 +68,14 @@ size_t luaZ_read (ZIO *z, void *b, size_t n) {
return 0;
}
const void *luaZ_getaddr (ZIO* z, size_t n) {
const void *res;
if (!checkbuffer(z))
return NULL; /* no more input */
if (z->n < n) /* not enough bytes? */
return NULL; /* block not whole; cannot give an address */
res = z->p; /* get block address */
z->n -= n; /* consume these bytes */
z->p += n;
return res;
/* ------------------------------------------------------------------------ */
char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n) {
if (n > buff->buffsize) {
if (n < LUA_MINBUFFER) n = LUA_MINBUFFER;
luaM_reallocvector(L, buff->buffer, buff->buffsize, n, char);
buff->buffsize = n;
}
return buff->buffer;
}

45
lib/lua/lzio.h
View File

@ -1,5 +1,5 @@
/*
** $Id: lzio.h $
** $Id: lzio.h,v 1.15 2003/03/20 16:00:56 roberto Exp $
** Buffered streams
** See Copyright Notice in lua.h
*/
@ -10,58 +10,55 @@
#include "lua.h"
#include "lmem.h"
#define EOZ (-1) /* end of stream */
typedef struct Zio ZIO;
#define zgetc(z) (((z)->n--)>0 ? cast_uchar(*(z)->p++) : luaZ_fill(z))
#define char2int(c) cast(int, cast(unsigned char, (c)))
#define zgetc(z) (((z)->n--)>0 ? char2int(*(z)->p++) : luaZ_fill(z))
#define zname(z) ((z)->name)
void luaZ_init (ZIO *z, lua_Chunkreader reader, void *data, const char *name);
size_t luaZ_read (ZIO* z, void* b, size_t n); /* read next n bytes */
int luaZ_lookahead (ZIO *z);
typedef struct Mbuffer {
char *buffer;
size_t n;
size_t buffsize;
} Mbuffer;
char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n);
#define luaZ_initbuffer(L, buff) ((buff)->buffer = NULL, (buff)->buffsize = 0)
#define luaZ_buffer(buff) ((buff)->buffer)
#define luaZ_sizebuffer(buff) ((buff)->buffsize)
#define luaZ_bufflen(buff) ((buff)->n)
#define luaZ_buffremove(buff,i) ((buff)->n -= cast_sizet(i))
#define luaZ_resetbuffer(buff) ((buff)->n = 0)
#define luaZ_buffer(buff) ((buff)->buffer)
#define luaZ_resizebuffer(L, buff, size) \
((buff)->buffer = luaM_reallocvchar(L, (buff)->buffer, \
(buff)->buffsize, size), \
(luaM_reallocvector(L, (buff)->buffer, (buff)->buffsize, size, char), \
(buff)->buffsize = size)
#define luaZ_freebuffer(L, buff) luaZ_resizebuffer(L, buff, 0)
LUAI_FUNC void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader,
void *data);
LUAI_FUNC size_t luaZ_read (ZIO* z, void *b, size_t n); /* read next n bytes */
LUAI_FUNC const void *luaZ_getaddr (ZIO* z, size_t n);
/* --------- Private Part ------------------ */
struct Zio {
size_t n; /* bytes still unread */
const char *p; /* current position in buffer */
lua_Reader reader; /* reader function */
void *data; /* additional data */
lua_State *L; /* Lua state (for reader) */
lua_Chunkreader reader;
void* data; /* additional data */
const char *name;
};
LUAI_FUNC int luaZ_fill (ZIO *z);
int luaZ_fill (ZIO *z);
#endif