6502
/
l65
mirror of https://github.com/g012/l65.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Moved from metalua to a derivative of LuaMinify.

This commit is contained in:
g012 2017-09-03 01:59:21 +02:00
parent 3db5fd64c3
commit 411e46f6f7
111 changed files with 30933 additions and 26549 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
.gitignore vendored
View File

@ -1,43 +1,2 @@
/build
# Compiled Lua sources
luac.out
# luarocks build files
*.src.rock
*.zip
*.tar.gz
# Object files
*.o
*.os
*.ko
*.obj
*.elf
# Precompiled Headers
*.gch
*.pch
# Libraries
*.lib
*.a
*.la
*.lo
*.def
*.exp
# Shared objects (inc. Windows DLLs)
*.dll
*.so
*.so.*
*.dylib
# Executables
*.exe
*.out
*.app
*.i*86
*.x86_64
*.hex
/build
/tmp

7
6502-def.lua Normal file
View File

@ -0,0 +1,7 @@
local macro = require "macro"
function addressing(get)
local t,v = get:next()
end
macro.define('lda', addressing)

82
6502.lua Normal file
View File

@ -0,0 +1,82 @@
adressing = {
imm=0x09, zp=0x05, zpx=0x15, ab=0x0d, abx=0x1d, aby=0x19, inx=0x01, iny=0x11,
acc=0x09,
}
encode = {
adc=0x60,
['and']=0x20,
asl=0x01,
lda=0xa0,
sta=0x80,
--lda = { imm=0xa9, zp=0xa5, zpx=0xb5, ab=0xad, abx=0xbd, aby=0xb9, inx=0xa1, iny=0xb1 },
}
--[=[
adressages:
lda #10 lda(10) lda"#10"
lda 10 lda{10} lda"10"
lda 10,x lda{10,"x"} ldax{10} lda{x=10} lda"10,x"
lda $1000 lda{0x1000}
lda $1000,x lda{0x1000,"x"} ldax{0x1000}
lda $1000,y lda{0x1000,"y"} lday{0x1000}
lda (10,x) lda{10,"(x)"} lda_x{10} a=(10,x) a=mem[zp[10+x]] lda"(10,x)"
lda (10),y lda{10,"(y)"} lda_y{10} a=(10),y a=mem[zp[10]+y] lda"(10),y"
sta 10 sta{10}
sta 10,x sta{10,"x"}
sta $1000 sta{0x1000}
sta $1000,x sta{0x1000,"x"}
sta $1000,y sta{0x1000,"y"}
sta (10,x) sta{10,"(x)"}
sta (10),y sta{10,"(y)"}
]=]
local function setfenv(fn, env)
local i = 1
while true do
local name = debug.getupvalue(fn, i)
if name == "_ENV" then
debug.upvaluejoin(fn, i, (function() return env end), 1)
break
elseif not name then break end
i = i + 1
end
return fn
end
local function getfenv(fn)
local i = 1
while true do
local name, val = debug.getupvalue(fn, i)
if name == "_ENV" then return val
elseif not name then break end
i = i + 1
end
end
asm6502_env = {
lda = function(v)
emit(0xa9, v)
end,
}
function asm(f, ...)
setfenv(f, asm6502_env)
f(...)
end
a,x,y = 0,0,0
do
local regs = { a="a", x="x", y="y" }
setmetatable(_G, {
__index = function(t,k,v)
if regs[k] then assert(loadstring("ld" .. k .. "(" .. v .. ")"))() end
return t[k]
end,
__newindex = function(t,k,v)
if regs[k] then assert(loadstring("st" .. k .. "(" .. v .. ")"))() end
t[k] = v
end,
})
end

79
asm.lua Normal file
View File

@ -0,0 +1,79 @@
dofile "vcs.lua"
TIM_OVERSCAN = 50 -- TIM64T, 3200 cycles = ~ 42 scanlines
TIM_VBLANK = 61 -- TIM64T, 3904 cycles = ~ 51 scanlines
TIM_KERNEL = 17 -- T1024T, 17408 cycles = ~229 scanlines
location(0xf000, 0xffff)
section "waitForIntim"
-- n_{ a=INTIM } ?
--lda(INTIM) -- or a=INTIM
--bne "waitForIntim"
ldx #0xf0
lda #0xac
lda #INTIM
lda 0xbeef
lda INTIM
lda INTIM,x
lda INTIM,y
lda (INTIM,x)
lda (INTIM),y
asl
asl INTIM
asl
bne "test"
bne waitForIntim
bne f()
bne _toto
rts
--[[
section "doOverscan"
sta{WSYNC} -- WSYNC=a
lda(2) sta{VBLANK} -- a=2 VBLANK=a
lda(TIM_OVERSCAN) sta{TIM64T} -- a=TIM_OVERSCAN TIM64T=a
jsr "waitForIntim"
section "doVBlank"
lda(0x0e)
label ".vsyncLoop"
sta{WSYNC}
sta{VSYNC}
lsr()
bne ".vsyncLoop"
lda(2)
sta{VBLANK}
lda(TIM_VBLANK)
sta{TIM64T}
jsr "waitForIntim"
section "doKernel"
lda(TIM_KERNEL)
sta{T1024T}
jsr "waitForIntim"
section "start"
-- clear zeropage
cld()
ldx(0)
txa()
label ".clearLoop"
dex()
tsx()
pha()
bne ".clearLoop"
-- main
label "mainLoop"
jsr "doOverscan"
jsr "doVBlank"
jsr "doKernel"
jmp "mainLoop"
section{ name="vectors", org=0xfffc }
word{ "start", "start" }
]]

24
asm.min.lua Normal file
View File

@ -0,0 +1,24 @@
dofile "vcs.lua"
TIM_OVERSCAN = 50
TIM_VBLANK = 61
TIM_KERNEL = 17
location(0xf000, 0xffff)
section "waitForIntim"
ldx_immediate(0xf0)
lda_immediate(0xac)
lda_immediate(INTIM)
lda_absolute(0xbeef)
lda_absolute(INTIM)
lda_absolute_x(INTIM)
lda_absolute_x(INTIM)
lda_indirect_x(INTIM)
lda_indirect_y(INTIM)
asl_implied()
asl_absolute(INTIM)
asl_implied()
bne_relative("test")
bne_relative("waitForIntim")
bne_relative(f())
bne_relative("_toto")
rts_implied()

2052
l65.lua Normal file
View File

File diff suppressed because it is too large Load Diff

990
lfs.c Normal file
View File

@ -0,0 +1,990 @@
/*
* lfs.c and lfs.h mixed together
*/
/*
** LuaFileSystem
** Copyright Kepler Project 2003 - 2016 (http://keplerproject.github.io/luafilesystem)
*/
/* Define 'chdir' for systems that do not implement it */
#ifdef NO_CHDIR
#define chdir(p) (-1)
#define chdir_error "Function 'chdir' not provided by system"
#else
#define chdir_error strerror(errno)
#endif
#ifdef _WIN32
#define chdir(p) (_chdir(p))
#define getcwd(d, s) (_getcwd(d, s))
#define rmdir(p) (_rmdir(p))
#define LFS_EXPORT __declspec (dllexport)
#ifndef fileno
#define fileno(f) (_fileno(f))
#endif
#else
#define LFS_EXPORT
#endif
#ifdef __cplusplus
extern "C" {
#endif
LFS_EXPORT int luaopen_lfs (lua_State *L);
#ifdef __cplusplus
}
#endif
/*
** LuaFileSystem
** Copyright Kepler Project 2003 - 2016 (http://keplerproject.github.io/luafilesystem)
**
** File system manipulation library.
** This library offers these functions:
** lfs.attributes (filepath [, attributename | attributetable])
** lfs.chdir (path)
** lfs.currentdir ()
** lfs.dir (path)
** lfs.link (old, new[, symlink])
** lfs.lock (fh, mode)
** lfs.lock_dir (path)
** lfs.mkdir (path)
** lfs.rmdir (path)
** lfs.setmode (filepath, mode)
** lfs.symlinkattributes (filepath [, attributename])
** lfs.touch (filepath [, atime [, mtime]])
** lfs.unlock (fh)
*/
#ifndef LFS_DO_NOT_USE_LARGE_FILE
#ifndef _WIN32
#ifndef _AIX
#define _FILE_OFFSET_BITS 64 /* Linux, Solaris and HP-UX */
#else
#define _LARGE_FILES 1 /* AIX */
#endif
#endif
#endif
#ifndef LFS_DO_NOT_USE_LARGE_FILE
#define _LARGEFILE64_SOURCE
#endif
#include <errno.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <time.h>
#include <sys/stat.h>
#ifdef _WIN32
#include <direct.h>
#include <windows.h>
#include <io.h>
#include <sys/locking.h>
#ifdef __BORLANDC__
#include <utime.h>
#else
#include <sys/utime.h>
#endif
#include <fcntl.h>
/* MAX_PATH seems to be 260. Seems kind of small. Is there a better one? */
#define LFS_MAXPATHLEN MAX_PATH
#else
#include <unistd.h>
#include <dirent.h>
#include <fcntl.h>
#include <sys/types.h>
#include <utime.h>
#include <sys/param.h> /* for MAXPATHLEN */
#define LFS_MAXPATHLEN MAXPATHLEN
#endif
//#include <lua.h>
//#include <lauxlib.h>
//#include <lualib.h>
//#include "lfs.h"
#define LFS_VERSION "1.6.3"
#define LFS_LIBNAME "lfs"
#if LUA_VERSION_NUM >= 503 /* Lua 5.3 */
#ifndef luaL_optlong
#define luaL_optlong luaL_optinteger
#endif
#endif
#if LUA_VERSION_NUM < 502
# define luaL_newlib(L,l) (lua_newtable(L), luaL_register(L,NULL,l))
#endif
/* Define 'strerror' for systems that do not implement it */
#ifdef NO_STRERROR
#define strerror(_) "System unable to describe the error"
#endif
#define DIR_METATABLE "directory metatable"
typedef struct dir_data {
int closed;
#ifdef _WIN32
intptr_t hFile;
char pattern[MAX_PATH+1];
#else
DIR *dir;
#endif
} dir_data;
#define LOCK_METATABLE "lock metatable"
#ifdef _WIN32
#ifdef __BORLANDC__
#define lfs_setmode(file, m) (setmode(_fileno(file), m))
#define STAT_STRUCT struct stati64
#else
#define lfs_setmode(file, m) (_setmode(_fileno(file), m))
#define STAT_STRUCT struct _stati64
#endif
#define STAT_FUNC _stati64
#define LSTAT_FUNC STAT_FUNC
#else
#define _O_TEXT 0
#define _O_BINARY 0
#define lfs_setmode(file, m) ((void)file, (void)m, 0)
#define STAT_STRUCT struct stat
#define STAT_FUNC stat
#define LSTAT_FUNC lstat
#endif
/*
** Utility functions
*/
static int pusherror(lua_State *L, const char *info)
{
lua_pushnil(L);
if (info==NULL)
lua_pushstring(L, strerror(errno));
else
lua_pushfstring(L, "%s: %s", info, strerror(errno));
lua_pushinteger(L, errno);
return 3;
}
static int pushresult(lua_State *L, int i, const char *info)
{
if (i==-1)
return pusherror(L, info);
lua_pushinteger(L, i);
return 1;
}
/*
** This function changes the working (current) directory
*/
static int change_dir (lua_State *L) {
const char *path = luaL_checkstring(L, 1);
if (chdir(path)) {
lua_pushnil (L);
lua_pushfstring (L,"Unable to change working directory to '%s'\n%s\n",
path, chdir_error);
return 2;
} else {
lua_pushboolean (L, 1);
return 1;
}
}
/*
** This function returns the current directory
** If unable to get the current directory, it returns nil
** and a string describing the error
*/
static int get_dir (lua_State *L) {
#ifdef NO_GETCWD
lua_pushnil(L);
lua_pushstring(L, "Function 'getcwd' not provided by system");
return 2;
#else
char *path = NULL;
/* Passing (NULL, 0) is not guaranteed to work. Use a temp buffer and size instead. */
size_t size = LFS_MAXPATHLEN; /* initial buffer size */
int result;
while (1) {
path = realloc(path, size);
if (!path) /* failed to allocate */
return pusherror(L, "get_dir realloc() failed");
if (getcwd(path, size) != NULL) {
/* success, push the path to the Lua stack */
lua_pushstring(L, path);
result = 1;
break;
}
if (errno != ERANGE) { /* unexpected error */
result = pusherror(L, "get_dir getcwd() failed");
break;
}
/* ERANGE = insufficient buffer capacity, double size and retry */
size *= 2;
}
free(path);
return result;
#endif
}
/*
** Check if the given element on the stack is a file and returns it.
*/
static FILE *check_file (lua_State *L, int idx, const char *funcname) {
#if LUA_VERSION_NUM == 501
FILE **fh = (FILE **)luaL_checkudata (L, idx, "FILE*");
if (*fh == NULL) {
luaL_error (L, "%s: closed file", funcname);
return 0;
} else
return *fh;
#elif LUA_VERSION_NUM >= 502 && LUA_VERSION_NUM <= 503
luaL_Stream *fh = (luaL_Stream *)luaL_checkudata (L, idx, "FILE*");
if (fh->closef == 0 || fh->f == NULL) {
luaL_error (L, "%s: closed file", funcname);
return 0;
} else
return fh->f;
#else
#error unsupported Lua version
#endif
}
/*
**
*/
static int _file_lock (lua_State *L, FILE *fh, const char *mode, const long start, long len, const char *funcname) {
int code;
#ifdef _WIN32
/* lkmode valid values are:
LK_LOCK Locks the specified bytes. If the bytes cannot be locked, the program immediately tries again after 1 second. If, after 10 attempts, the bytes cannot be locked, the constant returns an error.
LK_NBLCK Locks the specified bytes. If the bytes cannot be locked, the constant returns an error.
LK_NBRLCK Same as _LK_NBLCK.
LK_RLCK Same as _LK_LOCK.
LK_UNLCK Unlocks the specified bytes, which must have been previously locked.
Regions should be locked only briefly and should be unlocked before closing a file or exiting the program.
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vclib/html/_crt__locking.asp
*/
int lkmode;
switch (*mode) {
case 'r': lkmode = LK_NBLCK; break;
case 'w': lkmode = LK_NBLCK; break;
case 'u': lkmode = LK_UNLCK; break;
default : return luaL_error (L, "%s: invalid mode", funcname);
}
if (!len) {
fseek (fh, 0L, SEEK_END);
len = ftell (fh);
}
fseek (fh, start, SEEK_SET);
#ifdef __BORLANDC__
code = locking (fileno(fh), lkmode, len);
#else
code = _locking (fileno(fh), lkmode, len);
#endif
#else
struct flock f;
switch (*mode) {
case 'w': f.l_type = F_WRLCK; break;
case 'r': f.l_type = F_RDLCK; break;
case 'u': f.l_type = F_UNLCK; break;
default : return luaL_error (L, "%s: invalid mode", funcname);
}
f.l_whence = SEEK_SET;
f.l_start = (off_t)start;
f.l_len = (off_t)len;
code = fcntl (fileno(fh), F_SETLK, &f);
#endif
return (code != -1);
}
#ifdef _WIN32
typedef struct lfs_Lock {
HANDLE fd;
} lfs_Lock;
static int lfs_lock_dir(lua_State *L) {
size_t pathl; HANDLE fd;
lfs_Lock *lock;
char *ln;
const char *lockfile = "/lockfile.lfs";
const char *path = luaL_checklstring(L, 1, &pathl);
ln = (char*)malloc(pathl + strlen(lockfile) + 1);
if(!ln) {
lua_pushnil(L); lua_pushstring(L, strerror(errno)); return 2;
}
strcpy(ln, path); strcat(ln, lockfile);
if((fd = CreateFile(ln, GENERIC_WRITE, 0, NULL, CREATE_NEW,
FILE_ATTRIBUTE_NORMAL | FILE_FLAG_DELETE_ON_CLOSE, NULL)) == INVALID_HANDLE_VALUE) {
int en = GetLastError();
free(ln); lua_pushnil(L);
if(en == ERROR_FILE_EXISTS || en == ERROR_SHARING_VIOLATION)
lua_pushstring(L, "File exists");
else
lua_pushstring(L, strerror(en));
return 2;
}
free(ln);
lock = (lfs_Lock*)lua_newuserdata(L, sizeof(lfs_Lock));
lock->fd = fd;
luaL_getmetatable (L, LOCK_METATABLE);
lua_setmetatable (L, -2);
return 1;
}
static int lfs_unlock_dir(lua_State *L) {
lfs_Lock *lock = (lfs_Lock *)luaL_checkudata(L, 1, LOCK_METATABLE);
if(lock->fd != INVALID_HANDLE_VALUE) {
CloseHandle(lock->fd);
lock->fd=INVALID_HANDLE_VALUE;
}
return 0;
}
#else
typedef struct lfs_Lock {
char *ln;
} lfs_Lock;
static int lfs_lock_dir(lua_State *L) {
lfs_Lock *lock;
size_t pathl;
char *ln;
const char *lockfile = "/lockfile.lfs";
const char *path = luaL_checklstring(L, 1, &pathl);
lock = (lfs_Lock*)lua_newuserdata(L, sizeof(lfs_Lock));
ln = (char*)malloc(pathl + strlen(lockfile) + 1);
if(!ln) {
lua_pushnil(L); lua_pushstring(L, strerror(errno)); return 2;
}
strcpy(ln, path); strcat(ln, lockfile);
if(symlink("lock", ln) == -1) {
free(ln); lua_pushnil(L);
lua_pushstring(L, strerror(errno)); return 2;
}
lock->ln = ln;
luaL_getmetatable (L, LOCK_METATABLE);
lua_setmetatable (L, -2);
return 1;
}
static int lfs_unlock_dir(lua_State *L) {
lfs_Lock *lock = (lfs_Lock *)luaL_checkudata(L, 1, LOCK_METATABLE);
if(lock->ln) {
unlink(lock->ln);
free(lock->ln);
lock->ln = NULL;
}
return 0;
}
#endif
static int lfs_g_setmode (lua_State *L, FILE *f, int arg) {
static const int mode[] = {_O_BINARY, _O_TEXT};
static const char *const modenames[] = {"binary", "text", NULL};
int op = luaL_checkoption(L, arg, NULL, modenames);
int res = lfs_setmode(f, mode[op]);
if (res != -1) {
int i;
lua_pushboolean(L, 1);
for (i = 0; modenames[i] != NULL; i++) {
if (mode[i] == res) {
lua_pushstring(L, modenames[i]);
return 2;
}
}
lua_pushnil(L);
return 2;
} else {
return pusherror(L, NULL);
}
}
static int lfs_f_setmode(lua_State *L) {
return lfs_g_setmode(L, check_file(L, 1, "setmode"), 2);
}
/*
** Locks a file.
** @param #1 File handle.
** @param #2 String with lock mode ('w'rite, 'r'ead).
** @param #3 Number with start position (optional).
** @param #4 Number with length (optional).
*/
static int file_lock (lua_State *L) {
FILE *fh = check_file (L, 1, "lock");
const char *mode = luaL_checkstring (L, 2);
const long start = (long) luaL_optinteger (L, 3, 0);
long len = (long) luaL_optinteger (L, 4, 0);
if (_file_lock (L, fh, mode, start, len, "lock")) {
lua_pushboolean (L, 1);
return 1;
} else {
lua_pushnil (L);
lua_pushfstring (L, "%s", strerror(errno));
return 2;
}
}
/*
** Unlocks a file.
** @param #1 File handle.
** @param #2 Number with start position (optional).
** @param #3 Number with length (optional).
*/
static int file_unlock (lua_State *L) {
FILE *fh = check_file (L, 1, "unlock");
const long start = (long) luaL_optinteger (L, 2, 0);
long len = (long) luaL_optinteger (L, 3, 0);
if (_file_lock (L, fh, "u", start, len, "unlock")) {
lua_pushboolean (L, 1);
return 1;
} else {
lua_pushnil (L);
lua_pushfstring (L, "%s", strerror(errno));
return 2;
}
}
/*
** Creates a link.
** @param #1 Object to link to.
** @param #2 Name of link.
** @param #3 True if link is symbolic (optional).
*/
static int make_link(lua_State *L)
{
#ifndef _WIN32
const char *oldpath = luaL_checkstring(L, 1);
const char *newpath = luaL_checkstring(L, 2);
return pushresult(L,
(lua_toboolean(L,3) ? symlink : link)(oldpath, newpath), NULL);
#else
errno = ENOSYS; /* = "Function not implemented" */
return pushresult(L, -1, "make_link is not supported on Windows");
#endif
}
/*
** Creates a directory.
** @param #1 Directory path.
*/
static int make_dir (lua_State *L) {
const char *path = luaL_checkstring (L, 1);
int fail;
#ifdef _WIN32
fail = _mkdir (path);
#else
fail = mkdir (path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP |
S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH );
#endif
if (fail) {
lua_pushnil (L);
lua_pushfstring (L, "%s", strerror(errno));
return 2;
}
lua_pushboolean (L, 1);
return 1;
}
/*
** Removes a directory.
** @param #1 Directory path.
*/
static int remove_dir (lua_State *L) {
const char *path = luaL_checkstring (L, 1);
int fail;
fail = rmdir (path);
if (fail) {
lua_pushnil (L);
lua_pushfstring (L, "%s", strerror(errno));
return 2;
}
lua_pushboolean (L, 1);
return 1;
}
/*
** Directory iterator
*/
static int dir_iter (lua_State *L) {
#ifdef _WIN32
struct _finddata_t c_file;
#else
struct dirent *entry;
#endif
dir_data *d = (dir_data *)luaL_checkudata (L, 1, DIR_METATABLE);
luaL_argcheck (L, d->closed == 0, 1, "closed directory");
#ifdef _WIN32
if (d->hFile == 0L) { /* first entry */
if ((d->hFile = _findfirst (d->pattern, &c_file)) == -1L) {
lua_pushnil (L);
lua_pushstring (L, strerror (errno));
d->closed = 1;
return 2;
} else {
lua_pushstring (L, c_file.name);
return 1;
}
} else { /* next entry */
if (_findnext (d->hFile, &c_file) == -1L) {
/* no more entries => close directory */
_findclose (d->hFile);
d->closed = 1;
return 0;
} else {
lua_pushstring (L, c_file.name);
return 1;
}
}
#else
if ((entry = readdir (d->dir)) != NULL) {
lua_pushstring (L, entry->d_name);
return 1;
} else {
/* no more entries => close directory */
closedir (d->dir);
d->closed = 1;
return 0;
}
#endif
}
/*
** Closes directory iterators
*/
static int dir_close (lua_State *L) {
dir_data *d = (dir_data *)lua_touserdata (L, 1);
#ifdef _WIN32
if (!d->closed && d->hFile) {
_findclose (d->hFile);
}
#else
if (!d->closed && d->dir) {
closedir (d->dir);
}
#endif
d->closed = 1;
return 0;
}
/*
** Factory of directory iterators
*/
static int dir_iter_factory (lua_State *L) {
const char *path = luaL_checkstring (L, 1);
dir_data *d;
lua_pushcfunction (L, dir_iter);
d = (dir_data *) lua_newuserdata (L, sizeof(dir_data));
luaL_getmetatable (L, DIR_METATABLE);
lua_setmetatable (L, -2);
d->closed = 0;
#ifdef _WIN32
d->hFile = 0L;
if (strlen(path) > MAX_PATH-2)
luaL_error (L, "path too long: %s", path);
else
sprintf (d->pattern, "%s/*", path);
#else
d->dir = opendir (path);
if (d->dir == NULL)
luaL_error (L, "cannot open %s: %s", path, strerror (errno));
#endif
return 2;
}
/*
** Creates directory metatable.
*/
static int dir_create_meta (lua_State *L) {
luaL_newmetatable (L, DIR_METATABLE);
/* Method table */
lua_newtable(L);
lua_pushcfunction (L, dir_iter);
lua_setfield(L, -2, "next");
lua_pushcfunction (L, dir_close);
lua_setfield(L, -2, "close");
/* Metamethods */
lua_setfield(L, -2, "__index");
lua_pushcfunction (L, dir_close);
lua_setfield (L, -2, "__gc");
return 1;
}
/*
** Creates lock metatable.
*/
static int lock_create_meta (lua_State *L) {
luaL_newmetatable (L, LOCK_METATABLE);
/* Method table */
lua_newtable(L);
lua_pushcfunction(L, lfs_unlock_dir);
lua_setfield(L, -2, "free");
/* Metamethods */
lua_setfield(L, -2, "__index");
lua_pushcfunction(L, lfs_unlock_dir);
lua_setfield(L, -2, "__gc");
return 1;
}
#ifdef _WIN32
#ifndef S_ISDIR
#define S_ISDIR(mode) (mode&_S_IFDIR)
#endif
#ifndef S_ISREG
#define S_ISREG(mode) (mode&_S_IFREG)
#endif
#ifndef S_ISLNK
#define S_ISLNK(mode) (0)
#endif
#ifndef S_ISSOCK
#define S_ISSOCK(mode) (0)
#endif
#ifndef S_ISFIFO
#define S_ISFIFO(mode) (0)
#endif
#ifndef S_ISCHR
#define S_ISCHR(mode) (mode&_S_IFCHR)
#endif
#ifndef S_ISBLK
#define S_ISBLK(mode) (0)
#endif
#endif
/*
** Convert the inode protection mode to a string.
*/
#ifdef _WIN32
static const char *mode2string (unsigned short mode) {
#else
static const char *mode2string (mode_t mode) {
#endif
if ( S_ISREG(mode) )
return "file";
else if ( S_ISDIR(mode) )
return "directory";
else if ( S_ISLNK(mode) )
return "link";
else if ( S_ISSOCK(mode) )
return "socket";
else if ( S_ISFIFO(mode) )
return "named pipe";
else if ( S_ISCHR(mode) )
return "char device";
else if ( S_ISBLK(mode) )
return "block device";
else
return "other";
}
/*
** Set access time and modification values for file
*/
static int file_utime (lua_State *L) {
const char *file = luaL_checkstring (L, 1);
struct utimbuf utb, *buf;
if (lua_gettop (L) == 1) /* set to current date/time */
buf = NULL;
else {
utb.actime = (time_t)luaL_optnumber (L, 2, 0);
utb.modtime = (time_t) luaL_optinteger (L, 3, utb.actime);
buf = &utb;
}
if (utime (file, buf)) {
lua_pushnil (L);
lua_pushfstring (L, "%s", strerror (errno));
return 2;
}
lua_pushboolean (L, 1);
return 1;
}
/* inode protection mode */
static void push_st_mode (lua_State *L, STAT_STRUCT *info) {
lua_pushstring (L, mode2string (info->st_mode));
}
/* device inode resides on */
static void push_st_dev (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer) info->st_dev);
}
/* inode's number */
static void push_st_ino (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer) info->st_ino);
}
/* number of hard links to the file */
static void push_st_nlink (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer)info->st_nlink);
}
/* user-id of owner */
static void push_st_uid (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer)info->st_uid);
}
/* group-id of owner */
static void push_st_gid (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer)info->st_gid);
}
/* device type, for special file inode */
static void push_st_rdev (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer) info->st_rdev);
}
/* time of last access */
static void push_st_atime (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer) info->st_atime);
}
/* time of last data modification */
static void push_st_mtime (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer) info->st_mtime);
}
/* time of last file status change */
static void push_st_ctime (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer) info->st_ctime);
}
/* file size, in bytes */
static void push_st_size (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer)info->st_size);
}
#ifndef _WIN32
/* blocks allocated for file */
static void push_st_blocks (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer)info->st_blocks);
}
/* optimal file system I/O blocksize */
static void push_st_blksize (lua_State *L, STAT_STRUCT *info) {
lua_pushinteger (L, (lua_Integer)info->st_blksize);
}
#endif
/*
** Convert the inode protection mode to a permission list.
*/
#ifdef _WIN32
static const char *perm2string (unsigned short mode) {
static char perms[10] = "---------";
int i;
for (i=0;i<9;i++) perms[i]='-';
if (mode & _S_IREAD)
{ perms[0] = 'r'; perms[3] = 'r'; perms[6] = 'r'; }
if (mode & _S_IWRITE)
{ perms[1] = 'w'; perms[4] = 'w'; perms[7] = 'w'; }
if (mode & _S_IEXEC)
{ perms[2] = 'x'; perms[5] = 'x'; perms[8] = 'x'; }
return perms;
}
#else
static const char *perm2string (mode_t mode) {
static char perms[10] = "---------";
int i;
for (i=0;i<9;i++) perms[i]='-';
if (mode & S_IRUSR) perms[0] = 'r';
if (mode & S_IWUSR) perms[1] = 'w';
if (mode & S_IXUSR) perms[2] = 'x';
if (mode & S_IRGRP) perms[3] = 'r';
if (mode & S_IWGRP) perms[4] = 'w';
if (mode & S_IXGRP) perms[5] = 'x';
if (mode & S_IROTH) perms[6] = 'r';
if (mode & S_IWOTH) perms[7] = 'w';
if (mode & S_IXOTH) perms[8] = 'x';
return perms;
}
#endif
/* permssions string */
static void push_st_perm (lua_State *L, STAT_STRUCT *info) {
lua_pushstring (L, perm2string (info->st_mode));
}
typedef void (*_push_function) (lua_State *L, STAT_STRUCT *info);
struct _stat_members {
const char *name;
_push_function push;
};
struct _stat_members members[] = {
{ "mode", push_st_mode },
{ "dev", push_st_dev },
{ "ino", push_st_ino },
{ "nlink", push_st_nlink },
{ "uid", push_st_uid },
{ "gid", push_st_gid },
{ "rdev", push_st_rdev },
{ "access", push_st_atime },
{ "modification", push_st_mtime },
{ "change", push_st_ctime },
{ "size", push_st_size },
{ "permissions", push_st_perm },
#ifndef _WIN32
{ "blocks", push_st_blocks },
{ "blksize", push_st_blksize },
#endif
{ NULL, NULL }
};
/*
** Get file or symbolic link information
*/
static int _file_info_ (lua_State *L, int (*st)(const char*, STAT_STRUCT*)) {
STAT_STRUCT info;
const char *file = luaL_checkstring (L, 1);
int i;
if (st(file, &info)) {
lua_pushnil(L);
lua_pushfstring(L, "cannot obtain information from file '%s': %s", file, strerror(errno));
return 2;
}
if (lua_isstring (L, 2)) {
const char *member = lua_tostring (L, 2);
for (i = 0; members[i].name; i++) {
if (strcmp(members[i].name, member) == 0) {
/* push member value and return */
members[i].push (L, &info);
return 1;
}
}
/* member not found */
return luaL_error(L, "invalid attribute name '%s'", member);
}
/* creates a table if none is given, removes extra arguments */
lua_settop(L, 2);
if (!lua_istable (L, 2)) {
lua_newtable (L);
}
/* stores all members in table on top of the stack */
for (i = 0; members[i].name; i++) {
lua_pushstring (L, members[i].name);
members[i].push (L, &info);
lua_rawset (L, -3);
}
return 1;
}
/*
** Get file information using stat.
*/
static int file_info (lua_State *L) {
return _file_info_ (L, STAT_FUNC);
}
/*
** Push the symlink target to the top of the stack.
** Assumes the file name is at position 1 of the stack.
** Returns 1 if successful (with the target on top of the stack),
** 0 on failure (with stack unchanged, and errno set).
*/
static int push_link_target(lua_State *L) {
#ifdef _WIN32
errno = ENOSYS;
return 0;
#else
const char *file = luaL_checkstring(L, 1);
char *target = NULL;
int tsize, size = 256; /* size = initial buffer capacity */
while (1) {
target = realloc(target, size);
if (!target) /* failed to allocate */
return 0;
tsize = readlink(file, target, size);
if (tsize < 0) { /* a readlink() error occurred */
free(target);
return 0;
}
if (tsize < size)
break;
/* possibly truncated readlink() result, double size and retry */
size *= 2;
}
target[tsize] = '\0';
lua_pushlstring(L, target, tsize);
free(target);
return 1;
#endif
}
/*
** Get symbolic link information using lstat.
*/
static int link_info (lua_State *L) {
int ret;
if (lua_isstring (L, 2) && (strcmp(lua_tostring(L, 2), "target") == 0)) {
int ok = push_link_target(L);
return ok ? 1 : pusherror(L, "could not obtain link target");
}
ret = _file_info_ (L, LSTAT_FUNC);
if (ret == 1 && lua_type(L, -1) == LUA_TTABLE) {
int ok = push_link_target(L);
if (ok) {
lua_setfield(L, -2, "target");
}
}
return ret;
}
/*
** Assumes the table is on top of the stack.
*/
static void set_info (lua_State *L) {
lua_pushliteral(L, "Copyright (C) 2003-2016 Kepler Project");
lua_setfield(L, -2, "_COPYRIGHT");
lua_pushliteral(L, "LuaFileSystem is a Lua library developed to complement the set of functions related to file systems offered by the standard Lua distribution");
lua_setfield(L, -2, "_DESCRIPTION");
lua_pushliteral(L, "LuaFileSystem " LFS_VERSION);
lua_setfield(L, -2, "_VERSION");
}
static const struct luaL_Reg fslib[] = {
{"attributes", file_info},
{"chdir", change_dir},
{"currentdir", get_dir},
{"dir", dir_iter_factory},
{"link", make_link},
{"lock", file_lock},
{"mkdir", make_dir},
{"rmdir", remove_dir},
{"symlinkattributes", link_info},
{"setmode", lfs_f_setmode},
{"touch", file_utime},
{"unlock", file_unlock},
{"lock_dir", lfs_lock_dir},
{NULL, NULL},
};
LFS_EXPORT int luaopen_lfs (lua_State *L) {
dir_create_meta (L);
lock_create_meta (L);
luaL_newlib (L, fslib);
lua_pushvalue(L, -1);
lua_setglobal(L, LFS_LIBNAME);
set_info (L);
return 1;
}

3836
lpeg.c Normal file
View File

File diff suppressed because it is too large Load Diff

21902
lua.h Normal file
View File

File diff suppressed because it is too large Load Diff

713
macro.lua Normal file
View File

@ -0,0 +1,713 @@
----------------------------------------------
-- LuaMacro 2, a macro-preprocessor for Lua.
-- Unlike LuaMacro 1.x, it does not depend on the token-filter patch and generates
-- Lua code which can be printed out or compiled directly. C-style macros are easy, but LM2
-- allows for macros that can read their own input and generate output using Lua code.
-- New in this release are lexically-scoped macros.
-- The Lua Lpeg Lexer is by Peter Odding.
--
-- Examples:
--
-- macro.define 'sqr(x) ((x)*(x))'
-- macro.define 'assert_(expr) assert(expr,_STR_(expr))'
-- macro.define('R(n)',function(n)
-- n = n:get_number()
-- return ('-'):rep(n)
-- end
-- macro.define('lazy',function(get)
-- get() -- skip space
-- local expr,endt = get:upto(function(t,v)
-- return t == ',' or t == ')' or t == ';'
-- or (t=='space' and v:match '\n')
-- end)
-- return 'function(_) return '..tostring(expr)..' end'..tostring(endt)
-- end)
--
--
-- @author Steve Donovan
-- @copyright 2011
-- @license MIT/X11
-- @module macro
-- @alias M
local macro = {}
local M = macro
local lexer = require 'macro.lexer'
local Getter = require 'macro.Getter'
local TokenList = require 'macro.TokenList'
local scan_code = lexer.scan_lua
local append = table.insert
local setmetatable = setmetatable
--local tdump = require 'pl.pretty'.dump
local scan_iter, tnext = Getter.scan_iter, Getter.next
M.upto_keywords = Getter.upto_keywords
M.Putter = TokenList.new
-- given a token list, a set of formal arguments and the actual arguments,
-- return a new token list where the formal arguments have been replaced
-- by the actual arguments
local function substitute_tokenlist (tl,parms,args)
local append,put_tokens = table.insert,TokenList.tokens
local parm_map = {}
for i,name in ipairs(parms) do
parm_map[name] = args[i]
end
local res = {}
for _,tv in ipairs(tl) do
local t,v = tv[1],tv[2]
if t == 'iden' then
local pval = parm_map[v]
if pval then
put_tokens(res,pval)
else
append(res,tv)
end
else
append(res,tv)
end
end
return res
end
----------------
-- Defining and Working with Macros.
-- @section macros
--- make a copy of a list of tokens.
-- @param tok the list
-- @param pred copy up to this condition; if defined, must be a function
-- of two arguments, the token type and the token value.
-- @return the copy
-- @return the token that matched the predicate
function M.copy_tokens(tok,pred)
local res = {}
local t,v = tok()
while t and not (pred and pred(t,v)) do
append(res,{t,v})
t,v = tok()
end
return res,{t,v}
end
---- define new lexical tokens.
-- @param extra a list of strings defining the new tokens
-- @usage macro.define_tokens{'{|'}
function M.define_tokens(extra)
lexer.add_extra_tokens(extra)
end
local imacros,smacros = {},{}
M.macro_table = imacros
--- define a macro using a specification string and optional function.
-- The specification looks very much like a C preprocessor macro: the name,
-- followed by an optional formal argument list (_no_ space after name!) and
-- the substitution. e.g `answer 42` or `sqr(x) ((x)*(x))`
--
-- If there is no substitution, then the second argument must be a function which
-- will be evaluated for the actual substitution. If there are explicit parameters, then they will be passed as token lists. Otherwise, the function is passed a `get` and a `put` argument, which are `Getter` and `TokenList` objects.
--
-- The substitution function may return a `TokenList` object, or a string.
-- @param macstr
-- @param subst_fn the optional substitution function
-- @see macro.Getter, macro.TokenList
function M.define(macstr,subst_fn)
local tok,t,macname,parms,parm_map
local mtbl
tok = scan_code(macstr)
t,macname = tok()
if t == 'iden' then mtbl = imacros
elseif t ~= 'string' and t ~= 'number' and t ~= 'keyword' then
mtbl = smacros
else
error("a macro cannot be of type "..t)
end
t = tok()
if t == '(' then
parms = Getter.new(tok):idens()
end
mtbl[macname] = {
name = macname,
subst = subst_fn or M.copy_tokens(tok),
parms = parms
}
end
--- define a macro using a function and a parameter list.
-- @param name either an identifier or an operator.
-- @param subst a function
-- @param parms a list of parameter names
-- @return the existing value of this macro, if any
function M.set_macro(name,subst,parms)
local macros
if name:match '^[_%a][_%w]*$' then
macros = imacros
else
macros = smacros
end
if subst == nil then
macros[name] = nil
return
end
local last = macros[name]
if type(subst) ~= 'table' or not subst.name then
subst = {
name = name,
subst = subst,
parms = parms
}
end
macros[name] = subst
return last
end
--- defined a scoped macro. Like define except this macro will not
-- be visible outside the current scope.
-- @param name either an identifier or an operator.
-- @param subst a function
-- @param parms a list of parameter names
-- @see set_macro
function M.define_scoped (name,subst,parms)
local old_value = M.set_macro(name,subst,parms)
M.block_handler(-1,function()
M.set_macro(name,old_value)
end)
end
--- get the value of a macro. The macro substitution must either be a
-- a string or a single token.
-- @param name existing macro name
-- @return a string value, or nil if the macro does not exist.
function M.get_macro_value(name)
local mac = imacros[name]
if not mac then return nil end
if type(mac.subst) == 'table' then
return mac.subst[1][2]
else
return mac.subst
end
end
local function get_macro (mac, no_error)
local macro = imacros[mac]
if not macro and not no_error then
M.error("macro "..mac.." is not defined")
end
return macro
end
local push,pop = table.insert,table.remove
--- push a value on the stack associated with a macro.
-- @param name macro name
-- @param value any value
function M.push_macro_stack (name,value)
local macro = get_macro(name)
macro.stack = macro.stack or {}
push(macro.stack,value)
end
--- pop a value from a macro stack.
-- @param name macro name
-- @return any value, if defined
function M.pop_macro_stack (name)
local macro = get_macro(name)
if macro.stack and #macro.stack > 0 then
return pop(macro.stack)
end
end
--- value of top of macro stack.
-- @param name macro name
-- @return any value, if defined
function M.value_of_macro_stack (name)
local macro = get_macro(name,true)
if not macro then return nil end
if macro.stack and #macro.stack > 0 then
return macro.stack[#macro.stack]
end
end
local lua_keywords = {
['do'] = 'open', ['then'] = 'open', ['else'] = 'open', ['function'] = 'open',
['repeat'] = 'open';
['end'] = 'close', ['until'] = 'close',['elseif'] = 'close'
}
local c_keywords = {}
local keywords = lua_keywords
local block_handlers,keyword_handlers = {},{}
local level = 1
--- specify a block handler at a given level.
-- a block handler may indicate with an extra true return
-- that it wants to persist; it is passed the getter and the keyword
-- so we can get more specific end-of-block handlers.
-- @param lev relative block level
-- @param action will be called when the block reaches the level
function M.block_handler (lev,action)
lev = lev + level
if not block_handlers[lev] then
block_handlers[lev] = {}
end
append(block_handlers[lev],action)
end
local function process_block_handlers(level,get,v)
local persist,result
for _,bh in pairs(block_handlers[level]) do
local res,keep = bh(get,v)
if not keep then
if res then result = res end
else
persist = persist or {}
append(persist,bh)
end
end
block_handlers[level] = persist
return result
end
--- set a keyword handler. Unlike macros, the keyword itself is always
-- passed through, but the handler may add some output afterwards.
-- If the action is nil, then the handler for that keyword is removed.
-- @param word keyword
-- @param action function to be called when keyword is encountered
-- @return previous handler associated with this keyword
function M.keyword_handler (word,action)
if word == 'BEGIN' or word == 'END' then
keyword_handlers[word] = action
return
end
if action then
local last = keyword_handlers[word]
keyword_handlers[word] = action
return last
else
keyword_handlers[word] = nil
end
end
--- set a scoped keyword handler. Like keyword_handler, except
-- it restores the original keyword handler (if any) at the end
-- of the current block.
-- @param word keyword
-- @param action to be called when keyword is encountered
-- @see keyword_handler
function M.scoped_keyword_handler (keyword, action)
local last = M.keyword_handler(keyword,action)
M.block_handler(-1,function()
M.keyword_handler(keyword,last)
end)
end
-- a convenient way to use keyword handlers. This sets a handler and restores
-- the old handler at the end of the current block.
-- @param word keyword
-- @param action to be called when keyword is encountered
-- @return a function that creates a scoped keyword handler
function M.make_scoped_handler(keyword,handler)
return function() M.scoped_keyword_handler(keyword, action) end
end
M.please_throw = false
--- macro error messages.
-- @param msg the message: will also have file:line.
function M.error(msg)
msg = M.filename..':'..lexer.line..': '..msg
if M.please_throw then
error(msg,2)
else
io.stderr:write(msg,'\n')
os.exit(1)
end
end
M.define ('debug_',function()
M.DEBUG = true
end)
--- macro error assert.
-- @param expr an expression.
-- @param msg a message
function M.assert(expr,msg)
if not expr then M.error(msg or 'internal error') end
return expr
end
Getter.error = M.error
Getter.assert = M.assert
TokenList.assert = M.assert
local line_updater, line_table, last_name, last_lang
local function lua_line_updater (iline,oline)
if not line_table then line_table = {} end
append(line_table,{il=iline,ol=oline})
end
local function c_line_updater (iline,oline,last_t,last_v)
local endt = last_t == 'space' and last_v or '\n'
return '#line '..iline..' "'..M.filename..'"'..endt
end
local make_putter = TokenList.new
--- do a macro substitution on Lua source.
-- @param src Lua source (either string or file-like reader)
-- @param out output (a file-like writer)
-- @param name input file name
-- @param use_c nil for Lua; if 'line', then output #line directives; if true, then don't
-- @return the result as table of strings
-- @return line number information
function M.substitute(src,name, use_c)
local out, ii = {}, 1
local subparse
if name then
last_name = name
last_lang = use_c
else
name = last_name
use_c = last_lang and true
subparse = true
end
M.filename = name
if use_c then
lexer = require 'macro.clexer'
scan_code = lexer.scan_c
keywords = c_keywords
if use_c == 'line' then
line_updater = c_line_updater
else
line_updater = function() end
end
else
lexer = require 'macro.lexer'
scan_code = lexer.scan_lua
keywords = lua_keywords
line_updater = lua_line_updater
end
local tok = scan_code(src,name)
local iline,iline_changed = 0
local last_t,last_v = 'space','\n'
local do_action
local t,v = tok()
-- this function get() is always used, so that we can handle end-of-stream properly.
-- The substitution mechanism pushes a new stream on the tstack, which is popped
-- when empty.
local tstack = {}
local push,pop = table.insert,table.remove
local function get ()
last_t,last_v = t,v
local t,v = tok()
while not t do
tok = pop(tstack)
if tok == nil then
if not subparse and keyword_handlers.END then
do_action(keyword_handlers.END)
keyword_handlers.END = nil
end
if tok == nil then -- END action might have inserted some tokens
return nil
end
end -- finally finished
t,v = tok()
end
if name == lexer.name and iline ~= lexer.line then
iline = lexer.line -- input line has changed
iline_changed = last_v
end
return t,v
end
local getter = Getter.new(get)
--- get a list of consecutive matching tokens.
-- @param get token fetching function
-- @param accept set of token types (default: `{space=true,comment=true}`)
function getter.matching (get, accept)
accept = accept or {space=true, comment=true}
local tl = TokenList.new()
local t,v = get:peek(1, true)
while accept[t] do
t,v = get ()
append(tl, {t, v})
t,v = get:peek(1, true)
end
return tl
end
function getter:peek (offset,dont_skip)
local step = offset < 0 and -1 or 1 -- passing offset 0 is undefined
local k = 0
local token, t, v
repeat
while true do
token = tok (k)
if not token then return nil, 'EOS' end
t,v = token[1], token[2]
if dont_skip or (t ~= 'space' and t ~= 'comment') then break end
k = k + 1
end
offset = offset - step
k = k + step
until offset == 0
return t,v,k+1
end
function getter:peek2 ()
local t1,v1,k1 = self:peek(1)
local t2,v2 = self:peek(k1+1)
return t1,v1,t2,v2
end
function getter:patch (idx,text)
out[idx] = text
end
function getter:placeholder (put)
put:iden '/MARK?/'
return ii
end
function getter:copy_from (pos,clear)
local res = {}
for i = pos, ii do
if out[i] and not out[i]:match '^#line' then
append(res,out[i])
end
end
if clear then
for i = pos, ii do
table.remove(out,pos)
ii = ii - 1
end
end
return table.concat(res)
end
-- this feeds the results of a substitution into the token stream.
-- substitutions may be token lists, Lua strings or nil, in which case
-- the substitution is ignored. The result is to push a new token stream
-- onto the tstack, so it can be fetched using get() above
local function push_substitution (subst)
if subst == nil then return end
local st = type(subst)
push(tstack,tok)
if st == 'table' then
subst = scan_iter(subst)
elseif st == 'string' then
subst = scan_code(subst)
end
tok = subst
end
M.push_substitution = push_substitution
-- a macro object consists of a subst object and (optional) parameters.
-- If there are parms, then a macro argument list must follow.
-- The subst object is either a token list or a function; if a token list we
-- substitute the actual parameters for the formal parameters; if a function
-- then we call it with the actual parameters.
-- Without parameters, it may be a simple substitution (TL or Lua string) or
-- may be a function. In the latter case we call it passing the token getter,
-- assuming that it will grab anything it needs from the token stream.
local function expand_macro(get,mac)
local pass_through
local subst = mac.subst
local fun = type(subst)=='function'
if mac.parms then
t = tnext(get);
if t ~= '(' then
M.error('macro '..mac.name..' expects parameters')
end
local args,err = Getter.list(get)
M.assert(args,'no end of argument list')
if fun then
subst = subst(unpack(args))
else
if #mac.parms ~= #args then
M.error(mac.name.." takes "..#mac.parms.." arguments")
end
subst = substitute_tokenlist(subst,mac.parms,args)
end
elseif fun then
subst,pass_through = subst(getter,make_putter())
end
push_substitution(subst)
return pass_through
end
local multiline_tokens,sync = lexer.multiline_tokens,lexer.sync
local line,last_diff = 0,0
function do_action (action)
push_substitution(action(getter,make_putter()))
end
if not subparse and keyword_handlers.BEGIN then
do_action(keyword_handlers.BEGIN)
end
while t do
--print('tv',t,v)
local dump = true
if t == 'iden' then -- classic name macro
local mac = imacros[v]
if mac then
dump = expand_macro(get,mac)
end
elseif t == 'keyword' then
-- important to track block level for lexical scoping and block handlers
local class = keywords[v]
if class == 'open' then
if v ~= 'else' then level = level + 1 end
elseif class == 'close' then
level = level - 1
if block_handlers[level] then
local res = process_block_handlers(level,get,v)
if res then push_substitution(res) end
end
--* elseif class == 'hook' then
end
local action = keyword_handlers[v]
if action then do_action(action) end
else -- any unused 'operator' token (like @, \, #) can be used as a macro
if use_c then
if v == '{' then
level = level + 1
elseif v == '}' then
level = level - 1
if block_handlers[level] then
local res = process_block_handlers(level,get,v)
if res then push_substitution(res) end
end
end
end
local mac = smacros[v]
if mac then
dump = expand_macro(get,mac)
end
end
if dump then
if multiline_tokens[t] then -- track output line
line = sync(line, v)
end
if iline_changed then
local diff = line - iline
if diff ~= last_diff then
local ldir = line_updater(iline,line,last_t,last_v)
if ldir then out[ii] = ldir; ii=ii+1 end
last_diff = diff
end
iline_changed = nil
end
out[ii] = v
ii = ii + 1
end
t,v = get()
end
return out,line_table
end
--- take some Lua source and return the result of the substitution.
-- Does not raise any errors.
-- @param src either a string or a readable file object
-- @param name optional name for the chunk
-- @return the result or nil
-- @return the error, if error
function M.substitute_tostring(src,name,use_c,throw)
M.please_throw = true
local ok,out,li
if throw then
out,li = M.substitute(src,name,use_c)
else
ok,out,li = pcall(M.substitute,src,name,use_c)
end
if type(src) ~= 'string' and src.close then src:close() end
if not ok then return nil, out
else
return table.concat(out), li
end
end
local lua52 = _VERSION:match '5.2'
local load, searchpath = load, package.searchpath
if not lua52 then -- Lua 5.1
function load (env,src,name)
local chunk,err = loadstring(src,name)
if chunk and env then
setfenv(chunk,env)
end
return chunk,err
end
end
if not searchpath then
local sep = package.config:sub(1,1)
searchpath = function (mod,path)
mod = mod:gsub('%.',sep)
for m in path:gmatch('[^;]+') do
local nm = m:gsub('?',mod)
local f = io.open(nm,'r')
if f then f:close(); return nm end
end
end
end
--- load Lua code in a given envrionment after passing
-- through the macro preprocessor.
-- @param src either a string or a readable file object
-- @param name optional name for the chunk
-- @param env the environment (may be nil)
-- @return the cnunk, or nil
-- @return the error, if no chunk
function M.load(src,name,env)
local res,err = M.substitute_tostring(src,'tmp')
if not res then return nil,err end
return loadin(env,res,name)
end
--- evaluate Lua macro code in a given environment.
-- @param src either a string or a readable file object
-- @param env the environment (can be nil)
-- @return true if succeeded
-- @return result(s)
function M.eval(src,env)
local chunk,err = M.loadin(src,'(tmp)',env)
if not chunk then return nil,err end
return pcall(chunk)
end
package.mpath = './?.m.lua'
--- Make `require` use macro expansion.
-- This is controlled by package.mpath, which is initially './?.m.lua'
function M.set_package_loader()
-- directly inspired by https://github.com/bartbes/Meta/blob/master/meta.lua#L32,
-- after a suggestion by Alexander Gladysh
table.insert(package.searchers, function(name)
local fname = searchpath(name,package.mpath)
if not fname then return nil,"cannot find "..name end
local res,err = M.load(io.open(fname),lname)
if not res then
error (err)
end
return res
end)
end
return macro

24
macro/6502.lua Normal file
View File

@ -0,0 +1,24 @@
--[[
6502 assembler macros.
]]
local M = require 'macro'
local val = function(s)
end
local op_imm = {}
local op = {
lda = function(get,put)
get:expecting 'space'
local t,v = get:next()
if t ~= '#' then return nil,true end
t,v = get:block(nil, {['\n']=true,['--']=true})
return put 'lda.imm(' :tokenlist t ')' :token v
--v = get:upto '\n' --'[;\n(--)]'
--return ('lda.imm(%s)\n'):format(v)
end,
}
for k,v in pairs(op) do M.define(k,v) end

320
macro/Getter.lua Normal file
View File

@ -0,0 +1,320 @@
--- Getter class. Used to get values from the token stream. The first
-- argument `get` of a macro substitution function is of this type.
--
-- M.define ('\\',function(get,put)
-- local args, body = get:idens('('), get:list()
-- return put:keyword 'function' '(' : idens(args) ')' :
-- keyword 'return' : list(body) : space() : keyword 'end'
-- end)
--
-- The second argument `put` is a `TokenList` object.
-- @see macro.TokenList
-- @module macro.Getter
local TokenList = require 'macro.TokenList'
local append = table.insert
local setmetatable = setmetatable
local Getter = {
__call = function(self)
return self.fun()
end
}
local M = Getter
Getter.__index = Getter;
local scan_iter
function Getter.new (get)
return setmetatable({fun=get},Getter)
end
function Getter.from_tl(tl)
return Getter.new(scan_iter(tl))
end
local Tok = {
__tostring = function(self)
return self[2]
end
}
local function tok_new (t)
return setmetatable(t,Tok)
end
-- create a token iterator out of a token list
function Getter.scan_iter (tlist)
local i,n = 1,#tlist
return function(k)
if k ~= nil then
k = i + k
if k < 1 or k > n then return nil end
return tlist[k]
end
local tv = tlist[i]
if tv == nil then return nil end
i = i + 1
return tv[1],tv[2]
end
end
scan_iter = Getter.scan_iter
--- get the next non-whitespace token.
-- @return token type
-- @return token value
-- @function Getter.next
function Getter.next(get)
local t,v = get()
while t == 'space' or t == 'comment' do
t,v = get()
end
return t,v
end
local TL,LTL = TokenList.new, TokenList.new_list
local function tappend (tl,t,val)
val = val or t
append(tl,{t,val})
end
--- get a balanced block.
-- Typically for grabbing up to an `end` keyword including any nested
-- `if`, `do` or `function` blocks with their own `end` keywords.
-- @param tok the token stream
-- @param begintokens set of tokens requiring their own nested *endtokens*
-- (default: `{['do']=true,['function']=true,['if']=true}`)
-- @param endtokens set of tokens ending a block (default:`{['end']=true}`)
-- @return list of tokens
-- @return block end token in form `{type,value}`
-- @usage
-- -- copy a balanced table constructor
-- get:expecting '{'
-- put '{':tokens (get:block ({['{']=true}, {['}']=true}) '}')
function Getter.block(tok,begintokens,endtokens)
begintokens = begintokens or {['do']=true,['function']=true,['if']=true}
endtokens = endtokens or {['end']=true}
local level = 1 -- used to count expected matching `endtokens`
local tl = TL()
local token,value
repeat
token,value = tok()
if not token then return nil,'unexpected end of block' end
if begintokens[value] then
level = level + 1
elseif endtokens[value] then
level = level - 1
end
if level > 0 then -- final end token is returned separately
tappend(tl,token,value)
end
until level == 0
return tl,tok_new{token,value}
end
--- get a delimited list of token lists.
-- Typically used for grabbing argument lists like ('hello',a+1,fred(c,d)); will count parens
-- so that the delimiter (usually a comma) is ignored inside sub-expressions. You must have
-- already read the start token of the list, e.g. open parentheses. It will eat the end token
-- and return the list of TLs, plus the end token. Based on similar code in Penlight's
-- `pl.lexer` module.
-- @param tok the token stream
-- @param endt the end token (default ')')
-- @param delim the delimiter (default ',')
-- @return list of token lists
-- @return end token in form {type,value}
function Getter.list(tok,endtoken,delim)
endtoken = endtoken or ')'
delim = delim or ','
local parm_values = LTL()
local level = 1 -- used to count ( and )
local tl = TL()
local is_end
if type(endtoken) == 'function' then
is_end = endtoken
elseif endtoken == '\n' then
is_end = function(t,val)
return t == 'space' and val:find '\n'
end
else
is_end = function (t)
return t == endtoken
end
end
local token,value = tok()
if is_end(token,value) then return parm_values end
if token == 'space' then
token,value = tok()
end
while true do
if not token then return nil,'unexpected end of list' end -- end of stream is an error!
if is_end(token,value) and level == 1 then
append(parm_values,tl)
break
elseif token == '(' then
level = level + 1
tappend(tl,'(')
elseif token == ')' then
level = level - 1
if level == 0 then -- finished with parm list
append(parm_values,tl)
break
else
tappend(tl,')')
end
elseif token == '{' then
level = level + 1
tappend(tl,'{')
elseif token == '}' then
level = level - 1
tappend(tl,'}')
elseif token == delim and level == 1 then
append(parm_values,tl) -- a new parm
tl = TL()
else
tappend(tl,token,value)
end
token,value=tok()
end
return parm_values,tok_new{token,value}
end
function Getter.upto_keywords (k1,k2)
return function(t,v)
return t == 'keyword' and (v == k1 or v == k2)
end,''
end
local tnext = Getter.next
function Getter.upto(tok,k1,k2)
local endt = k1
if type(k1) == 'string' and k1:match '^%a+$' then
endt = Getter.upto_keywords(k1,k2)
end
local ltl,tok = tok:list(endt,'')
M.assert(ltl ~= nil and #ltl > 0,'failed to grab tokens')
return ltl[1],tok
end
function Getter.line(tok)
return tok:upto(function(t,v)
return (t=='space' and v:match '\n') or t == 'comment'
end)
end
local function prettyprint (t, v)
v = v:gsub ("\n", "\\n")
if t == "string" then
if #v > 16 then v = v:sub(1,12).."..."..v:sub(1,1) end
return t.." "..v
end
if #v > 16 then v = v:sub(1,12).."..." end
if t == "space" or t == "comment" or t == "keyword" then
return t.." '"..v.."'"
elseif t == v then
return "'"..v.."'"
else
return t.." "..v
end
end
--- get the next identifier token.
-- (will be an error if the token has wrong type)
-- @return identifier name
function Getter.iden(tok)
local t,v = tnext(tok)
M.assert(t == 'iden','expecting identifier, got '..prettyprint(t,v))
return v
end
Getter.name = Getter.iden -- backwards compatibility!
--- get the next number token.
-- (will be an error if the token has wrong type)
-- @return converted number
function Getter.number(tok)
local t,v = tnext(tok)
M.assert(t == 'number','expecting number, got '..prettyprint(t,v))
return tonumber(v)
end
--- get a delimited list of identifiers.
-- works like list.
-- @param tok the token stream
-- @param endt the end token (default ')')
-- @param delim the delimiter (default ',')
-- @see list
function Getter.idens(tok,endt,delim)
local ltl,err = tok:list(endt,delim)
if not ltl then error('idens: '..err) end
local names = {}
-- list() will return {{}} for an empty list of tlists
for i = 1,#ltl do
local tl = ltl[i]
local tv = tl[1]
if tv then
if tv[1] == 'space' then tv = tl[2] end
names[i] = tv[2]
end
end
return names, err
end
Getter.names = Getter.idens -- backwards compatibility!
--- get the next string token.
-- (will be an error if the token has wrong type)
-- @return string value (without quotes)
function Getter.string(tok)
local t,v = tok:expecting("string")
return v:sub(2,-2)
end
--- assert that the next token has the given type. This will throw an
-- error if the next non-whitespace token does not match.
-- @param type a token type ('iden','string',etc)
-- @param value a token value (optional)
-- @usage get:expecting '('
-- @usage get:expecting ('iden','bonzo')
function Getter.expecting (tok,type,value)
local t,v = tnext(tok)
if t ~= type then M.error ("expected "..type.." got "..prettyprint(t,v)) end
if value then
if v ~= value then M.error("expected "..value.." got "..prettyprint(t,v)) end
end
return t,v
end
--- peek ahead or before in the token stream.
-- @param k positive delta for looking ahead, negative for looking behind.
-- @param dont_skip true if you want to check for whitespace
-- @return the token type
-- @return the token value
-- @return the token offset
-- @function Getter.peek
--- peek ahead two tokens.
-- @return first token type
-- @return first token value
-- @return second token type
-- @return second token value
-- @function Getter.peek2
--- patch the token stream at the end.
-- @param idx index in output table
-- @param text to replace value at that index
-- @function Getter.patch
--- put out a placeholder for later patching.
-- @param put a putter object
-- @return an index into the output table
-- @function Getter.placeholder
return Getter

201
macro/TokenList.lua Normal file
View File

@ -0,0 +1,201 @@
---------------
-- A TokenList class for generating token lists.
--
-- There are also useful `get_` methods for extracting values from
-- the first token.
--
-- @module macro.TokenList
local TokenList = {}
local M = TokenList
TokenList.__index = TokenList
local append = table.insert
function TokenList.new (tl)
return setmetatable(tl or {},TokenList)
end
local TokenListList = {}
function TokenList.new_list (ltl)
return setmetatable(ltl or {},TokenListList)
end
TokenListList.__index = function(self,key)
local m = TokenList[key]
return function(self,...)
local res = {}
for i = 1,#self do res[i] = m(self[i],...) end
return TokenList.new_list(res)
end
end
-- token-getting helpers
local function extract (tl)
local tk = tl[1]
if tk[1] == 'space' then
tk = tl[2]
end
return tk
end
--- get an identifier from front of a token list.
-- @return identifier name
function TokenList.get_iden (tl)
local tk = extract(tl)
M.assert(tk[1]=='iden','expecting identifier')
return tk[2]
end
--- get an number from front of a token list.
-- @return number
function TokenList.get_number(tl)
local tk = extract(tl)
M.assert(tk[1]=='number','expecting number')
return tonumber(tk[2])
end
--- get a string from front of a token list.
-- @return string value (without quotes)
function TokenList.get_string(tl)
local tk = extract(tl)
M.assert(tk[1]=='string')
return tk[2]:sub(2,-2) -- watch out! what about long string literals??
end
--- takes a token list and strips spaces and comments.
-- @return new tokenlist
function TokenList.strip_spaces (tl)
local out = TokenList.new()
for _,t in ipairs(tl) do
if t[1] ~= 'comment' and t[1] ~= 'space' then
append(out,t)
end
end
return out
end
--- pick the n-th token from this tokenlist.
-- Note that it returns the value and type, not the type and value.
-- @param n (1 to #self)
-- @return token value
-- @return token type
function TokenList.pick (tl,n)
local t = tl[n]
return t[2],t[1]
end
-- token-putting helpers
local comma,space = {',',','},{'space',' '}
--- append an identifier.
-- @param name the identifier
-- @param no_space true if you don't want a space after the iden
-- @return self
function TokenList.iden(res,name,no_space)
append(res,{'iden',name})
if not no_space then
append(res,space)
end
return res
end
TokenList.name = TokenList.iden -- backwards compatibility!
--- append a string.
-- @param s the string
-- @return self
function TokenList.string(res,s)
append(res,{'string','"'..s..'"'})
return res
end
--- append a number.
-- @param val the number
-- @return self
function TokenList.number(res,val)
append(res,{'number',val})
return res
end
--- put out a list of identifiers, separated by commas.
-- @param res output token list
-- @param names a list of identifiers
-- @return self
function TokenList.idens(res,names)
for i = 1,#names do
res:iden(names[i],true)
if i ~= #names then append(res,comma) end
end
return res
end
TokenList.names = TokenList.idens -- backwards compatibility!
--- put out a token list.
-- @param res output token list
-- @param tl a token list
-- @return self
function TokenList.tokens(res,tl)
for j = 1,#tl do
append(res,tl[j])
end
return res
end
--- put out a list of token lists, separated by commas.
-- @param res output token list
-- @param ltl a list of token lists
-- @return self
function TokenList.list(res,ltl)
for i = 1,#ltl do
res:tokens(ltl[i])
if i ~= #ltl then append(res,comma) end
end
return res
end
--- put out a space token.
-- @param res output token list
-- @param space a string containing only whitespace (default ' ')
-- @return self
function TokenList.space(res,space)
append(res,{'space',space or ' '})
return res
end
--- put out a keyword token.
-- @param res output token list
-- @param keyw a Lua keyword
-- @param no_space true if you don't want a space after the iden
-- @return self
function TokenList.keyword(res,keyw,no_space)
append(res,{'keyword',keyw})
if not no_space then
append(res,space)
end
return res
end
--- convert this tokenlist into a string.
function TokenList.__tostring(tl)
local res = {}
for j = 1,#tl do
append(res,tl[j][2])
end
return table.concat(res)
end
--- put out a operator token. This is the overloaded call operator
-- for token lists.
-- @param res output token list
-- @param keyw an operator string
function TokenList.__call(res,t,v)
append(res,{t,v or t})
return res
end
return TokenList

161
macro/builtin.lua Normal file
View File

@ -0,0 +1,161 @@
-------
-- LuaMacro built-in macros.
-- @module macro.builtin
local M = require 'macro'
local function macro_def (scoped)
return function (get)
local t,name,parms,openp
local t,name = get:next()
local upto,ret
if t == '(' then
t,name = get:next()
upto = function(t,v) return t == ')' end
else
upto = function(t,v)
return t == 'space' and v:find '\n'
end
-- return space following (returned by copy_tokens)
ret = true
end
-- might be immediately followed by a parm list
t,openp = get()
if openp == '(' then
parms = get:names()
end
-- the actual substitution is up to the end of the line
local args, space = M.copy_tokens(get,upto)
if scoped then
M.define_scoped(name,args,parms)
else
M.set_macro(name,args,parms)
end
return ret and space[2]
end
end
--- a macro for defining lexically scoped simple macros.
-- def_ may be followed by an arglist, and the substitution is the
-- rest of the line.
-- @usage def_ block (function() _END_CLOSE_
-- @usage def_ sqr(x) ((x)*(x))
-- @macro def_
M.define ('def_',macro_def(true))
--- a global version of `def_`.
-- @see def_
-- @macro define_
M.define ('define_',macro_def(false))
--- set the value of an existing macro.
-- the name and value follows immediately, and the value must be
-- a single token
-- @usage set_ T 'string'
-- @usage set_ F function
-- @macro set_
M.define('set_',function(get)
local name = get:name()
local t,v = get:next()
M.set_macro(name,{{t,v}})
end)
--- undefining identifier macros.
-- @macro undef_
M.define('undef_',function(get)
M.set_macro(get:name())
end)
--- Insert text after current block end. `_END_` is followed by a quoted string
-- and is used to insert that string after the current block closes.
-- @macro _END_
M.define ('_END_',function(get)
local str = get:string()
M.block_handler(-1,function(get,word)
if word ~= 'end' then return nil,true end
return str
end)
end)
--- insert an end after the next closing block.
-- @macro _END_END_
-- @see _END_
M.define '_END_END_ _END_ " end"'
--- insert a closing parens after next closing block.
-- @usage def_ begin (function() _END_CLOSE_
-- fun begin ... end --> fun (function() ... end)
-- @macro _END_CLOSE_
-- @see _END_
M.define '_END_CLOSE_ _END_ ")"'
--- 'stringizing' macro.
-- Will convert its argument into a string.
-- @usage def_ _assert(x) assert(x,_STR_(x))
-- @macro _STR_
M.define('_STR_(x)',function(x)
x = tostring(x)
local put = M.Putter()
return put '"':name(x) '"'
end)
-- macro stack manipulation
--- push a value onto a given macro' stack.
-- @macro _PUSH_
-- @param mac existing macro name
-- @param V a string
M.define('_PUSH_(mac,V)',function(mac,V)
M.push_macro_stack(mac:get_string(),V:get_string())
end)
--- pop a value from a macro's stack.
-- @macro _POP_
-- @param mac existing macro name
-- @return a string
-- @see _PUSH_
M.define('_POP_',function(get,put)
local val = M.pop_macro_stack(get:string())
if val then
return put(val)
end
end)
--- drop the top of a macro's stack.
-- Like `_POP_`, except that it does not return the value
-- @macro _DROP_
-- @return existing macro name
-- @see _POP_
M.define('_DROP_',function(get)
M.pop_macro_stack(get:string())
end)
--- Load a Lua module immediately. This allows macro definitions to
-- to be loaded before the rest of the file is parsed.
-- If the module returns a function, then this is assumed to be a
-- substitution function, allowing macro modules to insert code
-- at this point.
-- @macro require_
M.define('require_',function(get,put)
local name = get:string()
local ok,fn = pcall(require,name)
if not ok then
fn = require('macro.'..name)
end
if type(fn) == 'function' then
return fn(get,put)
end
end)
--- Include the contents of a file. This inserts the file directly
-- into the token stream, and is equivalent to cpp's `#include` directive.
-- @macro include_
M.define('include_',function(get)
local str = get:string()
local f = M.assert(io.open(str))
local txt = f:read '*a'
f:close()
M.push_substitution(txt)
end)

169
macro/clexer.lua Normal file
View File

@ -0,0 +1,169 @@
--[[--- A C lexical scanner using LPeg.
= CREDITS
= based on the C lexer in Peter Odding's lua-lxsh
@module macro.clexer
--]]
local clexer = {}
local lpeg = require 'lpeg'
local P, R, S, C, Cc, Ct = lpeg.P, lpeg.R, lpeg.S, lpeg.C, lpeg.Cc, lpeg.Ct
-- create a pattern which captures the lua value [id] and the input matching
-- [patt] in a table
local function token(id, patt) return Ct(Cc(id) * C(patt)) end
-- private interface
local table_of_tokens
local extra_tokens
function clexer.add_extra_tokens(extra)
extra_tokens = extra_tokens or {}
for _,t in ipairs(extra) do
table.insert(extra_tokens,t)
end
table_of_tokens = nil -- re-initialize
end
function clexer.init ()
local digit = R('09')
local upp, low = R'AZ', R'az'
local oct, dec = R'07', R'09'
local hex = dec + R'AF' + R'af'
local letter = upp + low
local alnum = letter + dec + '_'
local endline = S'\r\n\f'
local newline = '\r\n' + endline
local escape = '\\' * ( newline
+ S'\\"\'?abfnrtv'
+ (#oct * oct^-3)
+ ('x' * #hex * hex^-2))
-- range of valid characters after first character of identifier
local idsafe = R('AZ', 'az', '\127\255') + P '_'
-- operators
local OT = P '=='
if extra_tokens then
for _,ex in ipairs(extra_tokens) do
OT = OT + P(ex)
end
end
local operator = token('operator', OT + P '.' + P'>>=' + '<<=' + '--' + '>>' + '>=' + '/=' + '==' + '<='
+ '+=' + '<<' + '*=' + '++' + '&&' + '|=' + '||' + '!=' + '&=' + '-='
+ '^=' + '%=' + '->' + S',)*%+&(-~/^]{}|.[>!?:=<;')
-- identifiers
local ident = token('iden', idsafe * (idsafe + digit) ^ 0)
-- keywords
local keyword = token('keyword', (P 'auto' + P 'break' + P 'case' + P'char' +
P 'const' + P 'continue' + P 'default' +
P 'do' + P 'double' + P 'else' + P 'enum' + P 'extern' + P 'float' +
P 'for' + P 'goto' + P 'if' + P 'int' + P 'long' + P 'register' +
P 'return' + P 'short' + P 'signed' + P 'sizeof' + P 'static' +
P 'struct' + P 'switch' + P 'typedef' + P 'union' + P 'void' +
P 'volatile' + P 'while') * -(idsafe + digit))
-- numbers
local number_sign = S'+-'^-1
local number_decimal = digit ^ 1
local number_hexadecimal = P '0' * S 'xX' * R('09', 'AF', 'af') ^ 1
local number_float = (digit^1 * P'.' * digit^0 + P'.' * digit^1) *
(S'eE' * number_sign * digit^1)^-1
local number = token('number', number_hexadecimal +
number_float +
number_decimal)
local string = token('string', '"' * ((1 - S'\\\r\n\f"') + escape)^0 * '"')
local char = token('char',"'" * ((1 - S"\\\r\n\f'") + escape) * "'")
-- comments
local singleline_comment = P '//' * (1 - S '\r\n\f') ^ 0
local multiline_comment = '/*' * (1 - P'*/')^0 * '*/'
local comment = token('comment', multiline_comment + singleline_comment)
local prepro = token('prepro',P '#' * (1 - S '\r\n\f') ^ 0)
-- whitespace
local whitespace = token('space', S('\r\n\f\t ')^1)
-- ordered choice of all tokens and last-resort error which consumes one character
local any_token = whitespace + number + keyword + ident +
string + char + comment + prepro + operator + token('error', 1)
table_of_tokens = Ct(any_token ^ 0)
end
-- increment [line] by the number of line-ends in [text]
local function sync(line, text)
local index, limit = 1, #text
while index <= limit do
local start, stop = text:find('\r\n', index, true)
if not start then
start, stop = text:find('[\r\n\f]', index)
if not start then break end
end
index = stop + 1
line = line + 1
end
return line
end
clexer.sync = sync
clexer.line = 0
-- we only need to synchronize the line-counter for these token types
local multiline_tokens = { comment = true, space = true }
clexer.multiline_tokens = multiline_tokens
function clexer.scan_c_tokenlist(input)
if not table_of_tokens then
clexer.init()
end
assert(type(input) == 'string', 'bad argument #1 (expected string)')
local line = 1
local tokens = lpeg.match(table_of_tokens, input)
for i, token in pairs(tokens) do
local t = token[1]
if t == 'operator' or t == 'error' then
token[1] = token[2]
end
token[3] = line
if multiline_tokens[t] then
line = sync(line, token[2])
end
end
return tokens
end
--- get a token iterator from a source containing Lua code.
-- S is the source - can be a string or a file-like object (i.e. read() returns line)
-- Note that this token iterator includes spaces and comments, and does not convert
-- string and number tokens - so e.g. a string token is quoted and a number token is
-- an unconverted string.
function clexer.scan_c(input,name)
if type(input) ~= 'string' and input.read then
input = input:read('*a')
end
local tokens = clexer.scan_c_tokenlist(input)
local i, n = 1, #tokens
return function(k)
if k ~= nil then
k = i + k
if k < 1 or k > n then return nil end
return tokens[k]
end
local tok = tokens[i]
i = i + 1
if tok then
clexer.line = tok[3]
clexer.name = name
return tok[1],tok[2]
end
end
end
return clexer

179
macro/lexer.lua Normal file
View File

@ -0,0 +1,179 @@
--[[--- A Lua lexical scanner using LPeg.
= CREDITS
Written by Peter Odding, 2007/04/04
= THANKS TO
- the Lua authors for a wonderful language;
- Roberto for LPeg;
- caffeine for keeping me awake :)
= LICENSE
Shamelessly ripped from the SQLite[3] project:
The author disclaims copyright to this source code. In place of a legal
notice, here is a blessing:
May you do good and not evil.
May you find forgiveness for yourself and forgive others.
May you share freely, never taking more than you give.
@module macro.lexer
--]]
local lexer = {}
local lpeg = require 'lpeg'
local P, R, S, C, Cb, Cc, Cg, Cmt, Ct =
lpeg.P, lpeg.R, lpeg.S, lpeg.C, lpeg.Cb, lpeg.Cc, lpeg.Cg, lpeg.Cmt, lpeg.Ct
-- create a pattern which captures the lua value [id] and the input matching
-- [patt] in a table
local function token(id, patt) return Ct(Cc(id) * C(patt)) end
-- private interface
local table_of_tokens
local extra_tokens
function lexer.add_extra_tokens(extra)
extra_tokens = extra_tokens or {}
for _,t in ipairs(extra) do
table.insert(extra_tokens,t)
end
table_of_tokens = nil -- re-initialize
end
function lexer.init ()
local digit = R('09')
-- range of valid characters after first character of identifier
--local idsafe = R('AZ', 'az', '\127\255') + P '_'
local idsafe = R('AZ', 'az') + P '_' + R '\206\223' * R '\128\255'
-- operators
local OT = P '=='
if extra_tokens then
for _,ex in ipairs(extra_tokens) do
OT = OT + P(ex)
end
end
local operator = token('operator', OT + P '.' + P '~=' + P '<=' + P '>=' + P '...'
+ P '..' + S '+-*/%^#=<>;:,.{}[]()')
-- identifiers
local ident = token('iden', idsafe * (idsafe + digit) ^ 0)
-- keywords
local keyword = token('keyword', (P 'and' + P 'break' + P 'do' + P 'elseif' +
P 'else' + P 'end' + P 'false' + P 'for' + P 'function' + P 'if' +
P 'in' + P 'local' + P 'nil' + P 'not' + P 'or' + P 'repeat' + P 'return' +
P 'then' + P 'true' + P 'until' + P 'while') * -(idsafe + digit))
-- numbers
local number_sign = S'+-'^-1
local number_decimal = digit ^ 1
local number_hexadecimal = P '0' * S 'xX' * R('09', 'AF', 'af') ^ 1
local number_float = (digit^1 * P'.' * digit^0 + P'.' * digit^1) *
(S'eE' * number_sign * digit^1)^-1
local number = token('number', number_hexadecimal +
number_float +
number_decimal)
-- callback for [=[ long strings ]=]
-- ps. LPeg is for Lua what regex is for Perl, which makes me smile :)
local equals = P '=' ^ 0
local open = P '[' * Cg(equals, "init") * P '[' * P '\n' ^ -1
local close = P ']' * C(equals) * P ']'
local closeeq = Cmt(close * Cb "init", function (s, i, a, b) return a == b end)
local longstring = open * C((P(1) - closeeq)^0) * close --/ 1
-- strings
local singlequoted_string = P "'" * ((1 - S "'\r\n\f\\") + (P '\\' * 1)) ^ 0 * "'"
local doublequoted_string = P '"' * ((1 - S '"\r\n\f\\') + (P '\\' * 1)) ^ 0 * '"'
local string = token('string', singlequoted_string +
doublequoted_string +
longstring)
-- comments
local singleline_comment = P '--' * (1 - S '\r\n\f') ^ 0
local multiline_comment = P '--' * longstring
local comment = token('comment', multiline_comment + singleline_comment)
-- whitespace
local whitespace = token('space', S('\r\n\f\t ')^1)
-- ordered choice of all tokens and last-resort error which consumes one character
local any_token = whitespace + number + keyword + ident +
string + comment + operator + token('error', 1)
table_of_tokens = Ct(any_token ^ 0)
end
-- increment [line] by the number of line-ends in [text]
local function sync(line, text)
local index, limit = 1, #text
while index <= limit do
local start, stop = text:find('\r\n', index, true)
if not start then
start, stop = text:find('[\r\n\f]', index)
if not start then break end
end
index = stop + 1
line = line + 1
end
return line
end
lexer.sync = sync
lexer.line = 0
-- we only need to synchronize the line-counter for these token types
local multiline_tokens = { comment = true, string = true, space = true }
lexer.multiline_tokens = multiline_tokens
function lexer.scan_lua_tokenlist(input)
if not table_of_tokens then
lexer.init()
end
assert(type(input) == 'string', 'bad argument #1 (expected string)')
local line = 1
local tokens = lpeg.match(table_of_tokens, input)
for i, token in pairs(tokens) do
local t = token[1]
if t == 'operator' or t == 'error' then
token[1] = token[2]
end
token[3] = line
if multiline_tokens[t] then
line = sync(line, token[2])
end
end
return tokens
end
--- get a token iterator from a source containing Lua code.
-- Note that this token iterator includes spaces and comments, and does not convert
-- string and number tokens - so e.g. a string token is quoted and a number token is
-- an unconverted string.
-- @param input the source - can be a string or a file-like object (i.e. read() returns line)
-- @param name for the source
function lexer.scan_lua(input,name)
if type(input) ~= 'string' and input.read then
input = input:read('*a')
end
local tokens = lexer.scan_lua_tokenlist(input)
local i, n = 1, #tokens
return function(k)
if k ~= nil then
k = i + k
if k < 1 or k > n then return nil end
return tokens[k]
end
local tok = tokens[i]
i = i + 1
if tok then
lexer.line = tok[3]
lexer.name = name
return tok[1],tok[2]
end
end
end
return lexer

15
main.c Normal file
View File

@ -0,0 +1,15 @@
#define LUA_IMPLEMENTATION
#include "lua.h"
extern int luaopen_lpeg(lua_State *L);
extern int luaopen_lfs(lua_State *L);
int main(int argc, char *argv[])
{
lua_State *L = luaL_newstate();
luaL_openlibs(L);
luaL_require(L, "lpeg", luaopen_lpeg, 1); lua_pop(L, 1);
luaL_require(L, "lfs", luaopen_lfs, 1); lua_pop(L, 1);
return 0;
}

59
premake5.lua
View File

@ -1,59 +0,0 @@
workspace "l65" do
local workspace_location = "build"
location(workspace_location)
startproject "l65"
configurations { "debug", "release" }
flags { "FatalCompileWarnings", "NoPCH", "StaticRuntime" }
platforms { "x86", "x64" }
filter "platforms:x86"
architecture "x86"
filter "platforms:x64"
architecture "x86_64"
filter {}
filter "configurations:debug"
defines { "_DEBUG" }
flags { "Symbols" }
filter "configurations:release"
defines { "NDEBUG" }
flags { "LinkTimeOptimization", "NoBufferSecurityCheck", "NoFramePointer" }
optimize "On"
floatingpoint "Fast"
vectorextensions "SSE2"
filter {}
filter "action:vs*"
defines { "WIN32", "_CRT_SECURE_NO_WARNINGS", "_CRT_SECURE_NO_DEPRECATE" }
flags { "MultiProcessorCompile", "NoEditAndContinue", "NoIncrementalLink", "NoManifest", "NoMinimalRebuild" }
disablewarnings { "4103", "4554", "6255", "6262", "28278" }
buildoptions { "/volatile:iso" }
filter {}
project "lua"
location(workspace_location)
kind "StaticLib"
language "C"
filter "action:vs*"
disablewarnings { "4244", "4702" }
filter {}
src = "src/lua"
includedirs { src }
files { src .. "/**.h", src .. "/**.c" }
project "l65"
location(workspace_location)
kind "ConsoleApp"
language "C"
targetdir "build/bin"
includedirs { "src/lua" }
files { "src/main.c" }
links { "lua" }
end

166
src/alt_getopt.lua
View File

@ -1,166 +0,0 @@
-- Copyright (c) 2009 Aleksey Cheusov <vle@gmx.net>
--
-- Permission is hereby granted, free of charge, to any person obtaining
-- a copy of this software and associated documentation files (the
-- "Software"), to deal in the Software without restriction, including
-- without limitation the rights to use, copy, modify, merge, publish,
-- distribute, sublicense, and/or sell copies of the Software, and to
-- permit persons to whom the Software is furnished to do so, subject to
-- the following conditions:
--
-- The above copyright notice and this permission notice shall be
-- included in all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
-- LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
-- OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-- WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
local type, pairs, ipairs, io, os = type, pairs, ipairs, io, os
module ("alt_getopt")
local function convert_short2long (opts)
local i = 1
local len = #opts
local ret = {}
for short_opt, accept_arg in opts:gmatch("(%w)(:?)") do
ret[short_opt]=#accept_arg
end
return ret
end
local function exit_with_error (msg, exit_status)
io.stderr:write (msg)
os.exit (exit_status)
end
local function err_unknown_opt (opt)
exit_with_error ("Unknown option `-" ..
(#opt > 1 and "-" or "") .. opt .. "'\n", 1)
end
local function canonize (options, opt)
if not options [opt] then
err_unknown_opt (opt)
end
while type (options [opt]) == "string" do
opt = options [opt]
if not options [opt] then
err_unknown_opt (opt)
end
end
return opt
end
function get_ordered_opts (arg, sh_opts, long_opts)
local i = 1
local count = 1
local opts = {}
local optarg = {}
local options = convert_short2long (sh_opts)
for k,v in pairs (long_opts) do
options [k] = v
end
while i <= #arg do
local a = arg [i]
if a == "--" then
i = i + 1
break
elseif a == "-" then
break
elseif a:sub (1, 2) == "--" then
local pos = a:find ("=", 1, true)
if pos then
local opt = a:sub (3, pos-1)
opt = canonize (options, opt)
if options [opt] == 0 then
exit_with_error ("Bad usage of option `" .. a .. "'\n", 1)
end
optarg [count] = a:sub (pos+1)
opts [count] = opt
else
local opt = a:sub (3)
opt = canonize (options, opt)
if options [opt] == 0 then
opts [count] = opt
else
if i == #arg then
exit_with_error ("Missed value for option `" .. a .. "'\n", 1)
end
optarg [count] = arg [i+1]
opts [count] = opt
i = i + 1
end
end
count = count + 1
elseif a:sub (1, 1) == "-" then
local j
for j=2,a:len () do
local opt = canonize (options, a:sub (j, j))
if options [opt] == 0 then
opts [count] = opt
count = count + 1
elseif a:len () == j then
if i == #arg then
exit_with_error ("Missed value for option `-" .. opt .. "'\n", 1)
end
optarg [count] = arg [i+1]
opts [count] = opt
i = i + 1
count = count + 1
break
else
optarg [count] = a:sub (j+1)
opts [count] = opt
count = count + 1
break
end
end
else
break
end
i = i + 1
end
return opts,i,optarg
end
function get_opts (arg, sh_opts, long_opts)
local ret = {}
local opts,optind,optarg = get_ordered_opts (arg, sh_opts, long_opts)
for i,v in ipairs (opts) do
if optarg [i] then
ret [v] = optarg [i]
else
ret [v] = 1
end
end
return ret,optind
end

59
src/checks.lua
View File

@ -1,59 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
-- Alternative implementation of checks() in Lua. Slower than
-- the C counterpart, but no compilation/porting concerns.
checkers = { }
local function check_one(expected, val)
if type(val)==expected then return true end
local mt = getmetatable(val)
if mt and mt.__type==expected then return true end
local f = checkers[expected]
if f and f(val) then return true end
return false
end
local function check_many(name, expected, val)
if expected=='?' then return true
elseif expected=='!' then return (val~=nil)
elseif type(expected) ~= 'string' then
error 'strings expected by checks()'
elseif val==nil and expected :sub(1,1) == '?' then return true end
for one in expected :gmatch "[^|?]+" do
if check_one(one, val) then return true end
end
return false
end
function checks(...)
for i, arg in ipairs{...} do
local name, val = debug.getlocal(2, i)
local success = check_many(name, arg, val)
if not success then
local fname = debug.getinfo(2, 'n').name
local fmt = "bad argument #%d to '%s' (%s expected, got %s)"
local msg = string.format(fmt, i, fname or "?", arg, type(val))
error(msg, 3)
end
end
end
return checks

191
src/lua/bit.c
View File

@ -1,191 +0,0 @@
/*
** Lua BitOp -- a bit operations library for Lua 5.1/5.2.
** http://bitop.luajit.org/
**
** Copyright (C) 2008-2012 Mike Pall. All rights reserved.
**
** Permission is hereby granted, free of charge, to any person obtaining
** a copy of this software and associated documentation files (the
** "Software"), to deal in the Software without restriction, including
** without limitation the rights to use, copy, modify, merge, publish,
** distribute, sublicense, and/or sell copies of the Software, and to
** permit persons to whom the Software is furnished to do so, subject to
** the following conditions:
**
** The above copyright notice and this permission notice shall be
** included in all copies or substantial portions of the Software.
**
** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
** EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
** IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
** CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
** TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
** SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
**
** [ MIT license: http://www.opensource.org/licenses/mit-license.php ]
*/
#define LUA_BITOP_VERSION "1.0.2"
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#ifdef _MSC_VER
/* MSVC is stuck in the last century and doesn't have C99's stdint.h. */
typedef __int32 int32_t;
typedef unsigned __int32 uint32_t;
typedef unsigned __int64 uint64_t;
#else
#include <stdint.h>
#endif
typedef int32_t SBits;
typedef uint32_t UBits;
typedef union {
lua_Number n;
#ifdef LUA_NUMBER_DOUBLE
uint64_t b;
#else
UBits b;
#endif
} BitNum;
/* Convert argument to bit type. */
static UBits barg(lua_State *L, int idx)
{
BitNum bn;
UBits b;
#if LUA_VERSION_NUM < 502
bn.n = lua_tonumber(L, idx);
#else
bn.n = luaL_checknumber(L, idx);
#endif
#if defined(LUA_NUMBER_DOUBLE)
bn.n += 6755399441055744.0; /* 2^52+2^51 */
#ifdef SWAPPED_DOUBLE
b = (UBits)(bn.b >> 32);
#else
b = (UBits)bn.b;
#endif
#elif defined(LUA_NUMBER_INT) || defined(LUA_NUMBER_LONG) || \
defined(LUA_NUMBER_LONGLONG) || defined(LUA_NUMBER_LONG_LONG) || \
defined(LUA_NUMBER_LLONG)
if (sizeof(UBits) == sizeof(lua_Number))
b = bn.b;
else
b = (UBits)(SBits)bn.n;
#elif defined(LUA_NUMBER_FLOAT)
#error "A 'float' lua_Number type is incompatible with this library"
#else
#error "Unknown number type, check LUA_NUMBER_* in luaconf.h"
#endif
#if LUA_VERSION_NUM < 502
if (b == 0 && !lua_isnumber(L, idx)) {
luaL_typerror(L, idx, "number");
}
#endif
return b;
}
/* Return bit type. */
#define BRET(b) lua_pushnumber(L, (lua_Number)(SBits)(b)); return 1;
static int bit_tobit(lua_State *L) { BRET(barg(L, 1)) }
static int bit_bnot(lua_State *L) { BRET(~barg(L, 1)) }
#define BIT_OP(func, opr) \
static int func(lua_State *L) { int i; UBits b = barg(L, 1); \
for (i = lua_gettop(L); i > 1; i--) b opr barg(L, i); BRET(b) }
BIT_OP(bit_band, &=)
BIT_OP(bit_bor, |=)
BIT_OP(bit_bxor, ^=)
BIT_OP(bit_idiv, /=)
#define bshl(b, n) (b << n)
#define bshr(b, n) (b >> n)
#define bsar(b, n) ((SBits)b >> n)
#define brol(b, n) ((b << n) | (b >> (32-n)))
#define bror(b, n) ((b << (32-n)) | (b >> n))
#define BIT_SH(func, fn) \
static int func(lua_State *L) { \
UBits b = barg(L, 1); UBits n = barg(L, 2) & 31; BRET(fn(b, n)) }
BIT_SH(bit_lshift, bshl)
BIT_SH(bit_rshift, bshr)
BIT_SH(bit_arshift, bsar)
BIT_SH(bit_rol, brol)
BIT_SH(bit_ror, bror)
static int bit_bswap(lua_State *L)
{
UBits b = barg(L, 1);
b = (b >> 24) | ((b >> 8) & 0xff00) | ((b & 0xff00) << 8) | (b << 24);
BRET(b)
}
static int bit_tohex(lua_State *L)
{
UBits b = barg(L, 1);
SBits n = lua_isnone(L, 2) ? 8 : (SBits)barg(L, 2);
const char *hexdigits = "0123456789abcdef";
char buf[8];
int i;
if (n < 0) { n = -n; hexdigits = "0123456789ABCDEF"; }
if (n > 8) n = 8;
for (i = (int)n; --i >= 0; ) { buf[i] = hexdigits[b & 15]; b >>= 4; }
lua_pushlstring(L, buf, (size_t)n);
return 1;
}
static const struct luaL_Reg bit_funcs[] = {
{ "tobit", bit_tobit },
{ "bnot", bit_bnot },
{ "band", bit_band },
{ "bor", bit_bor },
{ "bxor", bit_bxor },
{ "lshift", bit_lshift },
{ "rshift", bit_rshift },
{ "arshift", bit_arshift },
{ "rol", bit_rol },
{ "ror", bit_ror },
{ "bswap", bit_bswap },
{ "tohex", bit_tohex },
{ "idiv", bit_idiv },
{ NULL, NULL }
};
/* Signed right-shifts are implementation-defined per C89/C99.
** But the de facto standard are arithmetic right-shifts on two's
** complement CPUs. This behaviour is required here, so test for it.
*/
#define BAD_SAR (bsar(-8, 2) != (SBits)-2)
LUALIB_API int luaopen_bit(lua_State *L)
{
UBits b;
lua_pushnumber(L, (lua_Number)1437217655L);
b = barg(L, -1);
if (b != (UBits)1437217655L || BAD_SAR) { /* Perform a simple self-test. */
const char *msg = "compiled with incompatible luaconf.h";
#ifdef LUA_NUMBER_DOUBLE
#ifdef _WIN32
if (b == (UBits)1610612736L)
msg = "use D3DCREATE_FPU_PRESERVE with DirectX";
#endif
if (b == (UBits)1127743488L)
msg = "not compiled with SWAPPED_DOUBLE";
#endif
if (BAD_SAR)
msg = "arithmetic right-shift broken";
luaL_error(L, "bit library self-test failed (%s)", msg);
}
#if LUA_VERSION_NUM < 502
luaL_register(L, "bit", bit_funcs);
#else
luaL_newlib(L, bit_funcs);
#endif
return 1;
}

1087
src/lua/lapi.c
View File

File diff suppressed because it is too large Load Diff

16
src/lua/lapi.h
View File

@ -1,16 +0,0 @@
/*
** $Id: lapi.h,v 2.2.1.1 2007/12/27 13:02:25 roberto Exp $
** Auxiliary functions from Lua API
** See Copyright Notice in lua.h
*/
#ifndef lapi_h
#define lapi_h
#include "lobject.h"
LUAI_FUNC void luaA_pushobject (lua_State *L, const TValue *o);
#endif

652
src/lua/lauxlib.c
View File

@ -1,652 +0,0 @@
/*
** $Id: lauxlib.c,v 1.159.1.3 2008/01/21 13:20:51 roberto Exp $
** Auxiliary functions for building Lua libraries
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <errno.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
/* This file uses only the official API of Lua.
** Any function declared here could be written as an application function.
*/
#define lauxlib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#define FREELIST_REF 0 /* free list of references */
/* convert a stack index to positive */
#define abs_index(L, i) ((i) > 0 || (i) <= LUA_REGISTRYINDEX ? (i) : \
lua_gettop(L) + (i) + 1)
/*
** {======================================================
** Error-report functions
** =======================================================
*/
LUALIB_API int luaL_argerror (lua_State *L, int narg, const char *extramsg) {
lua_Debug ar;
if (!lua_getstack(L, 0, &ar)) /* no stack frame? */
return luaL_error(L, "bad argument #%d (%s)", narg, extramsg);
lua_getinfo(L, "n", &ar);
if (strcmp(ar.namewhat, "method") == 0) {
narg--; /* do not count `self' */
if (narg == 0) /* error is in the self argument itself? */
return luaL_error(L, "calling " LUA_QS " on bad self (%s)",
ar.name, extramsg);
}
if (ar.name == NULL)
ar.name = "?";
return luaL_error(L, "bad argument #%d to " LUA_QS " (%s)",
narg, ar.name, extramsg);
}
LUALIB_API int luaL_typerror (lua_State *L, int narg, const char *tname) {
const char *msg = lua_pushfstring(L, "%s expected, got %s",
tname, luaL_typename(L, narg));
return luaL_argerror(L, narg, msg);
}
static void tag_error (lua_State *L, int narg, int tag) {
luaL_typerror(L, narg, lua_typename(L, tag));
}
LUALIB_API void luaL_where (lua_State *L, int level) {
lua_Debug ar;
if (lua_getstack(L, level, &ar)) { /* check function at level */
lua_getinfo(L, "Sl", &ar); /* get info about it */
if (ar.currentline > 0) { /* is there info? */
lua_pushfstring(L, "%s:%d: ", ar.short_src, ar.currentline);
return;
}
}
lua_pushliteral(L, ""); /* else, no information available... */
}
LUALIB_API int luaL_error (lua_State *L, const char *fmt, ...) {
va_list argp;
va_start(argp, fmt);
luaL_where(L, 1);
lua_pushvfstring(L, fmt, argp);
va_end(argp);
lua_concat(L, 2);
return lua_error(L);
}
/* }====================================================== */
LUALIB_API int luaL_checkoption (lua_State *L, int narg, const char *def,
const char *const lst[]) {
const char *name = (def) ? luaL_optstring(L, narg, def) :
luaL_checkstring(L, narg);
int i;
for (i=0; lst[i]; i++)
if (strcmp(lst[i], name) == 0)
return i;
return luaL_argerror(L, narg,
lua_pushfstring(L, "invalid option " LUA_QS, name));
}
LUALIB_API int luaL_newmetatable (lua_State *L, const char *tname) {
lua_getfield(L, LUA_REGISTRYINDEX, tname); /* get registry.name */
if (!lua_isnil(L, -1)) /* name already in use? */
return 0; /* leave previous value on top, but return 0 */
lua_pop(L, 1);
lua_newtable(L); /* create metatable */
lua_pushvalue(L, -1);
lua_setfield(L, LUA_REGISTRYINDEX, tname); /* registry.name = metatable */
return 1;
}
LUALIB_API void *luaL_checkudata (lua_State *L, int ud, const char *tname) {
void *p = lua_touserdata(L, ud);
if (p != NULL) { /* value is a userdata? */
if (lua_getmetatable(L, ud)) { /* does it have a metatable? */
lua_getfield(L, LUA_REGISTRYINDEX, tname); /* get correct metatable */
if (lua_rawequal(L, -1, -2)) { /* does it have the correct mt? */
lua_pop(L, 2); /* remove both metatables */
return p;
}
}
}
luaL_typerror(L, ud, tname); /* else error */
return NULL; /* to avoid warnings */
}
LUALIB_API void luaL_checkstack (lua_State *L, int space, const char *mes) {
if (!lua_checkstack(L, space))
luaL_error(L, "stack overflow (%s)", mes);
}
LUALIB_API void luaL_checktype (lua_State *L, int narg, int t) {
if (lua_type(L, narg) != t)
tag_error(L, narg, t);
}
LUALIB_API void luaL_checkany (lua_State *L, int narg) {
if (lua_type(L, narg) == LUA_TNONE)
luaL_argerror(L, narg, "value expected");
}
LUALIB_API const char *luaL_checklstring (lua_State *L, int narg, size_t *len) {
const char *s = lua_tolstring(L, narg, len);
if (!s) tag_error(L, narg, LUA_TSTRING);
return s;
}
LUALIB_API const char *luaL_optlstring (lua_State *L, int narg,
const char *def, size_t *len) {
if (lua_isnoneornil(L, narg)) {
if (len)
*len = (def ? strlen(def) : 0);
return def;
}
else return luaL_checklstring(L, narg, len);
}
LUALIB_API lua_Number luaL_checknumber (lua_State *L, int narg) {
lua_Number d = lua_tonumber(L, narg);
if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */
tag_error(L, narg, LUA_TNUMBER);
return d;
}
LUALIB_API lua_Number luaL_optnumber (lua_State *L, int narg, lua_Number def) {
return luaL_opt(L, luaL_checknumber, narg, def);
}
LUALIB_API lua_Integer luaL_checkinteger (lua_State *L, int narg) {
lua_Integer d = lua_tointeger(L, narg);
if (d == 0 && !lua_isnumber(L, narg)) /* avoid extra test when d is not 0 */
tag_error(L, narg, LUA_TNUMBER);
return d;
}
LUALIB_API lua_Integer luaL_optinteger (lua_State *L, int narg,
lua_Integer def) {
return luaL_opt(L, luaL_checkinteger, narg, def);
}
LUALIB_API int luaL_getmetafield (lua_State *L, int obj, const char *event) {
if (!lua_getmetatable(L, obj)) /* no metatable? */
return 0;
lua_pushstring(L, event);
lua_rawget(L, -2);
if (lua_isnil(L, -1)) {
lua_pop(L, 2); /* remove metatable and metafield */
return 0;
}
else {
lua_remove(L, -2); /* remove only metatable */
return 1;
}
}
LUALIB_API int luaL_callmeta (lua_State *L, int obj, const char *event) {
obj = abs_index(L, obj);
if (!luaL_getmetafield(L, obj, event)) /* no metafield? */
return 0;
lua_pushvalue(L, obj);
lua_call(L, 1, 1);
return 1;
}
LUALIB_API void (luaL_register) (lua_State *L, const char *libname,
const luaL_Reg *l) {
luaI_openlib(L, libname, l, 0);
}
static int libsize (const luaL_Reg *l) {
int size = 0;
for (; l->name; l++) size++;
return size;
}
LUALIB_API void luaI_openlib (lua_State *L, const char *libname,
const luaL_Reg *l, int nup) {
if (libname) {
int size = libsize(l);
/* check whether lib already exists */
luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 1);
lua_getfield(L, -1, libname); /* get _LOADED[libname] */
if (!lua_istable(L, -1)) { /* not found? */
lua_pop(L, 1); /* remove previous result */
/* try global variable (and create one if it does not exist) */
if (luaL_findtable(L, LUA_GLOBALSINDEX, libname, size) != NULL)
luaL_error(L, "name conflict for module " LUA_QS, libname);
lua_pushvalue(L, -1);
lua_setfield(L, -3, libname); /* _LOADED[libname] = new table */
}
lua_remove(L, -2); /* remove _LOADED table */
lua_insert(L, -(nup+1)); /* move library table to below upvalues */
}
for (; l->name; l++) {
int i;
for (i=0; i<nup; i++) /* copy upvalues to the top */
lua_pushvalue(L, -nup);
lua_pushcclosure(L, l->func, nup);
lua_setfield(L, -(nup+2), l->name);
}
lua_pop(L, nup); /* remove upvalues */
}
/*
** {======================================================
** getn-setn: size for arrays
** =======================================================
*/
#if defined(LUA_COMPAT_GETN)
static int checkint (lua_State *L, int topop) {
int n = (lua_type(L, -1) == LUA_TNUMBER) ? lua_tointeger(L, -1) : -1;
lua_pop(L, topop);
return n;
}
static void getsizes (lua_State *L) {
lua_getfield(L, LUA_REGISTRYINDEX, "LUA_SIZES");
if (lua_isnil(L, -1)) { /* no `size' table? */
lua_pop(L, 1); /* remove nil */
lua_newtable(L); /* create it */
lua_pushvalue(L, -1); /* `size' will be its own metatable */
lua_setmetatable(L, -2);
lua_pushliteral(L, "kv");
lua_setfield(L, -2, "__mode"); /* metatable(N).__mode = "kv" */
lua_pushvalue(L, -1);
lua_setfield(L, LUA_REGISTRYINDEX, "LUA_SIZES"); /* store in register */
}
}
LUALIB_API void luaL_setn (lua_State *L, int t, int n) {
t = abs_index(L, t);
lua_pushliteral(L, "n");
lua_rawget(L, t);
if (checkint(L, 1) >= 0) { /* is there a numeric field `n'? */
lua_pushliteral(L, "n"); /* use it */
lua_pushinteger(L, n);
lua_rawset(L, t);
}
else { /* use `sizes' */
getsizes(L);
lua_pushvalue(L, t);
lua_pushinteger(L, n);
lua_rawset(L, -3); /* sizes[t] = n */
lua_pop(L, 1); /* remove `sizes' */
}
}
LUALIB_API int luaL_getn (lua_State *L, int t) {
int n;
t = abs_index(L, t);
lua_pushliteral(L, "n"); /* try t.n */
lua_rawget(L, t);
if ((n = checkint(L, 1)) >= 0) return n;
getsizes(L); /* else try sizes[t] */
lua_pushvalue(L, t);
lua_rawget(L, -2);
if ((n = checkint(L, 2)) >= 0) return n;
return (int)lua_objlen(L, t);
}
#endif
/* }====================================================== */
LUALIB_API const char *luaL_gsub (lua_State *L, const char *s, const char *p,
const char *r) {
const char *wild;
size_t l = strlen(p);
luaL_Buffer b;
luaL_buffinit(L, &b);
while ((wild = strstr(s, p)) != NULL) {
luaL_addlstring(&b, s, wild - s); /* push prefix */
luaL_addstring(&b, r); /* push replacement in place of pattern */
s = wild + l; /* continue after `p' */
}
luaL_addstring(&b, s); /* push last suffix */
luaL_pushresult(&b);
return lua_tostring(L, -1);
}
LUALIB_API const char *luaL_findtable (lua_State *L, int idx,
const char *fname, int szhint) {
const char *e;
lua_pushvalue(L, idx);
do {
e = strchr(fname, '.');
if (e == NULL) e = fname + strlen(fname);
lua_pushlstring(L, fname, e - fname);
lua_rawget(L, -2);
if (lua_isnil(L, -1)) { /* no such field? */
lua_pop(L, 1); /* remove this nil */
lua_createtable(L, 0, (*e == '.' ? 1 : szhint)); /* new table for field */
lua_pushlstring(L, fname, e - fname);
lua_pushvalue(L, -2);
lua_settable(L, -4); /* set new table into field */
}
else if (!lua_istable(L, -1)) { /* field has a non-table value? */
lua_pop(L, 2); /* remove table and value */
return fname; /* return problematic part of the name */
}
lua_remove(L, -2); /* remove previous table */
fname = e + 1;
} while (*e == '.');
return NULL;
}
/*
** {======================================================
** Generic Buffer manipulation
** =======================================================
*/
#define bufflen(B) ((B)->p - (B)->buffer)
#define bufffree(B) ((size_t)(LUAL_BUFFERSIZE - bufflen(B)))
#define LIMIT (LUA_MINSTACK/2)
static int emptybuffer (luaL_Buffer *B) {
size_t l = bufflen(B);
if (l == 0) return 0; /* put nothing on stack */
else {
lua_pushlstring(B->L, B->buffer, l);
B->p = B->buffer;
B->lvl++;
return 1;
}
}
static void adjuststack (luaL_Buffer *B) {
if (B->lvl > 1) {
lua_State *L = B->L;
int toget = 1; /* number of levels to concat */
size_t toplen = lua_strlen(L, -1);
do {
size_t l = lua_strlen(L, -(toget+1));
if (B->lvl - toget + 1 >= LIMIT || toplen > l) {
toplen += l;
toget++;
}
else break;
} while (toget < B->lvl);
lua_concat(L, toget);
B->lvl = B->lvl - toget + 1;
}
}
LUALIB_API char *luaL_prepbuffer (luaL_Buffer *B) {
if (emptybuffer(B))
adjuststack(B);
return B->buffer;
}
LUALIB_API void luaL_addlstring (luaL_Buffer *B, const char *s, size_t l) {
while (l--)
luaL_addchar(B, *s++);
}
LUALIB_API void luaL_addstring (luaL_Buffer *B, const char *s) {
luaL_addlstring(B, s, strlen(s));
}
LUALIB_API void luaL_pushresult (luaL_Buffer *B) {
emptybuffer(B);
lua_concat(B->L, B->lvl);
B->lvl = 1;
}
LUALIB_API void luaL_addvalue (luaL_Buffer *B) {
lua_State *L = B->L;
size_t vl;
const char *s = lua_tolstring(L, -1, &vl);
if (vl <= bufffree(B)) { /* fit into buffer? */
memcpy(B->p, s, vl); /* put it there */
B->p += vl;
lua_pop(L, 1); /* remove from stack */
}
else {
if (emptybuffer(B))
lua_insert(L, -2); /* put buffer before new value */
B->lvl++; /* add new value into B stack */
adjuststack(B);
}
}
LUALIB_API void luaL_buffinit (lua_State *L, luaL_Buffer *B) {
B->L = L;
B->p = B->buffer;
B->lvl = 0;
}
/* }====================================================== */
LUALIB_API int luaL_ref (lua_State *L, int t) {
int ref;
t = abs_index(L, t);
if (lua_isnil(L, -1)) {
lua_pop(L, 1); /* remove from stack */
return LUA_REFNIL; /* `nil' has a unique fixed reference */
}
lua_rawgeti(L, t, FREELIST_REF); /* get first free element */
ref = (int)lua_tointeger(L, -1); /* ref = t[FREELIST_REF] */
lua_pop(L, 1); /* remove it from stack */
if (ref != 0) { /* any free element? */
lua_rawgeti(L, t, ref); /* remove it from list */
lua_rawseti(L, t, FREELIST_REF); /* (t[FREELIST_REF] = t[ref]) */
}
else { /* no free elements */
ref = (int)lua_objlen(L, t);
ref++; /* create new reference */
}
lua_rawseti(L, t, ref);
return ref;
}
LUALIB_API void luaL_unref (lua_State *L, int t, int ref) {
if (ref >= 0) {
t = abs_index(L, t);
lua_rawgeti(L, t, FREELIST_REF);
lua_rawseti(L, t, ref); /* t[ref] = t[FREELIST_REF] */
lua_pushinteger(L, ref);
lua_rawseti(L, t, FREELIST_REF); /* t[FREELIST_REF] = ref */
}
}
/*
** {======================================================
** Load functions
** =======================================================
*/
typedef struct LoadF {
int extraline;
FILE *f;
char buff[LUAL_BUFFERSIZE];
} LoadF;
static const char *getF (lua_State *L, void *ud, size_t *size) {
LoadF *lf = (LoadF *)ud;
(void)L;
if (lf->extraline) {
lf->extraline = 0;
*size = 1;
return "\n";
}
if (feof(lf->f)) return NULL;
*size = fread(lf->buff, 1, sizeof(lf->buff), lf->f);
return (*size > 0) ? lf->buff : NULL;
}
static int errfile (lua_State *L, const char *what, int fnameindex) {
const char *serr = strerror(errno);
const char *filename = lua_tostring(L, fnameindex) + 1;
lua_pushfstring(L, "cannot %s %s: %s", what, filename, serr);
lua_remove(L, fnameindex);
return LUA_ERRFILE;
}
LUALIB_API int luaL_loadfile (lua_State *L, const char *filename) {
LoadF lf;
int status, readstatus;
int c;
int fnameindex = lua_gettop(L) + 1; /* index of filename on the stack */
lf.extraline = 0;
if (filename == NULL) {
lua_pushliteral(L, "=stdin");
lf.f = stdin;
}
else {
lua_pushfstring(L, "@%s", filename);
lf.f = fopen(filename, "r");
if (lf.f == NULL) return errfile(L, "open", fnameindex);
}
c = getc(lf.f);
if (c == '#') { /* Unix exec. file? */
lf.extraline = 1;
while ((c = getc(lf.f)) != EOF && c != '\n') ; /* skip first line */
if (c == '\n') c = getc(lf.f);
}
if (c == LUA_SIGNATURE[0] && filename) { /* binary file? */
lf.f = freopen(filename, "rb", lf.f); /* reopen in binary mode */
if (lf.f == NULL) return errfile(L, "reopen", fnameindex);
/* skip eventual `#!...' */
while ((c = getc(lf.f)) != EOF && c != LUA_SIGNATURE[0]) ;
lf.extraline = 0;
}
ungetc(c, lf.f);
status = lua_load(L, getF, &lf, lua_tostring(L, -1));
readstatus = ferror(lf.f);
if (filename) fclose(lf.f); /* close file (even in case of errors) */
if (readstatus) {
lua_settop(L, fnameindex); /* ignore results from `lua_load' */
return errfile(L, "read", fnameindex);
}
lua_remove(L, fnameindex);
return status;
}
typedef struct LoadS {
const char *s;
size_t size;
} LoadS;
static const char *getS (lua_State *L, void *ud, size_t *size) {
LoadS *ls = (LoadS *)ud;
(void)L;
if (ls->size == 0) return NULL;
*size = ls->size;
ls->size = 0;
return ls->s;
}
LUALIB_API int luaL_loadbuffer (lua_State *L, const char *buff, size_t size,
const char *name) {
LoadS ls;
ls.s = buff;
ls.size = size;
return lua_load(L, getS, &ls, name);
}
LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s) {
return luaL_loadbuffer(L, s, strlen(s), s);
}
/* }====================================================== */
static void *l_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {
(void)ud;
(void)osize;
if (nsize == 0) {
free(ptr);
return NULL;
}
else
return realloc(ptr, nsize);
}
static int panic (lua_State *L) {
(void)L; /* to avoid warnings */
fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n",
lua_tostring(L, -1));
return 0;
}
LUALIB_API lua_State *luaL_newstate (void) {
lua_State *L = lua_newstate(l_alloc, NULL);
if (L) lua_atpanic(L, &panic);
return L;
}

174
src/lua/lauxlib.h
View File

@ -1,174 +0,0 @@
/*
** $Id: lauxlib.h,v 1.88.1.1 2007/12/27 13:02:25 roberto Exp $
** Auxiliary functions for building Lua libraries
** See Copyright Notice in lua.h
*/
#ifndef lauxlib_h
#define lauxlib_h
#include <stddef.h>
#include <stdio.h>
#include "lua.h"
#if defined(LUA_COMPAT_GETN)
LUALIB_API int (luaL_getn) (lua_State *L, int t);
LUALIB_API void (luaL_setn) (lua_State *L, int t, int n);
#else
#define luaL_getn(L,i) ((int)lua_objlen(L, i))
#define luaL_setn(L,i,j) ((void)0) /* no op! */
#endif
#if defined(LUA_COMPAT_OPENLIB)
#define luaI_openlib luaL_openlib
#endif
/* extra error code for `luaL_load' */
#define LUA_ERRFILE (LUA_ERRERR+1)
typedef struct luaL_Reg {
const char *name;
lua_CFunction func;
} luaL_Reg;
LUALIB_API void (luaI_openlib) (lua_State *L, const char *libname,
const luaL_Reg *l, int nup);
LUALIB_API void (luaL_register) (lua_State *L, const char *libname,
const luaL_Reg *l);
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 lua_Integer (luaL_checkinteger) (lua_State *L, int numArg);
LUALIB_API lua_Integer (luaL_optinteger) (lua_State *L, int nArg,
lua_Integer def);
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_newmetatable) (lua_State *L, const char *tname);
LUALIB_API void *(luaL_checkudata) (lua_State *L, int ud, const char *tname);
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_checkoption) (lua_State *L, int narg, const char *def,
const char *const lst[]);
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_loadfile) (lua_State *L, const char *filename);
LUALIB_API int (luaL_loadbuffer) (lua_State *L, const char *buff, size_t sz,
const char *name);
LUALIB_API int (luaL_loadstring) (lua_State *L, const char *s);
LUALIB_API lua_State *(luaL_newstate) (void);
LUALIB_API const char *(luaL_gsub) (lua_State *L, const char *s, const char *p,
const char *r);
LUALIB_API const char *(luaL_findtable) (lua_State *L, int idx,
const char *fname, int szhint);
/*
** ===============================================================
** some useful macros
** ===============================================================
*/
#define luaL_argcheck(L, cond,numarg,extramsg) \
((void)((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_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)))
#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)))
/*
** {======================================================
** Generic Buffer manipulation
** =======================================================
*/
typedef struct luaL_Buffer {
char *p; /* current position in buffer */
int lvl; /* number of strings in the stack (level) */
lua_State *L;
char buffer[LUAL_BUFFERSIZE];
} luaL_Buffer;
#define luaL_addchar(B,c) \
((void)((B)->p < ((B)->buffer+LUAL_BUFFERSIZE) || luaL_prepbuffer(B)), \
(*(B)->p++ = (char)(c)))
/* compatibility only */
#define luaL_putchar(B,c) luaL_addchar(B,c)
#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);
/* }====================================================== */
/* 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))
#define luaL_reg luaL_Reg
#endif

653
src/lua/lbaselib.c
View File

@ -1,653 +0,0 @@
/*
** $Id: lbaselib.c,v 1.191.1.6 2008/02/14 16:46:22 roberto Exp $
** Basic library
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define lbaselib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
/*
** If your system does not support `stdout', you can just remove this function.
** If you need, you can define your own `print' function, following this
** model but changing `fputs' to put the strings at a proper place
** (a console window or a log file, for instance).
*/
static int luaB_print (lua_State *L) {
int n = lua_gettop(L); /* number of arguments */
int i;
lua_getglobal(L, "tostring");
for (i=1; i<=n; i++) {
const char *s;
lua_pushvalue(L, -1); /* function to be called */
lua_pushvalue(L, i); /* value to print */
lua_call(L, 1, 1);
s = lua_tostring(L, -1); /* get result */
if (s == NULL)
return luaL_error(L, LUA_QL("tostring") " must return a string to "
LUA_QL("print"));
if (i>1) fputs("\t", stdout);
fputs(s, stdout);
lua_pop(L, 1); /* pop result */
}
fputs("\n", stdout);
return 0;
}
static int luaB_tonumber (lua_State *L) {
int base = luaL_optint(L, 2, 10);
if (base == 10) { /* standard conversion */
luaL_checkany(L, 1);
if (lua_isnumber(L, 1)) {
lua_pushnumber(L, lua_tonumber(L, 1));
return 1;
}
}
else {
const char *s1 = luaL_checkstring(L, 1);
char *s2;
unsigned long n;
luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
n = strtoul(s1, &s2, base);
if (s1 != s2) { /* at least one valid digit? */
while (isspace((unsigned char)(*s2))) s2++; /* skip trailing spaces */
if (*s2 == '\0') { /* no invalid trailing characters? */
lua_pushnumber(L, (lua_Number)n);
return 1;
}
}
}
lua_pushnil(L); /* else not a number */
return 1;
}
static int luaB_error (lua_State *L) {
int level = luaL_optint(L, 2, 1);
lua_settop(L, 1);
if (lua_isstring(L, 1) && level > 0) { /* add extra information? */
luaL_where(L, level);
lua_pushvalue(L, 1);
lua_concat(L, 2);
}
return lua_error(L);
}
static int luaB_getmetatable (lua_State *L) {
luaL_checkany(L, 1);
if (!lua_getmetatable(L, 1)) {
lua_pushnil(L);
return 1; /* no metatable */
}
luaL_getmetafield(L, 1, "__metatable");
return 1; /* returns either __metatable field (if present) or metatable */
}
static int luaB_setmetatable (lua_State *L) {
int t = lua_type(L, 2);
luaL_checktype(L, 1, LUA_TTABLE);
luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
"nil or table expected");
if (luaL_getmetafield(L, 1, "__metatable"))
luaL_error(L, "cannot change a protected metatable");
lua_settop(L, 2);
lua_setmetatable(L, 1);
return 1;
}
static void getfunc (lua_State *L, int opt) {
if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);
else {
lua_Debug ar;
int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 1);
luaL_argcheck(L, level >= 0, 1, "level must be non-negative");
if (lua_getstack(L, level, &ar) == 0)
luaL_argerror(L, 1, "invalid level");
lua_getinfo(L, "f", &ar);
if (lua_isnil(L, -1))
luaL_error(L, "no function environment for tail call at level %d",
level);
}
}
static int luaB_getfenv (lua_State *L) {
getfunc(L, 1);
if (lua_iscfunction(L, -1)) /* is a C function? */
lua_pushvalue(L, LUA_GLOBALSINDEX); /* return the thread's global env. */
else
lua_getfenv(L, -1);
return 1;
}
static int luaB_setfenv (lua_State *L) {
luaL_checktype(L, 2, LUA_TTABLE);
getfunc(L, 0);
lua_pushvalue(L, 2);
if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) {
/* change environment of current thread */
lua_pushthread(L);
lua_insert(L, -2);
lua_setfenv(L, -2);
return 0;
}
else if (lua_iscfunction(L, -2) || lua_setfenv(L, -2) == 0)
luaL_error(L,
LUA_QL("setfenv") " cannot change environment of given object");
return 1;
}
static int luaB_rawequal (lua_State *L) {
luaL_checkany(L, 1);
luaL_checkany(L, 2);
lua_pushboolean(L, lua_rawequal(L, 1, 2));
return 1;
}
static int luaB_rawget (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
luaL_checkany(L, 2);
lua_settop(L, 2);
lua_rawget(L, 1);
return 1;
}
static int luaB_rawset (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
luaL_checkany(L, 2);
luaL_checkany(L, 3);
lua_settop(L, 3);
lua_rawset(L, 1);
return 1;
}
static int luaB_gcinfo (lua_State *L) {
lua_pushinteger(L, lua_getgccount(L));
return 1;
}
static int luaB_collectgarbage (lua_State *L) {
static const char *const opts[] = {"stop", "restart", "collect",
"count", "step", "setpause", "setstepmul", NULL};
static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL};
int o = luaL_checkoption(L, 1, "collect", opts);
int ex = luaL_optint(L, 2, 0);
int res = lua_gc(L, optsnum[o], ex);
switch (optsnum[o]) {
case LUA_GCCOUNT: {
int b = lua_gc(L, LUA_GCCOUNTB, 0);
lua_pushnumber(L, res + ((lua_Number)b/1024));
return 1;
}
case LUA_GCSTEP: {
lua_pushboolean(L, res);
return 1;
}
default: {
lua_pushnumber(L, res);
return 1;
}
}
}
static int luaB_type (lua_State *L) {
luaL_checkany(L, 1);
lua_pushstring(L, luaL_typename(L, 1));
return 1;
}
static int luaB_next (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
lua_settop(L, 2); /* create a 2nd argument if there isn't one */
if (lua_next(L, 1))
return 2;
else {
lua_pushnil(L);
return 1;
}
}
static int luaB_pairs (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */
lua_pushvalue(L, 1); /* state, */
lua_pushnil(L); /* and initial value */
return 3;
}
static int ipairsaux (lua_State *L) {
int i = luaL_checkint(L, 2);
luaL_checktype(L, 1, LUA_TTABLE);
i++; /* next value */
lua_pushinteger(L, i);
lua_rawgeti(L, 1, i);
return (lua_isnil(L, -1)) ? 0 : 2;
}
static int luaB_ipairs (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */
lua_pushvalue(L, 1); /* state, */
lua_pushinteger(L, 0); /* and initial value */
return 3;
}
static int load_aux (lua_State *L, int status) {
if (status == 0) /* OK? */
return 1;
else {
lua_pushnil(L);
lua_insert(L, -2); /* put before error message */
return 2; /* return nil plus error message */
}
}
static int luaB_loadstring (lua_State *L) {
size_t l;
const char *s = luaL_checklstring(L, 1, &l);
const char *chunkname = luaL_optstring(L, 2, s);
return load_aux(L, luaL_loadbuffer(L, s, l, chunkname));
}
static int luaB_loadfile (lua_State *L) {
const char *fname = luaL_optstring(L, 1, NULL);
return load_aux(L, luaL_loadfile(L, fname));
}
/*
** Reader for generic `load' function: `lua_load' uses the
** stack for internal stuff, so the reader cannot change the
** stack top. Instead, it keeps its resulting string in a
** reserved slot inside the stack.
*/
static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
(void)ud; /* to avoid warnings */
luaL_checkstack(L, 2, "too many nested functions");
lua_pushvalue(L, 1); /* get function */
lua_call(L, 0, 1); /* call it */
if (lua_isnil(L, -1)) {
*size = 0;
return NULL;
}
else if (lua_isstring(L, -1)) {
lua_replace(L, 3); /* save string in a reserved stack slot */
return lua_tolstring(L, 3, size);
}
else luaL_error(L, "reader function must return a string");
return NULL; /* to avoid warnings */
}
static int luaB_load (lua_State *L) {
int status;
const char *cname = luaL_optstring(L, 2, "=(load)");
luaL_checktype(L, 1, LUA_TFUNCTION);
lua_settop(L, 3); /* function, eventual name, plus one reserved slot */
status = lua_load(L, generic_reader, NULL, cname);
return load_aux(L, status);
}
static int luaB_dofile (lua_State *L) {
const char *fname = luaL_optstring(L, 1, NULL);
int n = lua_gettop(L);
if (luaL_loadfile(L, fname) != 0) lua_error(L);
lua_call(L, 0, LUA_MULTRET);
return lua_gettop(L) - n;
}
static int luaB_assert (lua_State *L) {
luaL_checkany(L, 1);
if (!lua_toboolean(L, 1))
return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));
return lua_gettop(L);
}
static int luaB_unpack (lua_State *L) {
int i, e, n;
luaL_checktype(L, 1, LUA_TTABLE);
i = luaL_optint(L, 2, 1);
e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1));
if (i > e) return 0; /* empty range */
n = e - i + 1; /* number of elements */
if (n <= 0 || !lua_checkstack(L, n)) /* n <= 0 means arith. overflow */
return luaL_error(L, "too many results to unpack");
lua_rawgeti(L, 1, i); /* push arg[i] (avoiding overflow problems) */
while (i++ < e) /* push arg[i + 1...e] */
lua_rawgeti(L, 1, i);
return n;
}
static int luaB_select (lua_State *L) {
int n = lua_gettop(L);
if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
lua_pushinteger(L, n-1);
return 1;
}
else {
int i = luaL_checkint(L, 1);
if (i < 0) i = n + i;
else if (i > n) i = n;
luaL_argcheck(L, 1 <= i, 1, "index out of range");
return n - i;
}
}
static int luaB_pcall (lua_State *L) {
int status;
luaL_checkany(L, 1);
status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);
lua_pushboolean(L, (status == 0));
lua_insert(L, 1);
return lua_gettop(L); /* return status + all results */
}
static int luaB_xpcall (lua_State *L) {
int status;
luaL_checkany(L, 2);
lua_settop(L, 2);
lua_insert(L, 1); /* put error function under function to be called */
status = lua_pcall(L, 0, LUA_MULTRET, 1);
lua_pushboolean(L, (status == 0));
lua_replace(L, 1);
return lua_gettop(L); /* return status + all results */
}
static int luaB_tostring (lua_State *L) {
luaL_checkany(L, 1);
if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */
return 1; /* use its value */
switch (lua_type(L, 1)) {
case LUA_TNUMBER:
lua_pushstring(L, lua_tostring(L, 1));
break;
case LUA_TSTRING:
lua_pushvalue(L, 1);
break;
case LUA_TBOOLEAN:
lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));
break;
case LUA_TNIL:
lua_pushliteral(L, "nil");
break;
default:
lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1));
break;
}
return 1;
}
static int luaB_newproxy (lua_State *L) {
lua_settop(L, 1);
lua_newuserdata(L, 0); /* create proxy */
if (lua_toboolean(L, 1) == 0)
return 1; /* no metatable */
else if (lua_isboolean(L, 1)) {
lua_newtable(L); /* create a new metatable `m' ... */
lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */
lua_pushboolean(L, 1);
lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */
}
else {
int validproxy = 0; /* to check if weaktable[metatable(u)] == true */
if (lua_getmetatable(L, 1)) {
lua_rawget(L, lua_upvalueindex(1));
validproxy = lua_toboolean(L, -1);
lua_pop(L, 1); /* remove value */
}
luaL_argcheck(L, validproxy, 1, "boolean or proxy expected");
lua_getmetatable(L, 1); /* metatable is valid; get it */
}
lua_setmetatable(L, 2);
return 1;
}
static const luaL_Reg base_funcs[] = {
{"assert", luaB_assert},
{"collectgarbage", luaB_collectgarbage},
{"dofile", luaB_dofile},
{"error", luaB_error},
{"gcinfo", luaB_gcinfo},
{"getfenv", luaB_getfenv},
{"getmetatable", luaB_getmetatable},
{"loadfile", luaB_loadfile},
{"load", luaB_load},
{"loadstring", luaB_loadstring},
{"next", luaB_next},
{"pcall", luaB_pcall},
{"print", luaB_print},
{"rawequal", luaB_rawequal},
{"rawget", luaB_rawget},
{"rawset", luaB_rawset},
{"select", luaB_select},
{"setfenv", luaB_setfenv},
{"setmetatable", luaB_setmetatable},
{"tonumber", luaB_tonumber},
{"tostring", luaB_tostring},
{"type", luaB_type},
{"unpack", luaB_unpack},
{"xpcall", luaB_xpcall},
{NULL, NULL}
};
/*
** {======================================================
** Coroutine library
** =======================================================
*/
#define CO_RUN 0 /* running */
#define CO_SUS 1 /* suspended */
#define CO_NOR 2 /* 'normal' (it resumed another coroutine) */
#define CO_DEAD 3
static const char *const statnames[] =
{"running", "suspended", "normal", "dead"};
static int costatus (lua_State *L, lua_State *co) {
if (L == co) return CO_RUN;
switch (lua_status(co)) {
case LUA_YIELD:
return CO_SUS;
case 0: {
lua_Debug ar;
if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */
return CO_NOR; /* it is running */
else if (lua_gettop(co) == 0)
return CO_DEAD;
else
return CO_SUS; /* initial state */
}
default: /* some error occured */
return CO_DEAD;
}
}
static int luaB_costatus (lua_State *L) {
lua_State *co = lua_tothread(L, 1);
luaL_argcheck(L, co, 1, "coroutine expected");
lua_pushstring(L, statnames[costatus(L, co)]);
return 1;
}
static int auxresume (lua_State *L, lua_State *co, int narg) {
int status = costatus(L, co);
if (!lua_checkstack(co, narg))
luaL_error(L, "too many arguments to resume");
if (status != CO_SUS) {
lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]);
return -1; /* error flag */
}
lua_xmove(L, co, narg);
lua_setlevel(L, co);
status = lua_resume(co, narg);
if (status == 0 || status == LUA_YIELD) {
int nres = lua_gettop(co);
if (!lua_checkstack(L, nres + 1))
luaL_error(L, "too many results to resume");
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 = lua_tothread(L, 1);
int r;
luaL_argcheck(L, co, 1, "coroutine expected");
r = auxresume(L, co, lua_gettop(L) - 1);
if (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 (r < 0) {
if (lua_isstring(L, -1)) { /* error object is a string? */
luaL_where(L, 1); /* add extra info */
lua_insert(L, -2);
lua_concat(L, 2);
}
lua_error(L); /* propagate error */
}
return r;
}
static int luaB_cocreate (lua_State *L) {
lua_State *NL = lua_newthread(L);
luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,
"Lua function expected");
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));
}
static int luaB_corunning (lua_State *L) {
if (lua_pushthread(L))
lua_pushnil(L); /* main thread is not a coroutine */
return 1;
}
static const luaL_Reg co_funcs[] = {
{"create", luaB_cocreate},
{"resume", luaB_coresume},
{"running", luaB_corunning},
{"status", luaB_costatus},
{"wrap", luaB_cowrap},
{"yield", luaB_yield},
{NULL, NULL}
};
/* }====================================================== */
static void auxopen (lua_State *L, const char *name,
lua_CFunction f, lua_CFunction u) {
lua_pushcfunction(L, u);
lua_pushcclosure(L, f, 1);
lua_setfield(L, -2, name);
}
static void base_open (lua_State *L) {
/* set global _G */
lua_pushvalue(L, LUA_GLOBALSINDEX);
lua_setglobal(L, "_G");
/* open lib into global table */
luaL_register(L, "_G", base_funcs);
lua_pushliteral(L, LUA_VERSION);
lua_setglobal(L, "_VERSION"); /* set global _VERSION */
/* `ipairs' and `pairs' need auxiliary functions as upvalues */
auxopen(L, "ipairs", luaB_ipairs, ipairsaux);
auxopen(L, "pairs", luaB_pairs, luaB_next);
/* `newproxy' needs a weaktable as upvalue */
lua_createtable(L, 0, 1); /* new table `w' */
lua_pushvalue(L, -1); /* `w' will be its own metatable */
lua_setmetatable(L, -2);
lua_pushliteral(L, "kv");
lua_setfield(L, -2, "__mode"); /* metatable(w).__mode = "kv" */
lua_pushcclosure(L, luaB_newproxy, 1);
lua_setglobal(L, "newproxy"); /* set global `newproxy' */
}
LUALIB_API int luaopen_base (lua_State *L) {
base_open(L);
luaL_register(L, LUA_COLIBNAME, co_funcs);
return 2;
}

831
src/lua/lcode.c
View File

@ -1,831 +0,0 @@
/*
** $Id: lcode.c,v 2.25.1.5 2011/01/31 14:53:16 roberto Exp $
** Code generator for Lua
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#define lcode_c
#define LUA_CORE
#include "lua.h"
#include "lcode.h"
#include "ldebug.h"
#include "ldo.h"
#include "lgc.h"
#include "llex.h"
#include "lmem.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lparser.h"
#include "ltable.h"
#define hasjumps(e) ((e)->t != (e)->f)
static int isnumeral(expdesc *e) {
return (e->k == VKNUM && e->t == NO_JUMP && e->f == NO_JUMP);
}
void luaK_nil (FuncState *fs, int from, int n) {
Instruction *previous;
if (fs->pc > fs->lasttarget) { /* no jumps to current position? */
if (fs->pc == 0) { /* function start? */
if (from >= fs->nactvar)
return; /* positions are already clean */
}
else {
previous = &fs->f->code[fs->pc-1];
if (GET_OPCODE(*previous) == OP_LOADNIL) {
int pfrom = GETARG_A(*previous);
int pto = GETARG_B(*previous);
if (pfrom <= from && from <= pto+1) { /* can connect both? */
if (from+n-1 > pto)
SETARG_B(*previous, from+n-1);
return;
}
}
}
}
luaK_codeABC(fs, OP_LOADNIL, from, from+n-1, 0); /* else no optimization */
}
int luaK_jump (FuncState *fs) {
int jpc = fs->jpc; /* save list of jumps to here */
int j;
fs->jpc = NO_JUMP;
j = luaK_codeAsBx(fs, OP_JMP, 0, NO_JUMP);
luaK_concat(fs, &j, jpc); /* keep them on hold */
return j;
}
void luaK_ret (FuncState *fs, int first, int nret) {
luaK_codeABC(fs, OP_RETURN, first, nret+1, 0);
}
static int condjump (FuncState *fs, OpCode op, int A, int B, int C) {
luaK_codeABC(fs, op, A, B, C);
return luaK_jump(fs);
}
static void fixjump (FuncState *fs, int pc, int dest) {
Instruction *jmp = &fs->f->code[pc];
int offset = dest-(pc+1);
lua_assert(dest != NO_JUMP);
if (abs(offset) > MAXARG_sBx)
luaX_syntaxerror(fs->ls, "control structure too long");
SETARG_sBx(*jmp, offset);
}
/*
** returns current `pc' and marks it as a jump target (to avoid wrong
** optimizations with consecutive instructions not in the same basic block).
*/
int luaK_getlabel (FuncState *fs) {
fs->lasttarget = fs->pc;
return fs->pc;
}
static int getjump (FuncState *fs, int pc) {
int offset = GETARG_sBx(fs->f->code[pc]);
if (offset == NO_JUMP) /* point to itself represents end of list */
return NO_JUMP; /* end of list */
else
return (pc+1)+offset; /* turn offset into absolute position */
}
static Instruction *getjumpcontrol (FuncState *fs, int pc) {
Instruction *pi = &fs->f->code[pc];
if (pc >= 1 && testTMode(GET_OPCODE(*(pi-1))))
return pi-1;
else
return pi;
}
/*
** check whether list has any jump that do not produce a value
** (or produce an inverted value)
*/
static int need_value (FuncState *fs, int list) {
for (; list != NO_JUMP; list = getjump(fs, list)) {
Instruction i = *getjumpcontrol(fs, list);
if (GET_OPCODE(i) != OP_TESTSET) return 1;
}
return 0; /* not found */
}
static int patchtestreg (FuncState *fs, int node, int reg) {
Instruction *i = getjumpcontrol(fs, node);
if (GET_OPCODE(*i) != OP_TESTSET)
return 0; /* cannot patch other instructions */
if (reg != NO_REG && reg != GETARG_B(*i))
SETARG_A(*i, reg);
else /* no register to put value or register already has the value */
*i = CREATE_ABC(OP_TEST, GETARG_B(*i), 0, GETARG_C(*i));
return 1;
}
static void removevalues (FuncState *fs, int list) {
for (; list != NO_JUMP; list = getjump(fs, list))
patchtestreg(fs, list, NO_REG);
}
static void patchlistaux (FuncState *fs, int list, int vtarget, int reg,
int dtarget) {
while (list != NO_JUMP) {
int next = getjump(fs, list);
if (patchtestreg(fs, list, reg))
fixjump(fs, list, vtarget);
else
fixjump(fs, list, dtarget); /* jump to default target */
list = next;
}
}
static void dischargejpc (FuncState *fs) {
patchlistaux(fs, fs->jpc, fs->pc, NO_REG, fs->pc);
fs->jpc = NO_JUMP;
}
void luaK_patchlist (FuncState *fs, int list, int target) {
if (target == fs->pc)
luaK_patchtohere(fs, list);
else {
lua_assert(target < fs->pc);
patchlistaux(fs, list, target, NO_REG, target);
}
}
void luaK_patchtohere (FuncState *fs, int list) {
luaK_getlabel(fs);
luaK_concat(fs, &fs->jpc, list);
}
void luaK_concat (FuncState *fs, int *l1, int l2) {
if (l2 == NO_JUMP) return;
else if (*l1 == NO_JUMP)
*l1 = l2;
else {
int list = *l1;
int next;
while ((next = getjump(fs, list)) != NO_JUMP) /* find last element */
list = next;
fixjump(fs, list, l2);
}
}
void luaK_checkstack (FuncState *fs, int n) {
int newstack = fs->freereg + n;
if (newstack > fs->f->maxstacksize) {
if (newstack >= MAXSTACK)
luaX_syntaxerror(fs->ls, "function or expression too complex");
fs->f->maxstacksize = cast_byte(newstack);
}
}
void luaK_reserveregs (FuncState *fs, int n) {
luaK_checkstack(fs, n);
fs->freereg += n;
}
static void freereg (FuncState *fs, int reg) {
if (!ISK(reg) && reg >= fs->nactvar) {
fs->freereg--;
lua_assert(reg == fs->freereg);
}
}
static void freeexp (FuncState *fs, expdesc *e) {
if (e->k == VNONRELOC)
freereg(fs, e->u.s.info);
}
static int addk (FuncState *fs, TValue *k, TValue *v) {
lua_State *L = fs->L;
TValue *idx = luaH_set(L, fs->h, k);
Proto *f = fs->f;
int oldsize = f->sizek;
if (ttisnumber(idx)) {
lua_assert(luaO_rawequalObj(&fs->f->k[cast_int(nvalue(idx))], v));
return cast_int(nvalue(idx));
}
else { /* constant not found; create a new entry */
setnvalue(idx, cast_num(fs->nk));
luaM_growvector(L, f->k, fs->nk, f->sizek, TValue,
MAXARG_Bx, "constant table overflow");
while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]);
setobj(L, &f->k[fs->nk], v);
luaC_barrier(L, f, v);
return fs->nk++;
}
}
int luaK_stringK (FuncState *fs, TString *s) {
TValue o;
setsvalue(fs->L, &o, s);
return addk(fs, &o, &o);
}
int luaK_numberK (FuncState *fs, lua_Number r) {
TValue o;
setnvalue(&o, r);
return addk(fs, &o, &o);
}
static int boolK (FuncState *fs, int b) {
TValue o;
setbvalue(&o, b);
return addk(fs, &o, &o);
}
static int nilK (FuncState *fs) {
TValue k, v;
setnilvalue(&v);
/* cannot use nil as key; instead use table itself to represent nil */
sethvalue(fs->L, &k, fs->h);
return addk(fs, &k, &v);
}
void luaK_setreturns (FuncState *fs, expdesc *e, int nresults) {
if (e->k == VCALL) { /* expression is an open function call? */
SETARG_C(getcode(fs, e), nresults+1);
}
else if (e->k == VVARARG) {
SETARG_B(getcode(fs, e), nresults+1);
SETARG_A(getcode(fs, e), fs->freereg);
luaK_reserveregs(fs, 1);
}
}
void luaK_setoneret (FuncState *fs, expdesc *e) {
if (e->k == VCALL) { /* expression is an open function call? */
e->k = VNONRELOC;
e->u.s.info = GETARG_A(getcode(fs, e));
}
else if (e->k == VVARARG) {
SETARG_B(getcode(fs, e), 2);
e->k = VRELOCABLE; /* can relocate its simple result */
}
}
void luaK_dischargevars (FuncState *fs, expdesc *e) {
switch (e->k) {
case VLOCAL: {
e->k = VNONRELOC;
break;
}
case VUPVAL: {
e->u.s.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.s.info, 0);
e->k = VRELOCABLE;
break;
}
case VGLOBAL: {
e->u.s.info = luaK_codeABx(fs, OP_GETGLOBAL, 0, e->u.s.info);
e->k = VRELOCABLE;
break;
}
case VINDEXED: {
freereg(fs, e->u.s.aux);
freereg(fs, e->u.s.info);
e->u.s.info = luaK_codeABC(fs, OP_GETTABLE, 0, e->u.s.info, e->u.s.aux);
e->k = VRELOCABLE;
break;
}
case VVARARG:
case VCALL: {
luaK_setoneret(fs, e);
break;
}
default: break; /* there is one value available (somewhere) */
}
}
static int code_label (FuncState *fs, int A, int b, int jump) {
luaK_getlabel(fs); /* those instructions may be jump targets */
return luaK_codeABC(fs, OP_LOADBOOL, A, b, jump);
}
static void discharge2reg (FuncState *fs, expdesc *e, int reg) {
luaK_dischargevars(fs, e);
switch (e->k) {
case VNIL: {
luaK_nil(fs, reg, 1);
break;
}
case VFALSE: case VTRUE: {
luaK_codeABC(fs, OP_LOADBOOL, reg, e->k == VTRUE, 0);
break;
}
case VK: {
luaK_codeABx(fs, OP_LOADK, reg, e->u.s.info);
break;
}
case VKNUM: {
luaK_codeABx(fs, OP_LOADK, reg, luaK_numberK(fs, e->u.nval));
break;
}
case VRELOCABLE: {
Instruction *pc = &getcode(fs, e);
SETARG_A(*pc, reg);
break;
}
case VNONRELOC: {
if (reg != e->u.s.info)
luaK_codeABC(fs, OP_MOVE, reg, e->u.s.info, 0);
break;
}
default: {
lua_assert(e->k == VVOID || e->k == VJMP);
return; /* nothing to do... */
}
}
e->u.s.info = reg;
e->k = VNONRELOC;
}
static void discharge2anyreg (FuncState *fs, expdesc *e) {
if (e->k != VNONRELOC) {
luaK_reserveregs(fs, 1);
discharge2reg(fs, e, fs->freereg-1);
}
}
static void exp2reg (FuncState *fs, expdesc *e, int reg) {
discharge2reg(fs, e, reg);
if (e->k == VJMP)
luaK_concat(fs, &e->t, e->u.s.info); /* put this jump in `t' list */
if (hasjumps(e)) {
int final; /* position after whole expression */
int p_f = NO_JUMP; /* position of an eventual LOAD false */
int p_t = NO_JUMP; /* position of an eventual LOAD true */
if (need_value(fs, e->t) || need_value(fs, e->f)) {
int fj = (e->k == VJMP) ? NO_JUMP : luaK_jump(fs);
p_f = code_label(fs, reg, 0, 1);
p_t = code_label(fs, reg, 1, 0);
luaK_patchtohere(fs, fj);
}
final = luaK_getlabel(fs);
patchlistaux(fs, e->f, final, reg, p_f);
patchlistaux(fs, e->t, final, reg, p_t);
}
e->f = e->t = NO_JUMP;
e->u.s.info = reg;
e->k = VNONRELOC;
}
void luaK_exp2nextreg (FuncState *fs, expdesc *e) {
luaK_dischargevars(fs, e);
freeexp(fs, e);
luaK_reserveregs(fs, 1);
exp2reg(fs, e, fs->freereg - 1);
}
int luaK_exp2anyreg (FuncState *fs, expdesc *e) {
luaK_dischargevars(fs, e);
if (e->k == VNONRELOC) {
if (!hasjumps(e)) return e->u.s.info; /* exp is already in a register */
if (e->u.s.info >= fs->nactvar) { /* reg. is not a local? */
exp2reg(fs, e, e->u.s.info); /* put value on it */
return e->u.s.info;
}
}
luaK_exp2nextreg(fs, e); /* default */
return e->u.s.info;
}
void luaK_exp2val (FuncState *fs, expdesc *e) {
if (hasjumps(e))
luaK_exp2anyreg(fs, e);
else
luaK_dischargevars(fs, e);
}
int luaK_exp2RK (FuncState *fs, expdesc *e) {
luaK_exp2val(fs, e);
switch (e->k) {
case VKNUM:
case VTRUE:
case VFALSE:
case VNIL: {
if (fs->nk <= MAXINDEXRK) { /* constant fit in RK operand? */
e->u.s.info = (e->k == VNIL) ? nilK(fs) :
(e->k == VKNUM) ? luaK_numberK(fs, e->u.nval) :
boolK(fs, (e->k == VTRUE));
e->k = VK;
return RKASK(e->u.s.info);
}
else break;
}
case VK: {
if (e->u.s.info <= MAXINDEXRK) /* constant fit in argC? */
return RKASK(e->u.s.info);
else break;
}
default: break;
}
/* not a constant in the right range: put it in a register */
return luaK_exp2anyreg(fs, e);
}
void luaK_storevar (FuncState *fs, expdesc *var, expdesc *ex) {
switch (var->k) {
case VLOCAL: {
freeexp(fs, ex);
exp2reg(fs, ex, var->u.s.info);
return;
}
case VUPVAL: {
int e = luaK_exp2anyreg(fs, ex);
luaK_codeABC(fs, OP_SETUPVAL, e, var->u.s.info, 0);
break;
}
case VGLOBAL: {
int e = luaK_exp2anyreg(fs, ex);
luaK_codeABx(fs, OP_SETGLOBAL, e, var->u.s.info);
break;
}
case VINDEXED: {
int e = luaK_exp2RK(fs, ex);
luaK_codeABC(fs, OP_SETTABLE, var->u.s.info, var->u.s.aux, e);
break;
}
default: {
lua_assert(0); /* invalid var kind to store */
break;
}
}
freeexp(fs, ex);
}
void luaK_self (FuncState *fs, expdesc *e, expdesc *key) {
int func;
luaK_exp2anyreg(fs, e);
freeexp(fs, e);
func = fs->freereg;
luaK_reserveregs(fs, 2);
luaK_codeABC(fs, OP_SELF, func, e->u.s.info, luaK_exp2RK(fs, key));
freeexp(fs, key);
e->u.s.info = func;
e->k = VNONRELOC;
}
static void invertjump (FuncState *fs, expdesc *e) {
Instruction *pc = getjumpcontrol(fs, e->u.s.info);
lua_assert(testTMode(GET_OPCODE(*pc)) && GET_OPCODE(*pc) != OP_TESTSET &&
GET_OPCODE(*pc) != OP_TEST);
SETARG_A(*pc, !(GETARG_A(*pc)));
}
static int jumponcond (FuncState *fs, expdesc *e, int cond) {
if (e->k == VRELOCABLE) {
Instruction ie = getcode(fs, e);
if (GET_OPCODE(ie) == OP_NOT) {
fs->pc--; /* remove previous OP_NOT */
return condjump(fs, OP_TEST, GETARG_B(ie), 0, !cond);
}
/* else go through */
}
discharge2anyreg(fs, e);
freeexp(fs, e);
return condjump(fs, OP_TESTSET, NO_REG, e->u.s.info, cond);
}
void luaK_goiftrue (FuncState *fs, expdesc *e) {
int pc; /* pc of last jump */
luaK_dischargevars(fs, e);
switch (e->k) {
case VK: case VKNUM: case VTRUE: {
pc = NO_JUMP; /* always true; do nothing */
break;
}
case VJMP: {
invertjump(fs, e);
pc = e->u.s.info;
break;
}
default: {
pc = jumponcond(fs, e, 0);
break;
}
}
luaK_concat(fs, &e->f, pc); /* insert last jump in `f' list */
luaK_patchtohere(fs, e->t);
e->t = NO_JUMP;
}
static void luaK_goiffalse (FuncState *fs, expdesc *e) {
int pc; /* pc of last jump */
luaK_dischargevars(fs, e);
switch (e->k) {
case VNIL: case VFALSE: {
pc = NO_JUMP; /* always false; do nothing */
break;
}
case VJMP: {
pc = e->u.s.info;
break;
}
default: {
pc = jumponcond(fs, e, 1);
break;
}
}
luaK_concat(fs, &e->t, pc); /* insert last jump in `t' list */
luaK_patchtohere(fs, e->f);
e->f = NO_JUMP;
}
static void codenot (FuncState *fs, expdesc *e) {
luaK_dischargevars(fs, e);
switch (e->k) {
case VNIL: case VFALSE: {
e->k = VTRUE;
break;
}
case VK: case VKNUM: case VTRUE: {
e->k = VFALSE;
break;
}
case VJMP: {
invertjump(fs, e);
break;
}
case VRELOCABLE:
case VNONRELOC: {
discharge2anyreg(fs, e);
freeexp(fs, e);
e->u.s.info = luaK_codeABC(fs, OP_NOT, 0, e->u.s.info, 0);
e->k = VRELOCABLE;
break;
}
default: {
lua_assert(0); /* cannot happen */
break;
}
}
/* interchange true and false lists */
{ int temp = e->f; e->f = e->t; e->t = temp; }
removevalues(fs, e->f);
removevalues(fs, e->t);
}
void luaK_indexed (FuncState *fs, expdesc *t, expdesc *k) {
t->u.s.aux = luaK_exp2RK(fs, k);
t->k = VINDEXED;
}
static int constfolding (OpCode op, expdesc *e1, expdesc *e2) {
lua_Number v1, v2, r;
if (!isnumeral(e1) || !isnumeral(e2)) return 0;
v1 = e1->u.nval;
v2 = e2->u.nval;
switch (op) {
case OP_ADD: r = luai_numadd(v1, v2); break;
case OP_SUB: r = luai_numsub(v1, v2); break;
case OP_MUL: r = luai_nummul(v1, v2); break;
case OP_DIV:
if (v2 == 0) return 0; /* do not attempt to divide by 0 */
r = luai_numdiv(v1, v2); break;
case OP_MOD:
if (v2 == 0) return 0; /* do not attempt to divide by 0 */
r = luai_nummod(v1, v2); break;
case OP_POW: r = luai_numpow(v1, v2); break;
case OP_UNM: r = luai_numunm(v1); break;
case OP_LEN: return 0; /* no constant folding for 'len' */
default: lua_assert(0); r = 0; break;
}
if (luai_numisnan(r)) return 0; /* do not attempt to produce NaN */
e1->u.nval = r;
return 1;
}
static void codearith (FuncState *fs, OpCode op, expdesc *e1, expdesc *e2) {
if (constfolding(op, e1, e2))
return;
else {
int o2 = (op != OP_UNM && op != OP_LEN) ? luaK_exp2RK(fs, e2) : 0;
int o1 = luaK_exp2RK(fs, e1);
if (o1 > o2) {
freeexp(fs, e1);
freeexp(fs, e2);
}
else {
freeexp(fs, e2);
freeexp(fs, e1);
}
e1->u.s.info = luaK_codeABC(fs, op, 0, o1, o2);
e1->k = VRELOCABLE;
}
}
static void codecomp (FuncState *fs, OpCode op, int cond, expdesc *e1,
expdesc *e2) {
int o1 = luaK_exp2RK(fs, e1);
int o2 = luaK_exp2RK(fs, e2);
freeexp(fs, e2);
freeexp(fs, e1);
if (cond == 0 && op != OP_EQ) {
int temp; /* exchange args to replace by `<' or `<=' */
temp = o1; o1 = o2; o2 = temp; /* o1 <==> o2 */
cond = 1;
}
e1->u.s.info = condjump(fs, op, cond, o1, o2);
e1->k = VJMP;
}
void luaK_prefix (FuncState *fs, UnOpr op, expdesc *e) {
expdesc e2;
e2.t = e2.f = NO_JUMP; e2.k = VKNUM; e2.u.nval = 0;
switch (op) {
case OPR_MINUS: {
if (!isnumeral(e))
luaK_exp2anyreg(fs, e); /* cannot operate on non-numeric constants */
codearith(fs, OP_UNM, e, &e2);
break;
}
case OPR_NOT: codenot(fs, e); break;
case OPR_LEN: {
luaK_exp2anyreg(fs, e); /* cannot operate on constants */
codearith(fs, OP_LEN, e, &e2);
break;
}
default: lua_assert(0);
}
}
void luaK_infix (FuncState *fs, BinOpr op, expdesc *v) {
switch (op) {
case OPR_AND: {
luaK_goiftrue(fs, v);
break;
}
case OPR_OR: {
luaK_goiffalse(fs, v);
break;
}
case OPR_CONCAT: {
luaK_exp2nextreg(fs, v); /* operand must be on the `stack' */
break;
}
case OPR_ADD: case OPR_SUB: case OPR_MUL: case OPR_DIV:
case OPR_MOD: case OPR_POW: {
if (!isnumeral(v)) luaK_exp2RK(fs, v);
break;
}
default: {
luaK_exp2RK(fs, v);
break;
}
}
}
void luaK_posfix (FuncState *fs, BinOpr op, expdesc *e1, expdesc *e2) {
switch (op) {
case OPR_AND: {
lua_assert(e1->t == NO_JUMP); /* list must be closed */
luaK_dischargevars(fs, e2);
luaK_concat(fs, &e2->f, e1->f);
*e1 = *e2;
break;
}
case OPR_OR: {
lua_assert(e1->f == NO_JUMP); /* list must be closed */
luaK_dischargevars(fs, e2);
luaK_concat(fs, &e2->t, e1->t);
*e1 = *e2;
break;
}
case OPR_CONCAT: {
luaK_exp2val(fs, e2);
if (e2->k == VRELOCABLE && GET_OPCODE(getcode(fs, e2)) == OP_CONCAT) {
lua_assert(e1->u.s.info == GETARG_B(getcode(fs, e2))-1);
freeexp(fs, e1);
SETARG_B(getcode(fs, e2), e1->u.s.info);
e1->k = VRELOCABLE; e1->u.s.info = e2->u.s.info;
}
else {
luaK_exp2nextreg(fs, e2); /* operand must be on the 'stack' */
codearith(fs, OP_CONCAT, e1, e2);
}
break;
}
case OPR_ADD: codearith(fs, OP_ADD, e1, e2); break;
case OPR_SUB: codearith(fs, OP_SUB, e1, e2); break;
case OPR_MUL: codearith(fs, OP_MUL, e1, e2); break;
case OPR_DIV: codearith(fs, OP_DIV, e1, e2); break;
case OPR_MOD: codearith(fs, OP_MOD, e1, e2); break;
case OPR_POW: codearith(fs, OP_POW, e1, e2); break;
case OPR_EQ: codecomp(fs, OP_EQ, 1, e1, e2); break;
case OPR_NE: codecomp(fs, OP_EQ, 0, e1, e2); break;
case OPR_LT: codecomp(fs, OP_LT, 1, e1, e2); break;
case OPR_LE: codecomp(fs, OP_LE, 1, e1, e2); break;
case OPR_GT: codecomp(fs, OP_LT, 0, e1, e2); break;
case OPR_GE: codecomp(fs, OP_LE, 0, e1, e2); break;
default: lua_assert(0);
}
}
void luaK_fixline (FuncState *fs, int line) {
fs->f->lineinfo[fs->pc - 1] = line;
}
static int luaK_code (FuncState *fs, Instruction i, int line) {
Proto *f = fs->f;
dischargejpc(fs); /* `pc' will change */
/* put new instruction in code array */
luaM_growvector(fs->L, f->code, fs->pc, f->sizecode, Instruction,
MAX_INT, "code size overflow");
f->code[fs->pc] = i;
/* save corresponding line information */
luaM_growvector(fs->L, f->lineinfo, fs->pc, f->sizelineinfo, int,
MAX_INT, "code size overflow");
f->lineinfo[fs->pc] = line;
return fs->pc++;
}
int luaK_codeABC (FuncState *fs, OpCode o, int a, int b, int c) {
lua_assert(getOpMode(o) == iABC);
lua_assert(getBMode(o) != OpArgN || b == 0);
lua_assert(getCMode(o) != OpArgN || c == 0);
return luaK_code(fs, CREATE_ABC(o, a, b, c), fs->ls->lastline);
}
int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) {
lua_assert(getOpMode(o) == iABx || getOpMode(o) == iAsBx);
lua_assert(getCMode(o) == OpArgN);
return luaK_code(fs, CREATE_ABx(o, a, bc), fs->ls->lastline);
}
void luaK_setlist (FuncState *fs, int base, int nelems, int tostore) {
int c = (nelems - 1)/LFIELDS_PER_FLUSH + 1;
int b = (tostore == LUA_MULTRET) ? 0 : tostore;
lua_assert(tostore != 0);
if (c <= MAXARG_C)
luaK_codeABC(fs, OP_SETLIST, base, b, c);
else {
luaK_codeABC(fs, OP_SETLIST, base, b, 0);
luaK_code(fs, cast(Instruction, c), fs->ls->lastline);
}
fs->freereg = base + 1; /* free registers with list values */
}

76
src/lua/lcode.h
View File

@ -1,76 +0,0 @@
/*
** $Id: lcode.h,v 1.48.1.1 2007/12/27 13:02:25 roberto Exp $
** Code generator for Lua
** See Copyright Notice in lua.h
*/
#ifndef lcode_h
#define lcode_h
#include "llex.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lparser.h"
/*
** Marks the end of a patch list. It is an invalid value both as an absolute
** address, and as a list link (would link an element to itself).
*/
#define NO_JUMP (-1)
/*
** grep "ORDER OPR" if you change these enums
*/
typedef enum BinOpr {
OPR_ADD, OPR_SUB, OPR_MUL, OPR_DIV, OPR_MOD, OPR_POW,
OPR_CONCAT,
OPR_NE, OPR_EQ,
OPR_LT, OPR_LE, OPR_GT, OPR_GE,
OPR_AND, OPR_OR,
OPR_NOBINOPR
} BinOpr;
typedef enum UnOpr { OPR_MINUS, OPR_NOT, OPR_LEN, OPR_NOUNOPR } UnOpr;
#define getcode(fs,e) ((fs)->f->code[(e)->u.s.info])
#define luaK_codeAsBx(fs,o,A,sBx) luaK_codeABx(fs,o,A,(sBx)+MAXARG_sBx)
#define luaK_setmultret(fs,e) luaK_setreturns(fs, e, LUA_MULTRET)
LUAI_FUNC int luaK_codeABx (FuncState *fs, OpCode o, int A, unsigned int Bx);
LUAI_FUNC int luaK_codeABC (FuncState *fs, OpCode o, int A, int B, int C);
LUAI_FUNC void luaK_fixline (FuncState *fs, int line);
LUAI_FUNC void luaK_nil (FuncState *fs, int from, int n);
LUAI_FUNC void luaK_reserveregs (FuncState *fs, int n);
LUAI_FUNC void luaK_checkstack (FuncState *fs, int n);
LUAI_FUNC int luaK_stringK (FuncState *fs, TString *s);
LUAI_FUNC int luaK_numberK (FuncState *fs, lua_Number r);
LUAI_FUNC void luaK_dischargevars (FuncState *fs, expdesc *e);
LUAI_FUNC int luaK_exp2anyreg (FuncState *fs, expdesc *e);
LUAI_FUNC void luaK_exp2nextreg (FuncState *fs, expdesc *e);
LUAI_FUNC void luaK_exp2val (FuncState *fs, expdesc *e);
LUAI_FUNC int luaK_exp2RK (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);
LUAI_FUNC void luaK_infix (FuncState *fs, BinOpr op, expdesc *v);
LUAI_FUNC void luaK_posfix (FuncState *fs, BinOpr op, expdesc *v1, expdesc *v2);
LUAI_FUNC void luaK_setlist (FuncState *fs, int base, int nelems, int tostore);
#endif

398
src/lua/ldblib.c
View File

@ -1,398 +0,0 @@
/*
** $Id: ldblib.c,v 1.104.1.4 2009/08/04 18:50:18 roberto Exp $
** Interface from Lua to its debug API
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define ldblib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
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_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
"nil or table expected");
lua_settop(L, 2);
lua_pushboolean(L, lua_setmetatable(L, 1));
return 1;
}
static int db_getfenv (lua_State *L) {
luaL_checkany(L, 1);
lua_getfenv(L, 1);
return 1;
}
static int db_setfenv (lua_State *L) {
luaL_checktype(L, 2, LUA_TTABLE);
lua_settop(L, 2);
if (lua_setfenv(L, 1) == 0)
luaL_error(L, LUA_QL("setfenv")
" cannot change environment of given object");
return 1;
}
static void settabss (lua_State *L, const char *i, const char *v) {
lua_pushstring(L, v);
lua_setfield(L, -2, i);
}
static void settabsi (lua_State *L, const char *i, int v) {
lua_pushinteger(L, v);
lua_setfield(L, -2, i);
}
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;
}
}
static void treatstackoption (lua_State *L, lua_State *L1, const char *fname) {
if (L == L1) {
lua_pushvalue(L, -2);
lua_remove(L, -3);
}
else
lua_xmove(L1, L, 1);
lua_setfield(L, -2, fname);
}
static int db_getinfo (lua_State *L) {
lua_Debug ar;
int arg;
lua_State *L1 = getthread(L, &arg);
const char *options = luaL_optstring(L, arg+2, "flnSu");
if (lua_isnumber(L, arg+1)) {
if (!lua_getstack(L1, (int)lua_tointeger(L, arg+1), &ar)) {
lua_pushnil(L); /* level out of range */
return 1;
}
}
else if (lua_isfunction(L, arg+1)) {
lua_pushfstring(L, ">%s", options);
options = lua_tostring(L, -1);
lua_pushvalue(L, arg+1);
lua_xmove(L, L1, 1);
}
else
return luaL_argerror(L, arg+1, "function or level expected");
if (!lua_getinfo(L1, options, &ar))
return luaL_argerror(L, arg+2, "invalid option");
lua_createtable(L, 0, 2);
if (strchr(options, 'S')) {
settabss(L, "source", ar.source);
settabss(L, "short_src", ar.short_src);
settabsi(L, "linedefined", ar.linedefined);
settabsi(L, "lastlinedefined", ar.lastlinedefined);
settabss(L, "what", ar.what);
}
if (strchr(options, 'l'))
settabsi(L, "currentline", ar.currentline);
if (strchr(options, 'u'))
settabsi(L, "nups", ar.nups);
if (strchr(options, 'n')) {
settabss(L, "name", ar.name);
settabss(L, "namewhat", ar.namewhat);
}
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);
lua_Debug ar;
const char *name;
if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */
return luaL_argerror(L, arg+1, "level out of range");
name = lua_getlocal(L1, &ar, luaL_checkint(L, arg+2));
if (name) {
lua_xmove(L1, L, 1);
lua_pushstring(L, name);
lua_pushvalue(L, -2);
return 2;
}
else {
lua_pushnil(L);
return 1;
}
}
static int db_setlocal (lua_State *L) {
int arg;
lua_State *L1 = getthread(L, &arg);
lua_Debug ar;
if (!lua_getstack(L1, luaL_checkint(L, arg+1), &ar)) /* out of range? */
return luaL_argerror(L, arg+1, "level out of range");
luaL_checkany(L, arg+3);
lua_settop(L, arg+3);
lua_xmove(L, L1, 1);
lua_pushstring(L, lua_setlocal(L1, &ar, luaL_checkint(L, arg+2)));
return 1;
}
static int auxupvalue (lua_State *L, int get) {
const char *name;
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));
return get + 1;
}
static int db_getupvalue (lua_State *L) {
return auxupvalue(L, 1);
}
static int db_setupvalue (lua_State *L) {
luaL_checkany(L, 3);
return auxupvalue(L, 0);
}
static const char KEY_HOOK = 'h';
static void hookf (lua_State *L, lua_Debug *ar) {
static const char *const hooknames[] =
{"call", "return", "line", "count", "tail return"};
lua_pushlightuserdata(L, (void *)&KEY_HOOK);
lua_rawget(L, LUA_REGISTRYINDEX);
lua_pushlightuserdata(L, L);
lua_rawget(L, -2);
if (lua_isfunction(L, -1)) {
lua_pushstring(L, hooknames[(int)ar->event]);
if (ar->currentline >= 0)
lua_pushinteger(L, ar->currentline);
else lua_pushnil(L);
lua_assert(lua_getinfo(L, "lS", ar));
lua_call(L, 2, 0);
}
}
static int makemask (const char *smask, int count) {
int mask = 0;
if (strchr(smask, 'c')) mask |= LUA_MASKCALL;
if (strchr(smask, 'r')) mask |= LUA_MASKRET;
if (strchr(smask, 'l')) mask |= LUA_MASKLINE;
if (count > 0) mask |= LUA_MASKCOUNT;
return mask;
}
static char *unmakemask (int mask, char *smask) {
int i = 0;
if (mask & LUA_MASKCALL) smask[i++] = 'c';
if (mask & LUA_MASKRET) smask[i++] = 'r';
if (mask & LUA_MASKLINE) smask[i++] = 'l';
smask[i] = '\0';
return smask;
}
static void gethooktable (lua_State *L) {
lua_pushlightuserdata(L, (void *)&KEY_HOOK);
lua_rawget(L, LUA_REGISTRYINDEX);
if (!lua_istable(L, -1)) {
lua_pop(L, 1);
lua_createtable(L, 0, 1);
lua_pushlightuserdata(L, (void *)&KEY_HOOK);
lua_pushvalue(L, -2);
lua_rawset(L, LUA_REGISTRYINDEX);
}
}
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)) {
lua_settop(L, arg+1);
func = NULL; mask = 0; count = 0; /* turn off hooks */
}
else {
const char *smask = luaL_checkstring(L, arg+2);
luaL_checktype(L, arg+1, LUA_TFUNCTION);
count = luaL_optint(L, arg+3, 0);
func = hookf; mask = makemask(smask, count);
}
gethooktable(L);
lua_pushlightuserdata(L, L1);
lua_pushvalue(L, arg+1);
lua_rawset(L, -3); /* set new hook */
lua_pop(L, 1); /* remove hook table */
lua_sethook(L1, func, mask, count); /* set hooks */
return 0;
}
static int db_gethook (lua_State *L) {
int arg;
lua_State *L1 = getthread(L, &arg);
char buff[5];
int mask = lua_gethookmask(L1);
lua_Hook hook = lua_gethook(L1);
if (hook != NULL && hook != hookf) /* external hook? */
lua_pushliteral(L, "external hook");
else {
gethooktable(L);
lua_pushlightuserdata(L, L1);
lua_rawget(L, -2); /* get hook */
lua_remove(L, -2); /* remove hook table */
}
lua_pushstring(L, unmakemask(mask, buff));
lua_pushinteger(L, lua_gethookcount(L1));
return 3;
}
static int db_debug (lua_State *L) {
for (;;) {
char buffer[250];
fputs("lua_debug> ", stderr);
if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
strcmp(buffer, "cont\n") == 0)
return 0;
if (luaL_loadbuffer(L, buffer, strlen(buffer), "=(debug command)") ||
lua_pcall(L, 0, 0, 0)) {
fputs(lua_tostring(L, -1), stderr);
fputs("\n", stderr);
}
lua_settop(L, 0); /* remove eventual returns */
}
}
#define LEVELS1 12 /* size of the first part of the stack */
#define LEVELS2 10 /* size of the second part of the stack */
static int db_errorfb (lua_State *L) {
int level;
int firstpart = 1; /* still before eventual `...' */
int arg;
lua_State *L1 = getthread(L, &arg);
lua_Debug ar;
if (lua_isnumber(L, arg+2)) {
level = (int)lua_tointeger(L, arg+2);
lua_pop(L, 1);
}
else
level = (L == L1) ? 1 : 0; /* level 0 may be this own function */
if (lua_gettop(L) == arg)
lua_pushliteral(L, "");
else if (!lua_isstring(L, arg+1)) return 1; /* message is not a string */
else lua_pushliteral(L, "\n");
lua_pushliteral(L, "stack traceback:");
while (lua_getstack(L1, level++, &ar)) {
if (level > LEVELS1 && firstpart) {
/* no more than `LEVELS2' more levels? */
if (!lua_getstack(L1, level+LEVELS2, &ar))
level--; /* keep going */
else {
lua_pushliteral(L, "\n\t..."); /* too many levels */
while (lua_getstack(L1, level+LEVELS2, &ar)) /* find last levels */
level++;
}
firstpart = 0;
continue;
}
lua_pushliteral(L, "\n\t");
lua_getinfo(L1, "Snl", &ar);
lua_pushfstring(L, "%s:", ar.short_src);
if (ar.currentline > 0)
lua_pushfstring(L, "%d:", ar.currentline);
if (*ar.namewhat != '\0') /* is there a name? */
lua_pushfstring(L, " in function " LUA_QS, ar.name);
else {
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) - arg);
}
lua_concat(L, lua_gettop(L) - arg);
return 1;
}
static const luaL_Reg dblib[] = {
{"debug", db_debug},
{"getfenv", db_getfenv},
{"gethook", db_gethook},
{"getinfo", db_getinfo},
{"getlocal", db_getlocal},
{"getregistry", db_getregistry},
{"getmetatable", db_getmetatable},
{"getupvalue", db_getupvalue},
{"setfenv", db_setfenv},
{"sethook", db_sethook},
{"setlocal", db_setlocal},
{"setmetatable", db_setmetatable},
{"setupvalue", db_setupvalue},
{"traceback", db_errorfb},
{NULL, NULL}
};
LUALIB_API int luaopen_debug (lua_State *L) {
luaL_register(L, LUA_DBLIBNAME, dblib);
return 1;
}

638
src/lua/ldebug.c
View File

@ -1,638 +0,0 @@
/*
** $Id: ldebug.c,v 2.29.1.6 2008/05/08 16:56:26 roberto Exp $
** Debug Interface
** See Copyright Notice in lua.h
*/
#include <stdarg.h>
#include <stddef.h>
#include <string.h>
#define ldebug_c
#define LUA_CORE
#include "lua.h"
#include "lapi.h"
#include "lcode.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lvm.h"
static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name);
static int currentpc (lua_State *L, CallInfo *ci) {
if (!isLua(ci)) return -1; /* function is not a Lua function? */
if (ci == L->ci)
ci->savedpc = L->savedpc;
return pcRel(ci->savedpc, ci_func(ci)->l.p);
}
static int currentline (lua_State *L, CallInfo *ci) {
int pc = currentpc(L, ci);
if (pc < 0)
return -1; /* only active lua functions have current-line information */
else
return getline(ci_func(ci)->l.p, pc);
}
/*
** this function can be called asynchronous (e.g. during a signal)
*/
LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
if (func == NULL || mask == 0) { /* turn off hooks? */
mask = 0;
func = NULL;
}
L->hook = func;
L->basehookcount = count;
resethookcount(L);
L->hookmask = cast_byte(mask);
return 1;
}
LUA_API lua_Hook lua_gethook (lua_State *L) {
return L->hook;
}
LUA_API int lua_gethookmask (lua_State *L) {
return L->hookmask;
}
LUA_API int lua_gethookcount (lua_State *L) {
return L->basehookcount;
}
LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
int status;
CallInfo *ci;
lua_lock(L);
for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) {
level--;
if (f_isLua(ci)) /* Lua function? */
level -= ci->tailcalls; /* skip lost tail calls */
}
if (level == 0 && ci > L->base_ci) { /* level found? */
status = 1;
ar->i_ci = cast_int(ci - L->base_ci);
}
else if (level < 0) { /* level is of a lost tail call? */
status = 1;
ar->i_ci = 0;
}
else status = 0; /* no such level */
lua_unlock(L);
return status;
}
static Proto *getluaproto (CallInfo *ci) {
return (isLua(ci) ? ci_func(ci)->l.p : NULL);
}
static const char *findlocal (lua_State *L, CallInfo *ci, int n) {
const char *name;
Proto *fp = getluaproto(ci);
if (fp && (name = luaF_getlocalname(fp, n, currentpc(L, ci))) != NULL)
return name; /* is a local variable in a Lua function */
else {
StkId limit = (ci == L->ci) ? L->top : (ci+1)->func;
if (limit - ci->base >= n && n > 0) /* is 'n' inside 'ci' stack? */
return "(*temporary)";
else
return NULL;
}
}
LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
CallInfo *ci = L->base_ci + ar->i_ci;
const char *name = findlocal(L, ci, n);
lua_lock(L);
if (name)
luaA_pushobject(L, ci->base + (n - 1));
lua_unlock(L);
return name;
}
LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
CallInfo *ci = L->base_ci + ar->i_ci;
const char *name = findlocal(L, ci, n);
lua_lock(L);
if (name)
setobjs2s(L, ci->base + (n - 1), L->top - 1);
L->top--; /* pop value */
lua_unlock(L);
return name;
}
static void funcinfo (lua_Debug *ar, Closure *cl) {
if (cl->c.isC) {
ar->source = "=[C]";
ar->linedefined = -1;
ar->lastlinedefined = -1;
ar->what = "C";
}
else {
ar->source = getstr(cl->l.p->source);
ar->linedefined = cl->l.p->linedefined;
ar->lastlinedefined = cl->l.p->lastlinedefined;
ar->what = (ar->linedefined == 0) ? "main" : "Lua";
}
luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
}
static void info_tailcall (lua_Debug *ar) {
ar->name = ar->namewhat = "";
ar->what = "tail";
ar->lastlinedefined = ar->linedefined = ar->currentline = -1;
ar->source = "=(tail call)";
luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
ar->nups = 0;
}
static void collectvalidlines (lua_State *L, Closure *f) {
if (f == NULL || f->c.isC) {
setnilvalue(L->top);
}
else {
Table *t = luaH_new(L, 0, 0);
int *lineinfo = f->l.p->lineinfo;
int i;
for (i=0; i<f->l.p->sizelineinfo; i++)
setbvalue(luaH_setnum(L, t, lineinfo[i]), 1);
sethvalue(L, L->top, t);
}
incr_top(L);
}
static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
Closure *f, CallInfo *ci) {
int status = 1;
if (f == NULL) {
info_tailcall(ar);
return status;
}
for (; *what; what++) {
switch (*what) {
case 'S': {
funcinfo(ar, f);
break;
}
case 'l': {
ar->currentline = (ci) ? currentline(L, ci) : -1;
break;
}
case 'u': {
ar->nups = f->c.nupvalues;
break;
}
case 'n': {
ar->namewhat = (ci) ? getfuncname(L, ci, &ar->name) : NULL;
if (ar->namewhat == NULL) {
ar->namewhat = ""; /* not found */
ar->name = NULL;
}
break;
}
case 'L':
case 'f': /* handled by lua_getinfo */
break;
default: status = 0; /* invalid option */
}
}
return status;
}
LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
int status;
Closure *f = NULL;
CallInfo *ci = NULL;
lua_lock(L);
if (*what == '>') {
StkId func = L->top - 1;
luai_apicheck(L, ttisfunction(func));
what++; /* skip the '>' */
f = clvalue(func);
L->top--; /* pop function */
}
else if (ar->i_ci != 0) { /* no tail call? */
ci = L->base_ci + ar->i_ci;
lua_assert(ttisfunction(ci->func));
f = clvalue(ci->func);
}
status = auxgetinfo(L, what, ar, f, ci);
if (strchr(what, 'f')) {
if (f == NULL) setnilvalue(L->top);
else setclvalue(L, L->top, f);
incr_top(L);
}
if (strchr(what, 'L'))
collectvalidlines(L, f);
lua_unlock(L);
return status;
}
/*
** {======================================================
** Symbolic Execution and code checker
** =======================================================
*/
#define check(x) if (!(x)) return 0;
#define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode)
#define checkreg(pt,reg) check((reg) < (pt)->maxstacksize)
static int precheck (const Proto *pt) {
check(pt->maxstacksize <= MAXSTACK);
check(pt->numparams+(pt->is_vararg & VARARG_HASARG) <= pt->maxstacksize);
check(!(pt->is_vararg & VARARG_NEEDSARG) ||
(pt->is_vararg & VARARG_HASARG));
check(pt->sizeupvalues <= pt->nups);
check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0);
check(pt->sizecode > 0 && GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN);
return 1;
}
#define checkopenop(pt,pc) luaG_checkopenop((pt)->code[(pc)+1])
int luaG_checkopenop (Instruction i) {
switch (GET_OPCODE(i)) {
case OP_CALL:
case OP_TAILCALL:
case OP_RETURN:
case OP_SETLIST: {
check(GETARG_B(i) == 0);
return 1;
}
default: return 0; /* invalid instruction after an open call */
}
}
static int checkArgMode (const Proto *pt, int r, enum OpArgMask mode) {
switch (mode) {
case OpArgN: check(r == 0); break;
case OpArgU: break;
case OpArgR: checkreg(pt, r); break;
case OpArgK:
check(ISK(r) ? INDEXK(r) < pt->sizek : r < pt->maxstacksize);
break;
}
return 1;
}
static Instruction symbexec (const Proto *pt, int lastpc, int reg) {
int pc;
int last; /* stores position of last instruction that changed `reg' */
last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */
check(precheck(pt));
for (pc = 0; pc < lastpc; pc++) {
Instruction i = pt->code[pc];
OpCode op = GET_OPCODE(i);
int a = GETARG_A(i);
int b = 0;
int c = 0;
check(op < NUM_OPCODES);
checkreg(pt, a);
switch (getOpMode(op)) {
case iABC: {
b = GETARG_B(i);
c = GETARG_C(i);
check(checkArgMode(pt, b, getBMode(op)));
check(checkArgMode(pt, c, getCMode(op)));
break;
}
case iABx: {
b = GETARG_Bx(i);
if (getBMode(op) == OpArgK) check(b < pt->sizek);
break;
}
case iAsBx: {
b = GETARG_sBx(i);
if (getBMode(op) == OpArgR) {
int dest = pc+1+b;
check(0 <= dest && dest < pt->sizecode);
if (dest > 0) {
int j;
/* check that it does not jump to a setlist count; this
is tricky, because the count from a previous setlist may
have the same value of an invalid setlist; so, we must
go all the way back to the first of them (if any) */
for (j = 0; j < dest; j++) {
Instruction d = pt->code[dest-1-j];
if (!(GET_OPCODE(d) == OP_SETLIST && GETARG_C(d) == 0)) break;
}
/* if 'j' is even, previous value is not a setlist (even if
it looks like one) */
check((j&1) == 0);
}
}
break;
}
}
if (testAMode(op)) {
if (a == reg) last = pc; /* change register `a' */
}
if (testTMode(op)) {
check(pc+2 < pt->sizecode); /* check skip */
check(GET_OPCODE(pt->code[pc+1]) == OP_JMP);
}
switch (op) {
case OP_LOADBOOL: {
if (c == 1) { /* does it jump? */
check(pc+2 < pt->sizecode); /* check its jump */
check(GET_OPCODE(pt->code[pc+1]) != OP_SETLIST ||
GETARG_C(pt->code[pc+1]) != 0);
}
break;
}
case OP_LOADNIL: {
if (a <= reg && reg <= b)
last = pc; /* set registers from `a' to `b' */
break;
}
case OP_GETUPVAL:
case OP_SETUPVAL: {
check(b < pt->nups);
break;
}
case OP_GETGLOBAL:
case OP_SETGLOBAL: {
check(ttisstring(&pt->k[b]));
break;
}
case OP_SELF: {
checkreg(pt, a+1);
if (reg == a+1) last = pc;
break;
}
case OP_CONCAT: {
check(b < c); /* at least two operands */
break;
}
case OP_TFORLOOP: {
check(c >= 1); /* at least one result (control variable) */
checkreg(pt, a+2+c); /* space for results */
if (reg >= a+2) last = pc; /* affect all regs above its base */
break;
}
case OP_FORLOOP:
case OP_FORPREP:
checkreg(pt, a+3);
/* go through */
case OP_JMP: {
int dest = pc+1+b;
/* not full check and jump is forward and do not skip `lastpc'? */
if (reg != NO_REG && pc < dest && dest <= lastpc)
pc += b; /* do the jump */
break;
}
case OP_CALL:
case OP_TAILCALL: {
if (b != 0) {
checkreg(pt, a+b-1);
}
c--; /* c = num. returns */
if (c == LUA_MULTRET) {
check(checkopenop(pt, pc));
}
else if (c != 0)
checkreg(pt, a+c-1);
if (reg >= a) last = pc; /* affect all registers above base */
break;
}
case OP_RETURN: {
b--; /* b = num. returns */
if (b > 0) checkreg(pt, a+b-1);
break;
}
case OP_SETLIST: {
if (b > 0) checkreg(pt, a + b);
if (c == 0) {
pc++;
check(pc < pt->sizecode - 1);
}
break;
}
case OP_CLOSURE: {
int nup, j;
check(b < pt->sizep);
nup = pt->p[b]->nups;
check(pc + nup < pt->sizecode);
for (j = 1; j <= nup; j++) {
OpCode op1 = GET_OPCODE(pt->code[pc + j]);
check(op1 == OP_GETUPVAL || op1 == OP_MOVE);
}
if (reg != NO_REG) /* tracing? */
pc += nup; /* do not 'execute' these pseudo-instructions */
break;
}
case OP_VARARG: {
check((pt->is_vararg & VARARG_ISVARARG) &&
!(pt->is_vararg & VARARG_NEEDSARG));
b--;
if (b == LUA_MULTRET) check(checkopenop(pt, pc));
checkreg(pt, a+b-1);
break;
}
default: break;
}
}
return pt->code[last];
}
#undef check
#undef checkjump
#undef checkreg
/* }====================================================== */
int luaG_checkcode (const Proto *pt) {
return (symbexec(pt, pt->sizecode, NO_REG) != 0);
}
static const char *kname (Proto *p, int c) {
if (ISK(c) && ttisstring(&p->k[INDEXK(c)]))
return svalue(&p->k[INDEXK(c)]);
else
return "?";
}
static const char *getobjname (lua_State *L, CallInfo *ci, int stackpos,
const char **name) {
if (isLua(ci)) { /* a Lua function? */
Proto *p = ci_func(ci)->l.p;
int pc = currentpc(L, ci);
Instruction i;
*name = luaF_getlocalname(p, stackpos+1, pc);
if (*name) /* is a local? */
return "local";
i = symbexec(p, pc, stackpos); /* try symbolic execution */
lua_assert(pc != -1);
switch (GET_OPCODE(i)) {
case OP_GETGLOBAL: {
int g = GETARG_Bx(i); /* global index */
lua_assert(ttisstring(&p->k[g]));
*name = svalue(&p->k[g]);
return "global";
}
case OP_MOVE: {
int a = GETARG_A(i);
int b = GETARG_B(i); /* move from `b' to `a' */
if (b < a)
return getobjname(L, ci, b, name); /* get name for `b' */
break;
}
case OP_GETTABLE: {
int k = GETARG_C(i); /* key index */
*name = kname(p, k);
return "field";
}
case OP_GETUPVAL: {
int u = GETARG_B(i); /* upvalue index */
*name = p->upvalues ? getstr(p->upvalues[u]) : "?";
return "upvalue";
}
case OP_SELF: {
int k = GETARG_C(i); /* key index */
*name = kname(p, k);
return "method";
}
default: break;
}
}
return NULL; /* no useful name found */
}
static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
Instruction i;
if ((isLua(ci) && ci->tailcalls > 0) || !isLua(ci - 1))
return NULL; /* calling function is not Lua (or is unknown) */
ci--; /* calling function */
i = ci_func(ci)->l.p->code[currentpc(L, ci)];
if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL ||
GET_OPCODE(i) == OP_TFORLOOP)
return getobjname(L, ci, GETARG_A(i), name);
else
return NULL; /* no useful name can be found */
}
/* only ANSI way to check whether a pointer points to an array */
static int isinstack (CallInfo *ci, const TValue *o) {
StkId p;
for (p = ci->base; p < ci->top; p++)
if (o == p) return 1;
return 0;
}
void luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
const char *name = NULL;
const char *t = luaT_typenames[ttype(o)];
const char *kind = (isinstack(L->ci, o)) ?
getobjname(L, L->ci, cast_int(o - L->base), &name) :
NULL;
if (kind)
luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)",
op, kind, name, t);
else
luaG_runerror(L, "attempt to %s a %s value", op, t);
}
void luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
if (ttisstring(p1) || ttisnumber(p1)) p1 = p2;
lua_assert(!ttisstring(p1) && !ttisnumber(p1));
luaG_typeerror(L, p1, "concatenate");
}
void luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) {
TValue temp;
if (luaV_tonumber(p1, &temp) == NULL)
p2 = p1; /* first operand is wrong */
luaG_typeerror(L, p2, "perform arithmetic on");
}
int luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
const char *t1 = luaT_typenames[ttype(p1)];
const char *t2 = luaT_typenames[ttype(p2)];
if (t1[2] == t2[2])
luaG_runerror(L, "attempt to compare two %s values", t1);
else
luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
return 0;
}
static void addinfo (lua_State *L, const char *msg) {
CallInfo *ci = L->ci;
if (isLua(ci)) { /* is Lua code? */
char buff[LUA_IDSIZE]; /* add file:line information */
int line = currentline(L, ci);
luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE);
luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
}
}
void luaG_errormsg (lua_State *L) {
if (L->errfunc != 0) { /* is there an error handling function? */
StkId errfunc = restorestack(L, L->errfunc);
if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR);
setobjs2s(L, L->top, L->top - 1); /* move argument */
setobjs2s(L, L->top - 1, errfunc); /* push function */
incr_top(L);
luaD_call(L, L->top - 2, 1); /* call it */
}
luaD_throw(L, LUA_ERRRUN);
}
void luaG_runerror (lua_State *L, const char *fmt, ...) {
va_list argp;
va_start(argp, fmt);
addinfo(L, luaO_pushvfstring(L, fmt, argp));
va_end(argp);
luaG_errormsg(L);
}

33
src/lua/ldebug.h
View File

@ -1,33 +0,0 @@
/*
** $Id: ldebug.h,v 2.3.1.1 2007/12/27 13:02:25 roberto Exp $
** Auxiliary functions from Debug Interface module
** See Copyright Notice in lua.h
*/
#ifndef ldebug_h
#define ldebug_h
#include "lstate.h"
#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)
LUAI_FUNC void luaG_typeerror (lua_State *L, const TValue *o,
const char *opname);
LUAI_FUNC void luaG_concaterror (lua_State *L, StkId p1, StkId p2);
LUAI_FUNC void luaG_aritherror (lua_State *L, const TValue *p1,
const TValue *p2);
LUAI_FUNC int luaG_ordererror (lua_State *L, const TValue *p1,
const TValue *p2);
LUAI_FUNC void luaG_runerror (lua_State *L, const char *fmt, ...);
LUAI_FUNC void luaG_errormsg (lua_State *L);
LUAI_FUNC int luaG_checkcode (const Proto *pt);
LUAI_FUNC int luaG_checkopenop (Instruction i);
#endif

519
src/lua/ldo.c
View File

@ -1,519 +0,0 @@
/*
** $Id: ldo.c,v 2.38.1.4 2012/01/18 02:27:10 roberto Exp $
** Stack and Call structure of Lua
** See Copyright Notice in lua.h
*/
#include <setjmp.h>
#include <stdlib.h>
#include <string.h>
#define ldo_c
#define LUA_CORE
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lparser.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lundump.h"
#include "lvm.h"
#include "lzio.h"
/*
** {======================================================
** Error-recovery functions
** =======================================================
*/
/* chain list of long jump buffers */
struct lua_longjmp {
struct lua_longjmp *previous;
luai_jmpbuf b;
volatile int status; /* error code */
};
void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop) {
switch (errcode) {
case LUA_ERRMEM: {
setsvalue2s(L, oldtop, luaS_newliteral(L, MEMERRMSG));
break;
}
case LUA_ERRERR: {
setsvalue2s(L, oldtop, luaS_newliteral(L, "error in error handling"));
break;
}
case LUA_ERRSYNTAX:
case LUA_ERRRUN: {
setobjs2s(L, oldtop, L->top - 1); /* error message on current top */
break;
}
}
L->top = oldtop + 1;
}
static void restore_stack_limit (lua_State *L) {
lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK - 1);
if (L->size_ci > LUAI_MAXCALLS) { /* there was an overflow? */
int inuse = cast_int(L->ci - L->base_ci);
if (inuse + 1 < LUAI_MAXCALLS) /* can `undo' overflow? */
luaD_reallocCI(L, LUAI_MAXCALLS);
}
}
static void resetstack (lua_State *L, int status) {
L->ci = L->base_ci;
L->base = L->ci->base;
luaF_close(L, L->base); /* close eventual pending closures */
luaD_seterrorobj(L, status, L->base);
L->nCcalls = L->baseCcalls;
L->allowhook = 1;
restore_stack_limit(L);
L->errfunc = 0;
L->errorJmp = NULL;
}
void luaD_throw (lua_State *L, int errcode) {
if (L->errorJmp) {
L->errorJmp->status = errcode;
LUAI_THROW(L, L->errorJmp);
}
else {
L->status = cast_byte(errcode);
if (G(L)->panic) {
resetstack(L, errcode);
lua_unlock(L);
G(L)->panic(L);
}
exit(EXIT_FAILURE);
}
}
int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud) {
struct lua_longjmp lj;
lj.status = 0;
lj.previous = L->errorJmp; /* chain new error handler */
L->errorJmp = &lj;
LUAI_TRY(L, &lj,
(*f)(L, ud);
);
L->errorJmp = lj.previous; /* restore old error handler */
return lj.status;
}
/* }====================================================== */
static void correctstack (lua_State *L, TValue *oldstack) {
CallInfo *ci;
GCObject *up;
L->top = (L->top - oldstack) + L->stack;
for (up = L->openupval; up != NULL; up = up->gch.next)
gco2uv(up)->v = (gco2uv(up)->v - oldstack) + L->stack;
for (ci = L->base_ci; ci <= L->ci; ci++) {
ci->top = (ci->top - oldstack) + L->stack;
ci->base = (ci->base - oldstack) + L->stack;
ci->func = (ci->func - oldstack) + L->stack;
}
L->base = (L->base - oldstack) + L->stack;
}
void luaD_reallocstack (lua_State *L, int newsize) {
TValue *oldstack = L->stack;
int realsize = newsize + 1 + EXTRA_STACK;
lua_assert(L->stack_last - L->stack == L->stacksize - EXTRA_STACK - 1);
luaM_reallocvector(L, L->stack, L->stacksize, realsize, TValue);
L->stacksize = realsize;
L->stack_last = L->stack+newsize;
correctstack(L, oldstack);
}
void luaD_reallocCI (lua_State *L, int newsize) {
CallInfo *oldci = L->base_ci;
luaM_reallocvector(L, L->base_ci, L->size_ci, newsize, CallInfo);
L->size_ci = newsize;
L->ci = (L->ci - oldci) + L->base_ci;
L->end_ci = L->base_ci + L->size_ci - 1;
}
void luaD_growstack (lua_State *L, int n) {
if (n <= L->stacksize) /* double size is enough? */
luaD_reallocstack(L, 2*L->stacksize);
else
luaD_reallocstack(L, L->stacksize + n);
}
static CallInfo *growCI (lua_State *L) {
if (L->size_ci > LUAI_MAXCALLS) /* overflow while handling overflow? */
luaD_throw(L, LUA_ERRERR);
else {
luaD_reallocCI(L, 2*L->size_ci);
if (L->size_ci > LUAI_MAXCALLS)
luaG_runerror(L, "stack overflow");
}
return ++L->ci;
}
void luaD_callhook (lua_State *L, int event, int line) {
lua_Hook hook = L->hook;
if (hook && L->allowhook) {
ptrdiff_t top = savestack(L, L->top);
ptrdiff_t ci_top = savestack(L, L->ci->top);
lua_Debug ar;
ar.event = event;
ar.currentline = line;
if (event == LUA_HOOKTAILRET)
ar.i_ci = 0; /* tail call; no debug information about it */
else
ar.i_ci = cast_int(L->ci - L->base_ci);
luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
L->ci->top = L->top + LUA_MINSTACK;
lua_assert(L->ci->top <= L->stack_last);
L->allowhook = 0; /* cannot call hooks inside a hook */
lua_unlock(L);
(*hook)(L, &ar);
lua_lock(L);
lua_assert(!L->allowhook);
L->allowhook = 1;
L->ci->top = restorestack(L, ci_top);
L->top = restorestack(L, top);
}
}
static StkId adjust_varargs (lua_State *L, Proto *p, int actual) {
int i;
int nfixargs = p->numparams;
Table *htab = NULL;
StkId base, fixed;
for (; actual < nfixargs; ++actual)
setnilvalue(L->top++);
#if defined(LUA_COMPAT_VARARG)
if (p->is_vararg & VARARG_NEEDSARG) { /* compat. with old-style vararg? */
int nvar = actual - nfixargs; /* number of extra arguments */
lua_assert(p->is_vararg & VARARG_HASARG);
luaC_checkGC(L);
luaD_checkstack(L, p->maxstacksize);
htab = luaH_new(L, nvar, 1); /* create `arg' table */
for (i=0; i<nvar; i++) /* put extra arguments into `arg' table */
setobj2n(L, luaH_setnum(L, htab, i+1), L->top - nvar + i);
/* store counter in field `n' */
setnvalue(luaH_setstr(L, htab, luaS_newliteral(L, "n")), cast_num(nvar));
}
#endif
/* move fixed parameters to final position */
fixed = L->top - actual; /* first fixed argument */
base = L->top; /* final position of first argument */
for (i=0; i<nfixargs; i++) {
setobjs2s(L, L->top++, fixed+i);
setnilvalue(fixed+i);
}
/* add `arg' parameter */
if (htab) {
sethvalue(L, L->top++, htab);
lua_assert(iswhite(obj2gco(htab)));
}
return base;
}
static StkId tryfuncTM (lua_State *L, StkId func) {
const TValue *tm = luaT_gettmbyobj(L, func, TM_CALL);
StkId p;
ptrdiff_t funcr = savestack(L, func);
if (!ttisfunction(tm))
luaG_typeerror(L, func, "call");
/* Open a hole inside the stack at `func' */
for (p = L->top; p > func; p--) setobjs2s(L, p, p-1);
incr_top(L);
func = restorestack(L, funcr); /* previous call may change stack */
setobj2s(L, func, tm); /* tag method is the new function to be called */
return func;
}
#define inc_ci(L) \
((L->ci == L->end_ci) ? growCI(L) : \
(condhardstacktests(luaD_reallocCI(L, L->size_ci)), ++L->ci))
int luaD_precall (lua_State *L, StkId func, int nresults) {
LClosure *cl;
ptrdiff_t funcr;
if (!ttisfunction(func)) /* `func' is not a function? */
func = tryfuncTM(L, func); /* check the `function' tag method */
funcr = savestack(L, func);
cl = &clvalue(func)->l;
L->ci->savedpc = L->savedpc;
if (!cl->isC) { /* Lua function? prepare its call */
CallInfo *ci;
StkId st, base;
Proto *p = cl->p;
luaD_checkstack(L, p->maxstacksize);
func = restorestack(L, funcr);
if (!p->is_vararg) { /* no varargs? */
base = func + 1;
if (L->top > base + p->numparams)
L->top = base + p->numparams;
}
else { /* vararg function */
int nargs = cast_int(L->top - func) - 1;
base = adjust_varargs(L, p, nargs);
func = restorestack(L, funcr); /* previous call may change the stack */
}
ci = inc_ci(L); /* now `enter' new function */
ci->func = func;
L->base = ci->base = base;
ci->top = L->base + p->maxstacksize;
lua_assert(ci->top <= L->stack_last);
L->savedpc = p->code; /* starting point */
ci->tailcalls = 0;
ci->nresults = nresults;
for (st = L->top; st < ci->top; st++)
setnilvalue(st);
L->top = ci->top;
if (L->hookmask & LUA_MASKCALL) {
L->savedpc++; /* hooks assume 'pc' is already incremented */
luaD_callhook(L, LUA_HOOKCALL, -1);
L->savedpc--; /* correct 'pc' */
}
return PCRLUA;
}
else { /* if is a C function, call it */
CallInfo *ci;
int n;
luaD_checkstack(L, LUA_MINSTACK); /* ensure minimum stack size */
ci = inc_ci(L); /* now `enter' new function */
ci->func = restorestack(L, funcr);
L->base = ci->base = ci->func + 1;
ci->top = L->top + LUA_MINSTACK;
lua_assert(ci->top <= L->stack_last);
ci->nresults = nresults;
if (L->hookmask & LUA_MASKCALL)
luaD_callhook(L, LUA_HOOKCALL, -1);
lua_unlock(L);
n = (*curr_func(L)->c.f)(L); /* do the actual call */
lua_lock(L);
if (n < 0) /* yielding? */
return PCRYIELD;
else {
luaD_poscall(L, L->top - n);
return PCRC;
}
}
}
static StkId callrethooks (lua_State *L, StkId firstResult) {
ptrdiff_t fr = savestack(L, firstResult); /* next call may change stack */
luaD_callhook(L, LUA_HOOKRET, -1);
if (f_isLua(L->ci)) { /* Lua function? */
while ((L->hookmask & LUA_MASKRET) && L->ci->tailcalls--) /* tail calls */
luaD_callhook(L, LUA_HOOKTAILRET, -1);
}
return restorestack(L, fr);
}
int luaD_poscall (lua_State *L, StkId firstResult) {
StkId res;
int wanted, i;
CallInfo *ci;
if (L->hookmask & LUA_MASKRET)
firstResult = callrethooks(L, firstResult);
ci = L->ci--;
res = ci->func; /* res == final position of 1st result */
wanted = ci->nresults;
L->base = (ci - 1)->base; /* restore base */
L->savedpc = (ci - 1)->savedpc; /* restore savedpc */
/* move results to correct place */
for (i = wanted; i != 0 && firstResult < L->top; i--)
setobjs2s(L, res++, firstResult++);
while (i-- > 0)
setnilvalue(res++);
L->top = res;
return (wanted - LUA_MULTRET); /* 0 iff wanted == LUA_MULTRET */
}
/*
** Call a function (C or Lua). The function to be called is at *func.
** The arguments are on the stack, right after the function.
** When returns, all the results are on the stack, starting at the original
** function position.
*/
void luaD_call (lua_State *L, StkId func, int nResults) {
if (++L->nCcalls >= LUAI_MAXCCALLS) {
if (L->nCcalls == LUAI_MAXCCALLS)
luaG_runerror(L, "C stack overflow");
else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3)))
luaD_throw(L, LUA_ERRERR); /* error while handing stack error */
}
if (luaD_precall(L, func, nResults) == PCRLUA) /* is a Lua function? */
luaV_execute(L, 1); /* call it */
L->nCcalls--;
luaC_checkGC(L);
}
static void resume (lua_State *L, void *ud) {
StkId firstArg = cast(StkId, ud);
CallInfo *ci = L->ci;
if (L->status == 0) { /* start coroutine? */
lua_assert(ci == L->base_ci && firstArg > L->base);
if (luaD_precall(L, firstArg - 1, LUA_MULTRET) != PCRLUA)
return;
}
else { /* resuming from previous yield */
lua_assert(L->status == LUA_YIELD);
L->status = 0;
if (!f_isLua(ci)) { /* `common' yield? */
/* finish interrupted execution of `OP_CALL' */
lua_assert(GET_OPCODE(*((ci-1)->savedpc - 1)) == OP_CALL ||
GET_OPCODE(*((ci-1)->savedpc - 1)) == OP_TAILCALL);
if (luaD_poscall(L, firstArg)) /* complete it... */
L->top = L->ci->top; /* and correct top if not multiple results */
}
else /* yielded inside a hook: just continue its execution */
L->base = L->ci->base;
}
luaV_execute(L, cast_int(L->ci - L->base_ci));
}
static int resume_error (lua_State *L, const char *msg) {
L->top = L->ci->base;
setsvalue2s(L, L->top, luaS_new(L, msg));
incr_top(L);
lua_unlock(L);
return LUA_ERRRUN;
}
LUA_API int lua_resume (lua_State *L, int nargs) {
int status;
lua_lock(L);
if (L->status != LUA_YIELD && (L->status != 0 || L->ci != L->base_ci))
return resume_error(L, "cannot resume non-suspended coroutine");
if (L->nCcalls >= LUAI_MAXCCALLS)
return resume_error(L, "C stack overflow");
luai_userstateresume(L, nargs);
lua_assert(L->errfunc == 0);
L->baseCcalls = ++L->nCcalls;
status = luaD_rawrunprotected(L, resume, L->top - nargs);
if (status != 0) { /* error? */
L->status = cast_byte(status); /* mark thread as `dead' */
luaD_seterrorobj(L, status, L->top);
L->ci->top = L->top;
}
else {
lua_assert(L->nCcalls == L->baseCcalls);
status = L->status;
}
--L->nCcalls;
lua_unlock(L);
return status;
}
LUA_API int lua_yield (lua_State *L, int nresults) {
luai_userstateyield(L, nresults);
lua_lock(L);
if (L->nCcalls > L->baseCcalls)
luaG_runerror(L, "attempt to yield across metamethod/C-call boundary");
L->base = L->top - nresults; /* protect stack slots below */
L->status = LUA_YIELD;
lua_unlock(L);
return -1;
}
int luaD_pcall (lua_State *L, Pfunc func, void *u,
ptrdiff_t old_top, ptrdiff_t ef) {
int status;
unsigned short oldnCcalls = L->nCcalls;
ptrdiff_t old_ci = saveci(L, L->ci);
lu_byte old_allowhooks = L->allowhook;
ptrdiff_t old_errfunc = L->errfunc;
L->errfunc = ef;
status = luaD_rawrunprotected(L, func, u);
if (status != 0) { /* an error occurred? */
StkId oldtop = restorestack(L, old_top);
luaF_close(L, oldtop); /* close eventual pending closures */
luaD_seterrorobj(L, status, oldtop);
L->nCcalls = oldnCcalls;
L->ci = restoreci(L, old_ci);
L->base = L->ci->base;
L->savedpc = L->ci->savedpc;
L->allowhook = old_allowhooks;
restore_stack_limit(L);
}
L->errfunc = old_errfunc;
return status;
}
/*
** Execute a protected parser.
*/
struct SParser { /* data to `f_parser' */
ZIO *z;
Mbuffer buff; /* buffer to be used by the scanner */
const char *name;
};
static void f_parser (lua_State *L, void *ud) {
int i;
Proto *tf;
Closure *cl;
struct SParser *p = cast(struct SParser *, ud);
int c = luaZ_lookahead(p->z);
luaC_checkGC(L);
tf = ((c == LUA_SIGNATURE[0]) ? luaU_undump : luaY_parser)(L, p->z,
&p->buff, p->name);
cl = luaF_newLclosure(L, tf->nups, hvalue(gt(L)));
cl->l.p = tf;
for (i = 0; i < tf->nups; i++) /* initialize eventual upvalues */
cl->l.upvals[i] = luaF_newupval(L);
setclvalue(L, L->top, cl);
incr_top(L);
}
int luaD_protectedparser (lua_State *L, ZIO *z, const char *name) {
struct SParser p;
int status;
p.z = z; p.name = name;
luaZ_initbuffer(L, &p.buff);
status = luaD_pcall(L, f_parser, &p, savestack(L, L->top), L->errfunc);
luaZ_freebuffer(L, &p.buff);
return status;
}

57
src/lua/ldo.h
View File

@ -1,57 +0,0 @@
/*
** $Id: ldo.h,v 2.7.1.1 2007/12/27 13:02:25 roberto Exp $
** Stack and Call structure of Lua
** See Copyright Notice in lua.h
*/
#ifndef ldo_h
#define ldo_h
#include "lobject.h"
#include "lstate.h"
#include "lzio.h"
#define luaD_checkstack(L,n) \
if ((char *)L->stack_last - (char *)L->top <= (n)*(int)sizeof(TValue)) \
luaD_growstack(L, n); \
else condhardstacktests(luaD_reallocstack(L, L->stacksize - EXTRA_STACK - 1));
#define incr_top(L) {luaD_checkstack(L,1); L->top++;}
#define savestack(L,p) ((char *)(p) - (char *)L->stack)
#define restorestack(L,n) ((TValue *)((char *)L->stack + (n)))
#define saveci(L,p) ((char *)(p) - (char *)L->base_ci)
#define restoreci(L,n) ((CallInfo *)((char *)L->base_ci + (n)))
/* results from luaD_precall */
#define PCRLUA 0 /* initiated a call to a Lua function */
#define PCRC 1 /* did a call to a C function */
#define PCRYIELD 2 /* C funtion yielded */
/* type of protected functions, to be ran by `runprotected' */
typedef void (*Pfunc) (lua_State *L, void *ud);
LUAI_FUNC int luaD_protectedparser (lua_State *L, ZIO *z, const char *name);
LUAI_FUNC void luaD_callhook (lua_State *L, int event, int line);
LUAI_FUNC int luaD_precall (lua_State *L, StkId func, int nresults);
LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults);
LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u,
ptrdiff_t oldtop, ptrdiff_t ef);
LUAI_FUNC int luaD_poscall (lua_State *L, StkId firstResult);
LUAI_FUNC void luaD_reallocCI (lua_State *L, int newsize);
LUAI_FUNC void luaD_reallocstack (lua_State *L, int newsize);
LUAI_FUNC void luaD_growstack (lua_State *L, int n);
LUAI_FUNC void luaD_throw (lua_State *L, int errcode);
LUAI_FUNC int luaD_rawrunprotected (lua_State *L, Pfunc f, void *ud);
LUAI_FUNC void luaD_seterrorobj (lua_State *L, int errcode, StkId oldtop);
#endif

164
src/lua/ldump.c
View File

@ -1,164 +0,0 @@
/*
** $Id: ldump.c,v 2.8.1.1 2007/12/27 13:02:25 roberto Exp $
** save precompiled Lua chunks
** See Copyright Notice in lua.h
*/
#include <stddef.h>
#define ldump_c
#define LUA_CORE
#include "lua.h"
#include "lobject.h"
#include "lstate.h"
#include "lundump.h"
typedef struct {
lua_State* L;
lua_Writer writer;
void* data;
int strip;
int status;
} DumpState;
#define DumpMem(b,n,size,D) DumpBlock(b,(n)*(size),D)
#define DumpVar(x,D) DumpMem(&x,1,sizeof(x),D)
static void DumpBlock(const void* b, size_t size, DumpState* D)
{
if (D->status==0)
{
lua_unlock(D->L);
D->status=(*D->writer)(D->L,b,size,D->data);
lua_lock(D->L);
}
}
static void DumpChar(int y, DumpState* D)
{
char x=(char)y;
DumpVar(x,D);
}
static void DumpInt(int x, DumpState* D)
{
DumpVar(x,D);
}
static void DumpNumber(lua_Number x, DumpState* D)
{
DumpVar(x,D);
}
static void DumpVector(const void* b, int n, size_t size, DumpState* D)
{
DumpInt(n,D);
DumpMem(b,n,size,D);
}
static void DumpString(const TString* s, DumpState* D)
{
if (s==NULL || getstr(s)==NULL)
{
size_t size=0;
DumpVar(size,D);
}
else
{
size_t size=s->tsv.len+1; /* include trailing '\0' */
DumpVar(size,D);
DumpBlock(getstr(s),size,D);
}
}
#define DumpCode(f,D) DumpVector(f->code,f->sizecode,sizeof(Instruction),D)
static void DumpFunction(const Proto* f, const TString* p, DumpState* D);
static void DumpConstants(const Proto* f, DumpState* D)
{
int i,n=f->sizek;
DumpInt(n,D);
for (i=0; i<n; i++)
{
const TValue* o=&f->k[i];
DumpChar(ttype(o),D);
switch (ttype(o))
{
case LUA_TNIL:
break;
case LUA_TBOOLEAN:
DumpChar(bvalue(o),D);
break;
case LUA_TNUMBER:
DumpNumber(nvalue(o),D);
break;
case LUA_TSTRING:
DumpString(rawtsvalue(o),D);
break;
default:
lua_assert(0); /* cannot happen */
break;
}
}
n=f->sizep;
DumpInt(n,D);
for (i=0; i<n; i++) DumpFunction(f->p[i],f->source,D);
}
static void DumpDebug(const Proto* f, DumpState* D)
{
int i,n;
n= (D->strip) ? 0 : f->sizelineinfo;
DumpVector(f->lineinfo,n,sizeof(int),D);
n= (D->strip) ? 0 : 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);
}
n= (D->strip) ? 0 : 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)
{
DumpString((f->source==p || D->strip) ? NULL : f->source,D);
DumpInt(f->linedefined,D);
DumpInt(f->lastlinedefined,D);
DumpChar(f->nups,D);
DumpChar(f->numparams,D);
DumpChar(f->is_vararg,D);
DumpChar(f->maxstacksize,D);
DumpCode(f,D);
DumpConstants(f,D);
DumpDebug(f,D);
}
static void DumpHeader(DumpState* D)
{
char h[LUAC_HEADERSIZE];
luaU_header(h);
DumpBlock(h,LUAC_HEADERSIZE,D);
}
/*
** 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.L=L;
D.writer=w;
D.data=data;
D.strip=strip;
D.status=0;
DumpHeader(&D);
DumpFunction(f,NULL,&D);
return D.status;
}

174
src/lua/lfunc.c
View File

@ -1,174 +0,0 @@
/*
** $Id: lfunc.c,v 2.12.1.2 2007/12/28 14:58:43 roberto Exp $
** Auxiliary functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
#include <stddef.h>
#define lfunc_c
#define LUA_CORE
#include "lua.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
Closure *luaF_newCclosure (lua_State *L, int nelems, Table *e) {
Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems)));
luaC_link(L, obj2gco(c), LUA_TFUNCTION);
c->c.isC = 1;
c->c.env = e;
c->c.nupvalues = cast_byte(nelems);
return c;
}
Closure *luaF_newLclosure (lua_State *L, int nelems, Table *e) {
Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems)));
luaC_link(L, obj2gco(c), LUA_TFUNCTION);
c->l.isC = 0;
c->l.env = e;
c->l.nupvalues = cast_byte(nelems);
while (nelems--) c->l.upvals[nelems] = NULL;
return c;
}
UpVal *luaF_newupval (lua_State *L) {
UpVal *uv = luaM_new(L, UpVal);
luaC_link(L, obj2gco(uv), LUA_TUPVAL);
uv->v = &uv->u.value;
setnilvalue(uv->v);
return uv;
}
UpVal *luaF_findupval (lua_State *L, StkId level) {
global_State *g = G(L);
GCObject **pp = &L->openupval;
UpVal *p;
UpVal *uv;
while (*pp != NULL && (p = ngcotouv(*pp))->v >= level) {
lua_assert(p->v != &p->u.value);
if (p->v == level) { /* found a corresponding upvalue? */
if (isdead(g, obj2gco(p))) /* is it dead? */
changewhite(obj2gco(p)); /* ressurect it */
return p;
}
pp = &p->next;
}
uv = luaM_new(L, UpVal); /* not found: create a new one */
uv->tt = LUA_TUPVAL;
uv->marked = luaC_white(g);
uv->v = level; /* current value lives in the stack */
uv->next = *pp; /* chain it in the proper position */
*pp = obj2gco(uv);
uv->u.l.prev = &g->uvhead; /* double link it in `uvhead' list */
uv->u.l.next = g->uvhead.u.l.next;
uv->u.l.next->u.l.prev = uv;
g->uvhead.u.l.next = uv;
lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv);
return uv;
}
static void unlinkupval (UpVal *uv) {
lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv);
uv->u.l.next->u.l.prev = uv->u.l.prev; /* remove from `uvhead' list */
uv->u.l.prev->u.l.next = uv->u.l.next;
}
void luaF_freeupval (lua_State *L, UpVal *uv) {
if (uv->v != &uv->u.value) /* is it open? */
unlinkupval(uv); /* remove from open list */
luaM_free(L, uv); /* free upvalue */
}
void luaF_close (lua_State *L, StkId level) {
UpVal *uv;
global_State *g = G(L);
while (L->openupval != NULL && (uv = ngcotouv(L->openupval))->v >= level) {
GCObject *o = obj2gco(uv);
lua_assert(!isblack(o) && uv->v != &uv->u.value);
L->openupval = uv->next; /* remove from `open' list */
if (isdead(g, o))
luaF_freeupval(L, uv); /* free upvalue */
else {
unlinkupval(uv);
setobj(L, &uv->u.value, uv->v);
uv->v = &uv->u.value; /* now current value lives here */
luaC_linkupval(L, uv); /* link upvalue into `gcroot' list */
}
}
}
Proto *luaF_newproto (lua_State *L) {
Proto *f = luaM_new(L, Proto);
luaC_link(L, obj2gco(f), LUA_TPROTO);
f->k = NULL;
f->sizek = 0;
f->p = NULL;
f->sizep = 0;
f->code = NULL;
f->sizecode = 0;
f->sizelineinfo = 0;
f->sizeupvalues = 0;
f->nups = 0;
f->upvalues = NULL;
f->numparams = 0;
f->is_vararg = 0;
f->maxstacksize = 0;
f->lineinfo = NULL;
f->sizelocvars = 0;
f->locvars = NULL;
f->linedefined = 0;
f->lastlinedefined = 0;
f->source = NULL;
return f;
}
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, TValue);
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_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_freemem(L, c, size);
}
/*
** 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) {
int i;
for (i = 0; i<f->sizelocvars && f->locvars[i].startpc <= pc; i++) {
if (pc < f->locvars[i].endpc) { /* is variable active? */
local_number--;
if (local_number == 0)
return getstr(f->locvars[i].varname);
}
}
return NULL; /* not found */
}

34
src/lua/lfunc.h
View File

@ -1,34 +0,0 @@
/*
** $Id: lfunc.h,v 2.4.1.1 2007/12/27 13:02:25 roberto Exp $
** Auxiliary functions to manipulate prototypes and closures
** See Copyright Notice in lua.h
*/
#ifndef lfunc_h
#define lfunc_h
#include "lobject.h"
#define sizeCclosure(n) (cast(int, sizeof(CClosure)) + \
cast(int, sizeof(TValue)*((n)-1)))
#define sizeLclosure(n) (cast(int, sizeof(LClosure)) + \
cast(int, sizeof(TValue *)*((n)-1)))
LUAI_FUNC Proto *luaF_newproto (lua_State *L);
LUAI_FUNC Closure *luaF_newCclosure (lua_State *L, int nelems, Table *e);
LUAI_FUNC Closure *luaF_newLclosure (lua_State *L, int nelems, Table *e);
LUAI_FUNC UpVal *luaF_newupval (lua_State *L);
LUAI_FUNC UpVal *luaF_findupval (lua_State *L, StkId level);
LUAI_FUNC void luaF_close (lua_State *L, StkId level);
LUAI_FUNC void luaF_freeproto (lua_State *L, Proto *f);
LUAI_FUNC void luaF_freeclosure (lua_State *L, Closure *c);
LUAI_FUNC void luaF_freeupval (lua_State *L, UpVal *uv);
LUAI_FUNC const char *luaF_getlocalname (const Proto *func, int local_number,
int pc);
#endif

710
src/lua/lgc.c
View File

@ -1,710 +0,0 @@
/*
** $Id: lgc.c,v 2.38.1.2 2011/03/18 18:05:38 roberto Exp $
** Garbage Collector
** See Copyright Notice in lua.h
*/
#include <string.h>
#define lgc_c
#define LUA_CORE
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#define GCSTEPSIZE 1024u
#define GCSWEEPMAX 40
#define GCSWEEPCOST 10
#define GCFINALIZECOST 100
#define maskmarks cast_byte(~(bitmask(BLACKBIT)|WHITEBITS))
#define makewhite(g,x) \
((x)->gch.marked = cast_byte(((x)->gch.marked & maskmarks) | luaC_white(g)))
#define white2gray(x) reset2bits((x)->gch.marked, WHITE0BIT, WHITE1BIT)
#define black2gray(x) resetbit((x)->gch.marked, BLACKBIT)
#define stringmark(s) reset2bits((s)->tsv.marked, WHITE0BIT, WHITE1BIT)
#define isfinalized(u) testbit((u)->marked, FINALIZEDBIT)
#define markfinalized(u) l_setbit((u)->marked, FINALIZEDBIT)
#define KEYWEAK bitmask(KEYWEAKBIT)
#define VALUEWEAK bitmask(VALUEWEAKBIT)
#define markvalue(g,o) { checkconsistency(o); \
if (iscollectable(o) && iswhite(gcvalue(o))) reallymarkobject(g,gcvalue(o)); }
#define markobject(g,t) { if (iswhite(obj2gco(t))) \
reallymarkobject(g, obj2gco(t)); }
#define setthreshold(g) (g->GCthreshold = (g->estimate/100) * g->gcpause)
static void removeentry (Node *n) {
lua_assert(ttisnil(gval(n)));
if (iscollectable(gkey(n)))
setttype(gkey(n), LUA_TDEADKEY); /* dead key; remove it */
}
static void reallymarkobject (global_State *g, GCObject *o) {
lua_assert(iswhite(o) && !isdead(g, o));
white2gray(o);
switch (o->gch.tt) {
case LUA_TSTRING: {
return;
}
case LUA_TUSERDATA: {
Table *mt = gco2u(o)->metatable;
gray2black(o); /* udata are never gray */
if (mt) markobject(g, mt);
markobject(g, gco2u(o)->env);
return;
}
case LUA_TUPVAL: {
UpVal *uv = gco2uv(o);
markvalue(g, uv->v);
if (uv->v == &uv->u.value) /* closed? */
gray2black(o); /* open upvalues are never black */
return;
}
case LUA_TFUNCTION: {
gco2cl(o)->c.gclist = g->gray;
g->gray = o;
break;
}
case LUA_TTABLE: {
gco2h(o)->gclist = g->gray;
g->gray = o;
break;
}
case LUA_TTHREAD: {
gco2th(o)->gclist = g->gray;
g->gray = o;
break;
}
case LUA_TPROTO: {
gco2p(o)->gclist = g->gray;
g->gray = o;
break;
}
default: lua_assert(0);
}
}
static void marktmu (global_State *g) {
GCObject *u = g->tmudata;
if (u) {
do {
u = u->gch.next;
makewhite(g, u); /* may be marked, if left from previous GC */
reallymarkobject(g, u);
} while (u != g->tmudata);
}
}
/* move `dead' udata that need finalization to list `tmudata' */
size_t luaC_separateudata (lua_State *L, int all) {
global_State *g = G(L);
size_t deadmem = 0;
GCObject **p = &g->mainthread->next;
GCObject *curr;
while ((curr = *p) != NULL) {
if (!(iswhite(curr) || all) || isfinalized(gco2u(curr)))
p = &curr->gch.next; /* don't bother with them */
else if (fasttm(L, gco2u(curr)->metatable, TM_GC) == NULL) {
markfinalized(gco2u(curr)); /* don't need finalization */
p = &curr->gch.next;
}
else { /* must call its gc method */
deadmem += sizeudata(gco2u(curr));
markfinalized(gco2u(curr));
*p = curr->gch.next;
/* link `curr' at the end of `tmudata' list */
if (g->tmudata == NULL) /* list is empty? */
g->tmudata = curr->gch.next = curr; /* creates a circular list */
else {
curr->gch.next = g->tmudata->gch.next;
g->tmudata->gch.next = curr;
g->tmudata = curr;
}
}
}
return deadmem;
}
static int traversetable (global_State *g, Table *h) {
int i;
int weakkey = 0;
int weakvalue = 0;
const TValue *mode;
if (h->metatable)
markobject(g, h->metatable);
mode = gfasttm(g, h->metatable, TM_MODE);
if (mode && ttisstring(mode)) { /* is there a weak mode? */
weakkey = (strchr(svalue(mode), 'k') != NULL);
weakvalue = (strchr(svalue(mode), 'v') != NULL);
if (weakkey || weakvalue) { /* is really weak? */
h->marked &= ~(KEYWEAK | VALUEWEAK); /* clear bits */
h->marked |= cast_byte((weakkey << KEYWEAKBIT) |
(weakvalue << VALUEWEAKBIT));
h->gclist = g->weak; /* must be cleared after GC, ... */
g->weak = obj2gco(h); /* ... so put in the appropriate list */
}
}
if (weakkey && weakvalue) return 1;
if (!weakvalue) {
i = h->sizearray;
while (i--)
markvalue(g, &h->array[i]);
}
i = sizenode(h);
while (i--) {
Node *n = gnode(h, i);
lua_assert(ttype(gkey(n)) != LUA_TDEADKEY || ttisnil(gval(n)));
if (ttisnil(gval(n)))
removeentry(n); /* remove empty entries */
else {
lua_assert(!ttisnil(gkey(n)));
if (!weakkey) markvalue(g, gkey(n));
if (!weakvalue) markvalue(g, gval(n));
}
}
return weakkey || weakvalue;
}
/*
** All marks are conditional because a GC may happen while the
** prototype is still being created
*/
static void traverseproto (global_State *g, Proto *f) {
int i;
if (f->source) stringmark(f->source);
for (i=0; i<f->sizek; i++) /* mark literals */
markvalue(g, &f->k[i]);
for (i=0; i<f->sizeupvalues; i++) { /* mark upvalue names */
if (f->upvalues[i])
stringmark(f->upvalues[i]);
}
for (i=0; i<f->sizep; i++) { /* mark nested protos */
if (f->p[i])
markobject(g, f->p[i]);
}
for (i=0; i<f->sizelocvars; i++) { /* mark local-variable names */
if (f->locvars[i].varname)
stringmark(f->locvars[i].varname);
}
}
static void traverseclosure (global_State *g, Closure *cl) {
markobject(g, cl->c.env);
if (cl->c.isC) {
int i;
for (i=0; i<cl->c.nupvalues; i++) /* mark its upvalues */
markvalue(g, &cl->c.upvalue[i]);
}
else {
int i;
lua_assert(cl->l.nupvalues == cl->l.p->nups);
markobject(g, cl->l.p);
for (i=0; i<cl->l.nupvalues; i++) /* mark its upvalues */
markobject(g, cl->l.upvals[i]);
}
}
static void checkstacksizes (lua_State *L, StkId max) {
int ci_used = cast_int(L->ci - L->base_ci); /* number of `ci' in use */
int s_used = cast_int(max - L->stack); /* part of stack in use */
if (L->size_ci > LUAI_MAXCALLS) /* handling overflow? */
return; /* do not touch the stacks */
if (4*ci_used < L->size_ci && 2*BASIC_CI_SIZE < L->size_ci)
luaD_reallocCI(L, L->size_ci/2); /* still big enough... */
condhardstacktests(luaD_reallocCI(L, ci_used + 1));
if (4*s_used < L->stacksize &&
2*(BASIC_STACK_SIZE+EXTRA_STACK) < L->stacksize)
luaD_reallocstack(L, L->stacksize/2); /* still big enough... */
condhardstacktests(luaD_reallocstack(L, s_used));
}
static void traversestack (global_State *g, lua_State *l) {
StkId o, lim;
CallInfo *ci;
markvalue(g, gt(l));
lim = l->top;
for (ci = l->base_ci; ci <= l->ci; ci++) {
lua_assert(ci->top <= l->stack_last);
if (lim < ci->top) lim = ci->top;
}
for (o = l->stack; o < l->top; o++)
markvalue(g, o);
for (; o <= lim; o++)
setnilvalue(o);
checkstacksizes(l, lim);
}
/*
** traverse one gray object, turning it to black.
** Returns `quantity' traversed.
*/
static l_mem propagatemark (global_State *g) {
GCObject *o = g->gray;
lua_assert(isgray(o));
gray2black(o);
switch (o->gch.tt) {
case LUA_TTABLE: {
Table *h = gco2h(o);
g->gray = h->gclist;
if (traversetable(g, h)) /* table is weak? */
black2gray(o); /* keep it gray */
return sizeof(Table) + sizeof(TValue) * h->sizearray +
sizeof(Node) * sizenode(h);
}
case LUA_TFUNCTION: {
Closure *cl = gco2cl(o);
g->gray = cl->c.gclist;
traverseclosure(g, cl);
return (cl->c.isC) ? sizeCclosure(cl->c.nupvalues) :
sizeLclosure(cl->l.nupvalues);
}
case LUA_TTHREAD: {
lua_State *th = gco2th(o);
g->gray = th->gclist;
th->gclist = g->grayagain;
g->grayagain = o;
black2gray(o);
traversestack(g, th);
return sizeof(lua_State) + sizeof(TValue) * th->stacksize +
sizeof(CallInfo) * th->size_ci;
}
case LUA_TPROTO: {
Proto *p = gco2p(o);
g->gray = p->gclist;
traverseproto(g, p);
return sizeof(Proto) + sizeof(Instruction) * p->sizecode +
sizeof(Proto *) * p->sizep +
sizeof(TValue) * p->sizek +
sizeof(int) * p->sizelineinfo +
sizeof(LocVar) * p->sizelocvars +
sizeof(TString *) * p->sizeupvalues;
}
default: lua_assert(0); return 0;
}
}
static size_t propagateall (global_State *g) {
size_t m = 0;
while (g->gray) m += propagatemark(g);
return m;
}
/*
** The next function tells whether a key or value can be cleared from
** a weak table. Non-collectable objects are never removed from weak
** tables. Strings behave as `values', so are never removed too. for
** other objects: if really collected, cannot keep them; for userdata
** being finalized, keep them in keys, but not in values
*/
static int iscleared (const TValue *o, int iskey) {
if (!iscollectable(o)) return 0;
if (ttisstring(o)) {
stringmark(rawtsvalue(o)); /* strings are `values', so are never weak */
return 0;
}
return iswhite(gcvalue(o)) ||
(ttisuserdata(o) && (!iskey && isfinalized(uvalue(o))));
}
/*
** clear collected entries from weaktables
*/
static void cleartable (GCObject *l) {
while (l) {
Table *h = gco2h(l);
int i = h->sizearray;
lua_assert(testbit(h->marked, VALUEWEAKBIT) ||
testbit(h->marked, KEYWEAKBIT));
if (testbit(h->marked, VALUEWEAKBIT)) {
while (i--) {
TValue *o = &h->array[i];
if (iscleared(o, 0)) /* value was collected? */
setnilvalue(o); /* remove value */
}
}
i = sizenode(h);
while (i--) {
Node *n = gnode(h, i);
if (!ttisnil(gval(n)) && /* non-empty entry? */
(iscleared(key2tval(n), 1) || iscleared(gval(n), 0))) {
setnilvalue(gval(n)); /* remove value ... */
removeentry(n); /* remove entry from table */
}
}
l = h->gclist;
}
}
static void freeobj (lua_State *L, GCObject *o) {
switch (o->gch.tt) {
case LUA_TPROTO: luaF_freeproto(L, gco2p(o)); break;
case LUA_TFUNCTION: luaF_freeclosure(L, gco2cl(o)); break;
case LUA_TUPVAL: luaF_freeupval(L, gco2uv(o)); break;
case LUA_TTABLE: luaH_free(L, gco2h(o)); break;
case LUA_TTHREAD: {
lua_assert(gco2th(o) != L && gco2th(o) != G(L)->mainthread);
luaE_freethread(L, gco2th(o));
break;
}
case LUA_TSTRING: {
G(L)->strt.nuse--;
luaM_freemem(L, o, sizestring(gco2ts(o)));
break;
}
case LUA_TUSERDATA: {
luaM_freemem(L, o, sizeudata(gco2u(o)));
break;
}
default: lua_assert(0);
}
}
#define sweepwholelist(L,p) sweeplist(L,p,MAX_LUMEM)
static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) {
GCObject *curr;
global_State *g = G(L);
int deadmask = otherwhite(g);
while ((curr = *p) != NULL && count-- > 0) {
if (curr->gch.tt == LUA_TTHREAD) /* sweep open upvalues of each thread */
sweepwholelist(L, &gco2th(curr)->openupval);
if ((curr->gch.marked ^ WHITEBITS) & deadmask) { /* not dead? */
lua_assert(!isdead(g, curr) || testbit(curr->gch.marked, FIXEDBIT));
makewhite(g, curr); /* make it white (for next cycle) */
p = &curr->gch.next;
}
else { /* must erase `curr' */
lua_assert(isdead(g, curr) || deadmask == bitmask(SFIXEDBIT));
*p = curr->gch.next;
if (curr == g->rootgc) /* is the first element of the list? */
g->rootgc = curr->gch.next; /* adjust first */
freeobj(L, curr);
}
}
return p;
}
static void checkSizes (lua_State *L) {
global_State *g = G(L);
/* check size of string hash */
if (g->strt.nuse < cast(lu_int32, g->strt.size/4) &&
g->strt.size > MINSTRTABSIZE*2)
luaS_resize(L, g->strt.size/2); /* table is too big */
/* check size of buffer */
if (luaZ_sizebuffer(&g->buff) > LUA_MINBUFFER*2) { /* buffer too big? */
size_t newsize = luaZ_sizebuffer(&g->buff) / 2;
luaZ_resizebuffer(L, &g->buff, newsize);
}
}
static void GCTM (lua_State *L) {
global_State *g = G(L);
GCObject *o = g->tmudata->gch.next; /* get first element */
Udata *udata = rawgco2u(o);
const TValue *tm;
/* remove udata from `tmudata' */
if (o == g->tmudata) /* last element? */
g->tmudata = NULL;
else
g->tmudata->gch.next = udata->uv.next;
udata->uv.next = g->mainthread->next; /* return it to `root' list */
g->mainthread->next = o;
makewhite(g, o);
tm = fasttm(L, udata->uv.metatable, TM_GC);
if (tm != NULL) {
lu_byte oldah = L->allowhook;
lu_mem oldt = g->GCthreshold;
L->allowhook = 0; /* stop debug hooks during GC tag method */
g->GCthreshold = 2*g->totalbytes; /* avoid GC steps */
setobj2s(L, L->top, tm);
setuvalue(L, L->top+1, udata);
L->top += 2;
luaD_call(L, L->top - 2, 0);
L->allowhook = oldah; /* restore hooks */
g->GCthreshold = oldt; /* restore threshold */
}
}
/*
** Call all GC tag methods
*/
void luaC_callGCTM (lua_State *L) {
while (G(L)->tmudata)
GCTM(L);
}
void luaC_freeall (lua_State *L) {
global_State *g = G(L);
int i;
g->currentwhite = WHITEBITS | bitmask(SFIXEDBIT); /* mask to collect all elements */
sweepwholelist(L, &g->rootgc);
for (i = 0; i < g->strt.size; i++) /* free all string lists */
sweepwholelist(L, &g->strt.hash[i]);
}
static void markmt (global_State *g) {
int i;
for (i=0; i<NUM_TAGS; i++)
if (g->mt[i]) markobject(g, g->mt[i]);
}
/* mark root set */
static void markroot (lua_State *L) {
global_State *g = G(L);
g->gray = NULL;
g->grayagain = NULL;
g->weak = NULL;
markobject(g, g->mainthread);
/* make global table be traversed before main stack */
markvalue(g, gt(g->mainthread));
markvalue(g, registry(L));
markmt(g);
g->gcstate = GCSpropagate;
}
static void remarkupvals (global_State *g) {
UpVal *uv;
for (uv = g->uvhead.u.l.next; uv != &g->uvhead; uv = uv->u.l.next) {
lua_assert(uv->u.l.next->u.l.prev == uv && uv->u.l.prev->u.l.next == uv);
if (isgray(obj2gco(uv)))
markvalue(g, uv->v);
}
}
static void atomic (lua_State *L) {
global_State *g = G(L);
size_t udsize; /* total size of userdata to be finalized */
/* remark occasional upvalues of (maybe) dead threads */
remarkupvals(g);
/* traverse objects cautch by write barrier and by 'remarkupvals' */
propagateall(g);
/* remark weak tables */
g->gray = g->weak;
g->weak = NULL;
lua_assert(!iswhite(obj2gco(g->mainthread)));
markobject(g, L); /* mark running thread */
markmt(g); /* mark basic metatables (again) */
propagateall(g);
/* remark gray again */
g->gray = g->grayagain;
g->grayagain = NULL;
propagateall(g);
udsize = luaC_separateudata(L, 0); /* separate userdata to be finalized */
marktmu(g); /* mark `preserved' userdata */
udsize += propagateall(g); /* remark, to propagate `preserveness' */
cleartable(g->weak); /* remove collected objects from weak tables */
/* flip current white */
g->currentwhite = cast_byte(otherwhite(g));
g->sweepstrgc = 0;
g->sweepgc = &g->rootgc;
g->gcstate = GCSsweepstring;
g->estimate = g->totalbytes - udsize; /* first estimate */
}
static l_mem singlestep (lua_State *L) {
global_State *g = G(L);
/*lua_checkmemory(L);*/
switch (g->gcstate) {
case GCSpause: {
markroot(L); /* start a new collection */
return 0;
}
case GCSpropagate: {
if (g->gray)
return propagatemark(g);
else { /* no more `gray' objects */
atomic(L); /* finish mark phase */
return 0;
}
}
case GCSsweepstring: {
lu_mem old = g->totalbytes;
sweepwholelist(L, &g->strt.hash[g->sweepstrgc++]);
if (g->sweepstrgc >= g->strt.size) /* nothing more to sweep? */
g->gcstate = GCSsweep; /* end sweep-string phase */
lua_assert(old >= g->totalbytes);
g->estimate -= old - g->totalbytes;
return GCSWEEPCOST;
}
case GCSsweep: {
lu_mem old = g->totalbytes;
g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX);
if (*g->sweepgc == NULL) { /* nothing more to sweep? */
checkSizes(L);
g->gcstate = GCSfinalize; /* end sweep phase */
}
lua_assert(old >= g->totalbytes);
g->estimate -= old - g->totalbytes;
return GCSWEEPMAX*GCSWEEPCOST;
}
case GCSfinalize: {
if (g->tmudata) {
GCTM(L);
if (g->estimate > GCFINALIZECOST)
g->estimate -= GCFINALIZECOST;
return GCFINALIZECOST;
}
else {
g->gcstate = GCSpause; /* end collection */
g->gcdept = 0;
return 0;
}
}
default: lua_assert(0); return 0;
}
}
void luaC_step (lua_State *L) {
global_State *g = G(L);
l_mem lim = (GCSTEPSIZE/100) * g->gcstepmul;
if (lim == 0)
lim = (MAX_LUMEM-1)/2; /* no limit */
g->gcdept += g->totalbytes - g->GCthreshold;
do {
lim -= singlestep(L);
if (g->gcstate == GCSpause)
break;
} while (lim > 0);
if (g->gcstate != GCSpause) {
if (g->gcdept < GCSTEPSIZE)
g->GCthreshold = g->totalbytes + GCSTEPSIZE; /* - lim/g->gcstepmul;*/
else {
g->gcdept -= GCSTEPSIZE;
g->GCthreshold = g->totalbytes;
}
}
else {
setthreshold(g);
}
}
void luaC_fullgc (lua_State *L) {
global_State *g = G(L);
if (g->gcstate <= GCSpropagate) {
/* reset sweep marks to sweep all elements (returning them to white) */
g->sweepstrgc = 0;
g->sweepgc = &g->rootgc;
/* reset other collector lists */
g->gray = NULL;
g->grayagain = NULL;
g->weak = NULL;
g->gcstate = GCSsweepstring;
}
lua_assert(g->gcstate != GCSpause && g->gcstate != GCSpropagate);
/* finish any pending sweep phase */
while (g->gcstate != GCSfinalize) {
lua_assert(g->gcstate == GCSsweepstring || g->gcstate == GCSsweep);
singlestep(L);
}
markroot(L);
while (g->gcstate != GCSpause) {
singlestep(L);
}
setthreshold(g);
}
void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v) {
global_State *g = G(L);
lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));
lua_assert(g->gcstate != GCSfinalize && g->gcstate != GCSpause);
lua_assert(ttype(&o->gch) != LUA_TTABLE);
/* must keep invariant? */
if (g->gcstate == GCSpropagate)
reallymarkobject(g, v); /* restore invariant */
else /* don't mind */
makewhite(g, o); /* mark as white just to avoid other barriers */
}
void luaC_barrierback (lua_State *L, Table *t) {
global_State *g = G(L);
GCObject *o = obj2gco(t);
lua_assert(isblack(o) && !isdead(g, o));
lua_assert(g->gcstate != GCSfinalize && g->gcstate != GCSpause);
black2gray(o); /* make table gray (again) */
t->gclist = g->grayagain;
g->grayagain = o;
}
void luaC_link (lua_State *L, GCObject *o, lu_byte tt) {
global_State *g = G(L);
o->gch.next = g->rootgc;
g->rootgc = o;
o->gch.marked = luaC_white(g);
o->gch.tt = tt;
}
void luaC_linkupval (lua_State *L, UpVal *uv) {
global_State *g = G(L);
GCObject *o = obj2gco(uv);
o->gch.next = g->rootgc; /* link upvalue into `rootgc' list */
g->rootgc = o;
if (isgray(o)) {
if (g->gcstate == GCSpropagate) {
gray2black(o); /* closed upvalues need barrier */
luaC_barrier(L, uv, uv->v);
}
else { /* sweep phase: sweep it (turning it into white) */
makewhite(g, o);
lua_assert(g->gcstate != GCSfinalize && g->gcstate != GCSpause);
}
}
}

110
src/lua/lgc.h
View File

@ -1,110 +0,0 @@
/*
** $Id: lgc.h,v 2.15.1.1 2007/12/27 13:02:25 roberto Exp $
** Garbage Collector
** See Copyright Notice in lua.h
*/
#ifndef lgc_h
#define lgc_h
#include "lobject.h"
/*
** Possible states of the Garbage Collector
*/
#define GCSpause 0
#define GCSpropagate 1
#define GCSsweepstring 2
#define GCSsweep 3
#define GCSfinalize 4
/*
** some userful bit tricks
*/
#define resetbits(x,m) ((x) &= cast(lu_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))
#define set2bits(x,b1,b2) setbits(x, (bit2mask(b1, b2)))
#define reset2bits(x,b1,b2) resetbits(x, (bit2mask(b1, b2)))
#define test2bits(x,b1,b2) testbits(x, (bit2mask(b1, b2)))
/*
** Layout for bit use in `marked' field:
** bit 0 - object is white (type 0)
** bit 1 - object is white (type 1)
** bit 2 - object is black
** bit 3 - for userdata: has been finalized
** bit 3 - for tables: has weak keys
** bit 4 - for tables: has weak values
** bit 5 - object is fixed (should not be collected)
** bit 6 - object is "super" fixed (only the main thread)
*/
#define WHITE0BIT 0
#define WHITE1BIT 1
#define BLACKBIT 2
#define FINALIZEDBIT 3
#define KEYWEAKBIT 3
#define VALUEWEAKBIT 4
#define FIXEDBIT 5
#define SFIXEDBIT 6
#define WHITEBITS bit2mask(WHITE0BIT, WHITE1BIT)
#define iswhite(x) test2bits((x)->gch.marked, WHITE0BIT, WHITE1BIT)
#define isblack(x) testbit((x)->gch.marked, BLACKBIT)
#define isgray(x) (!isblack(x) && !iswhite(x))
#define otherwhite(g) (g->currentwhite ^ WHITEBITS)
#define isdead(g,v) ((v)->gch.marked & otherwhite(g) & WHITEBITS)
#define changewhite(x) ((x)->gch.marked ^= WHITEBITS)
#define gray2black(x) l_setbit((x)->gch.marked, BLACKBIT)
#define valiswhite(x) (iscollectable(x) && iswhite(gcvalue(x)))
#define luaC_white(g) cast(lu_byte, (g)->currentwhite & WHITEBITS)
#define luaC_checkGC(L) { \
condhardstacktests(luaD_reallocstack(L, L->stacksize - EXTRA_STACK - 1)); \
if (G(L)->totalbytes >= G(L)->GCthreshold) \
luaC_step(L); }
#define luaC_barrier(L,p,v) { if (valiswhite(v) && isblack(obj2gco(p))) \
luaC_barrierf(L,obj2gco(p),gcvalue(v)); }
#define luaC_barriert(L,t,v) { if (valiswhite(v) && isblack(obj2gco(t))) \
luaC_barrierback(L,t); }
#define luaC_objbarrier(L,p,o) \
{ if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) \
luaC_barrierf(L,obj2gco(p),obj2gco(o)); }
#define luaC_objbarriert(L,t,o) \
{ if (iswhite(obj2gco(o)) && isblack(obj2gco(t))) luaC_barrierback(L,t); }
LUAI_FUNC size_t luaC_separateudata (lua_State *L, int all);
LUAI_FUNC void luaC_callGCTM (lua_State *L);
LUAI_FUNC void luaC_freeall (lua_State *L);
LUAI_FUNC void luaC_step (lua_State *L);
LUAI_FUNC void luaC_fullgc (lua_State *L);
LUAI_FUNC void luaC_link (lua_State *L, GCObject *o, lu_byte tt);
LUAI_FUNC void luaC_linkupval (lua_State *L, UpVal *uv);
LUAI_FUNC void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v);
LUAI_FUNC void luaC_barrierback (lua_State *L, Table *t);
#endif

39
src/lua/linit.c
View File

@ -1,39 +0,0 @@
/*
** $Id: linit.c,v 1.14.1.1 2007/12/27 13:02:25 roberto Exp $
** Initialization of libraries for lua.c
** See Copyright Notice in lua.h
*/
#define linit_c
#define LUA_LIB
#include "lua.h"
#include "lualib.h"
#include "lauxlib.h"
static const luaL_Reg lualibs[] = {
{"", luaopen_base},
{LUA_LOADLIBNAME, luaopen_package},
{LUA_TABLIBNAME, luaopen_table},
{LUA_IOLIBNAME, luaopen_io},
{LUA_OSLIBNAME, luaopen_os},
{LUA_STRLIBNAME, luaopen_string},
{LUA_MATHLIBNAME, luaopen_math},
{LUA_DBLIBNAME, luaopen_debug},
{LUA_BITLIBNAME, luaopen_bit},
{NULL, NULL}
};
LUALIB_API void luaL_openlibs (lua_State *L) {
const luaL_Reg *lib = lualibs;
for (; lib->func; lib++) {
lua_pushcfunction(L, lib->func);
lua_pushstring(L, lib->name);
lua_call(L, 1, 0);
}
}

556
src/lua/liolib.c
View File

@ -1,556 +0,0 @@
/*
** $Id: liolib.c,v 2.73.1.4 2010/05/14 15:33:51 roberto Exp $
** Standard I/O (and system) library
** See Copyright Notice in lua.h
*/
#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define liolib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#define IO_INPUT 1
#define IO_OUTPUT 2
static const char *const fnames[] = {"input", "output"};
static int pushresult (lua_State *L, int i, const char *filename) {
int en = errno; /* calls to Lua API may change this value */
if (i) {
lua_pushboolean(L, 1);
return 1;
}
else {
lua_pushnil(L);
if (filename)
lua_pushfstring(L, "%s: %s", filename, strerror(en));
else
lua_pushfstring(L, "%s", strerror(en));
lua_pushinteger(L, en);
return 3;
}
}
static void fileerror (lua_State *L, int arg, const char *filename) {
lua_pushfstring(L, "%s: %s", filename, strerror(errno));
luaL_argerror(L, arg, lua_tostring(L, -1));
}
#define tofilep(L) ((FILE **)luaL_checkudata(L, 1, LUA_FILEHANDLE))
static int io_type (lua_State *L) {
void *ud;
luaL_checkany(L, 1);
ud = lua_touserdata(L, 1);
lua_getfield(L, LUA_REGISTRYINDEX, LUA_FILEHANDLE);
if (ud == NULL || !lua_getmetatable(L, 1) || !lua_rawequal(L, -2, -1))
lua_pushnil(L); /* not a file */
else if (*((FILE **)ud) == NULL)
lua_pushliteral(L, "closed file");
else
lua_pushliteral(L, "file");
return 1;
}
static FILE *tofile (lua_State *L) {
FILE **f = tofilep(L);
if (*f == NULL)
luaL_error(L, "attempt to use a closed file");
return *f;
}
/*
** When creating file handles, always creates a `closed' file handle
** before opening the actual file; so, if there is a memory error, the
** file is not left opened.
*/
static FILE **newfile (lua_State *L) {
FILE **pf = (FILE **)lua_newuserdata(L, sizeof(FILE *));
*pf = NULL; /* file handle is currently `closed' */
luaL_getmetatable(L, LUA_FILEHANDLE);
lua_setmetatable(L, -2);
return pf;
}
/*
** function to (not) close the standard files stdin, stdout, and stderr
*/
static int io_noclose (lua_State *L) {
lua_pushnil(L);
lua_pushliteral(L, "cannot close standard file");
return 2;
}
/*
** function to close 'popen' files
*/
static int io_pclose (lua_State *L) {
FILE **p = tofilep(L);
int ok = lua_pclose(L, *p);
*p = NULL;
return pushresult(L, ok, NULL);
}
/*
** function to close regular files
*/
static int io_fclose (lua_State *L) {
FILE **p = tofilep(L);
int ok = (fclose(*p) == 0);
*p = NULL;
return pushresult(L, ok, NULL);
}
static int aux_close (lua_State *L) {
lua_getfenv(L, 1);
lua_getfield(L, -1, "__close");
return (lua_tocfunction(L, -1))(L);
}
static int io_close (lua_State *L) {
if (lua_isnone(L, 1))
lua_rawgeti(L, LUA_ENVIRONINDEX, IO_OUTPUT);
tofile(L); /* make sure argument is a file */
return aux_close(L);
}
static int io_gc (lua_State *L) {
FILE *f = *tofilep(L);
/* ignore closed files */
if (f != NULL)
aux_close(L);
return 0;
}
static int io_tostring (lua_State *L) {
FILE *f = *tofilep(L);
if (f == NULL)
lua_pushliteral(L, "file (closed)");
else
lua_pushfstring(L, "file (%p)", f);
return 1;
}
static int io_open (lua_State *L) {
const char *filename = luaL_checkstring(L, 1);
const char *mode = luaL_optstring(L, 2, "r");
FILE **pf = newfile(L);
*pf = fopen(filename, mode);
return (*pf == NULL) ? pushresult(L, 0, filename) : 1;
}
/*
** this function has a separated environment, which defines the
** correct __close for 'popen' files
*/
static int io_popen (lua_State *L) {
const char *filename = luaL_checkstring(L, 1);
const char *mode = luaL_optstring(L, 2, "r");
FILE **pf = newfile(L);
*pf = lua_popen(L, filename, mode);
return (*pf == NULL) ? pushresult(L, 0, filename) : 1;
}
static int io_tmpfile (lua_State *L) {
FILE **pf = newfile(L);
*pf = tmpfile();
return (*pf == NULL) ? pushresult(L, 0, NULL) : 1;
}
static FILE *getiofile (lua_State *L, int findex) {
FILE *f;
lua_rawgeti(L, LUA_ENVIRONINDEX, findex);
f = *(FILE **)lua_touserdata(L, -1);
if (f == NULL)
luaL_error(L, "standard %s file is closed", fnames[findex - 1]);
return f;
}
static int g_iofile (lua_State *L, int f, const char *mode) {
if (!lua_isnoneornil(L, 1)) {
const char *filename = lua_tostring(L, 1);
if (filename) {
FILE **pf = newfile(L);
*pf = fopen(filename, mode);
if (*pf == NULL)
fileerror(L, 1, filename);
}
else {
tofile(L); /* check that it's a valid file handle */
lua_pushvalue(L, 1);
}
lua_rawseti(L, LUA_ENVIRONINDEX, f);
}
/* return current value */
lua_rawgeti(L, LUA_ENVIRONINDEX, f);
return 1;
}
static int io_input (lua_State *L) {
return g_iofile(L, IO_INPUT, "r");
}
static int io_output (lua_State *L) {
return g_iofile(L, IO_OUTPUT, "w");
}
static int io_readline (lua_State *L);
static void aux_lines (lua_State *L, int idx, int toclose) {
lua_pushvalue(L, idx);
lua_pushboolean(L, toclose); /* close/not close file when finished */
lua_pushcclosure(L, io_readline, 2);
}
static int f_lines (lua_State *L) {
tofile(L); /* check that it's a valid file handle */
aux_lines(L, 1, 0);
return 1;
}
static int io_lines (lua_State *L) {
if (lua_isnoneornil(L, 1)) { /* no arguments? */
/* will iterate over default input */
lua_rawgeti(L, LUA_ENVIRONINDEX, IO_INPUT);
return f_lines(L);
}
else {
const char *filename = luaL_checkstring(L, 1);
FILE **pf = newfile(L);
*pf = fopen(filename, "r");
if (*pf == NULL)
fileerror(L, 1, filename);
aux_lines(L, lua_gettop(L), 1);
return 1;
}
}
/*
** {======================================================
** READ
** =======================================================
*/
static int read_number (lua_State *L, FILE *f) {
lua_Number d;
if (fscanf(f, LUA_NUMBER_SCAN, &d) == 1) {
lua_pushnumber(L, d);
return 1;
}
else {
lua_pushnil(L); /* "result" to be removed */
return 0; /* read fails */
}
}
static int test_eof (lua_State *L, FILE *f) {
int c = getc(f);
ungetc(c, f);
lua_pushlstring(L, NULL, 0);
return (c != EOF);
}
static int read_line (lua_State *L, FILE *f) {
luaL_Buffer b;
luaL_buffinit(L, &b);
for (;;) {
size_t l;
char *p = luaL_prepbuffer(&b);
if (fgets(p, LUAL_BUFFERSIZE, f) == NULL) { /* eof? */
luaL_pushresult(&b); /* close buffer */
return (lua_objlen(L, -1) > 0); /* check whether read something */
}
l = strlen(p);
if (l == 0 || p[l-1] != '\n')
luaL_addsize(&b, l);
else {
luaL_addsize(&b, l - 1); /* do not include `eol' */
luaL_pushresult(&b); /* close buffer */
return 1; /* read at least an `eol' */
}
}
}
static int read_chars (lua_State *L, FILE *f, size_t n) {
size_t rlen; /* how much to read */
size_t nr; /* number of chars actually read */
luaL_Buffer b;
luaL_buffinit(L, &b);
rlen = LUAL_BUFFERSIZE; /* try to read that much each time */
do {
char *p = luaL_prepbuffer(&b);
if (rlen > n) rlen = n; /* cannot read more than asked */
nr = fread(p, sizeof(char), rlen, f);
luaL_addsize(&b, nr);
n -= nr; /* still have to read `n' chars */
} while (n > 0 && nr == rlen); /* until end of count or eof */
luaL_pushresult(&b); /* close buffer */
return (n == 0 || lua_objlen(L, -1) > 0);
}
static int g_read (lua_State *L, FILE *f, int first) {
int nargs = lua_gettop(L) - 1;
int success;
int n;
clearerr(f);
if (nargs == 0) { /* no arguments? */
success = read_line(L, f);
n = first+1; /* to return 1 result */
}
else { /* ensure stack space for all results and for auxlib's buffer */
luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments");
success = 1;
for (n = first; nargs-- && success; n++) {
if (lua_type(L, n) == LUA_TNUMBER) {
size_t l = (size_t)lua_tointeger(L, n);
success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l);
}
else {
const char *p = lua_tostring(L, n);
luaL_argcheck(L, p && p[0] == '*', n, "invalid option");
switch (p[1]) {
case 'n': /* number */
success = read_number(L, f);
break;
case 'l': /* line */
success = read_line(L, f);
break;
case 'a': /* file */
read_chars(L, f, ~((size_t)0)); /* read MAX_SIZE_T chars */
success = 1; /* always success */
break;
default:
return luaL_argerror(L, n, "invalid format");
}
}
}
}
if (ferror(f))
return pushresult(L, 0, NULL);
if (!success) {
lua_pop(L, 1); /* remove last result */
lua_pushnil(L); /* push nil instead */
}
return n - first;
}
static int io_read (lua_State *L) {
return g_read(L, getiofile(L, IO_INPUT), 1);
}
static int f_read (lua_State *L) {
return g_read(L, tofile(L), 2);
}
static int io_readline (lua_State *L) {
FILE *f = *(FILE **)lua_touserdata(L, lua_upvalueindex(1));
int sucess;
if (f == NULL) /* file is already closed? */
luaL_error(L, "file is already closed");
sucess = read_line(L, f);
if (ferror(f))
return luaL_error(L, "%s", strerror(errno));
if (sucess) return 1;
else { /* EOF */
if (lua_toboolean(L, lua_upvalueindex(2))) { /* generator created file? */
lua_settop(L, 0);
lua_pushvalue(L, lua_upvalueindex(1));
aux_close(L); /* close it */
}
return 0;
}
}
/* }====================================================== */
static int g_write (lua_State *L, FILE *f, int arg) {
int nargs = lua_gettop(L) - 1;
int status = 1;
for (; nargs--; arg++) {
if (lua_type(L, arg) == LUA_TNUMBER) {
/* optimization: could be done exactly as for strings */
status = status &&
fprintf(f, LUA_NUMBER_FMT, lua_tonumber(L, arg)) > 0;
}
else {
size_t l;
const char *s = luaL_checklstring(L, arg, &l);
status = status && (fwrite(s, sizeof(char), l, f) == l);
}
}
return pushresult(L, status, NULL);
}
static int io_write (lua_State *L) {
return g_write(L, getiofile(L, IO_OUTPUT), 1);
}
static int f_write (lua_State *L) {
return g_write(L, tofile(L), 2);
}
static int f_seek (lua_State *L) {
static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
static const char *const modenames[] = {"set", "cur", "end", NULL};
FILE *f = tofile(L);
int op = luaL_checkoption(L, 2, "cur", modenames);
long offset = luaL_optlong(L, 3, 0);
op = fseek(f, offset, mode[op]);
if (op)
return pushresult(L, 0, NULL); /* error */
else {
lua_pushinteger(L, ftell(f));
return 1;
}
}
static int f_setvbuf (lua_State *L) {
static const int mode[] = {_IONBF, _IOFBF, _IOLBF};
static const char *const modenames[] = {"no", "full", "line", NULL};
FILE *f = tofile(L);
int op = luaL_checkoption(L, 2, NULL, modenames);
lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE);
int res = setvbuf(f, NULL, mode[op], sz);
return pushresult(L, res == 0, NULL);
}
static int io_flush (lua_State *L) {
return pushresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL);
}
static int f_flush (lua_State *L) {
return pushresult(L, fflush(tofile(L)) == 0, NULL);
}
static const luaL_Reg iolib[] = {
{"close", io_close},
{"flush", io_flush},
{"input", io_input},
{"lines", io_lines},
{"open", io_open},
{"output", io_output},
{"popen", io_popen},
{"read", io_read},
{"tmpfile", io_tmpfile},
{"type", io_type},
{"write", io_write},
{NULL, NULL}
};
static const luaL_Reg flib[] = {
{"close", io_close},
{"flush", f_flush},
{"lines", f_lines},
{"read", f_read},
{"seek", f_seek},
{"setvbuf", f_setvbuf},
{"write", f_write},
{"__gc", io_gc},
{"__tostring", io_tostring},
{NULL, NULL}
};
static void createmeta (lua_State *L) {
luaL_newmetatable(L, LUA_FILEHANDLE); /* create metatable for file handles */
lua_pushvalue(L, -1); /* push metatable */
lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */
luaL_register(L, NULL, flib); /* file methods */
}
static void createstdfile (lua_State *L, FILE *f, int k, const char *fname) {
*newfile(L) = f;
if (k > 0) {
lua_pushvalue(L, -1);
lua_rawseti(L, LUA_ENVIRONINDEX, k);
}
lua_pushvalue(L, -2); /* copy environment */
lua_setfenv(L, -2); /* set it */
lua_setfield(L, -3, fname);
}
static void newfenv (lua_State *L, lua_CFunction cls) {
lua_createtable(L, 0, 1);
lua_pushcfunction(L, cls);
lua_setfield(L, -2, "__close");
}
LUALIB_API int luaopen_io (lua_State *L) {
createmeta(L);
/* create (private) environment (with fields IO_INPUT, IO_OUTPUT, __close) */
newfenv(L, io_fclose);
lua_replace(L, LUA_ENVIRONINDEX);
/* open library */
luaL_register(L, LUA_IOLIBNAME, iolib);
/* create (and set) default files */
newfenv(L, io_noclose); /* close function for default files */
createstdfile(L, stdin, IO_INPUT, "stdin");
createstdfile(L, stdout, IO_OUTPUT, "stdout");
createstdfile(L, stderr, 0, "stderr");
lua_pop(L, 1); /* pop environment for default files */
lua_getfield(L, -1, "popen");
newfenv(L, io_pclose); /* create environment for 'popen' */
lua_setfenv(L, -2); /* set fenv for 'popen' */
lua_pop(L, 1); /* pop 'popen' */
return 1;
}

463
src/lua/llex.c
View File

@ -1,463 +0,0 @@
/*
** $Id: llex.c,v 2.20.1.2 2009/11/23 14:58:22 roberto Exp $
** Lexical Analyzer
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <locale.h>
#include <string.h>
#define llex_c
#define LUA_CORE
#include "lua.h"
#include "ldo.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 currIsNewline(ls) (ls->current == '\n' || ls->current == '\r')
/* ORDER RESERVED */
const char *const luaX_tokens [] = {
"and", "break", "do", "else", "elseif",
"end", "false", "for", "function", "if",
"in", "local", "nil", "not", "or", "repeat",
"return", "then", "true", "until", "while",
"..", "...", "==", ">=", "<=", "~=",
"<number>", "<name>", "<string>", "<eof>",
NULL
};
#define save_and_next(ls) (save(ls, ls->current), next(ls))
static void save (LexState *ls, int c) {
Mbuffer *b = ls->buff;
if (b->n + 1 > b->buffsize) {
size_t newsize;
if (b->buffsize >= MAX_SIZET/2)
luaX_lexerror(ls, "lexical element too long", 0);
newsize = b->buffsize * 2;
luaZ_resizebuffer(ls->L, b, newsize);
}
b->buffer[b->n++] = cast(char, c);
}
void luaX_init (lua_State *L) {
int i;
for (i=0; i<NUM_RESERVED; i++) {
TString *ts = luaS_new(L, luaX_tokens[i]);
luaS_fix(ts); /* reserved words are never collected */
lua_assert(strlen(luaX_tokens[i])+1 <= TOKEN_LEN);
ts->tsv.reserved = cast_byte(i+1); /* reserved word */
}
}
#define MAXSRC 80
const char *luaX_token2str (LexState *ls, int token) {
if (token < FIRST_RESERVED) {
lua_assert(token == cast(unsigned char, token));
return (iscntrl(token)) ? luaO_pushfstring(ls->L, "char(%d)", token) :
luaO_pushfstring(ls->L, "%c", token);
}
else
return luaX_tokens[token-FIRST_RESERVED];
}
static const char *txtToken (LexState *ls, int token) {
switch (token) {
case TK_NAME:
case TK_STRING:
case TK_NUMBER:
save(ls, '\0');
return luaZ_buffer(ls->buff);
default:
return luaX_token2str(ls, token);
}
}
void luaX_lexerror (LexState *ls, const char *msg, int token) {
char buff[MAXSRC];
luaO_chunkid(buff, getstr(ls->source), MAXSRC);
msg = luaO_pushfstring(ls->L, "%s:%d: %s", buff, ls->linenumber, msg);
if (token)
luaO_pushfstring(ls->L, "%s near " LUA_QS, msg, txtToken(ls, token));
luaD_throw(ls->L, LUA_ERRSYNTAX);
}
void luaX_syntaxerror (LexState *ls, const char *msg) {
luaX_lexerror(ls, msg, ls->t.token);
}
TString *luaX_newstring (LexState *ls, const char *str, size_t l) {
lua_State *L = ls->L;
TString *ts = luaS_newlstr(L, str, l);
TValue *o = luaH_setstr(L, ls->fs->h, ts); /* entry for `str' */
if (ttisnil(o)) {
setbvalue(o, 1); /* make sure `str' will not be collected */
luaC_checkGC(L);
}
return ts;
}
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 >= MAX_INT)
luaX_syntaxerror(ls, "chunk has too many lines");
}
void luaX_setinput (lua_State *L, LexState *ls, ZIO *z, TString *source) {
ls->decpoint = '.';
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;
luaZ_resizebuffer(ls->L, ls->buff, LUA_MINBUFFER); /* initialize buffer */
next(ls); /* read first char */
}
/*
** =======================================================
** LEXICAL ANALYZER
** =======================================================
*/
static int check_next (LexState *ls, const char *set) {
if (!strchr(set, ls->current))
return 0;
save_and_next(ls);
return 1;
}
static void buffreplace (LexState *ls, char from, char to) {
size_t n = luaZ_bufflen(ls->buff);
char *p = luaZ_buffer(ls->buff);
while (n--)
if (p[n] == from) p[n] = to;
}
static void trydecpoint (LexState *ls, SemInfo *seminfo) {
/* format error: try to update decimal point separator */
struct lconv *cv = localeconv();
char old = ls->decpoint;
ls->decpoint = (cv ? cv->decimal_point[0] : '.');
buffreplace(ls, old, ls->decpoint); /* try updated decimal separator */
if (!luaO_str2d(luaZ_buffer(ls->buff), &seminfo->r)) {
/* format error with correct decimal point: no more options */
buffreplace(ls, ls->decpoint, '.'); /* undo change (for error message) */
luaX_lexerror(ls, "malformed number", TK_NUMBER);
}
}
/* LUA_NUMBER */
static void read_numeral (LexState *ls, SemInfo *seminfo) {
lua_assert(isdigit(ls->current));
do {
save_and_next(ls);
} while (isdigit(ls->current) || ls->current == '.');
if (check_next(ls, "Ee")) /* `E'? */
check_next(ls, "+-"); /* optional exponent sign */
while (isalnum(ls->current) || ls->current == '_')
save_and_next(ls);
save(ls, '\0');
buffreplace(ls, '.', ls->decpoint); /* follow locale for decimal point */
if (!luaO_str2d(luaZ_buffer(ls->buff), &seminfo->r)) /* format error? */
trydecpoint(ls, seminfo); /* try to update decimal point separator */
}
static int skip_sep (LexState *ls) {
int 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 : (-count) - 1;
}
static void read_long_string (LexState *ls, SemInfo *seminfo, int sep) {
int cont = 0;
(void)(cont); /* avoid warnings when `cont' is not used */
save_and_next(ls); /* skip 2nd `[' */
if (currIsNewline(ls)) /* string starts with a newline? */
inclinenumber(ls); /* skip it */
for (;;) {
switch (ls->current) {
case EOZ:
luaX_lexerror(ls, (seminfo) ? "unfinished long string" :
"unfinished long comment", TK_EOS);
break; /* to avoid warnings */
#if defined(LUA_COMPAT_LSTR)
case '[': {
if (skip_sep(ls) == sep) {
save_and_next(ls); /* skip 2nd `[' */
cont++;
#if LUA_COMPAT_LSTR == 1
if (sep == 0)
luaX_lexerror(ls, "nesting of [[...]] is deprecated", '[');
#endif
}
break;
}
#endif
case ']': {
if (skip_sep(ls) == sep) {
save_and_next(ls); /* skip 2nd `]' */
#if defined(LUA_COMPAT_LSTR) && LUA_COMPAT_LSTR == 2
cont--;
if (sep == 0 && cont >= 0) break;
#endif
goto endloop;
}
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);
}
}
} endloop:
if (seminfo)
seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + (2 + sep),
luaZ_bufflen(ls->buff) - 2*(2 + sep));
}
static void read_string (LexState *ls, int del, SemInfo *seminfo) {
save_and_next(ls);
while (ls->current != del) {
switch (ls->current) {
case EOZ:
luaX_lexerror(ls, "unfinished string", TK_EOS);
continue; /* to avoid warnings */
case '\n':
case '\r':
luaX_lexerror(ls, "unfinished string", TK_STRING);
continue; /* to avoid warnings */
case '\\': {
int c;
next(ls); /* do not save the `\' */
switch (ls->current) {
case 'a': c = '\a'; break;
case 'b': c = '\b'; break;
case 'f': c = '\f'; break;
case 'n': c = '\n'; break;
case 'r': c = '\r'; break;
case 't': c = '\t'; break;
case 'v': c = '\v'; break;
case '\n': /* go through */
case '\r': save(ls, '\n'); inclinenumber(ls); continue;
case EOZ: continue; /* will raise an error next loop */
default: {
if (!isdigit(ls->current))
save_and_next(ls); /* handles \\, \", \', and \? */
else { /* \xxx */
int i = 0;
c = 0;
do {
c = 10*c + (ls->current-'0');
next(ls);
} while (++i<3 && isdigit(ls->current));
if (c > UCHAR_MAX)
luaX_lexerror(ls, "escape sequence too large", TK_STRING);
save(ls, c);
}
continue;
}
}
save(ls, c);
next(ls);
continue;
}
default:
save_and_next(ls);
}
}
save_and_next(ls); /* skip delimiter */
seminfo->ts = luaX_newstring(ls, luaZ_buffer(ls->buff) + 1,
luaZ_bufflen(ls->buff) - 2);
}
static int llex (LexState *ls, SemInfo *seminfo) {
luaZ_resetbuffer(ls->buff);
for (;;) {
switch (ls->current) {
case '\n':
case '\r': {
inclinenumber(ls);
continue;
}
case '-': {
next(ls);
if (ls->current != '-') return '-';
/* else is a comment */
next(ls);
if (ls->current == '[') {
int sep = skip_sep(ls);
luaZ_resetbuffer(ls->buff); /* `skip_sep' may dirty the buffer */
if (sep >= 0) {
read_long_string(ls, NULL, sep); /* long comment */
luaZ_resetbuffer(ls->buff);
continue;
}
}
/* else short comment */
while (!currIsNewline(ls) && ls->current != EOZ)
next(ls);
continue;
}
case '[': {
int sep = skip_sep(ls);
if (sep >= 0) {
read_long_string(ls, seminfo, sep);
return TK_STRING;
}
else if (sep == -1) return '[';
else luaX_lexerror(ls, "invalid long string delimiter", TK_STRING);
}
case '=': {
next(ls);
if (ls->current != '=') return '=';
else { next(ls); return TK_EQ; }
}
case '<': {
next(ls);
if (ls->current != '=') return '<';
else { next(ls); return TK_LE; }
}
case '>': {
next(ls);
if (ls->current != '=') return '>';
else { next(ls); return TK_GE; }
}
case '~': {
next(ls);
if (ls->current != '=') return '~';
else { next(ls); return TK_NE; }
}
case '"':
case '\'': {
read_string(ls, ls->current, seminfo);
return TK_STRING;
}
case '.': {
save_and_next(ls);
if (check_next(ls, ".")) {
if (check_next(ls, "."))
return TK_DOTS; /* ... */
else return TK_CONCAT; /* .. */
}
else if (!isdigit(ls->current)) return '.';
else {
read_numeral(ls, seminfo);
return TK_NUMBER;
}
}
case EOZ: {
return TK_EOS;
}
default: {
if (isspace(ls->current)) {
lua_assert(!currIsNewline(ls));
next(ls);
continue;
}
else if (isdigit(ls->current)) {
read_numeral(ls, seminfo);
return TK_NUMBER;
}
else if (isalpha(ls->current) || ls->current == '_') {
/* identifier or reserved word */
TString *ts;
do {
save_and_next(ls);
} while (isalnum(ls->current) || ls->current == '_');
ts = luaX_newstring(ls, luaZ_buffer(ls->buff),
luaZ_bufflen(ls->buff));
if (ts->tsv.reserved > 0) /* reserved word? */
return ts->tsv.reserved - 1 + FIRST_RESERVED;
else {
seminfo->ts = ts;
return TK_NAME;
}
}
else {
int c = ls->current;
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 */
}
void luaX_lookahead (LexState *ls) {
lua_assert(ls->lookahead.token == TK_EOS);
ls->lookahead.token = llex(ls, &ls->lookahead.seminfo);
}

81
src/lua/llex.h
View File

@ -1,81 +0,0 @@
/*
** $Id: llex.h,v 1.58.1.1 2007/12/27 13:02:25 roberto Exp $
** Lexical Analyzer
** See Copyright Notice in lua.h
*/
#ifndef llex_h
#define llex_h
#include "lobject.h"
#include "lzio.h"
#define FIRST_RESERVED 257
/* maximum length of a reserved word */
#define TOKEN_LEN (sizeof("function")/sizeof(char))
/*
* WARNING: if you change the order of this enumeration,
* grep "ORDER RESERVED"
*/
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_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_CONCAT, TK_DOTS, TK_EQ, TK_GE, TK_LE, TK_NE, TK_NUMBER,
TK_NAME, TK_STRING, TK_EOS
};
/* number of reserved words */
#define NUM_RESERVED (cast(int, TK_WHILE-FIRST_RESERVED+1))
/* array with token `names' */
LUAI_DATA const char *const luaX_tokens [];
typedef union {
lua_Number r;
TString *ts;
} SemInfo; /* semantics information */
typedef struct Token {
int token;
SemInfo seminfo;
} Token;
typedef struct LexState {
int current; /* current character (charint) */
int linenumber; /* input line counter */
int lastline; /* line of last token `consumed' */
Token t; /* current token */
Token lookahead; /* look ahead token */
struct FuncState *fs; /* `FuncState' is private to the parser */
struct lua_State *L;
ZIO *z; /* input stream */
Mbuffer *buff; /* buffer for tokens */
TString *source; /* current source name */
char decpoint; /* locale decimal point */
} LexState;
LUAI_FUNC void luaX_init (lua_State *L);
LUAI_FUNC void luaX_setinput (lua_State *L, LexState *ls, ZIO *z,
TString *source);
LUAI_FUNC TString *luaX_newstring (LexState *ls, const char *str, size_t l);
LUAI_FUNC void luaX_next (LexState *ls);
LUAI_FUNC void luaX_lookahead (LexState *ls);
LUAI_FUNC void luaX_lexerror (LexState *ls, const char *msg, int token);
LUAI_FUNC void luaX_syntaxerror (LexState *ls, const char *s);
LUAI_FUNC const char *luaX_token2str (LexState *ls, int token);
#endif

128
src/lua/llimits.h
View File

@ -1,128 +0,0 @@
/*
** $Id: llimits.h,v 1.69.1.1 2007/12/27 13:02:25 roberto Exp $
** Limits, basic types, and some other `installation-dependent' definitions
** See Copyright Notice in lua.h
*/
#ifndef llimits_h
#define llimits_h
#include <limits.h>
#include <stddef.h>
#include "lua.h"
typedef LUAI_UINT32 lu_int32;
typedef LUAI_UMEM lu_mem;
typedef LUAI_MEM l_mem;
/* chars used as small naturals (so that `char' is reserved for characters) */
typedef unsigned char lu_byte;
#define MAX_SIZET ((size_t)(~(size_t)0)-2)
#define MAX_LUMEM ((lu_mem)(~(lu_mem)0)-2)
#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
/*
** conversion of pointer to integer
** this is for hashing only; there is no problem if the integer
** cannot hold the whole pointer value
*/
#define IntPoint(p) ((unsigned int)(lu_mem)(p))
/* type to ensure maximum alignment */
typedef LUAI_USER_ALIGNMENT_T L_Umaxalign;
/* result of a `usual argument conversion' over lua_Number */
typedef LUAI_UACNUMBER l_uacNumber;
/* internal assertions for in-house debugging */
#ifdef lua_assert
#define check_exp(c,e) (lua_assert(c), (e))
#define api_check(l,e) lua_assert(e)
#else
#define lua_assert(c) ((void)0)
#define check_exp(c,e) (e)
#define api_check luai_apicheck
#endif
#ifndef UNUSED
#define UNUSED(x) ((void)(x)) /* to avoid warnings */
#endif
#ifndef cast
#define cast(t, exp) ((t)(exp))
#endif
#define cast_byte(i) cast(lu_byte, (i))
#define cast_num(i) cast(lua_Number, (i))
#define cast_int(i) cast(int, (i))
/*
** type for virtual-machine instructions
** must be an unsigned with (at least) 4 bytes (see details in lopcodes.h)
*/
typedef lu_int32 Instruction;
/* maximum stack for a Lua function */
#define MAXSTACK 250
/* 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
#ifndef lua_lock
#define lua_lock(L) ((void) 0)
#define lua_unlock(L) ((void) 0)
#endif
#ifndef luai_threadyield
#define luai_threadyield(L) {lua_unlock(L); lua_lock(L);}
#endif
/*
** macro to control inclusion of some hard tests on stack reallocation
*/
#ifndef HARDSTACKTESTS
#define condhardstacktests(x) ((void)0)
#else
#define condhardstacktests(x) x
#endif
#endif

263
src/lua/lmathlib.c
View File

@ -1,263 +0,0 @@
/*
** $Id: lmathlib.c,v 1.67.1.1 2007/12/27 13:02:25 roberto Exp $
** Standard mathematical library
** See Copyright Notice in lua.h
*/
#include <stdlib.h>
#include <math.h>
#define lmathlib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#undef PI
#define PI (3.14159265358979323846)
#define RADIANS_PER_DEGREE (PI/180.0)
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(luaL_checknumber(L, 1)));
return 1;
}
static int math_sinh (lua_State *L) {
lua_pushnumber(L, sinh(luaL_checknumber(L, 1)));
return 1;
}
static int math_cos (lua_State *L) {
lua_pushnumber(L, cos(luaL_checknumber(L, 1)));
return 1;
}
static int math_cosh (lua_State *L) {
lua_pushnumber(L, cosh(luaL_checknumber(L, 1)));
return 1;
}
static int math_tan (lua_State *L) {
lua_pushnumber(L, tan(luaL_checknumber(L, 1)));
return 1;
}
static int math_tanh (lua_State *L) {
lua_pushnumber(L, tanh(luaL_checknumber(L, 1)));
return 1;
}
static int math_asin (lua_State *L) {
lua_pushnumber(L, asin(luaL_checknumber(L, 1)));
return 1;
}
static int math_acos (lua_State *L) {
lua_pushnumber(L, acos(luaL_checknumber(L, 1)));
return 1;
}
static int math_atan (lua_State *L) {
lua_pushnumber(L, atan(luaL_checknumber(L, 1)));
return 1;
}
static int math_atan2 (lua_State *L) {
lua_pushnumber(L, 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_fmod (lua_State *L) {
lua_pushnumber(L, fmod(luaL_checknumber(L, 1), luaL_checknumber(L, 2)));
return 1;
}
static int math_modf (lua_State *L) {
double ip;
double fp = modf(luaL_checknumber(L, 1), &ip);
lua_pushnumber(L, ip);
lua_pushnumber(L, fp);
return 2;
}
static int math_sqrt (lua_State *L) {
lua_pushnumber(L, sqrt(luaL_checknumber(L, 1)));
return 1;
}
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_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, exp(luaL_checknumber(L, 1)));
return 1;
}
static int math_deg (lua_State *L) {
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)*RADIANS_PER_DEGREE);
return 1;
}
static int math_frexp (lua_State *L) {
int e;
lua_pushnumber(L, frexp(luaL_checknumber(L, 1), &e));
lua_pushinteger(L, e);
return 2;
}
static int math_ldexp (lua_State *L) {
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 */
lua_Number dmin = luaL_checknumber(L, 1);
int i;
for (i=2; i<=n; i++) {
lua_Number d = luaL_checknumber(L, i);
if (d < dmin)
dmin = d;
}
lua_pushnumber(L, dmin);
return 1;
}
static int math_max (lua_State *L) {
int n = lua_gettop(L); /* number of arguments */
lua_Number dmax = luaL_checknumber(L, 1);
int i;
for (i=2; i<=n; i++) {
lua_Number d = luaL_checknumber(L, i);
if (d > dmax)
dmax = d;
}
lua_pushnumber(L, dmax);
return 1;
}
static int math_random (lua_State *L) {
/* 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, r); /* Number between 0 and 1 */
break;
}
case 1: { /* only upper limit */
int u = luaL_checkint(L, 1);
luaL_argcheck(L, 1<=u, 1, "interval is empty");
lua_pushnumber(L, floor(r*u)+1); /* int between 1 and `u' */
break;
}
case 2: { /* lower and upper limits */
int l = luaL_checkint(L, 1);
int u = luaL_checkint(L, 2);
luaL_argcheck(L, l<=u, 2, "interval is empty");
lua_pushnumber(L, floor(r*(u-l+1))+l); /* int between `l' and `u' */
break;
}
default: return luaL_error(L, "wrong number of arguments");
}
return 1;
}
static int math_randomseed (lua_State *L) {
srand(luaL_checkint(L, 1));
return 0;
}
static const luaL_Reg mathlib[] = {
{"abs", math_abs},
{"acos", math_acos},
{"asin", math_asin},
{"atan2", math_atan2},
{"atan", math_atan},
{"ceil", math_ceil},
{"cosh", math_cosh},
{"cos", math_cos},
{"deg", math_deg},
{"exp", math_exp},
{"floor", math_floor},
{"fmod", math_fmod},
{"frexp", math_frexp},
{"ldexp", math_ldexp},
{"log10", math_log10},
{"log", math_log},
{"max", math_max},
{"min", math_min},
{"modf", math_modf},
{"pow", math_pow},
{"rad", math_rad},
{"random", math_random},
{"randomseed", math_randomseed},
{"sinh", math_sinh},
{"sin", math_sin},
{"sqrt", math_sqrt},
{"tanh", math_tanh},
{"tan", math_tan},
{NULL, NULL}
};
/*
** Open math library
*/
LUALIB_API int luaopen_math (lua_State *L) {
luaL_register(L, LUA_MATHLIBNAME, mathlib);
lua_pushnumber(L, PI);
lua_setfield(L, -2, "pi");
lua_pushnumber(L, HUGE_VAL);
lua_setfield(L, -2, "huge");
#if defined(LUA_COMPAT_MOD)
lua_getfield(L, -1, "fmod");
lua_setfield(L, -2, "mod");
#endif
return 1;
}

86
src/lua/lmem.c
View File

@ -1,86 +0,0 @@
/*
** $Id: lmem.c,v 1.70.1.1 2007/12/27 13:02:25 roberto Exp $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
#include <stddef.h>
#define lmem_c
#define LUA_CORE
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
/*
** 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)
**
** Lua ensures that (ptr == NULL) iff (osize == 0).
**
** * frealloc(ud, NULL, 0, x) creates a new block of size `x'
**
** * frealloc(ud, p, x, 0) frees the block `p'
** (in this specific case, frealloc must return NULL).
** particularly, frealloc(ud, NULL, 0, 0) does nothing
** (which is equivalent to free(NULL) in ANSI C)
**
** frealloc returns NULL if it cannot create or reallocate the area
** (any reallocation to an equal or smaller size cannot fail!)
*/
#define MINSIZEARRAY 4
void *luaM_growaux_ (lua_State *L, void *block, int *size, size_t size_elems,
int limit, const char *errormsg) {
void *newblock;
int newsize;
if (*size >= limit/2) { /* cannot double it? */
if (*size >= limit) /* cannot grow even a little? */
luaG_runerror(L, errormsg);
newsize = limit; /* still have at least one free place */
}
else {
newsize = (*size)*2;
if (newsize < MINSIZEARRAY)
newsize = MINSIZEARRAY; /* minimum size */
}
newblock = luaM_reallocv(L, block, *size, newsize, size_elems);
*size = newsize; /* update only when everything else is OK */
return newblock;
}
void *luaM_toobig (lua_State *L) {
luaG_runerror(L, "memory allocation error: block too big");
return NULL; /* to avoid warnings */
}
/*
** generic allocation routine.
*/
void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
global_State *g = G(L);
lua_assert((osize == 0) == (block == NULL));
block = (*g->frealloc)(g->ud, block, osize, nsize);
if (block == NULL && nsize > 0)
luaD_throw(L, LUA_ERRMEM);
lua_assert((nsize == 0) == (block == NULL));
g->totalbytes = (g->totalbytes - osize) + nsize;
return block;
}

49
src/lua/lmem.h
View File

@ -1,49 +0,0 @@
/*
** $Id: lmem.h,v 1.31.1.1 2007/12/27 13:02:25 roberto Exp $
** Interface to Memory Manager
** See Copyright Notice in lua.h
*/
#ifndef lmem_h
#define lmem_h
#include <stddef.h>
#include "llimits.h"
#include "lua.h"
#define MEMERRMSG "not enough memory"
#define luaM_reallocv(L,b,on,n,e) \
((cast(size_t, (n)+1) <= MAX_SIZET/(e)) ? /* +1 to avoid warnings */ \
luaM_realloc_(L, (b), (on)*(e), (n)*(e)) : \
luaM_toobig(L))
#define luaM_freemem(L, b, s) luaM_realloc_(L, (b), (s), 0)
#define luaM_free(L, b) luaM_realloc_(L, (b), sizeof(*(b)), 0)
#define luaM_freearray(L, b, n, t) luaM_reallocv(L, (b), n, 0, sizeof(t))
#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_reallocv(L, NULL, 0, n, sizeof(t)))
#define luaM_growvector(L,v,nelems,size,t,limit,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) \
((v)=cast(t *, luaM_reallocv(L, v, oldn, n, sizeof(t))))
LUAI_FUNC void *luaM_realloc_ (lua_State *L, void *block, size_t oldsize,
size_t size);
LUAI_FUNC void *luaM_toobig (lua_State *L);
LUAI_FUNC void *luaM_growaux_ (lua_State *L, void *block, int *size,
size_t size_elem, int limit,
const char *errormsg);
#endif

666
src/lua/loadlib.c
View File

@ -1,666 +0,0 @@
/*
** $Id: loadlib.c,v 1.52.1.4 2009/09/09 13:17:16 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 Darwin (Mac OS X), an
** implementation for Windows, and a stub for other systems.
*/
#include <stdlib.h>
#include <string.h>
#define loadlib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
/* prefix for open functions in C libraries */
#define LUA_POF "luaopen_"
/* separator for open functions in C libraries */
#define LUA_OFSEP "_"
#define LIBPREFIX "LOADLIB: "
#define POF LUA_POF
#define LIB_FAIL "open"
/* error codes for ll_loadfunc */
#define ERRLIB 1
#define ERRFUNC 2
#define setprogdir(L) ((void)0)
static void ll_unloadlib (void *lib);
static void *ll_load (lua_State *L, const char *path);
static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym);
#if defined(LUA_DL_DLOPEN)
/*
** {========================================================================
** 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 ll_unloadlib (void *lib) {
dlclose(lib);
}
static void *ll_load (lua_State *L, const char *path) {
void *lib = dlopen(path, RTLD_NOW);
if (lib == NULL) lua_pushstring(L, dlerror());
return lib;
}
static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
lua_CFunction f = (lua_CFunction)dlsym(lib, sym);
if (f == NULL) lua_pushstring(L, dlerror());
return f;
}
/* }====================================================== */
#elif defined(LUA_DL_DLL)
/*
** {======================================================================
** This is an implementation of loadlib for Windows using native functions.
** =======================================================================
*/
#include <windows.h>
#undef setprogdir
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);
if (n == 0 || n == nsize || (lb = strrchr(buff, '\\')) == NULL)
luaL_error(L, "unable to get ModuleFileName");
else {
*lb = '\0';
luaL_gsub(L, lua_tostring(L, -1), LUA_EXECDIR, buff);
lua_remove(L, -2); /* remove original string */
}
}
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), NULL))
lua_pushstring(L, buffer);
else
lua_pushfstring(L, "system error %d\n", error);
}
static void ll_unloadlib (void *lib) {
FreeLibrary((HINSTANCE)lib);
}
static void *ll_load (lua_State *L, const char *path) {
HINSTANCE lib = LoadLibraryA(path);
if (lib == NULL) pusherror(L);
return lib;
}
static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
lua_CFunction f = (lua_CFunction)GetProcAddress((HINSTANCE)lib, sym);
if (f == NULL) pusherror(L);
return f;
}
/* }====================================================== */
#elif defined(LUA_DL_DYLD)
/*
** {======================================================================
** Native Mac OS X / Darwin Implementation
** =======================================================================
*/
#include <mach-o/dyld.h>
/* Mac appends a `_' before C function names */
#undef POF
#define POF "_" LUA_POF
static void pusherror (lua_State *L) {
const char *err_str;
const char *err_file;
NSLinkEditErrors err;
int err_num;
NSLinkEditError(&err, &err_num, &err_file, &err_str);
lua_pushstring(L, err_str);
}
static const char *errorfromcode (NSObjectFileImageReturnCode ret) {
switch (ret) {
case NSObjectFileImageInappropriateFile:
return "file is not a bundle";
case NSObjectFileImageArch:
return "library is for wrong CPU type";
case NSObjectFileImageFormat:
return "bad format";
case NSObjectFileImageAccess:
return "cannot access file";
case NSObjectFileImageFailure:
default:
return "unable to load library";
}
}
static void ll_unloadlib (void *lib) {
NSUnLinkModule((NSModule)lib, NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
}
static void *ll_load (lua_State *L, const char *path) {
NSObjectFileImage img;
NSObjectFileImageReturnCode ret;
/* this would be a rare case, but prevents crashing if it happens */
if(!_dyld_present()) {
lua_pushliteral(L, "dyld not present");
return NULL;
}
ret = NSCreateObjectFileImageFromFile(path, &img);
if (ret == NSObjectFileImageSuccess) {
NSModule mod = NSLinkModule(img, path, NSLINKMODULE_OPTION_PRIVATE |
NSLINKMODULE_OPTION_RETURN_ON_ERROR);
NSDestroyObjectFileImage(img);
if (mod == NULL) pusherror(L);
return mod;
}
lua_pushstring(L, errorfromcode(ret));
return NULL;
}
static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
NSSymbol nss = NSLookupSymbolInModule((NSModule)lib, sym);
if (nss == NULL) {
lua_pushfstring(L, "symbol " LUA_QS " not found", sym);
return NULL;
}
return (lua_CFunction)NSAddressOfSymbol(nss);
}
/* }====================================================== */
#else
/*
** {======================================================
** Fallback for other systems
** =======================================================
*/
#undef LIB_FAIL
#define LIB_FAIL "absent"
#define DLMSG "dynamic libraries not enabled; check your Lua installation"
static void ll_unloadlib (void *lib) {
(void)lib; /* to avoid warnings */
}
static void *ll_load (lua_State *L, const char *path) {
(void)path; /* to avoid warnings */
lua_pushliteral(L, DLMSG);
return NULL;
}
static lua_CFunction ll_sym (lua_State *L, void *lib, const char *sym) {
(void)lib; (void)sym; /* to avoid warnings */
lua_pushliteral(L, DLMSG);
return NULL;
}
/* }====================================================== */
#endif
static void **ll_register (lua_State *L, const char *path) {
void **plib;
lua_pushfstring(L, "%s%s", LIBPREFIX, path);
lua_gettable(L, LUA_REGISTRYINDEX); /* check library in registry? */
if (!lua_isnil(L, -1)) /* is there an entry? */
plib = (void **)lua_touserdata(L, -1);
else { /* no entry yet; create one */
lua_pop(L, 1);
plib = (void **)lua_newuserdata(L, sizeof(const void *));
*plib = NULL;
luaL_getmetatable(L, "_LOADLIB");
lua_setmetatable(L, -2);
lua_pushfstring(L, "%s%s", LIBPREFIX, path);
lua_pushvalue(L, -2);
lua_settable(L, LUA_REGISTRYINDEX);
}
return plib;
}
/*
** __gc tag method: calls library's `ll_unloadlib' function with the lib
** handle
*/
static int gctm (lua_State *L) {
void **lib = (void **)luaL_checkudata(L, 1, "_LOADLIB");
if (*lib) ll_unloadlib(*lib);
*lib = NULL; /* mark library as closed */
return 0;
}
static int ll_loadfunc (lua_State *L, const char *path, const char *sym) {
void **reg = ll_register(L, path);
if (*reg == NULL) *reg = ll_load(L, path);
if (*reg == NULL)
return ERRLIB; /* unable to load library */
else {
lua_CFunction f = ll_sym(L, *reg, sym);
if (f == NULL)
return ERRFUNC; /* unable to find function */
lua_pushcfunction(L, f);
return 0; /* return function */
}
}
static int ll_loadlib (lua_State *L) {
const char *path = luaL_checkstring(L, 1);
const char *init = luaL_checkstring(L, 2);
int stat = ll_loadfunc(L, path, init);
if (stat == 0) /* no errors? */
return 1; /* return the loaded function */
else { /* error; error message is on stack top */
lua_pushnil(L);
lua_insert(L, -2);
lua_pushstring(L, (stat == ERRLIB) ? LIB_FAIL : "init");
return 3; /* return nil, 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;
}
static const char *pushnexttemplate (lua_State *L, const char *path) {
const char *l;
while (*path == *LUA_PATHSEP) path++; /* skip separators */
if (*path == '\0') return NULL; /* no more templates */
l = strchr(path, *LUA_PATHSEP); /* find next separator */
if (l == NULL) l = path + strlen(path);
lua_pushlstring(L, path, l - path); /* template */
return l;
}
static const char *findfile (lua_State *L, const char *name,
const char *pname) {
const char *path;
name = luaL_gsub(L, name, ".", LUA_DIRSEP);
lua_getfield(L, LUA_ENVIRONINDEX, pname);
path = lua_tostring(L, -1);
if (path == NULL)
luaL_error(L, LUA_QL("package.%s") " must be a string", pname);
lua_pushliteral(L, ""); /* error accumulator */
while ((path = pushnexttemplate(L, path)) != NULL) {
const char *filename;
filename = luaL_gsub(L, lua_tostring(L, -1), LUA_PATH_MARK, name);
lua_remove(L, -2); /* remove path template */
if (readable(filename)) /* does file exist and is readable? */
return filename; /* return that file name */
lua_pushfstring(L, "\n\tno file " LUA_QS, filename);
lua_remove(L, -2); /* remove file name */
lua_concat(L, 2); /* add entry to possible error message */
}
return NULL; /* not found */
}
static void loaderror (lua_State *L, const char *filename) {
luaL_error(L, "error loading module " LUA_QS " from file " LUA_QS ":\n\t%s",
lua_tostring(L, 1), filename, lua_tostring(L, -1));
}
static int loader_Lua (lua_State *L) {
const char *filename;
const char *name = luaL_checkstring(L, 1);
filename = findfile(L, name, "path");
if (filename == NULL) return 1; /* library not found in this path */
if (luaL_loadfile(L, filename) != 0)
loaderror(L, filename);
return 1; /* library loaded successfully */
}
static const char *mkfuncname (lua_State *L, const char *modname) {
const char *funcname;
const char *mark = strchr(modname, *LUA_IGMARK);
if (mark) modname = mark + 1;
funcname = luaL_gsub(L, modname, ".", LUA_OFSEP);
funcname = lua_pushfstring(L, POF"%s", funcname);
lua_remove(L, -2); /* remove 'gsub' result */
return funcname;
}
static int loader_C (lua_State *L) {
const char *funcname;
const char *name = luaL_checkstring(L, 1);
const char *filename = findfile(L, name, "cpath");
if (filename == NULL) return 1; /* library not found in this path */
funcname = mkfuncname(L, name);
if (ll_loadfunc(L, filename, funcname) != 0)
loaderror(L, filename);
return 1; /* library loaded successfully */
}
static int loader_Croot (lua_State *L) {
const char *funcname;
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, p - name);
filename = findfile(L, lua_tostring(L, -1), "cpath");
if (filename == NULL) return 1; /* root not found */
funcname = mkfuncname(L, name);
if ((stat = ll_loadfunc(L, filename, funcname)) != 0) {
if (stat != ERRFUNC) loaderror(L, filename); /* real error */
lua_pushfstring(L, "\n\tno module " LUA_QS " in file " LUA_QS,
name, filename);
return 1; /* function not found */
}
return 1;
}
static int loader_preload (lua_State *L) {
const char *name = luaL_checkstring(L, 1);
lua_getfield(L, LUA_ENVIRONINDEX, "preload");
if (!lua_istable(L, -1))
luaL_error(L, LUA_QL("package.preload") " must be a table");
lua_getfield(L, -1, name);
if (lua_isnil(L, -1)) /* not found? */
lua_pushfstring(L, "\n\tno field package.preload['%s']", name);
return 1;
}
static const int sentinel_ = 0;
#define sentinel ((void *)&sentinel_)
static int ll_require (lua_State *L) {
const char *name = luaL_checkstring(L, 1);
int i;
lua_settop(L, 1); /* _LOADED table will be at index 2 */
lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED");
lua_getfield(L, 2, name);
if (lua_toboolean(L, -1)) { /* is it there? */
if (lua_touserdata(L, -1) == sentinel) /* check loops */
luaL_error(L, "loop or previous error loading module " LUA_QS, name);
return 1; /* package is already loaded */
}
/* else must load it; iterate over available loaders */
lua_getfield(L, LUA_ENVIRONINDEX, "loaders");
if (!lua_istable(L, -1))
luaL_error(L, LUA_QL("package.loaders") " must be a table");
lua_pushliteral(L, ""); /* error message accumulator */
for (i=1; ; i++) {
lua_rawgeti(L, -2, i); /* get a loader */
if (lua_isnil(L, -1))
luaL_error(L, "module " LUA_QS " not found:%s",
name, lua_tostring(L, -2));
lua_pushstring(L, name);
lua_call(L, 1, 1); /* call it */
if (lua_isfunction(L, -1)) /* did it find module? */
break; /* module loaded successfully */
else if (lua_isstring(L, -1)) /* loader returned error message? */
lua_concat(L, 2); /* accumulate it */
else
lua_pop(L, 1);
}
lua_pushlightuserdata(L, sentinel);
lua_setfield(L, 2, name); /* _LOADED[name] = sentinel */
lua_pushstring(L, name); /* pass name as argument to module */
lua_call(L, 1, 1); /* run loaded module */
if (!lua_isnil(L, -1)) /* non-nil return? */
lua_setfield(L, 2, name); /* _LOADED[name] = returned value */
lua_getfield(L, 2, name);
if (lua_touserdata(L, -1) == sentinel) { /* module did not set a value? */
lua_pushboolean(L, 1); /* use true as result */
lua_pushvalue(L, -1); /* extra copy to be returned */
lua_setfield(L, 2, name); /* _LOADED[name] = true */
}
return 1;
}
/* }====================================================== */
/*
** {======================================================
** 'module' function
** =======================================================
*/
static void setfenv (lua_State *L) {
lua_Debug ar;
if (lua_getstack(L, 1, &ar) == 0 ||
lua_getinfo(L, "f", &ar) == 0 || /* get calling function */
lua_iscfunction(L, -1))
luaL_error(L, LUA_QL("module") " not called from a Lua function");
lua_pushvalue(L, -2);
lua_setfenv(L, -2);
lua_pop(L, 1);
}
static void dooptions (lua_State *L, int n) {
int i;
for (i = 2; i <= n; i++) {
lua_pushvalue(L, i); /* get option (a function) */
lua_pushvalue(L, -2); /* module */
lua_call(L, 1, 0);
}
}
static void modinit (lua_State *L, const char *modname) {
const char *dot;
lua_pushvalue(L, -1);
lua_setfield(L, -2, "_M"); /* module._M = module */
lua_pushstring(L, modname);
lua_setfield(L, -2, "_NAME");
dot = strrchr(modname, '.'); /* look for last dot in module name */
if (dot == NULL) dot = modname;
else dot++;
/* set _PACKAGE as package name (full module name minus last part) */
lua_pushlstring(L, modname, dot - modname);
lua_setfield(L, -2, "_PACKAGE");
}
static int ll_module (lua_State *L) {
const char *modname = luaL_checkstring(L, 1);
int loaded = lua_gettop(L) + 1; /* index of _LOADED table */
lua_getfield(L, LUA_REGISTRYINDEX, "_LOADED");
lua_getfield(L, loaded, modname); /* get _LOADED[modname] */
if (!lua_istable(L, -1)) { /* not found? */
lua_pop(L, 1); /* remove previous result */
/* try global variable (and create one if it does not exist) */
if (luaL_findtable(L, LUA_GLOBALSINDEX, modname, 1) != NULL)
return luaL_error(L, "name conflict for module " LUA_QS, modname);
lua_pushvalue(L, -1);
lua_setfield(L, loaded, modname); /* _LOADED[modname] = new table */
}
/* check whether table already has a _NAME field */
lua_getfield(L, -1, "_NAME");
if (!lua_isnil(L, -1)) /* is table an initialized module? */
lua_pop(L, 1);
else { /* no; initialize it */
lua_pop(L, 1);
modinit(L, modname);
}
lua_pushvalue(L, -1);
setfenv(L);
dooptions(L, loaded - 1);
return 0;
}
static int ll_seeall (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
if (!lua_getmetatable(L, 1)) {
lua_createtable(L, 0, 1); /* create new metatable */
lua_pushvalue(L, -1);
lua_setmetatable(L, 1);
}
lua_pushvalue(L, LUA_GLOBALSINDEX);
lua_setfield(L, -2, "__index"); /* mt.__index = _G */
return 0;
}
/* }====================================================== */
/* auxiliary mark (for internal use) */
#define AUXMARK "\1"
static void setpath (lua_State *L, const char *fieldname, const char *envname,
const char *def) {
const char *path = getenv(envname);
if (path == NULL) /* no environment variable? */
lua_pushstring(L, def); /* use default */
else {
/* replace ";;" by ";AUXMARK;" and then AUXMARK by default path */
path = luaL_gsub(L, path, LUA_PATHSEP LUA_PATHSEP,
LUA_PATHSEP AUXMARK LUA_PATHSEP);
luaL_gsub(L, path, AUXMARK, def);
lua_remove(L, -2);
}
setprogdir(L);
lua_setfield(L, -2, fieldname);
}
static const luaL_Reg pk_funcs[] = {
{"loadlib", ll_loadlib},
{"seeall", ll_seeall},
{NULL, NULL}
};
static const luaL_Reg ll_funcs[] = {
{"module", ll_module},
{"require", ll_require},
{NULL, NULL}
};
static const lua_CFunction loaders[] =
{loader_preload, loader_Lua, loader_C, loader_Croot, NULL};
LUALIB_API int luaopen_package (lua_State *L) {
int i;
/* create new type _LOADLIB */
luaL_newmetatable(L, "_LOADLIB");
lua_pushcfunction(L, gctm);
lua_setfield(L, -2, "__gc");
/* create `package' table */
luaL_register(L, LUA_LOADLIBNAME, pk_funcs);
#if defined(LUA_COMPAT_LOADLIB)
lua_getfield(L, -1, "loadlib");
lua_setfield(L, LUA_GLOBALSINDEX, "loadlib");
#endif
lua_pushvalue(L, -1);
lua_replace(L, LUA_ENVIRONINDEX);
/* create `loaders' table */
lua_createtable(L, sizeof(loaders)/sizeof(loaders[0]) - 1, 0);
/* fill it with pre-defined loaders */
for (i=0; loaders[i] != NULL; i++) {
lua_pushcfunction(L, loaders[i]);
lua_rawseti(L, -2, i+1);
}
lua_setfield(L, -2, "loaders"); /* put it in field `loaders' */
setpath(L, "path", LUA_PATH, LUA_PATH_DEFAULT); /* set field `path' */
setpath(L, "cpath", LUA_CPATH, LUA_CPATH_DEFAULT); /* set field `cpath' */
/* store config information */
lua_pushliteral(L, LUA_DIRSEP "\n" LUA_PATHSEP "\n" LUA_PATH_MARK "\n"
LUA_EXECDIR "\n" LUA_IGMARK);
lua_setfield(L, -2, "config");
/* set field `loaded' */
luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 2);
lua_setfield(L, -2, "loaded");
/* set field `preload' */
lua_newtable(L);
lua_setfield(L, -2, "preload");
lua_pushvalue(L, LUA_GLOBALSINDEX);
luaL_register(L, NULL, ll_funcs); /* open lib into global table */
lua_pop(L, 1);
return 1; /* return 'package' table */
}

214
src/lua/lobject.c
View File

@ -1,214 +0,0 @@
/*
** $Id: lobject.c,v 2.22.1.1 2007/12/27 13:02:25 roberto Exp $
** Some generic functions over Lua objects
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define lobject_c
#define LUA_CORE
#include "lua.h"
#include "ldo.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "lvm.h"
const TValue luaO_nilobject_ = {{NULL}, LUA_TNIL};
/*
** converts an integer to a "floating point byte", represented as
** (eeeeexxx), where the real value is (1xxx) * 2^(eeeee - 1) if
** eeeee != 0 and (xxx) otherwise.
*/
int luaO_int2fb (unsigned int x) {
int e = 0; /* expoent */
while (x >= 16) {
x = (x+1) >> 1;
e++;
}
if (x < 8) return x;
else return ((e+1) << 3) | (cast_int(x) - 8);
}
/* converts back */
int luaO_fb2int (int x) {
int e = (x >> 3) & 31;
if (e == 0) return x;
else return ((x & 7)+8) << (e - 1);
}
int luaO_log2 (unsigned int x) {
static const lu_byte log_2[256] = {
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,
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
};
int l = -1;
while (x >= 256) { l += 8; x >>= 8; }
return l + log_2[x];
}
int luaO_rawequalObj (const TValue *t1, const TValue *t2) {
if (ttype(t1) != ttype(t2)) return 0;
else switch (ttype(t1)) {
case LUA_TNIL:
return 1;
case LUA_TNUMBER:
return luai_numeq(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);
}
}
int luaO_str2d (const char *s, lua_Number *result) {
char *endptr;
*result = lua_str2number(s, &endptr);
if (endptr == s) return 0; /* conversion failed */
if (*endptr == 'x' || *endptr == 'X') /* maybe an hexadecimal constant? */
*result = cast_num(strtoul(s, &endptr, 16));
if (*endptr == '\0') return 1; /* most common case */
while (isspace(cast(unsigned char, *endptr))) endptr++;
if (*endptr != '\0') return 0; /* invalid trailing characters? */
return 1;
}
static void pushstr (lua_State *L, const char *str) {
setsvalue2s(L, L->top, luaS_new(L, str));
incr_top(L);
}
/* this function handles only `%d', `%c', %f, %p, and `%s' formats */
const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) {
int n = 1;
pushstr(L, "");
for (;;) {
const char *e = strchr(fmt, '%');
if (e == NULL) break;
setsvalue2s(L, L->top, luaS_newlstr(L, fmt, e-fmt));
incr_top(L);
switch (*(e+1)) {
case 's': {
const char *s = va_arg(argp, char *);
if (s == NULL) s = "(null)";
pushstr(L, s);
break;
}
case 'c': {
char buff[2];
buff[0] = cast(char, va_arg(argp, int));
buff[1] = '\0';
pushstr(L, buff);
break;
}
case 'd': {
setnvalue(L->top, cast_num(va_arg(argp, int)));
incr_top(L);
break;
}
case 'f': {
setnvalue(L->top, cast_num(va_arg(argp, l_uacNumber)));
incr_top(L);
break;
}
case 'p': {
char buff[4*sizeof(void *) + 8]; /* should be enough space for a `%p' */
sprintf(buff, "%p", va_arg(argp, void *));
pushstr(L, buff);
break;
}
case '%': {
pushstr(L, "%");
break;
}
default: {
char buff[3];
buff[0] = '%';
buff[1] = *(e+1);
buff[2] = '\0';
pushstr(L, buff);
break;
}
}
n += 2;
fmt = e+2;
}
pushstr(L, fmt);
luaV_concat(L, n+1, cast_int(L->top - L->base) - 1);
L->top -= n;
return svalue(L->top - 1);
}
const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) {
const char *msg;
va_list argp;
va_start(argp, fmt);
msg = luaO_pushvfstring(L, fmt, argp);
va_end(argp);
return msg;
}
void luaO_chunkid (char *out, const char *source, size_t bufflen) {
if (*source == '=') {
strncpy(out, source+1, bufflen); /* remove first char */
out[bufflen-1] = '\0'; /* ensures null termination */
}
else { /* out = "source", or "...source" */
if (*source == '@') {
size_t 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 { /* out = [string "string"] */
size_t len = strcspn(source, "\n\r"); /* 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, "\"]");
}
}
}

381
src/lua/lobject.h
View File

@ -1,381 +0,0 @@
/*
** $Id: lobject.h,v 2.20.1.2 2008/08/06 13:29:48 roberto Exp $
** Type definitions for Lua objects
** See Copyright Notice in lua.h
*/
#ifndef lobject_h
#define lobject_h
#include <stdarg.h>
#include "llimits.h"
#include "lua.h"
/* tags for values visible from Lua */
#define LAST_TAG LUA_TTHREAD
#define NUM_TAGS (LAST_TAG+1)
/*
** Extra tags for non-values
*/
#define LUA_TPROTO (LAST_TAG+1)
#define LUA_TUPVAL (LAST_TAG+2)
#define LUA_TDEADKEY (LAST_TAG+3)
/*
** Union of all collectable objects
*/
typedef union GCObject GCObject;
/*
** Common Header for all collectable objects (in macro form, to be
** included in other objects)
*/
#define CommonHeader GCObject *next; lu_byte tt; lu_byte marked
/*
** Common header in struct form
*/
typedef struct GCheader {
CommonHeader;
} GCheader;
/*
** Union of all Lua values
*/
typedef union {
GCObject *gc;
void *p;
lua_Number n;
int b;
} Value;
/*
** Tagged Values
*/
#define TValuefields Value value; int tt
typedef struct lua_TValue {
TValuefields;
} TValue;
/* Macros to test type */
#define ttisnil(o) (ttype(o) == LUA_TNIL)
#define ttisnumber(o) (ttype(o) == LUA_TNUMBER)
#define ttisstring(o) (ttype(o) == LUA_TSTRING)
#define ttistable(o) (ttype(o) == LUA_TTABLE)
#define ttisfunction(o) (ttype(o) == LUA_TFUNCTION)
#define ttisboolean(o) (ttype(o) == LUA_TBOOLEAN)
#define ttisuserdata(o) (ttype(o) == LUA_TUSERDATA)
#define ttisthread(o) (ttype(o) == LUA_TTHREAD)
#define ttislightuserdata(o) (ttype(o) == LUA_TLIGHTUSERDATA)
/* Macros to access values */
#define ttype(o) ((o)->tt)
#define gcvalue(o) check_exp(iscollectable(o), (o)->value.gc)
#define pvalue(o) check_exp(ttislightuserdata(o), (o)->value.p)
#define nvalue(o) check_exp(ttisnumber(o), (o)->value.n)
#define rawtsvalue(o) check_exp(ttisstring(o), &(o)->value.gc->ts)
#define tsvalue(o) (&rawtsvalue(o)->tsv)
#define rawuvalue(o) check_exp(ttisuserdata(o), &(o)->value.gc->u)
#define uvalue(o) (&rawuvalue(o)->uv)
#define clvalue(o) check_exp(ttisfunction(o), &(o)->value.gc->cl)
#define hvalue(o) check_exp(ttistable(o), &(o)->value.gc->h)
#define bvalue(o) check_exp(ttisboolean(o), (o)->value.b)
#define thvalue(o) check_exp(ttisthread(o), &(o)->value.gc->th)
#define l_isfalse(o) (ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0))
/*
** for internal debug only
*/
#define checkconsistency(obj) \
lua_assert(!iscollectable(obj) || (ttype(obj) == (obj)->value.gc->gch.tt))
#define checkliveness(g,obj) \
lua_assert(!iscollectable(obj) || \
((ttype(obj) == (obj)->value.gc->gch.tt) && !isdead(g, (obj)->value.gc)))
/* Macros to set values */
#define setnilvalue(obj) ((obj)->tt=LUA_TNIL)
#define setnvalue(obj,x) \
{ TValue *i_o=(obj); i_o->value.n=(x); i_o->tt=LUA_TNUMBER; }
#define setpvalue(obj,x) \
{ TValue *i_o=(obj); i_o->value.p=(x); i_o->tt=LUA_TLIGHTUSERDATA; }
#define setbvalue(obj,x) \
{ TValue *i_o=(obj); i_o->value.b=(x); i_o->tt=LUA_TBOOLEAN; }
#define setsvalue(L,obj,x) \
{ TValue *i_o=(obj); \
i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TSTRING; \
checkliveness(G(L),i_o); }
#define setuvalue(L,obj,x) \
{ TValue *i_o=(obj); \
i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TUSERDATA; \
checkliveness(G(L),i_o); }
#define setthvalue(L,obj,x) \
{ TValue *i_o=(obj); \
i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TTHREAD; \
checkliveness(G(L),i_o); }
#define setclvalue(L,obj,x) \
{ TValue *i_o=(obj); \
i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TFUNCTION; \
checkliveness(G(L),i_o); }
#define sethvalue(L,obj,x) \
{ TValue *i_o=(obj); \
i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TTABLE; \
checkliveness(G(L),i_o); }
#define setptvalue(L,obj,x) \
{ TValue *i_o=(obj); \
i_o->value.gc=cast(GCObject *, (x)); i_o->tt=LUA_TPROTO; \
checkliveness(G(L),i_o); }
#define setobj(L,obj1,obj2) \
{ const TValue *o2=(obj2); TValue *o1=(obj1); \
o1->value = o2->value; o1->tt=o2->tt; \
checkliveness(G(L),o1); }
/*
** different types of sets, according to destination
*/
/* from stack to (same) stack */
#define setobjs2s setobj
/* to stack (not from same stack) */
#define setobj2s setobj
#define setsvalue2s setsvalue
#define sethvalue2s sethvalue
#define setptvalue2s setptvalue
/* from table to same table */
#define setobjt2t setobj
/* to table */
#define setobj2t setobj
/* to new object */
#define setobj2n setobj
#define setsvalue2n setsvalue
#define setttype(obj, tt) (ttype(obj) = (tt))
#define iscollectable(o) (ttype(o) >= LUA_TSTRING)
typedef TValue *StkId; /* index to stack elements */
/*
** String headers for string table
*/
typedef union TString {
L_Umaxalign dummy; /* ensures maximum alignment for strings */
struct {
CommonHeader;
lu_byte reserved;
unsigned int hash;
size_t len;
} tsv;
} TString;
#define getstr(ts) cast(const char *, (ts) + 1)
#define svalue(o) getstr(rawtsvalue(o))
typedef union Udata {
L_Umaxalign dummy; /* ensures maximum alignment for `local' udata */
struct {
CommonHeader;
struct Table *metatable;
struct Table *env;
size_t len;
} uv;
} Udata;
/*
** Function Prototypes
*/
typedef struct Proto {
CommonHeader;
TValue *k; /* constants used by the function */
Instruction *code;
struct Proto **p; /* functions defined inside the function */
int *lineinfo; /* map from opcodes to source lines */
struct LocVar *locvars; /* information about local variables */
TString **upvalues; /* upvalue names */
TString *source;
int sizeupvalues;
int sizek; /* size of `k' */
int sizecode;
int sizelineinfo;
int sizep; /* size of `p' */
int sizelocvars;
int linedefined;
int lastlinedefined;
GCObject *gclist;
lu_byte nups; /* number of upvalues */
lu_byte numparams;
lu_byte is_vararg;
lu_byte maxstacksize;
} Proto;
/* masks for new-style vararg */
#define VARARG_HASARG 1
#define VARARG_ISVARARG 2
#define VARARG_NEEDSARG 4
typedef struct LocVar {
TString *varname;
int startpc; /* first point where variable is active */
int endpc; /* first point where variable is dead */
} LocVar;
/*
** Upvalues
*/
typedef struct UpVal {
CommonHeader;
TValue *v; /* points to stack or to its own value */
union {
TValue value; /* the value (when closed) */
struct { /* double linked list (when open) */
struct UpVal *prev;
struct UpVal *next;
} l;
} u;
} UpVal;
/*
** Closures
*/
#define ClosureHeader \
CommonHeader; lu_byte isC; lu_byte nupvalues; GCObject *gclist; \
struct Table *env
typedef struct CClosure {
ClosureHeader;
lua_CFunction f;
TValue upvalue[1];
} CClosure;
typedef struct LClosure {
ClosureHeader;
struct Proto *p;
UpVal *upvals[1];
} LClosure;
typedef union Closure {
CClosure c;
LClosure l;
} Closure;
#define iscfunction(o) (ttype(o) == LUA_TFUNCTION && clvalue(o)->c.isC)
#define isLfunction(o) (ttype(o) == LUA_TFUNCTION && !clvalue(o)->c.isC)
/*
** Tables
*/
typedef union TKey {
struct {
TValuefields;
struct Node *next; /* for chaining */
} nk;
TValue tvk;
} TKey;
typedef struct Node {
TValue i_val;
TKey i_key;
} Node;
typedef struct Table {
CommonHeader;
lu_byte flags; /* 1<<p means tagmethod(p) is not present */
lu_byte lsizenode; /* log2 of size of `node' array */
struct Table *metatable;
TValue *array; /* array part */
Node *node;
Node *lastfree; /* any free position is before this position */
GCObject *gclist;
int sizearray; /* size of `array' array */
} Table;
/*
** `module' operation for hashing (size is always a power of 2)
*/
#define lmod(s,size) \
(check_exp((size&(size-1))==0, (cast(int, (s) & ((size)-1)))))
#define twoto(x) (1<<(x))
#define sizenode(t) (twoto((t)->lsizenode))
#define luaO_nilobject (&luaO_nilobject_)
LUAI_DATA const TValue luaO_nilobject_;
#define ceillog2(x) (luaO_log2((x)-1) + 1)
LUAI_FUNC int luaO_log2 (unsigned int x);
LUAI_FUNC int luaO_int2fb (unsigned int x);
LUAI_FUNC int luaO_fb2int (int x);
LUAI_FUNC int luaO_rawequalObj (const TValue *t1, const TValue *t2);
LUAI_FUNC int luaO_str2d (const char *s, lua_Number *result);
LUAI_FUNC const char *luaO_pushvfstring (lua_State *L, const char *fmt,
va_list argp);
LUAI_FUNC const char *luaO_pushfstring (lua_State *L, const char *fmt, ...);
LUAI_FUNC void luaO_chunkid (char *out, const char *source, size_t len);
#endif

102
src/lua/lopcodes.c
View File

@ -1,102 +0,0 @@
/*
** $Id: lopcodes.c,v 1.37.1.1 2007/12/27 13:02:25 roberto Exp $
** See Copyright Notice in lua.h
*/
#define lopcodes_c
#define LUA_CORE
#include "lopcodes.h"
/* ORDER OP */
const char *const luaP_opnames[NUM_OPCODES+1] = {
"MOVE",
"LOADK",
"LOADBOOL",
"LOADNIL",
"GETUPVAL",
"GETGLOBAL",
"GETTABLE",
"SETGLOBAL",
"SETUPVAL",
"SETTABLE",
"NEWTABLE",
"SELF",
"ADD",
"SUB",
"MUL",
"DIV",
"MOD",
"POW",
"UNM",
"NOT",
"LEN",
"CONCAT",
"JMP",
"EQ",
"LT",
"LE",
"TEST",
"TESTSET",
"CALL",
"TAILCALL",
"RETURN",
"FORLOOP",
"FORPREP",
"TFORLOOP",
"SETLIST",
"CLOSE",
"CLOSURE",
"VARARG",
NULL
};
#define opmode(t,a,b,c,m) (((t)<<7) | ((a)<<6) | ((b)<<4) | ((c)<<2) | (m))
const lu_byte luaP_opmodes[NUM_OPCODES] = {
/* T A B C mode opcode */
opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_MOVE */
,opmode(0, 1, OpArgK, OpArgN, iABx) /* OP_LOADK */
,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_LOADBOOL */
,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_LOADNIL */
,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_GETUPVAL */
,opmode(0, 1, OpArgK, OpArgN, iABx) /* OP_GETGLOBAL */
,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_GETTABLE */
,opmode(0, 0, OpArgK, OpArgN, iABx) /* OP_SETGLOBAL */
,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_SETUPVAL */
,opmode(0, 0, OpArgK, OpArgK, iABC) /* OP_SETTABLE */
,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_NEWTABLE */
,opmode(0, 1, OpArgR, OpArgK, iABC) /* OP_SELF */
,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_ADD */
,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_SUB */
,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MUL */
,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_DIV */
,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_MOD */
,opmode(0, 1, OpArgK, OpArgK, iABC) /* OP_POW */
,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_UNM */
,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_NOT */
,opmode(0, 1, OpArgR, OpArgN, iABC) /* OP_LEN */
,opmode(0, 1, OpArgR, OpArgR, iABC) /* OP_CONCAT */
,opmode(0, 0, OpArgR, OpArgN, iAsBx) /* OP_JMP */
,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_EQ */
,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LT */
,opmode(1, 0, OpArgK, OpArgK, iABC) /* OP_LE */
,opmode(1, 1, OpArgR, OpArgU, iABC) /* OP_TEST */
,opmode(1, 1, OpArgR, OpArgU, iABC) /* OP_TESTSET */
,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_CALL */
,opmode(0, 1, OpArgU, OpArgU, iABC) /* OP_TAILCALL */
,opmode(0, 0, OpArgU, OpArgN, iABC) /* OP_RETURN */
,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORLOOP */
,opmode(0, 1, OpArgR, OpArgN, iAsBx) /* OP_FORPREP */
,opmode(1, 0, OpArgN, OpArgU, iABC) /* OP_TFORLOOP */
,opmode(0, 0, OpArgU, OpArgU, iABC) /* OP_SETLIST */
,opmode(0, 0, OpArgN, OpArgN, iABC) /* OP_CLOSE */
,opmode(0, 1, OpArgU, OpArgN, iABx) /* OP_CLOSURE */
,opmode(0, 1, OpArgU, OpArgN, iABC) /* OP_VARARG */
};

268
src/lua/lopcodes.h
View File

@ -1,268 +0,0 @@
/*
** $Id: lopcodes.h,v 1.125.1.1 2007/12/27 13:02:25 roberto Exp $
** Opcodes for Lua virtual machine
** See Copyright Notice in lua.h
*/
#ifndef lopcodes_h
#define lopcodes_h
#include "llimits.h"
/*===========================================================================
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
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.
===========================================================================*/
enum OpMode {iABC, iABx, iAsBx}; /* basic instruction format */
/*
** size and position of opcode arguments.
*/
#define SIZE_C 9
#define SIZE_B 9
#define SIZE_Bx (SIZE_C + SIZE_B)
#define SIZE_A 8
#define SIZE_OP 6
#define POS_OP 0
#define POS_A (POS_OP + SIZE_OP)
#define POS_C (POS_A + SIZE_A)
#define POS_B (POS_C + SIZE_C)
#define POS_Bx POS_C
/*
** limits for opcode arguments.
** we use (signed) int to manipulate most arguments,
** so they must fit in LUAI_BITSINT-1 bits (-1 for sign)
*/
#if SIZE_Bx < LUAI_BITSINT-1
#define MAXARG_Bx ((1<<SIZE_Bx)-1)
#define MAXARG_sBx (MAXARG_Bx>>1) /* `sBx' is signed */
#else
#define MAXARG_Bx MAX_INT
#define MAXARG_sBx MAX_INT
#endif
#define MAXARG_A ((1<<SIZE_A)-1)
#define MAXARG_B ((1<<SIZE_B)-1)
#define MAXARG_C ((1<<SIZE_C)-1)
/* 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' */
#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(Instruction, o)<<POS_OP)&MASK1(SIZE_OP,POS_OP))))
#define GETARG_A(i) (cast(int, ((i)>>POS_A) & MASK1(SIZE_A,0)))
#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 CREATE_ABC(o,a,b,c) ((cast(Instruction, o)<<POS_OP) \
| (cast(Instruction, a)<<POS_A) \
| (cast(Instruction, b)<<POS_B) \
| (cast(Instruction, c)<<POS_C))
#define CREATE_ABx(o,a,bc) ((cast(Instruction, o)<<POS_OP) \
| (cast(Instruction, a)<<POS_A) \
| (cast(Instruction, bc)<<POS_Bx))
/*
** Macros to operate RK indices
*/
/* this bit 1 means constant (0 means register) */
#define BITRK (1 << (SIZE_B - 1))
/* test whether value is a constant */
#define ISK(x) ((x) & BITRK)
/* gets the index of the constant */
#define INDEXK(r) ((int)(r) & ~BITRK)
#define MAXINDEXRK (BITRK - 1)
/* code a constant index as a RK value */
#define RKASK(x) ((x) | BITRK)
/*
** invalid register that fits in 8 bits
*/
#define NO_REG MAXARG_A
/*
** R(x) - register
** Kst(x) - constant (in constant table)
** RK(x) == if ISK(x) then Kst(INDEXK(x)) else R(x)
*/
/*
** grep "ORDER OP" if you change these enums
*/
typedef enum {
/*----------------------------------------------------------------------
name args description
------------------------------------------------------------------------*/
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_GETGLOBAL,/* A Bx R(A) := Gbl[Kst(Bx)] */
OP_GETTABLE,/* A B C R(A) := R(B)[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 B C R(A) := {} (size = B,C) */
OP_SELF,/* A B C R(A+1) := R(B); R(A) := R(B)[RK(C)] */
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_MOD,/* 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_LEN,/* A B R(A) := length of R(B) */
OP_CONCAT,/* A B C R(A) := R(B).. ... ..R(C) */
OP_JMP,/* sBx pc+=sBx */
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_TEST,/* A C if not (R(A) <=> C) then pc++ */
OP_TESTSET,/* A B C if (R(B) <=> C) then R(A) := R(B) else pc++ */
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_FORLOOP,/* A sBx R(A)+=R(A+2);
if R(A) <?= R(A+1) then { pc+=sBx; R(A+3)=R(A) }*/
OP_FORPREP,/* A sBx R(A)-=R(A+2); pc+=sBx */
OP_TFORLOOP,/* A C R(A+3), ... ,R(A+2+C) := R(A)(R(A+1), R(A+2));
if R(A+3) ~= nil then R(A+2)=R(A+3) else pc++ */
OP_SETLIST,/* A B C R(A)[(C-1)*FPF+i] := R(A+i), 1 <= i <= B */
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)) */
OP_VARARG/* A B R(A), R(A+1), ..., R(A+B-1) = vararg */
} OpCode;
#define NUM_OPCODES (cast(int, OP_VARARG) + 1)
/*===========================================================================
Notes:
(*) 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'.
(*) In OP_VARARG, if (B == 0) then use actual number of varargs and
set top (like in OP_CALL with C == 0).
(*) In OP_RETURN, if (B == 0) then return up to `top'
(*) In OP_SETLIST, if (B == 0) then B = `top';
if (C == 0) then next `instruction' is real C
(*) For comparisons, A specifies what condition the test should accept
(true or false).
(*) All `skips' (pc++) assume that next instruction is a jump
===========================================================================*/
/*
** masks for instruction properties. The format is:
** bits 0-1: op mode
** bits 2-3: C arg mode
** bits 4-5: B arg mode
** bit 6: instruction set register A
** bit 7: operator is a test
*/
enum OpArgMask {
OpArgN, /* argument is not used */
OpArgU, /* argument is used */
OpArgR, /* argument is a register or a jump offset */
OpArgK /* argument is a constant or register/constant */
};
LUAI_DATA const lu_byte luaP_opmodes[NUM_OPCODES];
#define getOpMode(m) (cast(enum OpMode, luaP_opmodes[m] & 3))
#define getBMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 4) & 3))
#define getCMode(m) (cast(enum OpArgMask, (luaP_opmodes[m] >> 2) & 3))
#define testAMode(m) (luaP_opmodes[m] & (1 << 6))
#define testTMode(m) (luaP_opmodes[m] & (1 << 7))
LUAI_DATA const char *const luaP_opnames[NUM_OPCODES+1]; /* opcode names */
/* number of list items to accumulate before a SETLIST instruction */
#define LFIELDS_PER_FLUSH 50
#endif

243
src/lua/loslib.c
View File

@ -1,243 +0,0 @@
/*
** $Id: loslib.c,v 1.19.1.3 2008/01/18 16:38:18 roberto Exp $
** Standard Operating System library
** See Copyright Notice in lua.h
*/
#include <errno.h>
#include <locale.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#define loslib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
static int os_pushresult (lua_State *L, int i, const char *filename) {
int en = errno; /* calls to Lua API may change this value */
if (i) {
lua_pushboolean(L, 1);
return 1;
}
else {
lua_pushnil(L);
lua_pushfstring(L, "%s: %s", filename, strerror(en));
lua_pushinteger(L, en);
return 3;
}
}
static int os_execute (lua_State *L) {
lua_pushinteger(L, system(luaL_optstring(L, 1, NULL)));
return 1;
}
static int os_remove (lua_State *L) {
const char *filename = luaL_checkstring(L, 1);
return os_pushresult(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);
return os_pushresult(L, rename(fromname, toname) == 0, fromname);
}
static int os_tmpname (lua_State *L) {
char buff[LUA_TMPNAMBUFSIZE];
int err;
lua_tmpnam(buff, err);
if (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=? }
** =======================================================
*/
static void setfield (lua_State *L, const char *key, int value) {
lua_pushinteger(L, value);
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);
}
static int getboolfield (lua_State *L, const char *key) {
int res;
lua_getfield(L, -1, key);
res = lua_isnil(L, -1) ? -1 : lua_toboolean(L, -1);
lua_pop(L, 1);
return res;
}
static int getfield (lua_State *L, const char *key, int d) {
int res;
lua_getfield(L, -1, key);
if (lua_isnumber(L, -1))
res = (int)lua_tointeger(L, -1);
else {
if (d < 0)
return luaL_error(L, "field " LUA_QS " missing in date table", key);
res = d;
}
lua_pop(L, 1);
return res;
}
static int os_date (lua_State *L) {
const char *s = luaL_optstring(L, 1, "%c");
time_t t = luaL_opt(L, (time_t)luaL_checknumber, 2, time(NULL));
struct tm *stm;
if (*s == '!') { /* UTC? */
stm = gmtime(&t);
s++; /* skip `!' */
}
else
stm = localtime(&t);
if (stm == NULL) /* invalid date? */
lua_pushnil(L);
else if (strcmp(s, "*t") == 0) {
lua_createtable(L, 0, 9); /* 9 = number of fields */
setfield(L, "sec", stm->tm_sec);
setfield(L, "min", stm->tm_min);
setfield(L, "hour", stm->tm_hour);
setfield(L, "day", stm->tm_mday);
setfield(L, "month", stm->tm_mon+1);
setfield(L, "year", stm->tm_year+1900);
setfield(L, "wday", stm->tm_wday+1);
setfield(L, "yday", stm->tm_yday+1);
setboolfield(L, "isdst", stm->tm_isdst);
}
else {
char cc[3];
luaL_Buffer b;
cc[0] = '%'; cc[2] = '\0';
luaL_buffinit(L, &b);
for (; *s; s++) {
if (*s != '%' || *(s + 1) == '\0') /* no conversion specifier? */
luaL_addchar(&b, *s);
else {
size_t reslen;
char buff[200]; /* should be big enough for any conversion result */
cc[1] = *(++s);
reslen = strftime(buff, sizeof(buff), cc, stm);
luaL_addlstring(&b, buff, 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_sec = getfield(L, "sec", 0);
ts.tm_min = getfield(L, "min", 0);
ts.tm_hour = getfield(L, "hour", 12);
ts.tm_mday = getfield(L, "day", -1);
ts.tm_mon = getfield(L, "month", -1) - 1;
ts.tm_year = getfield(L, "year", -1) - 1900;
ts.tm_isdst = getboolfield(L, "isdst");
t = mktime(&ts);
}
if (t == (time_t)(-1))
lua_pushnil(L);
else
lua_pushnumber(L, (lua_Number)t);
return 1;
}
static int os_difftime (lua_State *L) {
lua_pushnumber(L, difftime((time_t)(luaL_checknumber(L, 1)),
(time_t)(luaL_optnumber(L, 2, 0))));
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) {
exit(luaL_optint(L, 1, EXIT_SUCCESS));
}
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}
};
/* }====================================================== */
LUALIB_API int luaopen_os (lua_State *L) {
luaL_register(L, LUA_OSLIBNAME, syslib);
return 1;
}

1339
src/lua/lparser.c
View File

File diff suppressed because it is too large Load Diff

82
src/lua/lparser.h
View File

@ -1,82 +0,0 @@
/*
** $Id: lparser.h,v 1.57.1.1 2007/12/27 13:02:25 roberto Exp $
** Lua Parser
** See Copyright Notice in lua.h
*/
#ifndef lparser_h
#define lparser_h
#include "llimits.h"
#include "lobject.h"
#include "lzio.h"
/*
** Expression descriptor
*/
typedef enum {
VVOID, /* no value */
VNIL,
VTRUE,
VFALSE,
VK, /* info = index of constant in `k' */
VKNUM, /* nval = numerical value */
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 = instruction pc */
VVARARG /* info = instruction pc */
} expkind;
typedef struct expdesc {
expkind k;
union {
struct { int info, aux; } s;
lua_Number nval;
} u;
int t; /* patch list of `exit when true' */
int f; /* patch list of `exit when false' */
} expdesc;
typedef struct upvaldesc {
lu_byte k;
lu_byte info;
} upvaldesc;
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 */
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' */
short nlocvars; /* number of elements in `locvars' */
lu_byte nactvar; /* number of active local variables */
upvaldesc upvalues[LUAI_MAXUPVALUES]; /* upvalues */
unsigned short actvar[LUAI_MAXVARS]; /* declared-variable stack */
} FuncState;
LUAI_FUNC Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff,
const char *name);
#endif

214
src/lua/lstate.c
View File

@ -1,214 +0,0 @@
/*
** $Id: lstate.c,v 2.36.1.2 2008/01/03 15:20:39 roberto Exp $
** Global State
** See Copyright Notice in lua.h
*/
#include <stddef.h>
#define lstate_c
#define LUA_CORE
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "llex.h"
#include "lmem.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#define state_size(x) (sizeof(x) + LUAI_EXTRASPACE)
#define fromstate(l) (cast(lu_byte *, (l)) - LUAI_EXTRASPACE)
#define tostate(l) (cast(lua_State *, cast(lu_byte *, l) + LUAI_EXTRASPACE))
/*
** Main thread combines a thread state and the global state
*/
typedef struct LG {
lua_State l;
global_State g;
} LG;
static void stack_init (lua_State *L1, lua_State *L) {
/* initialize CallInfo array */
L1->base_ci = luaM_newvector(L, BASIC_CI_SIZE, CallInfo);
L1->ci = L1->base_ci;
L1->size_ci = BASIC_CI_SIZE;
L1->end_ci = L1->base_ci + L1->size_ci - 1;
/* initialize stack array */
L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, TValue);
L1->stacksize = BASIC_STACK_SIZE + EXTRA_STACK;
L1->top = L1->stack;
L1->stack_last = L1->stack+(L1->stacksize - EXTRA_STACK)-1;
/* initialize first ci */
L1->ci->func = L1->top;
setnilvalue(L1->top++); /* `function' entry for this `ci' */
L1->base = L1->ci->base = L1->top;
L1->ci->top = L1->top + LUA_MINSTACK;
}
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, TValue);
}
/*
** open parts that may cause memory-allocation errors
*/
static void f_luaopen (lua_State *L, void *ud) {
global_State *g = G(L);
UNUSED(ud);
stack_init(L, L); /* init stack */
sethvalue(L, gt(L), luaH_new(L, 0, 2)); /* table of globals */
sethvalue(L, registry(L), luaH_new(L, 0, 2)); /* registry */
luaS_resize(L, MINSTRTABSIZE); /* initial size of string table */
luaT_init(L);
luaX_init(L);
luaS_fix(luaS_newliteral(L, MEMERRMSG));
g->GCthreshold = 4*g->totalbytes;
}
static void preinit_state (lua_State *L, global_State *g) {
G(L) = g;
L->stack = NULL;
L->stacksize = 0;
L->errorJmp = NULL;
L->hook = NULL;
L->hookmask = 0;
L->basehookcount = 0;
L->allowhook = 1;
resethookcount(L);
L->openupval = NULL;
L->size_ci = 0;
L->nCcalls = L->baseCcalls = 0;
L->status = 0;
L->base_ci = L->ci = NULL;
L->savedpc = NULL;
L->errfunc = 0;
setnilvalue(gt(L));
}
static void close_state (lua_State *L) {
global_State *g = G(L);
luaF_close(L, L->stack); /* close all upvalues for this thread */
luaC_freeall(L); /* collect all objects */
lua_assert(g->rootgc == obj2gco(L));
lua_assert(g->strt.nuse == 0);
luaM_freearray(L, G(L)->strt.hash, G(L)->strt.size, TString *);
luaZ_freebuffer(L, &g->buff);
freestack(L, L);
lua_assert(g->totalbytes == sizeof(LG));
(*g->frealloc)(g->ud, fromstate(L), state_size(LG), 0);
}
lua_State *luaE_newthread (lua_State *L) {
lua_State *L1 = tostate(luaM_malloc(L, state_size(lua_State)));
luaC_link(L, obj2gco(L1), LUA_TTHREAD);
preinit_state(L1, G(L));
stack_init(L1, L); /* init stack */
setobj2n(L, gt(L1), gt(L)); /* share table of globals */
L1->hookmask = L->hookmask;
L1->basehookcount = L->basehookcount;
L1->hook = L->hook;
resethookcount(L1);
lua_assert(iswhite(obj2gco(L1)));
return L1;
}
void luaE_freethread (lua_State *L, lua_State *L1) {
luaF_close(L1, L1->stack); /* close all upvalues for this thread */
lua_assert(L1->openupval == NULL);
luai_userstatefree(L1);
freestack(L, L1);
luaM_freemem(L, fromstate(L1), state_size(lua_State));
}
LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
int i;
lua_State *L;
global_State *g;
void *l = (*f)(ud, NULL, 0, state_size(LG));
if (l == NULL) return NULL;
L = tostate(l);
g = &((LG *)L)->g;
L->next = NULL;
L->tt = LUA_TTHREAD;
g->currentwhite = bit2mask(WHITE0BIT, FIXEDBIT);
L->marked = luaC_white(g);
set2bits(L->marked, FIXEDBIT, SFIXEDBIT);
preinit_state(L, g);
g->frealloc = f;
g->ud = ud;
g->mainthread = L;
g->uvhead.u.l.prev = &g->uvhead;
g->uvhead.u.l.next = &g->uvhead;
g->GCthreshold = 0; /* mark it as unfinished state */
g->strt.size = 0;
g->strt.nuse = 0;
g->strt.hash = NULL;
setnilvalue(registry(L));
luaZ_initbuffer(L, &g->buff);
g->panic = NULL;
g->gcstate = GCSpause;
g->rootgc = obj2gco(L);
g->sweepstrgc = 0;
g->sweepgc = &g->rootgc;
g->gray = NULL;
g->grayagain = NULL;
g->weak = NULL;
g->tmudata = NULL;
g->totalbytes = sizeof(LG);
g->gcpause = LUAI_GCPAUSE;
g->gcstepmul = LUAI_GCMUL;
g->gcdept = 0;
for (i=0; i<NUM_TAGS; i++) g->mt[i] = NULL;
if (luaD_rawrunprotected(L, f_luaopen, NULL) != 0) {
/* memory allocation error: free partial state */
close_state(L);
L = NULL;
}
else
luai_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) {
L = G(L)->mainthread; /* only the main thread can be closed */
lua_lock(L);
luaF_close(L, L->stack); /* close all upvalues for this thread */
luaC_separateudata(L, 1); /* 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 = L->baseCcalls = 0;
} while (luaD_rawrunprotected(L, callallgcTM, NULL) != 0);
lua_assert(G(L)->tmudata == NULL);
luai_userstateclose(L);
close_state(L);
}

169
src/lua/lstate.h
View File

@ -1,169 +0,0 @@
/*
** $Id: lstate.h,v 2.24.1.2 2008/01/03 15:20:39 roberto Exp $
** Global State
** See Copyright Notice in lua.h
*/
#ifndef lstate_h
#define lstate_h
#include "lua.h"
#include "lobject.h"
#include "ltm.h"
#include "lzio.h"
struct lua_longjmp; /* defined in ldo.c */
/* table of globals */
#define gt(L) (&L->l_gt)
/* registry */
#define registry(L) (&G(L)->l_registry)
/* extra stack space to handle TM calls and some other extras */
#define EXTRA_STACK 5
#define BASIC_CI_SIZE 8
#define BASIC_STACK_SIZE (2*LUA_MINSTACK)
typedef struct stringtable {
GCObject **hash;
lu_int32 nuse; /* number of elements */
int size;
} stringtable;
/*
** informations about a call
*/
typedef struct CallInfo {
StkId base; /* base for this function */
StkId func; /* function index in the stack */
StkId top; /* top for this function */
const Instruction *savedpc;
int nresults; /* expected number of results from this function */
int tailcalls; /* number of tail calls lost under this entry */
} CallInfo;
#define curr_func(L) (clvalue(L->ci->func))
#define ci_func(ci) (clvalue((ci)->func))
#define f_isLua(ci) (!ci_func(ci)->c.isC)
#define isLua(ci) (ttisfunction((ci)->func) && f_isLua(ci))
/*
** `global state', shared by all threads of this state
*/
typedef struct global_State {
stringtable strt; /* hash table for strings */
lua_Alloc frealloc; /* function to reallocate memory */
void *ud; /* auxiliary data to `frealloc' */
lu_byte currentwhite;
lu_byte gcstate; /* state of garbage collector */
int sweepstrgc; /* position of sweep in `strt' */
GCObject *rootgc; /* list of all collectable objects */
GCObject **sweepgc; /* position of sweep in `rootgc' */
GCObject *gray; /* list of gray objects */
GCObject *grayagain; /* list of objects to be traversed atomically */
GCObject *weak; /* list of weak tables (to be cleared) */
GCObject *tmudata; /* last element of list of userdata to be GC */
Mbuffer buff; /* temporary buffer for string concatentation */
lu_mem GCthreshold;
lu_mem totalbytes; /* number of bytes currently allocated */
lu_mem estimate; /* an estimate of number of bytes actually in use */
lu_mem gcdept; /* how much GC is `behind schedule' */
int gcpause; /* size of pause between successive GCs */
int gcstepmul; /* GC `granularity' */
lua_CFunction panic; /* to be called in unprotected errors */
TValue l_registry;
struct lua_State *mainthread;
UpVal uvhead; /* head of double-linked list of all open upvalues */
struct Table *mt[NUM_TAGS]; /* metatables for basic types */
TString *tmname[TM_N]; /* array with tag-method names */
} global_State;
/*
** `per thread' state
*/
struct lua_State {
CommonHeader;
lu_byte status;
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 */
const Instruction *savedpc; /* `savedpc' of current function */
StkId stack_last; /* last free slot in the stack */
StkId stack; /* stack base */
CallInfo *end_ci; /* points after end of ci array*/
CallInfo *base_ci; /* array of CallInfo's */
int stacksize;
int size_ci; /* size of array `base_ci' */
unsigned short nCcalls; /* number of nested C calls */
unsigned short baseCcalls; /* nested C calls when resuming coroutine */
lu_byte hookmask;
lu_byte allowhook;
int basehookcount;
int hookcount;
lua_Hook hook;
TValue l_gt; /* table of globals */
TValue env; /* temporary place for environments */
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
*/
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 */
};
/* macros to convert a GCObject into a specific value */
#define rawgco2ts(o) check_exp((o)->gch.tt == LUA_TSTRING, &((o)->ts))
#define gco2ts(o) (&rawgco2ts(o)->tsv)
#define rawgco2u(o) check_exp((o)->gch.tt == LUA_TUSERDATA, &((o)->u))
#define gco2u(o) (&rawgco2u(o)->uv)
#define gco2cl(o) check_exp((o)->gch.tt == LUA_TFUNCTION, &((o)->cl))
#define gco2h(o) check_exp((o)->gch.tt == LUA_TTABLE, &((o)->h))
#define gco2p(o) check_exp((o)->gch.tt == LUA_TPROTO, &((o)->p))
#define gco2uv(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 gco2th(o) check_exp((o)->gch.tt == LUA_TTHREAD, &((o)->th))
/* macro to convert any Lua object into a GCObject */
#define obj2gco(v) (cast(GCObject *, (v)))
LUAI_FUNC lua_State *luaE_newthread (lua_State *L);
LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1);
#endif

111
src/lua/lstring.c
View File

@ -1,111 +0,0 @@
/*
** $Id: lstring.c,v 2.8.1.1 2007/12/27 13:02:25 roberto Exp $
** String table (keeps all strings handled by Lua)
** See Copyright Notice in lua.h
*/
#include <string.h>
#define lstring_c
#define LUA_CORE
#include "lua.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
void luaS_resize (lua_State *L, int newsize) {
GCObject **newhash;
stringtable *tb;
int i;
if (G(L)->gcstate == GCSsweepstring)
return; /* cannot resize during GC traverse */
newhash = luaM_newvector(L, newsize, GCObject *);
tb = &G(L)->strt;
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 */
unsigned int h = gco2ts(p)->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;
}
static TString *newlstr (lua_State *L, const char *str, size_t l,
unsigned int h) {
TString *ts;
stringtable *tb;
if (l+1 > (MAX_SIZET - sizeof(TString))/sizeof(char))
luaM_toobig(L);
ts = cast(TString *, luaM_malloc(L, (l+1)*sizeof(char)+sizeof(TString)));
ts->tsv.len = l;
ts->tsv.hash = h;
ts->tsv.marked = luaC_white(G(L));
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] = obj2gco(ts);
tb->nuse++;
if (tb->nuse > cast(lu_int32, tb->size) && tb->size <= MAX_INT/2)
luaS_resize(L, tb->size*2); /* too crowded */
return ts;
}
TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
GCObject *o;
unsigned int h = cast(unsigned int, 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)+cast(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 = rawgco2ts(o);
if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0)) {
/* string may be dead */
if (isdead(G(L), o)) changewhite(o);
return ts;
}
}
return newlstr(L, str, l, h); /* not found */
}
Udata *luaS_newudata (lua_State *L, size_t s, Table *e) {
Udata *u;
if (s > MAX_SIZET - sizeof(Udata))
luaM_toobig(L);
u = cast(Udata *, luaM_malloc(L, s + sizeof(Udata)));
u->uv.marked = luaC_white(G(L)); /* is not finalized */
u->uv.tt = LUA_TUSERDATA;
u->uv.len = s;
u->uv.metatable = NULL;
u->uv.env = e;
/* chain it on udata list (after main thread) */
u->uv.next = G(L)->mainthread->next;
G(L)->mainthread->next = obj2gco(u);
return u;
}

31
src/lua/lstring.h
View File

@ -1,31 +0,0 @@
/*
** $Id: lstring.h,v 1.43.1.1 2007/12/27 13:02:25 roberto Exp $
** String table (keep all strings handled by Lua)
** See Copyright Notice in lua.h
*/
#ifndef lstring_h
#define lstring_h
#include "lgc.h"
#include "lobject.h"
#include "lstate.h"
#define sizestring(s) (sizeof(union TString)+((s)->len+1)*sizeof(char))
#define sizeudata(u) (sizeof(union Udata)+(u)->len)
#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) l_setbit((s)->tsv.marked, FIXEDBIT)
LUAI_FUNC void luaS_resize (lua_State *L, int newsize);
LUAI_FUNC Udata *luaS_newudata (lua_State *L, size_t s, Table *e);
LUAI_FUNC TString *luaS_newlstr (lua_State *L, const char *str, size_t l);
#endif

871
src/lua/lstrlib.c
View File

@ -1,871 +0,0 @@
/*
** $Id: lstrlib.c,v 1.132.1.5 2010/05/14 15:34:19 roberto Exp $
** Standard library for string operations and pattern-matching
** See Copyright Notice in lua.h
*/
#include <ctype.h>
#include <stddef.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define lstrlib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
/* macro to `unsign' a character */
#define uchar(c) ((unsigned char)(c))
static int str_len (lua_State *L) {
size_t l;
luaL_checklstring(L, 1, &l);
lua_pushinteger(L, l);
return 1;
}
static ptrdiff_t posrelat (ptrdiff_t pos, size_t len) {
/* relative string position: negative means back from end */
if (pos < 0) pos += (ptrdiff_t)len + 1;
return (pos >= 0) ? pos : 0;
}
static int str_sub (lua_State *L) {
size_t l;
const char *s = luaL_checklstring(L, 1, &l);
ptrdiff_t start = posrelat(luaL_checkinteger(L, 2), l);
ptrdiff_t end = posrelat(luaL_optinteger(L, 3, -1), l);
if (start < 1) start = 1;
if (end > (ptrdiff_t)l) end = (ptrdiff_t)l;
if (start <= end)
lua_pushlstring(L, s+start-1, end-start+1);
else lua_pushliteral(L, "");
return 1;
}
static int str_reverse (lua_State *L) {
size_t l;
luaL_Buffer b;
const char *s = luaL_checklstring(L, 1, &l);
luaL_buffinit(L, &b);
while (l--) luaL_addchar(&b, s[l]);
luaL_pushresult(&b);
return 1;
}
static int str_lower (lua_State *L) {
size_t l;
size_t i;
luaL_Buffer b;
const char *s = luaL_checklstring(L, 1, &l);
luaL_buffinit(L, &b);
for (i=0; i<l; i++)
luaL_addchar(&b, tolower(uchar(s[i])));
luaL_pushresult(&b);
return 1;
}
static int str_upper (lua_State *L) {
size_t l;
size_t i;
luaL_Buffer b;
const char *s = luaL_checklstring(L, 1, &l);
luaL_buffinit(L, &b);
for (i=0; i<l; i++)
luaL_addchar(&b, toupper(uchar(s[i])));
luaL_pushresult(&b);
return 1;
}
static int str_rep (lua_State *L) {
size_t l;
luaL_Buffer b;
const char *s = luaL_checklstring(L, 1, &l);
int n = luaL_checkint(L, 2);
luaL_buffinit(L, &b);
while (n-- > 0)
luaL_addlstring(&b, s, l);
luaL_pushresult(&b);
return 1;
}
static int str_byte (lua_State *L) {
size_t l;
const char *s = luaL_checklstring(L, 1, &l);
ptrdiff_t posi = posrelat(luaL_optinteger(L, 2, 1), l);
ptrdiff_t pose = posrelat(luaL_optinteger(L, 3, posi), l);
int n, i;
if (posi <= 0) posi = 1;
if ((size_t)pose > l) pose = l;
if (posi > pose) return 0; /* empty interval; return no values */
n = (int)(pose - posi + 1);
if (posi + n <= pose) /* overflow? */
luaL_error(L, "string slice too long");
luaL_checkstack(L, n, "string slice too long");
for (i=0; i<n; i++)
lua_pushinteger(L, uchar(s[posi+i-1]));
return n;
}
static int str_char (lua_State *L) {
int n = lua_gettop(L); /* number of arguments */
int i;
luaL_Buffer b;
luaL_buffinit(L, &b);
for (i=1; i<=n; i++) {
int c = luaL_checkint(L, i);
luaL_argcheck(L, uchar(c) == c, i, "invalid value");
luaL_addchar(&b, uchar(c));
}
luaL_pushresult(&b);
return 1;
}
static int writer (lua_State *L, const void* b, size_t size, void* B) {
(void)L;
luaL_addlstring((luaL_Buffer*) B, (const char *)b, size);
return 0;
}
static int str_dump (lua_State *L) {
luaL_Buffer b;
luaL_checktype(L, 1, LUA_TFUNCTION);
lua_settop(L, 1);
luaL_buffinit(L,&b);
if (lua_dump(L, writer, &b) != 0)
luaL_error(L, "unable to dump given function");
luaL_pushresult(&b);
return 1;
}
/*
** {======================================================
** PATTERN MATCHING
** =======================================================
*/
#define CAP_UNFINISHED (-1)
#define CAP_POSITION (-2)
typedef struct MatchState {
const char *src_init; /* init of source string */
const char *src_end; /* end (`\0') of source string */
lua_State *L;
int level; /* total number of captures (finished or unfinished) */
struct {
const char *init;
ptrdiff_t len;
} capture[LUA_MAXCAPTURES];
} MatchState;
#define L_ESC '%'
#define SPECIALS "^$*+?.([%-"
static int check_capture (MatchState *ms, int l) {
l -= '1';
if (l < 0 || l >= ms->level || ms->capture[l].len == CAP_UNFINISHED)
return luaL_error(ms->L, "invalid capture index");
return l;
}
static int capture_to_close (MatchState *ms) {
int level = ms->level;
for (level--; level>=0; level--)
if (ms->capture[level].len == CAP_UNFINISHED) return level;
return luaL_error(ms->L, "invalid pattern capture");
}
static const char *classend (MatchState *ms, const char *p) {
switch (*p++) {
case L_ESC: {
if (*p == '\0')
luaL_error(ms->L, "malformed pattern (ends with " LUA_QL("%%") ")");
return p+1;
}
case '[': {
if (*p == '^') p++;
do { /* look for a `]' */
if (*p == '\0')
luaL_error(ms->L, "malformed pattern (missing " LUA_QL("]") ")");
if (*(p++) == L_ESC && *p != '\0')
p++; /* skip escapes (e.g. `%]') */
} while (*p != ']');
return p+1;
}
default: {
return p;
}
}
}
static int match_class (int c, int cl) {
int res;
switch (tolower(cl)) {
case 'a' : res = isalpha(c); break;
case 'c' : res = iscntrl(c); break;
case 'd' : res = isdigit(c); break;
case 'l' : res = islower(c); break;
case 'p' : res = ispunct(c); break;
case 's' : res = isspace(c); break;
case 'u' : res = isupper(c); break;
case 'w' : res = isalnum(c); break;
case 'x' : res = isxdigit(c); break;
case 'z' : res = (c == 0); break;
default: return (cl == c);
}
return (islower(cl) ? res : !res);
}
static int matchbracketclass (int c, const char *p, const char *ec) {
int sig = 1;
if (*(p+1) == '^') {
sig = 0;
p++; /* skip the `^' */
}
while (++p < ec) {
if (*p == L_ESC) {
p++;
if (match_class(c, uchar(*p)))
return sig;
}
else if ((*(p+1) == '-') && (p+2 < ec)) {
p+=2;
if (uchar(*(p-2)) <= c && c <= uchar(*p))
return sig;
}
else if (uchar(*p) == c) return sig;
}
return !sig;
}
static int singlematch (int c, const char *p, const char *ep) {
switch (*p) {
case '.': return 1; /* matches any char */
case L_ESC: return match_class(c, uchar(*(p+1)));
case '[': return matchbracketclass(c, p, ep-1);
default: return (uchar(*p) == c);
}
}
static const char *match (MatchState *ms, const char *s, const char *p);
static const char *matchbalance (MatchState *ms, const char *s,
const char *p) {
if (*p == 0 || *(p+1) == 0)
luaL_error(ms->L, "unbalanced pattern");
if (*s != *p) return NULL;
else {
int b = *p;
int e = *(p+1);
int cont = 1;
while (++s < ms->src_end) {
if (*s == e) {
if (--cont == 0) return s+1;
}
else if (*s == b) cont++;
}
}
return NULL; /* string ends out of balance */
}
static const char *max_expand (MatchState *ms, const char *s,
const char *p, const char *ep) {
ptrdiff_t i = 0; /* counts maximum expand for item */
while ((s+i)<ms->src_end && singlematch(uchar(*(s+i)), p, ep))
i++;
/* keeps trying to match with the maximum repetitions */
while (i>=0) {
const char *res = match(ms, (s+i), ep+1);
if (res) return res;
i--; /* else didn't match; reduce 1 repetition to try again */
}
return NULL;
}
static const char *min_expand (MatchState *ms, const char *s,
const char *p, const char *ep) {
for (;;) {
const char *res = match(ms, s, ep+1);
if (res != NULL)
return res;
else if (s<ms->src_end && singlematch(uchar(*s), p, ep))
s++; /* try with one more repetition */
else return NULL;
}
}
static const char *start_capture (MatchState *ms, const char *s,
const char *p, int what) {
const char *res;
int level = ms->level;
if (level >= LUA_MAXCAPTURES) luaL_error(ms->L, "too many captures");
ms->capture[level].init = s;
ms->capture[level].len = what;
ms->level = level+1;
if ((res=match(ms, s, p)) == NULL) /* match failed? */
ms->level--; /* undo capture */
return res;
}
static const char *end_capture (MatchState *ms, const char *s,
const char *p) {
int l = capture_to_close(ms);
const char *res;
ms->capture[l].len = s - ms->capture[l].init; /* close capture */
if ((res = match(ms, s, p)) == NULL) /* match failed? */
ms->capture[l].len = CAP_UNFINISHED; /* undo capture */
return res;
}
static const char *match_capture (MatchState *ms, const char *s, int l) {
size_t len;
l = check_capture(ms, l);
len = ms->capture[l].len;
if ((size_t)(ms->src_end-s) >= len &&
memcmp(ms->capture[l].init, s, len) == 0)
return s+len;
else return NULL;
}
static const char *match (MatchState *ms, const char *s, const char *p) {
init: /* using goto's to optimize tail recursion */
switch (*p) {
case '(': { /* start capture */
if (*(p+1) == ')') /* position capture? */
return start_capture(ms, s, p+2, CAP_POSITION);
else
return start_capture(ms, s, p+1, CAP_UNFINISHED);
}
case ')': { /* end capture */
return end_capture(ms, s, p+1);
}
case L_ESC: {
switch (*(p+1)) {
case 'b': { /* balanced string? */
s = matchbalance(ms, s, p+2);
if (s == NULL) return NULL;
p+=4; goto init; /* else return match(ms, s, p+4); */
}
case 'f': { /* frontier? */
const char *ep; char previous;
p += 2;
if (*p != '[')
luaL_error(ms->L, "missing " LUA_QL("[") " after "
LUA_QL("%%f") " in pattern");
ep = classend(ms, p); /* points to what is next */
previous = (s == ms->src_init) ? '\0' : *(s-1);
if (matchbracketclass(uchar(previous), p, ep-1) ||
!matchbracketclass(uchar(*s), p, ep-1)) return NULL;
p=ep; goto init; /* else return match(ms, s, ep); */
}
default: {
if (isdigit(uchar(*(p+1)))) { /* capture results (%0-%9)? */
s = match_capture(ms, s, uchar(*(p+1)));
if (s == NULL) return NULL;
p+=2; goto init; /* else return match(ms, s, p+2) */
}
goto dflt; /* case default */
}
}
}
case '\0': { /* end of pattern */
return s; /* match succeeded */
}
case '$': {
if (*(p+1) == '\0') /* is the `$' the last char in pattern? */
return (s == ms->src_end) ? s : NULL; /* check end of string */
else goto dflt;
}
default: dflt: { /* it is a pattern item */
const char *ep = classend(ms, p); /* points to what is next */
int m = s<ms->src_end && singlematch(uchar(*s), p, ep);
switch (*ep) {
case '?': { /* optional */
const char *res;
if (m && ((res=match(ms, s+1, ep+1)) != NULL))
return res;
p=ep+1; goto init; /* else return match(ms, s, ep+1); */
}
case '*': { /* 0 or more repetitions */
return max_expand(ms, s, p, ep);
}
case '+': { /* 1 or more repetitions */
return (m ? max_expand(ms, s+1, p, ep) : NULL);
}
case '-': { /* 0 or more repetitions (minimum) */
return min_expand(ms, s, p, ep);
}
default: {
if (!m) return NULL;
s++; p=ep; goto init; /* else return match(ms, s+1, ep); */
}
}
}
}
}
static const char *lmemfind (const char *s1, size_t l1,
const char *s2, size_t l2) {
if (l2 == 0) return s1; /* empty strings are everywhere */
else if (l2 > l1) return NULL; /* avoids a negative `l1' */
else {
const char *init; /* to search for a `*s2' inside `s1' */
l2--; /* 1st char will be checked by `memchr' */
l1 = l1-l2; /* `s2' cannot be found after that */
while (l1 > 0 && (init = (const char *)memchr(s1, *s2, l1)) != NULL) {
init++; /* 1st char is already checked */
if (memcmp(init, s2+1, l2) == 0)
return init-1;
else { /* correct `l1' and `s1' to try again */
l1 -= init-s1;
s1 = init;
}
}
return NULL; /* not found */
}
}
static void push_onecapture (MatchState *ms, int i, const char *s,
const char *e) {
if (i >= ms->level) {
if (i == 0) /* ms->level == 0, too */
lua_pushlstring(ms->L, s, e - s); /* add whole match */
else
luaL_error(ms->L, "invalid capture index");
}
else {
ptrdiff_t l = ms->capture[i].len;
if (l == CAP_UNFINISHED) luaL_error(ms->L, "unfinished capture");
if (l == CAP_POSITION)
lua_pushinteger(ms->L, ms->capture[i].init - ms->src_init + 1);
else
lua_pushlstring(ms->L, ms->capture[i].init, l);
}
}
static int push_captures (MatchState *ms, const char *s, const char *e) {
int i;
int nlevels = (ms->level == 0 && s) ? 1 : ms->level;
luaL_checkstack(ms->L, nlevels, "too many captures");
for (i = 0; i < nlevels; i++)
push_onecapture(ms, i, s, e);
return nlevels; /* number of strings pushed */
}
static int str_find_aux (lua_State *L, int find) {
size_t l1, l2;
const char *s = luaL_checklstring(L, 1, &l1);
const char *p = luaL_checklstring(L, 2, &l2);
ptrdiff_t init = posrelat(luaL_optinteger(L, 3, 1), l1) - 1;
if (init < 0) init = 0;
else if ((size_t)(init) > l1) init = (ptrdiff_t)l1;
if (find && (lua_toboolean(L, 4) || /* explicit request? */
strpbrk(p, SPECIALS) == NULL)) { /* or no special characters? */
/* do a plain search */
const char *s2 = lmemfind(s+init, l1-init, p, l2);
if (s2) {
lua_pushinteger(L, s2-s+1);
lua_pushinteger(L, s2-s+l2);
return 2;
}
}
else {
MatchState ms;
int anchor = (*p == '^') ? (p++, 1) : 0;
const char *s1=s+init;
ms.L = L;
ms.src_init = s;
ms.src_end = s+l1;
do {
const char *res;
ms.level = 0;
if ((res=match(&ms, s1, p)) != NULL) {
if (find) {
lua_pushinteger(L, s1-s+1); /* start */
lua_pushinteger(L, res-s); /* end */
return push_captures(&ms, NULL, 0) + 2;
}
else
return push_captures(&ms, s1, res);
}
} while (s1++ < ms.src_end && !anchor);
}
lua_pushnil(L); /* not found */
return 1;
}
static int str_find (lua_State *L) {
return str_find_aux(L, 1);
}
static int str_match (lua_State *L) {
return str_find_aux(L, 0);
}
static int gmatch_aux (lua_State *L) {
MatchState ms;
size_t ls;
const char *s = lua_tolstring(L, lua_upvalueindex(1), &ls);
const char *p = lua_tostring(L, lua_upvalueindex(2));
const char *src;
ms.L = L;
ms.src_init = s;
ms.src_end = s+ls;
for (src = s + (size_t)lua_tointeger(L, lua_upvalueindex(3));
src <= ms.src_end;
src++) {
const char *e;
ms.level = 0;
if ((e = match(&ms, src, p)) != NULL) {
lua_Integer newstart = e-s;
if (e == src) newstart++; /* empty match? go at least one position */
lua_pushinteger(L, newstart);
lua_replace(L, lua_upvalueindex(3));
return push_captures(&ms, src, e);
}
}
return 0; /* not found */
}
static int gmatch (lua_State *L) {
luaL_checkstring(L, 1);
luaL_checkstring(L, 2);
lua_settop(L, 2);
lua_pushinteger(L, 0);
lua_pushcclosure(L, gmatch_aux, 3);
return 1;
}
static int gfind_nodef (lua_State *L) {
return luaL_error(L, LUA_QL("string.gfind") " was renamed to "
LUA_QL("string.gmatch"));
}
static void add_s (MatchState *ms, luaL_Buffer *b, const char *s,
const char *e) {
size_t l, i;
const char *news = lua_tolstring(ms->L, 3, &l);
for (i = 0; i < l; i++) {
if (news[i] != L_ESC)
luaL_addchar(b, news[i]);
else {
i++; /* skip ESC */
if (!isdigit(uchar(news[i])))
luaL_addchar(b, news[i]);
else if (news[i] == '0')
luaL_addlstring(b, s, e - s);
else {
push_onecapture(ms, news[i] - '1', s, e);
luaL_addvalue(b); /* add capture to accumulated result */
}
}
}
}
static void add_value (MatchState *ms, luaL_Buffer *b, const char *s,
const char *e) {
lua_State *L = ms->L;
switch (lua_type(L, 3)) {
case LUA_TNUMBER:
case LUA_TSTRING: {
add_s(ms, b, s, e);
return;
}
case LUA_TFUNCTION: {
int n;
lua_pushvalue(L, 3);
n = push_captures(ms, s, e);
lua_call(L, n, 1);
break;
}
case LUA_TTABLE: {
push_onecapture(ms, 0, s, e);
lua_gettable(L, 3);
break;
}
}
if (!lua_toboolean(L, -1)) { /* nil or false? */
lua_pop(L, 1);
lua_pushlstring(L, s, e - s); /* keep original text */
}
else if (!lua_isstring(L, -1))
luaL_error(L, "invalid replacement value (a %s)", luaL_typename(L, -1));
luaL_addvalue(b); /* add result to accumulator */
}
static int str_gsub (lua_State *L) {
size_t srcl;
const char *src = luaL_checklstring(L, 1, &srcl);
const char *p = luaL_checkstring(L, 2);
int tr = lua_type(L, 3);
int max_s = luaL_optint(L, 4, srcl+1);
int anchor = (*p == '^') ? (p++, 1) : 0;
int n = 0;
MatchState ms;
luaL_Buffer b;
luaL_argcheck(L, tr == LUA_TNUMBER || tr == LUA_TSTRING ||
tr == LUA_TFUNCTION || tr == LUA_TTABLE, 3,
"string/function/table expected");
luaL_buffinit(L, &b);
ms.L = L;
ms.src_init = src;
ms.src_end = src+srcl;
while (n < max_s) {
const char *e;
ms.level = 0;
e = match(&ms, src, p);
if (e) {
n++;
add_value(&ms, &b, src, e);
}
if (e && e>src) /* non empty match? */
src = e; /* skip it */
else if (src < ms.src_end)
luaL_addchar(&b, *src++);
else break;
if (anchor) break;
}
luaL_addlstring(&b, src, ms.src_end-src);
luaL_pushresult(&b);
lua_pushinteger(L, n); /* number of substitutions */
return 2;
}
/* }====================================================== */
/* maximum size of each formatted item (> len(format('%99.99f', -1e308))) */
#define MAX_ITEM 512
/* valid flags in a format specification */
#define FLAGS "-+ #0"
/*
** maximum size of each format specification (such as '%-099.99d')
** (+10 accounts for %99.99x plus margin of error)
*/
#define MAX_FORMAT (sizeof(FLAGS) + sizeof(LUA_INTFRMLEN) + 10)
static void addquoted (lua_State *L, luaL_Buffer *b, int arg) {
size_t l;
const char *s = luaL_checklstring(L, arg, &l);
luaL_addchar(b, '"');
while (l--) {
switch (*s) {
case '"': case '\\': case '\n': {
luaL_addchar(b, '\\');
luaL_addchar(b, *s);
break;
}
case '\r': {
luaL_addlstring(b, "\\r", 2);
break;
}
case '\0': {
luaL_addlstring(b, "\\000", 4);
break;
}
default: {
luaL_addchar(b, *s);
break;
}
}
s++;
}
luaL_addchar(b, '"');
}
static const char *scanformat (lua_State *L, const char *strfrmt, char *form) {
const char *p = strfrmt;
while (*p != '\0' && strchr(FLAGS, *p) != NULL) p++; /* skip flags */
if ((size_t)(p - strfrmt) >= sizeof(FLAGS))
luaL_error(L, "invalid format (repeated flags)");
if (isdigit(uchar(*p))) p++; /* skip width */
if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
if (*p == '.') {
p++;
if (isdigit(uchar(*p))) p++; /* skip precision */
if (isdigit(uchar(*p))) p++; /* (2 digits at most) */
}
if (isdigit(uchar(*p)))
luaL_error(L, "invalid format (width or precision too long)");
*(form++) = '%';
strncpy(form, strfrmt, p - strfrmt + 1);
form += p - strfrmt + 1;
*form = '\0';
return p;
}
static void addintlen (char *form) {
size_t l = strlen(form);
char spec = form[l - 1];
strcpy(form + l - 1, LUA_INTFRMLEN);
form[l + sizeof(LUA_INTFRMLEN) - 2] = spec;
form[l + sizeof(LUA_INTFRMLEN) - 1] = '\0';
}
static int str_format (lua_State *L) {
int top = lua_gettop(L);
int arg = 1;
size_t sfl;
const char *strfrmt = luaL_checklstring(L, arg, &sfl);
const char *strfrmt_end = strfrmt+sfl;
luaL_Buffer b;
luaL_buffinit(L, &b);
while (strfrmt < strfrmt_end) {
if (*strfrmt != L_ESC)
luaL_addchar(&b, *strfrmt++);
else if (*++strfrmt == L_ESC)
luaL_addchar(&b, *strfrmt++); /* %% */
else { /* format item */
char form[MAX_FORMAT]; /* to store the format (`%...') */
char buff[MAX_ITEM]; /* to store the formatted item */
if (++arg > top)
luaL_argerror(L, arg, "no value");
strfrmt = scanformat(L, strfrmt, form);
switch (*strfrmt++) {
case 'c': {
sprintf(buff, form, (int)luaL_checknumber(L, arg));
break;
}
case 'd': case 'i': {
addintlen(form);
sprintf(buff, form, (LUA_INTFRM_T)luaL_checknumber(L, arg));
break;
}
case 'o': case 'u': case 'x': case 'X': {
addintlen(form);
sprintf(buff, form, (unsigned LUA_INTFRM_T)luaL_checknumber(L, arg));
break;
}
case 'e': case 'E': case 'f':
case 'g': case 'G': {
sprintf(buff, form, (double)luaL_checknumber(L, arg));
break;
}
case 'q': {
addquoted(L, &b, arg);
continue; /* skip the 'addsize' at the end */
}
case 's': {
size_t l;
const char *s = luaL_checklstring(L, arg, &l);
if (!strchr(form, '.') && l >= 100) {
/* no precision and string is too long to be formatted;
keep original string */
lua_pushvalue(L, arg);
luaL_addvalue(&b);
continue; /* skip the `addsize' at the end */
}
else {
sprintf(buff, form, s);
break;
}
}
default: { /* also treat cases `pnLlh' */
return luaL_error(L, "invalid option " LUA_QL("%%%c") " to "
LUA_QL("format"), *(strfrmt - 1));
}
}
luaL_addlstring(&b, buff, strlen(buff));
}
}
luaL_pushresult(&b);
return 1;
}
static const luaL_Reg strlib[] = {
{"byte", str_byte},
{"char", str_char},
{"dump", str_dump},
{"find", str_find},
{"format", str_format},
{"gfind", gfind_nodef},
{"gmatch", gmatch},
{"gsub", str_gsub},
{"len", str_len},
{"lower", str_lower},
{"match", str_match},
{"rep", str_rep},
{"reverse", str_reverse},
{"sub", str_sub},
{"upper", str_upper},
{NULL, NULL}
};
static void createmetatable (lua_State *L) {
lua_createtable(L, 0, 1); /* create metatable for strings */
lua_pushliteral(L, ""); /* dummy string */
lua_pushvalue(L, -2);
lua_setmetatable(L, -2); /* set string metatable */
lua_pop(L, 1); /* pop dummy string */
lua_pushvalue(L, -2); /* string library... */
lua_setfield(L, -2, "__index"); /* ...is the __index metamethod */
lua_pop(L, 1); /* pop metatable */
}
/*
** Open string library
*/
LUALIB_API int luaopen_string (lua_State *L) {
luaL_register(L, LUA_STRLIBNAME, strlib);
#if defined(LUA_COMPAT_GFIND)
lua_getfield(L, -1, "gmatch");
lua_setfield(L, -2, "gfind");
#endif
createmetatable(L);
return 1;
}

588
src/lua/ltable.c
View File

@ -1,588 +0,0 @@
/*
** $Id: ltable.c,v 2.32.1.2 2007/12/28 15:32:23 roberto Exp $
** Lua tables (hash)
** See Copyright Notice in lua.h
*/
/*
** Implementation of tables (aka arrays, objects, or hash tables).
** Tables keep its elements in two parts: an array part and a hash part.
** Non-negative integer keys are all candidates to be kept in the array
** part. The actual size of the array is the largest `n' such that at
** least half the slots between 0 and n are in use.
** Hash uses a mix of chained scatter table with Brent's variation.
** A main invariant of these tables is that, if an element is not
** in its main position (i.e. the `original' position that its hash gives
** to it), then the colliding element is in its own main position.
** Hence even when the load factor reaches 100%, performance remains good.
*/
#include <math.h>
#include <string.h>
#define ltable_c
#define LUA_CORE
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lgc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstate.h"
#include "ltable.h"
/*
** max size of array part is 2^MAXBITS
*/
#if LUAI_BITSINT > 26
#define MAXBITS 26
#else
#define MAXBITS (LUAI_BITSINT-2)
#endif
#define MAXASIZE (1 << MAXBITS)
#define hashpow2(t,n) (gnode(t, lmod((n), sizenode(t))))
#define hashstr(t,str) hashpow2(t, (str)->tsv.hash)
#define hashboolean(t,p) hashpow2(t, p)
/*
** for some types, it is better to avoid modulus by power of 2, as
** they tend to have many 2 factors.
*/
#define hashmod(t,n) (gnode(t, ((n) % ((sizenode(t)-1)|1))))
#define hashpointer(t,p) hashmod(t, IntPoint(p))
/*
** number of ints inside a lua_Number
*/
#define numints cast_int(sizeof(lua_Number)/sizeof(int))
#define dummynode (&dummynode_)
static const Node dummynode_ = {
{{NULL}, LUA_TNIL}, /* value */
{{{NULL}, LUA_TNIL, NULL}} /* key */
};
/*
** hash for lua_Numbers
*/
static Node *hashnum (const Table *t, lua_Number n) {
unsigned int a[numints];
int i;
if (luai_numeq(n, 0)) /* avoid problems with -0 */
return gnode(t, 0);
memcpy(a, &n, sizeof(a));
for (i = 1; i < numints; i++) a[0] += a[i];
return hashmod(t, a[0]);
}
/*
** returns the `main' position of an element in a table (that is, the index
** of its hash value)
*/
static Node *mainposition (const Table *t, const TValue *key) {
switch (ttype(key)) {
case LUA_TNUMBER:
return hashnum(t, nvalue(key));
case LUA_TSTRING:
return hashstr(t, rawtsvalue(key));
case LUA_TBOOLEAN:
return hashboolean(t, bvalue(key));
case LUA_TLIGHTUSERDATA:
return hashpointer(t, pvalue(key));
default:
return hashpointer(t, gcvalue(key));
}
}
/*
** returns the index for `key' if `key' is an appropriate key to live in
** the array part of the table, -1 otherwise.
*/
static int arrayindex (const TValue *key) {
if (ttisnumber(key)) {
lua_Number n = nvalue(key);
int k;
lua_number2int(k, n);
if (luai_numeq(cast_num(k), n))
return k;
}
return -1; /* `key' did not match some condition */
}
/*
** returns the index of a `key' for table traversals. First goes all
** elements in the array part, then elements in the hash part. The
** beginning of a traversal is signalled by -1.
*/
static int findindex (lua_State *L, Table *t, StkId key) {
int i;
if (ttisnil(key)) return -1; /* first iteration */
i = arrayindex(key);
if (0 < i && i <= t->sizearray) /* is `key' inside array part? */
return i-1; /* yes; that's the index (corrected to C) */
else {
Node *n = mainposition(t, key);
do { /* check whether `key' is somewhere in the chain */
/* key may be dead already, but it is ok to use it in `next' */
if (luaO_rawequalObj(key2tval(n), key) ||
(ttype(gkey(n)) == LUA_TDEADKEY && iscollectable(key) &&
gcvalue(gkey(n)) == gcvalue(key))) {
i = cast_int(n - gnode(t, 0)); /* key index in hash table */
/* hash elements are numbered after array ones */
return i + t->sizearray;
}
else n = gnext(n);
} while (n);
luaG_runerror(L, "invalid key to " LUA_QL("next")); /* key not found */
return 0; /* to avoid warnings */
}
}
int luaH_next (lua_State *L, Table *t, StkId key) {
int i = findindex(L, t, key); /* find original element */
for (i++; i < t->sizearray; i++) { /* try first array part */
if (!ttisnil(&t->array[i])) { /* a non-nil value? */
setnvalue(key, cast_num(i+1));
setobj2s(L, key+1, &t->array[i]);
return 1;
}
}
for (i -= t->sizearray; i < sizenode(t); i++) { /* then hash part */
if (!ttisnil(gval(gnode(t, i)))) { /* a non-nil value? */
setobj2s(L, key, key2tval(gnode(t, i)));
setobj2s(L, key+1, gval(gnode(t, i)));
return 1;
}
}
return 0; /* no more elements */
}
/*
** {=============================================================
** Rehash
** ==============================================================
*/
static int computesizes (int nums[], int *narray) {
int i;
int twotoi; /* 2^i */
int a = 0; /* number of elements smaller than 2^i */
int na = 0; /* number of elements to go to array part */
int n = 0; /* optimal size for array part */
for (i = 0, twotoi = 1; twotoi/2 < *narray; i++, twotoi *= 2) {
if (nums[i] > 0) {
a += nums[i];
if (a > twotoi/2) { /* more than half elements present? */
n = twotoi; /* optimal size (till now) */
na = a; /* all elements smaller than n will go to array part */
}
}
if (a == *narray) break; /* all elements already counted */
}
*narray = n;
lua_assert(*narray/2 <= na && na <= *narray);
return na;
}
static int countint (const TValue *key, int *nums) {
int k = arrayindex(key);
if (0 < k && k <= MAXASIZE) { /* is `key' an appropriate array index? */
nums[ceillog2(k)]++; /* count as such */
return 1;
}
else
return 0;
}
static int numusearray (const Table *t, int *nums) {
int lg;
int ttlg; /* 2^lg */
int ause = 0; /* summation of `nums' */
int i = 1; /* count to traverse all array keys */
for (lg=0, ttlg=1; lg<=MAXBITS; lg++, ttlg*=2) { /* for each slice */
int lc = 0; /* counter */
int lim = ttlg;
if (lim > t->sizearray) {
lim = t->sizearray; /* adjust upper limit */
if (i > lim)
break; /* no more elements to count */
}
/* count elements in range (2^(lg-1), 2^lg] */
for (; i <= lim; i++) {
if (!ttisnil(&t->array[i-1]))
lc++;
}
nums[lg] += lc;
ause += lc;
}
return ause;
}
static int numusehash (const Table *t, int *nums, int *pnasize) {
int totaluse = 0; /* total number of elements */
int ause = 0; /* summation of `nums' */
int i = sizenode(t);
while (i--) {
Node *n = &t->node[i];
if (!ttisnil(gval(n))) {
ause += countint(key2tval(n), nums);
totaluse++;
}
}
*pnasize += ause;
return totaluse;
}
static void setarrayvector (lua_State *L, Table *t, int size) {
int i;
luaM_reallocvector(L, t->array, t->sizearray, size, TValue);
for (i=t->sizearray; i<size; i++)
setnilvalue(&t->array[i]);
t->sizearray = size;
}
static void setnodevector (lua_State *L, Table *t, int size) {
int lsize;
if (size == 0) { /* no elements to hash part? */
t->node = cast(Node *, dummynode); /* use common `dummynode' */
lsize = 0;
}
else {
int i;
lsize = ceillog2(size);
if (lsize > MAXBITS)
luaG_runerror(L, "table overflow");
size = twoto(lsize);
t->node = luaM_newvector(L, size, Node);
for (i=0; i<size; i++) {
Node *n = gnode(t, i);
gnext(n) = NULL;
setnilvalue(gkey(n));
setnilvalue(gval(n));
}
}
t->lsizenode = cast_byte(lsize);
t->lastfree = gnode(t, size); /* all positions are free */
}
static void resize (lua_State *L, Table *t, int nasize, int nhsize) {
int i;
int oldasize = t->sizearray;
int oldhsize = t->lsizenode;
Node *nold = t->node; /* save old hash ... */
if (nasize > oldasize) /* array part must grow? */
setarrayvector(L, t, nasize);
/* create new hash part with appropriate size */
setnodevector(L, t, nhsize);
if (nasize < oldasize) { /* array part must shrink? */
t->sizearray = nasize;
/* re-insert elements from vanishing slice */
for (i=nasize; i<oldasize; i++) {
if (!ttisnil(&t->array[i]))
setobjt2t(L, luaH_setnum(L, t, i+1), &t->array[i]);
}
/* shrink array */
luaM_reallocvector(L, t->array, oldasize, nasize, TValue);
}
/* re-insert elements from hash part */
for (i = twoto(oldhsize) - 1; i >= 0; i--) {
Node *old = nold+i;
if (!ttisnil(gval(old)))
setobjt2t(L, luaH_set(L, t, key2tval(old)), gval(old));
}
if (nold != dummynode)
luaM_freearray(L, nold, twoto(oldhsize), Node); /* free old array */
}
void luaH_resizearray (lua_State *L, Table *t, int nasize) {
int nsize = (t->node == dummynode) ? 0 : sizenode(t);
resize(L, t, nasize, nsize);
}
static void rehash (lua_State *L, Table *t, const TValue *ek) {
int nasize, na;
int nums[MAXBITS+1]; /* nums[i] = number of keys between 2^(i-1) and 2^i */
int i;
int totaluse;
for (i=0; i<=MAXBITS; i++) nums[i] = 0; /* reset counts */
nasize = numusearray(t, nums); /* count keys in array part */
totaluse = nasize; /* all those keys are integer keys */
totaluse += numusehash(t, nums, &nasize); /* count keys in hash part */
/* count extra key */
nasize += countint(ek, nums);
totaluse++;
/* compute new size for array part */
na = computesizes(nums, &nasize);
/* resize the table to new computed sizes */
resize(L, t, nasize, totaluse - na);
}
/*
** }=============================================================
*/
Table *luaH_new (lua_State *L, int narray, int nhash) {
Table *t = luaM_new(L, Table);
luaC_link(L, obj2gco(t), LUA_TTABLE);
t->metatable = NULL;
t->flags = cast_byte(~0);
/* temporary values (kept only if some malloc fails) */
t->array = NULL;
t->sizearray = 0;
t->lsizenode = 0;
t->node = cast(Node *, dummynode);
setarrayvector(L, t, narray);
setnodevector(L, t, nhash);
return t;
}
void luaH_free (lua_State *L, Table *t) {
if (t->node != dummynode)
luaM_freearray(L, t->node, sizenode(t), Node);
luaM_freearray(L, t->array, t->sizearray, TValue);
luaM_free(L, t);
}
static Node *getfreepos (Table *t) {
while (t->lastfree-- > t->node) {
if (ttisnil(gkey(t->lastfree)))
return t->lastfree;
}
return NULL; /* could not find a free place */
}
/*
** inserts a new key into a hash table; first, check whether key's main
** position is free. If not, check whether colliding node is in its main
** position or not: if it is not, move colliding node to an empty place and
** put new key in its main position; otherwise (colliding node is in its main
** position), new key goes to an empty position.
*/
static TValue *newkey (lua_State *L, Table *t, const TValue *key) {
Node *mp = mainposition(t, key);
if (!ttisnil(gval(mp)) || mp == dummynode) {
Node *othern;
Node *n = getfreepos(t); /* get a free place */
if (n == NULL) { /* cannot find a free place? */
rehash(L, t, key); /* grow table */
return luaH_set(L, t, key); /* re-insert key into grown table */
}
lua_assert(n != dummynode);
othern = mainposition(t, key2tval(mp));
if (othern != mp) { /* is colliding node out of its main position? */
/* yes; move colliding node into free position */
while (gnext(othern) != mp) othern = gnext(othern); /* find previous */
gnext(othern) = n; /* redo the chain with `n' in place of `mp' */
*n = *mp; /* copy colliding node into free pos. (mp->next also goes) */
gnext(mp) = NULL; /* now `mp' is free */
setnilvalue(gval(mp));
}
else { /* colliding node is in its own main position */
/* new node will go into free position */
gnext(n) = gnext(mp); /* chain new position */
gnext(mp) = n;
mp = n;
}
}
gkey(mp)->value = key->value; gkey(mp)->tt = key->tt;
luaC_barriert(L, t, key);
lua_assert(ttisnil(gval(mp)));
return gval(mp);
}
/*
** search function for integers
*/
const TValue *luaH_getnum (Table *t, int key) {
/* (1 <= key && key <= t->sizearray) */
if (cast(unsigned int, key-1) < cast(unsigned int, t->sizearray))
return &t->array[key-1];
else {
lua_Number nk = cast_num(key);
Node *n = hashnum(t, nk);
do { /* check whether `key' is somewhere in the chain */
if (ttisnumber(gkey(n)) && luai_numeq(nvalue(gkey(n)), nk))
return gval(n); /* that's it */
else n = gnext(n);
} while (n);
return luaO_nilobject;
}
}
/*
** search function for strings
*/
const TValue *luaH_getstr (Table *t, TString *key) {
Node *n = hashstr(t, key);
do { /* check whether `key' is somewhere in the chain */
if (ttisstring(gkey(n)) && rawtsvalue(gkey(n)) == key)
return gval(n); /* that's it */
else n = gnext(n);
} while (n);
return luaO_nilobject;
}
/*
** main search function
*/
const TValue *luaH_get (Table *t, const TValue *key) {
switch (ttype(key)) {
case LUA_TNIL: return luaO_nilobject;
case LUA_TSTRING: return luaH_getstr(t, rawtsvalue(key));
case LUA_TNUMBER: {
int k;
lua_Number n = nvalue(key);
lua_number2int(k, n);
if (luai_numeq(cast_num(k), nvalue(key))) /* index is int? */
return luaH_getnum(t, k); /* use specialized version */
/* else go through */
}
default: {
Node *n = mainposition(t, key);
do { /* check whether `key' is somewhere in the chain */
if (luaO_rawequalObj(key2tval(n), key))
return gval(n); /* that's it */
else n = gnext(n);
} while (n);
return luaO_nilobject;
}
}
}
TValue *luaH_set (lua_State *L, Table *t, const TValue *key) {
const TValue *p = luaH_get(t, key);
t->flags = 0;
if (p != luaO_nilobject)
return cast(TValue *, p);
else {
if (ttisnil(key)) luaG_runerror(L, "table index is nil");
else if (ttisnumber(key) && luai_numisnan(nvalue(key)))
luaG_runerror(L, "table index is NaN");
return newkey(L, t, key);
}
}
TValue *luaH_setnum (lua_State *L, Table *t, int key) {
const TValue *p = luaH_getnum(t, key);
if (p != luaO_nilobject)
return cast(TValue *, p);
else {
TValue k;
setnvalue(&k, cast_num(key));
return newkey(L, t, &k);
}
}
TValue *luaH_setstr (lua_State *L, Table *t, TString *key) {
const TValue *p = luaH_getstr(t, key);
if (p != luaO_nilobject)
return cast(TValue *, p);
else {
TValue k;
setsvalue(L, &k, key);
return newkey(L, t, &k);
}
}
static int unbound_search (Table *t, unsigned int j) {
unsigned int i = j; /* i is zero or a present index */
j++;
/* find `i' and `j' such that i is present and j is not */
while (!ttisnil(luaH_getnum(t, j))) {
i = j;
j *= 2;
if (j > cast(unsigned int, MAX_INT)) { /* overflow? */
/* table was built with bad purposes: resort to linear search */
i = 1;
while (!ttisnil(luaH_getnum(t, i))) i++;
return i - 1;
}
}
/* now do a binary search between them */
while (j - i > 1) {
unsigned int m = (i+j)/2;
if (ttisnil(luaH_getnum(t, m))) j = m;
else i = m;
}
return i;
}
/*
** Try to find a boundary in table `t'. A `boundary' is an integer index
** such that t[i] is non-nil and t[i+1] is nil (and 0 if t[1] is nil).
*/
int luaH_getn (Table *t) {
unsigned int j = t->sizearray;
if (j > 0 && ttisnil(&t->array[j - 1])) {
/* there is a boundary in the array part: (binary) search for it */
unsigned int i = 0;
while (j - i > 1) {
unsigned int m = (i+j)/2;
if (ttisnil(&t->array[m - 1])) j = m;
else i = m;
}
return i;
}
/* else must find a boundary in hash part */
else if (t->node == dummynode) /* hash part is empty? */
return j; /* that is easy... */
else return unbound_search(t, j);
}
#if defined(LUA_DEBUG)
Node *luaH_mainposition (const Table *t, const TValue *key) {
return mainposition(t, key);
}
int luaH_isdummy (Node *n) { return n == dummynode; }
#endif

40
src/lua/ltable.h
View File

@ -1,40 +0,0 @@
/*
** $Id: ltable.h,v 2.10.1.1 2007/12/27 13:02:25 roberto Exp $
** Lua tables (hash)
** See Copyright Notice in lua.h
*/
#ifndef ltable_h
#define ltable_h
#include "lobject.h"
#define gnode(t,i) (&(t)->node[i])
#define gkey(n) (&(n)->i_key.nk)
#define gval(n) (&(n)->i_val)
#define gnext(n) ((n)->i_key.nk.next)
#define key2tval(n) (&(n)->i_key.tvk)
LUAI_FUNC const TValue *luaH_getnum (Table *t, int key);
LUAI_FUNC TValue *luaH_setnum (lua_State *L, Table *t, int key);
LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key);
LUAI_FUNC TValue *luaH_setstr (lua_State *L, Table *t, TString *key);
LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key);
LUAI_FUNC TValue *luaH_set (lua_State *L, Table *t, const TValue *key);
LUAI_FUNC Table *luaH_new (lua_State *L, int narray, int lnhash);
LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, int nasize);
LUAI_FUNC void luaH_free (lua_State *L, Table *t);
LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key);
LUAI_FUNC int luaH_getn (Table *t);
#if defined(LUA_DEBUG)
LUAI_FUNC Node *luaH_mainposition (const Table *t, const TValue *key);
LUAI_FUNC int luaH_isdummy (Node *n);
#endif
#endif

287
src/lua/ltablib.c
View File

@ -1,287 +0,0 @@
/*
** $Id: ltablib.c,v 1.38.1.3 2008/02/14 16:46:58 roberto Exp $
** Library for Table Manipulation
** See Copyright Notice in lua.h
*/
#include <stddef.h>
#define ltablib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
#define aux_getn(L,n) (luaL_checktype(L, n, LUA_TTABLE), luaL_getn(L, n))
static int 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_pushinteger(L, 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 */
}
return 0;
}
static int foreach (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
luaL_checktype(L, 2, LUA_TFUNCTION);
lua_pushnil(L); /* first key */
while (lua_next(L, 1)) {
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 */
}
return 0;
}
static int maxn (lua_State *L) {
lua_Number max = 0;
luaL_checktype(L, 1, LUA_TTABLE);
lua_pushnil(L); /* first key */
while (lua_next(L, 1)) {
lua_pop(L, 1); /* remove value */
if (lua_type(L, -1) == LUA_TNUMBER) {
lua_Number v = lua_tonumber(L, -1);
if (v > max) max = v;
}
}
lua_pushnumber(L, max);
return 1;
}
static int getn (lua_State *L) {
lua_pushinteger(L, aux_getn(L, 1));
return 1;
}
static int setn (lua_State *L) {
luaL_checktype(L, 1, LUA_TTABLE);
#ifndef luaL_setn
luaL_setn(L, 1, luaL_checkint(L, 2));
#else
luaL_error(L, LUA_QL("setn") " is obsolete");
#endif
lua_pushvalue(L, 1);
return 1;
}
static int tinsert (lua_State *L) {
int e = aux_getn(L, 1) + 1; /* first empty element */
int pos; /* where to insert new element */
switch (lua_gettop(L)) {
case 2: { /* called with only 2 arguments */
pos = e; /* insert new element at the end */
break;
}
case 3: {
int i;
pos = luaL_checkint(L, 2); /* 2nd argument is the position */
if (pos > e) e = pos; /* `grow' array if necessary */
for (i = e; i > pos; i--) { /* move up elements */
lua_rawgeti(L, 1, i-1);
lua_rawseti(L, 1, i); /* t[i] = t[i-1] */
}
break;
}
default: {
return luaL_error(L, "wrong number of arguments to " LUA_QL("insert"));
}
}
luaL_setn(L, 1, e); /* new size */
lua_rawseti(L, 1, pos); /* t[pos] = v */
return 0;
}
static int tremove (lua_State *L) {
int e = aux_getn(L, 1);
int pos = luaL_optint(L, 2, e);
if (!(1 <= pos && pos <= e)) /* position is outside bounds? */
return 0; /* nothing to remove */
luaL_setn(L, 1, e - 1); /* t.n = n-1 */
lua_rawgeti(L, 1, pos); /* result = t[pos] */
for ( ;pos<e; pos++) {
lua_rawgeti(L, 1, pos+1);
lua_rawseti(L, 1, pos); /* t[pos] = t[pos+1] */
}
lua_pushnil(L);
lua_rawseti(L, 1, e); /* t[e] = nil */
return 1;
}
static void addfield (lua_State *L, luaL_Buffer *b, int i) {
lua_rawgeti(L, 1, i);
if (!lua_isstring(L, -1))
luaL_error(L, "invalid value (%s) at index %d in table for "
LUA_QL("concat"), luaL_typename(L, -1), i);
luaL_addvalue(b);
}
static int tconcat (lua_State *L) {
luaL_Buffer b;
size_t lsep;
int i, last;
const char *sep = luaL_optlstring(L, 2, "", &lsep);
luaL_checktype(L, 1, LUA_TTABLE);
i = luaL_optint(L, 3, 1);
last = luaL_opt(L, luaL_checkint, 4, luaL_getn(L, 1));
luaL_buffinit(L, &b);
for (; i < last; i++) {
addfield(L, &b, i);
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;
}
/*
** {======================================================
** Quicksort
** (based on `Algorithms in MODULA-3', Robert Sedgewick;
** Addison-Wesley, 1993.)
*/
static void set2 (lua_State *L, int i, int j) {
lua_rawseti(L, 1, i);
lua_rawseti(L, 1, j);
}
static int sort_comp (lua_State *L, int a, int b) {
if (!lua_isnil(L, 2)) { /* function? */
int res;
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);
res = lua_toboolean(L, -1);
lua_pop(L, 1);
return res;
}
else /* a < b? */
return lua_lessthan(L, a, b);
}
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);
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[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 (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 {
j=i+1; i=u; u=j-2;
}
auxsort(L, j, i); /* call recursively the smaller one */
} /* repeat the routine for the larger one */
}
static int 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},
{"foreach", foreach},
{"foreachi", foreachi},
{"getn", getn},
{"maxn", maxn},
{"insert", tinsert},
{"remove", tremove},
{"setn", setn},
{"sort", sort},
{NULL, NULL}
};
LUALIB_API int luaopen_table (lua_State *L) {
luaL_register(L, LUA_TABLIBNAME, tab_funcs);
return 1;
}

75
src/lua/ltm.c
View File

@ -1,75 +0,0 @@
/*
** $Id: ltm.c,v 2.8.1.1 2007/12/27 13:02:25 roberto Exp $
** Tag methods
** See Copyright Notice in lua.h
*/
#include <string.h>
#define ltm_c
#define LUA_CORE
#include "lua.h"
#include "lobject.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
const char *const luaT_typenames[] = {
"nil", "boolean", "userdata", "number",
"string", "table", "function", "userdata", "thread",
"proto", "upval"
};
void luaT_init (lua_State *L) {
static const char *const luaT_eventname[] = { /* ORDER TM */
"__index", "__newindex",
"__gc", "__mode", "__eq",
"__add", "__sub", "__mul", "__div", "__mod",
"__pow", "__unm", "__len", "__lt", "__le",
"__concat", "__call"
};
int i;
for (i=0; i<TM_N; i++) {
G(L)->tmname[i] = luaS_new(L, luaT_eventname[i]);
luaS_fix(G(L)->tmname[i]); /* never collect these names */
}
}
/*
** 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_getstr(events, ename);
lua_assert(event <= TM_EQ);
if (ttisnil(tm)) { /* no tag method? */
events->flags |= cast_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;
switch (ttype(o)) {
case LUA_TTABLE:
mt = hvalue(o)->metatable;
break;
case LUA_TUSERDATA:
mt = uvalue(o)->metatable;
break;
default:
mt = G(L)->mt[ttype(o)];
}
return (mt ? luaH_getstr(mt, G(L)->tmname[event]) : luaO_nilobject);
}

54
src/lua/ltm.h
View File

@ -1,54 +0,0 @@
/*
** $Id: ltm.h,v 2.6.1.1 2007/12/27 13:02:25 roberto Exp $
** Tag methods
** See Copyright Notice in lua.h
*/
#ifndef ltm_h
#define ltm_h
#include "lobject.h"
/*
* WARNING: if you change the order of this enumeration,
* grep "ORDER TM"
*/
typedef enum {
TM_INDEX,
TM_NEWINDEX,
TM_GC,
TM_MODE,
TM_EQ, /* last tag method with `fast' access */
TM_ADD,
TM_SUB,
TM_MUL,
TM_DIV,
TM_MOD,
TM_POW,
TM_UNM,
TM_LEN,
TM_LT,
TM_LE,
TM_CONCAT,
TM_CALL,
TM_N /* number of elements in the enum */
} TMS;
#define gfasttm(g,et,e) ((et) == NULL ? NULL : \
((et)->flags & (1u<<(e))) ? NULL : luaT_gettm(et, e, (g)->tmname[e]))
#define fasttm(l,et,e) gfasttm(G(l), et, e)
LUAI_DATA const char *const luaT_typenames[];
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);
#endif

388
src/lua/lua.h
View File

@ -1,388 +0,0 @@
/*
** $Id: lua.h,v 1.218.1.7 2012/01/13 20:36:20 roberto Exp $
** Lua - An Extensible Extension Language
** Lua.org, PUC-Rio, Brazil (http://www.lua.org)
** See Copyright Notice at the end of this file
*/
#ifndef lua_h
#define lua_h
#include <stdarg.h>
#include <stddef.h>
#include "luaconf.h"
#define LUA_VERSION "Lua 5.1"
#define LUA_RELEASE "Lua 5.1.5"
#define LUA_VERSION_NUM 501
#define LUA_COPYRIGHT "Copyright (C) 1994-2012 Lua.org, PUC-Rio"
#define LUA_AUTHORS "R. Ierusalimschy, L. H. de Figueiredo & W. Celes"
/* mark for precompiled code (`<esc>Lua') */
#define LUA_SIGNATURE "\033Lua"
/* option for multiple returns in `lua_pcall' and `lua_call' */
#define LUA_MULTRET (-1)
/*
** pseudo-indices
*/
#define LUA_REGISTRYINDEX (-10000)
#define LUA_ENVIRONINDEX (-10001)
#define LUA_GLOBALSINDEX (-10002)
#define lua_upvalueindex(i) (LUA_GLOBALSINDEX-(i))
/* thread status; 0 is OK */
#define LUA_YIELD 1
#define LUA_ERRRUN 2
#define LUA_ERRSYNTAX 3
#define LUA_ERRMEM 4
#define LUA_ERRERR 5
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_Reader) (lua_State *L, void *ud, size_t *sz);
typedef int (*lua_Writer) (lua_State *L, const void* p, size_t sz, void* ud);
/*
** prototype for memory-allocation functions
*/
typedef void * (*lua_Alloc) (void *ud, void *ptr, size_t osize, size_t nsize);
/*
** basic types
*/
#define LUA_TNONE (-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
/* minimum Lua stack available to a C function */
#define LUA_MINSTACK 20
/*
** generic extra include file
*/
#if defined(LUA_USER_H)
#include LUA_USER_H
#endif
/* type of numbers in Lua */
typedef LUA_NUMBER lua_Number;
/* type for integer functions */
typedef LUA_INTEGER lua_Integer;
/*
** state manipulation
*/
LUA_API lua_State *(lua_newstate) (lua_Alloc f, void *ud);
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);
/*
** basic stack manipulation
*/
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);
/*
** 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_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_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);
LUA_API lua_Number (lua_tonumber) (lua_State *L, int idx);
LUA_API lua_Integer (lua_tointeger) (lua_State *L, int idx);
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 size_t (lua_objlen) (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 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);
LUA_API int (lua_pushthread) (lua_State *L);
/*
** get functions (Lua -> stack)
*/
LUA_API void (lua_gettable) (lua_State *L, int idx);
LUA_API void (lua_getfield) (lua_State *L, int idx, const char *k);
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_createtable) (lua_State *L, int narr, int nrec);
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_settable) (lua_State *L, int idx);
LUA_API void (lua_setfield) (lua_State *L, int idx, const char *k);
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)
*/
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_Reader reader, void *dt,
const char *chunkname);
LUA_API int (lua_dump) (lua_State *L, lua_Writer writer, void *data);
/*
** coroutine functions
*/
LUA_API int (lua_yield) (lua_State *L, int nresults);
LUA_API int (lua_resume) (lua_State *L, int narg);
LUA_API int (lua_status) (lua_State *L);
/*
** garbage-collection function and 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_GCSETPAUSE 6
#define LUA_GCSETSTEPMUL 7
LUA_API int (lua_gc) (lua_State *L, int what, int data);
/*
** miscellaneous functions
*/
LUA_API int (lua_error) (lua_State *L);
LUA_API int (lua_next) (lua_State *L, int idx);
LUA_API void (lua_concat) (lua_State *L, int n);
LUA_API lua_Alloc (lua_getallocf) (lua_State *L, void **ud);
LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud);
/*
** ===============================================================
** some useful macros
** ===============================================================
*/
#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_pushcfunction(L, (f)), lua_setglobal(L, (n)))
#define lua_pushcfunction(L,f) lua_pushcclosure(L, (f), 0)
#define lua_strlen(L,i) lua_objlen(L, (i))
#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_setglobal(L,s) lua_setfield(L, LUA_GLOBALSINDEX, (s))
#define lua_getglobal(L,s) lua_getfield(L, LUA_GLOBALSINDEX, (s))
#define lua_tostring(L,i) lua_tolstring(L, (i), NULL)
/*
** compatibility macros and functions
*/
#define lua_open() luaL_newstate()
#define lua_getregistry(L) lua_pushvalue(L, LUA_REGISTRYINDEX)
#define lua_getgccount(L) lua_gc(L, LUA_GCCOUNT, 0)
#define lua_Chunkreader lua_Reader
#define lua_Chunkwriter lua_Writer
/* hack */
LUA_API void lua_setlevel (lua_State *from, lua_State *to);
/*
** {======================================================================
** Debug API
** =======================================================================
*/
/*
** Event codes
*/
#define LUA_HOOKCALL 0
#define LUA_HOOKRET 1
#define LUA_HOOKLINE 2
#define LUA_HOOKCOUNT 3
#define LUA_HOOKTAILRET 4
/*
** Event masks
*/
#define LUA_MASKCALL (1 << LUA_HOOKCALL)
#define LUA_MASKRET (1 << LUA_HOOKRET)
#define LUA_MASKLINE (1 << LUA_HOOKLINE)
#define LUA_MASKCOUNT (1 << LUA_HOOKCOUNT)
typedef struct lua_Debug lua_Debug; /* activation record */
/* Functions to be called by the debuger in specific events */
typedef void (*lua_Hook) (lua_State *L, lua_Debug *ar);
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);
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 *source; /* (S) */
int currentline; /* (l) */
int nups; /* (u) number of upvalues */
int linedefined; /* (S) */
int lastlinedefined; /* (S) */
char short_src[LUA_IDSIZE]; /* (S) */
/* private part */
int i_ci; /* active function */
};
/* }====================================================================== */
/******************************************************************************
* Copyright (C) 1994-2012 Lua.org, 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
* "Software"), to deal in the Software without restriction, including
* without limitation the rights to use, copy, modify, merge, publish,
* distribute, sublicense, and/or sell copies of the Software, and to
* permit persons to whom the Software is furnished to do so, subject to
* the following conditions:
*
* The above copyright notice and this permission notice shall be
* included in all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
******************************************************************************/
#endif

763
src/lua/luaconf.h
View File

@ -1,763 +0,0 @@
/*
** $Id: luaconf.h,v 1.82.1.7 2008/02/11 16:25:08 roberto Exp $
** Configuration file for Lua
** See Copyright Notice in lua.h
*/
#ifndef lconfig_h
#define lconfig_h
#include <limits.h>
#include <stddef.h>
/*
** ==================================================================
** Search for "@@" to find all configurable definitions.
** ===================================================================
*/
/*
@@ LUA_ANSI controls the use of non-ansi features.
** CHANGE it (define it) if you want Lua to avoid the use of any
** non-ansi feature or library.
*/
#if defined(__STRICT_ANSI__)
#define LUA_ANSI
#endif
#if !defined(LUA_ANSI) && defined(_WIN32)
#define LUA_WIN
#endif
#if defined(LUA_USE_LINUX)
#define LUA_USE_POSIX
#define LUA_USE_DLOPEN /* needs an extra library: -ldl */
#define LUA_USE_READLINE /* needs some extra libraries */
#endif
#if defined(LUA_USE_MACOSX)
#define LUA_USE_POSIX
#define LUA_DL_DYLD /* does not need extra library */
#endif
/*
@@ LUA_USE_POSIX includes all functionallity listed as X/Open System
@* Interfaces Extension (XSI).
** CHANGE it (define it) if your system is XSI compatible.
*/
#if defined(LUA_USE_POSIX)
#define LUA_USE_MKSTEMP
#define LUA_USE_ISATTY
#define LUA_USE_POPEN
#define LUA_USE_ULONGJMP
#endif
/*
@@ LUA_PATH and LUA_CPATH are the names of the environment variables that
@* Lua check to set its paths.
@@ LUA_INIT is the name of the environment variable that Lua
@* checks for initialization code.
** CHANGE them if you want different names.
*/
#define LUA_PATH "LUA_PATH"
#define LUA_CPATH "LUA_CPATH"
#define LUA_INIT "LUA_INIT"
/*
@@ 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.
*/
#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_PATH_DEFAULT \
".\\?.lua;" LUA_LDIR"?.lua;" LUA_LDIR"?\\init.lua;" \
LUA_CDIR"?.lua;" LUA_CDIR"?\\init.lua"
#define LUA_CPATH_DEFAULT \
".\\?.dll;" LUA_CDIR"?.dll;" LUA_CDIR"loadall.dll"
#else
#define LUA_ROOT "/usr/local/"
#define LUA_LDIR LUA_ROOT "share/lua/5.1/"
#define LUA_CDIR LUA_ROOT "lib/lua/5.1/"
#define LUA_PATH_DEFAULT \
"./?.lua;" LUA_LDIR"?.lua;" LUA_LDIR"?/init.lua;" \
LUA_CDIR"?.lua;" LUA_CDIR"?/init.lua"
#define LUA_CPATH_DEFAULT \
"./?.so;" LUA_CDIR"?.so;" LUA_CDIR"loadall.so"
#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(_WIN32)
#define LUA_DIRSEP "\\"
#else
#define LUA_DIRSEP "/"
#endif
/*
@@ LUA_PATHSEP is the character that separates templates in a path.
@@ LUA_PATH_MARK is the string that marks the substitution points in a
@* template.
@@ LUA_EXECDIR in a Windows path is replaced by the executable's
@* directory.
@@ LUA_IGMARK is a mark to ignore all before it when bulding the
@* luaopen_ function name.
** CHANGE them if for some reason your system cannot use those
** characters. (E.g., if one of those characters is a common character
** in file/directory names.) Probably you do not need to change them.
*/
#define LUA_PATHSEP ";"
#define LUA_PATH_MARK "?"
#define LUA_EXECDIR "!"
#define LUA_IGMARK "-"
/*
@@ LUA_INTEGER is the integral type used by lua_pushinteger/lua_tointeger.
** CHANGE that if ptrdiff_t is not adequate on your machine. (On most
** machines, ptrdiff_t gives a good choice between int or long.)
*/
#define LUA_INTEGER ptrdiff_t
/*
@@ LUA_API is a mark for all core API functions.
@@ LUALIB_API is a mark for all standard library 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
/*
@@ LUAI_FUNC is a mark for all extern functions that are not to be
@* exported to outside modules.
@@ LUAI_DATA is a mark for all extern (const) variables that are not to
@* be exported to outside modules.
** CHANGE them if you need to mark them in some special way. Elf/gcc
** (versions 3.2 and later) mark them as "hidden" to optimize access
** when Lua is compiled as a shared library.
*/
#if defined(luaall_c)
#define LUAI_FUNC static
#define LUAI_DATA /* empty */
#elif defined(__GNUC__) && ((__GNUC__*100 + __GNUC_MINOR__) >= 302) && \
defined(__ELF__)
#define LUAI_FUNC __attribute__((visibility("hidden"))) extern
#define LUAI_DATA LUAI_FUNC
#else
#define LUAI_FUNC extern
#define LUAI_DATA extern
#endif
/*
@@ LUA_QL describes how error messages quote program elements.
** CHANGE it if you want a different appearance.
*/
#define LUA_QL(x) "'" x "'"
#define LUA_QS LUA_QL("%s")
/*
@@ 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
/*
** {==================================================================
** Stand-alone configuration
** ===================================================================
*/
#if defined(lua_c) || defined(luaall_c)
/*
@@ lua_stdin_is_tty detects whether the standard input is a 'tty' (that
@* is, whether we're running lua interactively).
** CHANGE it if you have a better definition for non-POSIX/non-Windows
** systems.
*/
#if defined(LUA_USE_ISATTY)
#include <unistd.h>
#define lua_stdin_is_tty() isatty(0)
#elif defined(LUA_WIN)
#include <io.h>
#include <stdio.h>
#define lua_stdin_is_tty() _isatty(_fileno(stdin))
#else
#define lua_stdin_is_tty() 1 /* assume stdin is a tty */
#endif
/*
@@ LUA_PROMPT is the default prompt used by stand-alone Lua.
@@ LUA_PROMPT2 is the default continuation prompt used by stand-alone Lua.
** CHANGE them if you want different prompts. (You can also change the
** prompts dynamically, assigning to globals _PROMPT/_PROMPT2.)
*/
#define LUA_PROMPT "> "
#define LUA_PROMPT2 ">> "
/*
@@ LUA_PROGNAME is the default name for the stand-alone Lua program.
** CHANGE it if your stand-alone interpreter has a different name and
** your system is not able to detect that name automatically.
*/
#define LUA_PROGNAME "lua"
/*
@@ LUA_MAXINPUT is the maximum length for an input line in the
@* stand-alone interpreter.
** CHANGE it if you need longer lines.
*/
#define LUA_MAXINPUT 512
/*
@@ 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.
** CHANGE them if you want to improve this functionality (e.g., by using
** GNU readline and history facilities).
*/
#if defined(LUA_USE_READLINE)
#include <stdio.h>
#include <readline/readline.h>
#include <readline/history.h>
#define lua_readline(L,b,p) ((void)L, ((b)=readline(p)) != NULL)
#define lua_saveline(L,idx) \
if (lua_strlen(L,idx) > 0) /* non-empty line? */ \
add_history(lua_tostring(L, idx)); /* add it to history */
#define lua_freeline(L,b) ((void)L, free(b))
#else
#define lua_readline(L,b,p) \
((void)L, fputs(p, stdout), fflush(stdout), /* show prompt */ \
fgets(b, LUA_MAXINPUT, stdin) != NULL) /* get line */
#define lua_saveline(L,idx) { (void)L; (void)idx; }
#define lua_freeline(L,b) { (void)L; (void)b; }
#endif
#endif
/* }================================================================== */
/*
@@ LUAI_GCPAUSE defines the default pause between garbage-collector cycles
@* as a percentage.
** CHANGE it if you want the GC to run faster or slower (higher values
** mean larger pauses which mean slower collection.) You can also change
** this value dynamically.
*/
#define LUAI_GCPAUSE 200 /* 200% (wait memory to double before next GC) */
/*
@@ LUAI_GCMUL defines the default speed of garbage collection relative to
@* memory allocation as a percentage.
** CHANGE it if you want to change the granularity of the garbage
** collection. (Higher values mean coarser collections. 0 represents
** infinity, where each step performs a full collection.) You can also
** change this value dynamically.
*/
#define LUAI_GCMUL 200 /* GC runs 'twice the speed' of memory allocation */
/*
@@ LUA_COMPAT_GETN controls compatibility with old getn behavior.
** CHANGE it (define it) if you want exact compatibility with the
** behavior of setn/getn in Lua 5.0.
*/
#undef LUA_COMPAT_GETN
/*
@@ LUA_COMPAT_LOADLIB controls compatibility about global loadlib.
** CHANGE it to undefined as soon as you do not need a global 'loadlib'
** function (the function is still available as 'package.loadlib').
*/
#undef LUA_COMPAT_LOADLIB
/*
@@ LUA_COMPAT_VARARG controls compatibility with old vararg feature.
** CHANGE it to undefined as soon as your programs use only '...' to
** access vararg parameters (instead of the old 'arg' table).
*/
#define LUA_COMPAT_VARARG
/*
@@ LUA_COMPAT_MOD controls compatibility with old math.mod function.
** CHANGE it to undefined as soon as your programs use 'math.fmod' or
** the new '%' operator instead of 'math.mod'.
*/
#define LUA_COMPAT_MOD
/*
@@ LUA_COMPAT_LSTR controls compatibility with old long string nesting
@* facility.
** CHANGE it to 2 if you want the old behaviour, or undefine it to turn
** off the advisory error when nesting [[...]].
*/
#define LUA_COMPAT_LSTR 1
/*
@@ LUA_COMPAT_GFIND controls compatibility with old 'string.gfind' name.
** CHANGE it to undefined as soon as you rename 'string.gfind' to
** 'string.gmatch'.
*/
#define LUA_COMPAT_GFIND
/*
@@ LUA_COMPAT_OPENLIB controls compatibility with old 'luaL_openlib'
@* behavior.
** CHANGE it to undefined as soon as you replace to 'luaL_register'
** your uses of 'luaL_openlib'
*/
#define LUA_COMPAT_OPENLIB
/*
@@ luai_apicheck is the assert macro used by the Lua-C API.
** CHANGE luai_apicheck if you want Lua to perform some checks in the
** parameters it gets from API calls. This may slow down the interpreter
** a bit, but may be quite useful when debugging C code that interfaces
** with Lua. A useful redefinition is to use assert.h.
*/
#if defined(LUA_USE_APICHECK)
#include <assert.h>
#define luai_apicheck(L,o) { (void)L; assert(o); }
#else
#define luai_apicheck(L,o) { (void)L; }
#endif
/*
@@ LUAI_BITSINT defines the number of bits in an int.
** CHANGE here if Lua cannot automatically detect the number of bits of
** your machine. Probably you do not need to change this.
*/
/* avoid overflows in comparison */
#if INT_MAX-20 < 32760
#define LUAI_BITSINT 16
#elif INT_MAX > 2147483640L
/* int has at least 32 bits */
#define LUAI_BITSINT 32
#else
#error "you must define LUA_BITSINT with number of bits in an integer"
#endif
/*
@@ LUAI_UINT32 is an unsigned integer with at least 32 bits.
@@ LUAI_INT32 is an signed integer with at least 32 bits.
@@ LUAI_UMEM is an unsigned integer big enough to count the total
@* memory used by Lua.
@@ LUAI_MEM is a signed integer big enough to count the total memory
@* used by Lua.
** CHANGE here if for some weird reason the default definitions are not
** good enough for your machine. (The definitions in the 'else'
** part always works, but may waste space on machines with 64-bit
** longs.) Probably you do not need to change this.
*/
#if LUAI_BITSINT >= 32
#define LUAI_UINT32 unsigned int
#define LUAI_INT32 int
#define LUAI_MAXINT32 INT_MAX
#define LUAI_UMEM size_t
#define LUAI_MEM ptrdiff_t
#else
/* 16-bit ints */
#define LUAI_UINT32 unsigned long
#define LUAI_INT32 long
#define LUAI_MAXINT32 LONG_MAX
#define LUAI_UMEM unsigned long
#define LUAI_MEM long
#endif
/*
@@ LUAI_MAXCALLS limits the number of nested calls.
** CHANGE it if you need really deep recursive calls. This limit is
** arbitrary; its only purpose is to stop infinite recursion before
** exhausting memory.
*/
#define LUAI_MAXCALLS 20000
/*
@@ LUAI_MAXCSTACK limits the number of Lua stack slots that a C function
@* can use.
** CHANGE it if you need lots of (Lua) stack space for your C
** functions. This limit is arbitrary; its only purpose is to stop C
** functions to consume unlimited stack space. (must be smaller than
** -LUA_REGISTRYINDEX)
*/
#define LUAI_MAXCSTACK 8000
/*
** {==================================================================
** CHANGE (to smaller values) the following definitions if your system
** has a small C stack. (Or you may want to change them to larger
** values if your system has a large C stack and these limits are
** too rigid for you.) Some of these constants control the size of
** stack-allocated arrays used by the compiler or the interpreter, while
** others limit the maximum number of recursive calls that the compiler
** or the interpreter can perform. Values too large may cause a C stack
** overflow for some forms of deep constructs.
** ===================================================================
*/
/*
@@ LUAI_MAXCCALLS is the maximum depth for nested C calls (short) and
@* syntactical nested non-terminals in a program.
*/
#define LUAI_MAXCCALLS 200
/*
@@ LUAI_MAXVARS is the maximum number of local variables per function
@* (must be smaller than 250).
*/
#define LUAI_MAXVARS 200
/*
@@ LUAI_MAXUPVALUES is the maximum number of upvalues per function
@* (must be smaller than 250).
*/
#define LUAI_MAXUPVALUES 60
/*
@@ LUAL_BUFFERSIZE is the buffer size used by the lauxlib buffer system.
*/
#define LUAL_BUFFERSIZE BUFSIZ
/* }================================================================== */
/*
** {==================================================================
@@ LUA_NUMBER is the type of numbers in Lua.
** CHANGE the following definitions only if you want to build Lua
** with a number type different from double. You may also need to
** change lua_number2int & lua_number2integer.
** ===================================================================
*/
#define LUA_NUMBER_DOUBLE
#define LUA_NUMBER double
/*
@@ LUAI_UACNUMBER is the result of an 'usual argument conversion'
@* over a number.
*/
#define LUAI_UACNUMBER double
/*
@@ LUA_NUMBER_SCAN is the format for reading numbers.
@@ LUA_NUMBER_FMT is the format for writing numbers.
@@ lua_number2str converts a number to a string.
@@ LUAI_MAXNUMBER2STR is maximum size of previous conversion.
@@ lua_str2number converts a string to a number.
*/
#define LUA_NUMBER_SCAN "%lf"
#define LUA_NUMBER_FMT "%.14g"
#define lua_number2str(s,n) sprintf((s), LUA_NUMBER_FMT, (n))
#define LUAI_MAXNUMBER2STR 32 /* 16 digits, sign, point, and \0 */
#define lua_str2number(s,p) strtod((s), (p))
/*
@@ The luai_num* macros define the primitive operations over numbers.
*/
#if defined(LUA_CORE)
#include <math.h>
#define luai_numadd(a,b) ((a)+(b))
#define luai_numsub(a,b) ((a)-(b))
#define luai_nummul(a,b) ((a)*(b))
#define luai_numdiv(a,b) ((a)/(b))
#define luai_nummod(a,b) ((a) - floor((a)/(b))*(b))
#define luai_numpow(a,b) (pow(a,b))
#define luai_numunm(a) (-(a))
#define luai_numeq(a,b) ((a)==(b))
#define luai_numlt(a,b) ((a)<(b))
#define luai_numle(a,b) ((a)<=(b))
#define luai_numisnan(a) (!luai_numeq((a), (a)))
#endif
/*
@@ lua_number2int is a macro to convert lua_Number to int.
@@ lua_number2integer is a macro to convert lua_Number to lua_Integer.
** CHANGE them if you know a faster way to convert a lua_Number to
** int (with any rounding method and without throwing errors) in your
** system. In Pentium machines, a naive typecast from double to int
** in C is extremely slow, so any alternative is worth trying.
*/
/* On a Pentium, resort to a trick */
#if defined(LUA_NUMBER_DOUBLE) && !defined(LUA_ANSI) && !defined(__SSE2__) && \
(defined(__i386) || defined (_M_IX86) || defined(__i386__))
/* On a Microsoft compiler, use assembler */
#if defined(_MSC_VER)
#define lua_number2int(i,d) __asm fld d __asm fistp i
#define lua_number2integer(i,n) lua_number2int(i, n)
/* the next trick should work on any Pentium, but sometimes clashes
with a DirectX idiosyncrasy */
#else
union luai_Cast { double l_d; long l_l; };
#define lua_number2int(i,d) \
{ volatile union luai_Cast u; u.l_d = (d) + 6755399441055744.0; (i) = u.l_l; }
#define lua_number2integer(i,n) lua_number2int(i, n)
#endif
/* this option always works, but may be slow */
#else
#define lua_number2int(i,d) ((i)=(int)(d))
#define lua_number2integer(i,d) ((i)=(lua_Integer)(d))
#endif
/* }================================================================== */
/*
@@ LUAI_USER_ALIGNMENT_T is a type that requires maximum alignment.
** CHANGE it if your system requires alignments larger than double. (For
** instance, if your system supports long doubles and they must be
** aligned in 16-byte boundaries, then you should add long double in the
** union.) Probably you do not need to change this.
*/
#define LUAI_USER_ALIGNMENT_T union { double u; void *s; long l; }
/*
@@ LUAI_THROW/LUAI_TRY define how Lua does exception handling.
** CHANGE them if you prefer to use longjmp/setjmp even with C++
** or if want/don't to use _longjmp/_setjmp instead of regular
** longjmp/setjmp. By default, Lua handles errors with exceptions when
** compiling as C++ code, with _longjmp/_setjmp when asked to use them,
** and with longjmp/setjmp otherwise.
*/
#if defined(__cplusplus)
/* C++ exceptions */
#define LUAI_THROW(L,c) throw(c)
#define LUAI_TRY(L,c,a) try { a } catch(...) \
{ if ((c)->status == 0) (c)->status = -1; }
#define luai_jmpbuf int /* dummy variable */
#elif defined(LUA_USE_ULONGJMP)
/* in Unix, try _longjmp/_setjmp (more efficient) */
#define LUAI_THROW(L,c) _longjmp((c)->b, 1)
#define LUAI_TRY(L,c,a) if (_setjmp((c)->b) == 0) { a }
#define luai_jmpbuf jmp_buf
#else
/* default handling with long jumps */
#define LUAI_THROW(L,c) longjmp((c)->b, 1)
#define LUAI_TRY(L,c,a) if (setjmp((c)->b) == 0) { a }
#define luai_jmpbuf jmp_buf
#endif
/*
@@ LUA_MAXCAPTURES is the maximum number of captures that a pattern
@* can do during pattern-matching.
** CHANGE it if you need more captures. This limit is arbitrary.
*/
#define LUA_MAXCAPTURES 32
/*
@@ lua_tmpnam is the function that the OS library uses to create a
@* temporary name.
@@ LUA_TMPNAMBUFSIZE is the maximum size of a name created by lua_tmpnam.
** CHANGE them if you have an alternative to tmpnam (which is considered
** insecure) or if you want the original tmpnam anyway. By default, Lua
** uses tmpnam except when POSIX is available, where it uses mkstemp.
*/
#if defined(loslib_c) || defined(luaall_c)
#if defined(LUA_USE_MKSTEMP)
#include <unistd.h>
#define LUA_TMPNAMBUFSIZE 32
#define lua_tmpnam(b,e) { \
strcpy(b, "/tmp/lua_XXXXXX"); \
e = mkstemp(b); \
if (e != -1) close(e); \
e = (e == -1); }
#else
#define LUA_TMPNAMBUFSIZE L_tmpnam
#define lua_tmpnam(b,e) { e = (tmpnam(b) == NULL); }
#endif
#endif
/*
@@ lua_popen spawns a new process connected to the current one through
@* the file streams.
** CHANGE it if you have a way to implement it in your system.
*/
#if defined(LUA_USE_POPEN)
#define lua_popen(L,c,m) ((void)L, fflush(NULL), popen(c,m))
#define lua_pclose(L,file) ((void)L, (pclose(file) != -1))
#elif defined(LUA_WIN)
#define lua_popen(L,c,m) ((void)L, _popen(c,m))
#define lua_pclose(L,file) ((void)L, (_pclose(file) != -1))
#else
#define lua_popen(L,c,m) ((void)((void)c, m), \
luaL_error(L, LUA_QL("popen") " not supported"), (FILE*)0)
#define lua_pclose(L,file) ((void)((void)L, file), 0)
#endif
/*
@@ LUA_DL_* define which dynamic-library system Lua should use.
** CHANGE here if Lua has problems choosing the appropriate
** dynamic-library system for your platform (either Windows' DLL, Mac's
** dyld, or Unix's dlopen). If your system is some kind of Unix, there
** is a good chance that it has dlopen, so LUA_DL_DLOPEN will work for
** it. To use dlopen you also need to adapt the src/Makefile (probably
** adding -ldl to the linker options), so Lua does not select it
** automatically. (When you change the makefile to add -ldl, you must
** also add -DLUA_USE_DLOPEN.)
** If you do not want any kind of dynamic library, undefine all these
** options.
** By default, _WIN32 gets LUA_DL_DLL and MAC OS X gets LUA_DL_DYLD.
*/
#if defined(LUA_USE_DLOPEN)
#define LUA_DL_DLOPEN
#endif
#if defined(LUA_WIN)
#define LUA_DL_DLL
#endif
/*
@@ LUAI_EXTRASPACE allows you to add user-specific data in a lua_State
@* (the data goes just *before* the lua_State pointer).
** CHANGE (define) this if you really need that. This value must be
** a multiple of the maximum alignment required for your machine.
*/
#define LUAI_EXTRASPACE 0
/*
@@ luai_userstate* allow user-specific actions on threads.
** CHANGE them if you defined LUAI_EXTRASPACE and need to do something
** extra when a thread is created/deleted/resumed/yielded.
*/
#define luai_userstateopen(L) ((void)L)
#define luai_userstateclose(L) ((void)L)
#define luai_userstatethread(L,L1) ((void)L)
#define luai_userstatefree(L) ((void)L)
#define luai_userstateresume(L,n) ((void)L)
#define luai_userstateyield(L,n) ((void)L)
/*
@@ LUA_INTFRMLEN is the length modifier for integer conversions
@* in 'string.format'.
@@ LUA_INTFRM_T is the integer type correspoding to the previous length
@* modifier.
** CHANGE them if your system supports long long or does not support long.
*/
#if defined(LUA_USELONGLONG)
#define LUA_INTFRMLEN "ll"
#define LUA_INTFRM_T long long
#else
#define LUA_INTFRMLEN "l"
#define LUA_INTFRM_T long
#endif
/* =================================================================== */
/*
** Local configuration. You can use this space to add your redefinitions
** without modifying the main part of the file.
*/
#endif

55
src/lua/lualib.h
View File

@ -1,55 +0,0 @@
/*
** $Id: lualib.h,v 1.36.1.1 2007/12/27 13:02:25 roberto Exp $
** Lua standard libraries
** See Copyright Notice in lua.h
*/
#ifndef lualib_h
#define lualib_h
#include "lua.h"
/* Key to file-handle type */
#define LUA_FILEHANDLE "FILE*"
#define LUA_COLIBNAME "coroutine"
LUALIB_API int (luaopen_base) (lua_State *L);
#define LUA_TABLIBNAME "table"
LUALIB_API int (luaopen_table) (lua_State *L);
#define LUA_IOLIBNAME "io"
LUALIB_API int (luaopen_io) (lua_State *L);
#define LUA_OSLIBNAME "os"
LUALIB_API int (luaopen_os) (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);
#define LUA_LOADLIBNAME "package"
LUALIB_API int (luaopen_package) (lua_State *L);
#define LUA_BITLIBNAME "bit"
LUALIB_API int (luaopen_bit) (lua_State *L);
/* open all previous libraries */
LUALIB_API void (luaL_openlibs) (lua_State *L);
#ifndef lua_assert
#define lua_assert(x) ((void)0)
#endif
#endif

227
src/lua/lundump.c
View File

@ -1,227 +0,0 @@
/*
** $Id: lundump.c,v 2.7.1.4 2008/04/04 19:51:41 roberto Exp $
** load precompiled Lua chunks
** See Copyright Notice in lua.h
*/
#include <string.h>
#define lundump_c
#define LUA_CORE
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lmem.h"
#include "lobject.h"
#include "lstring.h"
#include "lundump.h"
#include "lzio.h"
typedef struct {
lua_State* L;
ZIO* Z;
Mbuffer* b;
const char* name;
} LoadState;
#ifdef LUAC_TRUST_BINARIES
#define IF(c,s)
#define error(S,s)
#else
#define IF(c,s) if (c) error(S,s)
static void error(LoadState* S, const char* why)
{
luaO_pushfstring(S->L,"%s: %s in precompiled chunk",S->name,why);
luaD_throw(S->L,LUA_ERRSYNTAX);
}
#endif
#define LoadMem(S,b,n,size) LoadBlock(S,b,(n)*(size))
#define LoadByte(S) (lu_byte)LoadChar(S)
#define LoadVar(S,x) LoadMem(S,&x,1,sizeof(x))
#define LoadVector(S,b,n,size) LoadMem(S,b,n,size)
static void LoadBlock(LoadState* S, void* b, size_t size)
{
size_t r=luaZ_read(S->Z,b,size);
IF (r!=0, "unexpected end");
}
static int LoadChar(LoadState* S)
{
char x;
LoadVar(S,x);
return x;
}
static int LoadInt(LoadState* S)
{
int x;
LoadVar(S,x);
IF (x<0, "bad integer");
return x;
}
static lua_Number LoadNumber(LoadState* S)
{
lua_Number x;
LoadVar(S,x);
return x;
}
static TString* LoadString(LoadState* S)
{
size_t size;
LoadVar(S,size);
if (size==0)
return NULL;
else
{
char* s=luaZ_openspace(S->L,S->b,size);
LoadBlock(S,s,size);
return luaS_newlstr(S->L,s,size-1); /* remove trailing '\0' */
}
}
static void LoadCode(LoadState* S, Proto* f)
{
int n=LoadInt(S);
f->code=luaM_newvector(S->L,n,Instruction);
f->sizecode=n;
LoadVector(S,f->code,n,sizeof(Instruction));
}
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,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=LoadChar(S);
switch (t)
{
case LUA_TNIL:
setnilvalue(o);
break;
case LUA_TBOOLEAN:
setbvalue(o,LoadChar(S)!=0);
break;
case LUA_TNUMBER:
setnvalue(o,LoadNumber(S));
break;
case LUA_TSTRING:
setsvalue2n(S->L,o,LoadString(S));
break;
default:
error(S,"bad constant");
break;
}
}
n=LoadInt(S);
f->p=luaM_newvector(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]=LoadFunction(S,f->source);
}
static void LoadDebug(LoadState* S, Proto* f)
{
int i,n;
n=LoadInt(S);
f->lineinfo=luaM_newvector(S->L,n,int);
f->sizelineinfo=n;
LoadVector(S,f->lineinfo,n,sizeof(int));
n=LoadInt(S);
f->locvars=luaM_newvector(S->L,n,LocVar);
f->sizelocvars=n;
for (i=0; i<n; i++) f->locvars[i].varname=NULL;
for (i=0; i<n; i++)
{
f->locvars[i].varname=LoadString(S);
f->locvars[i].startpc=LoadInt(S);
f->locvars[i].endpc=LoadInt(S);
}
n=LoadInt(S);
f->upvalues=luaM_newvector(S->L,n,TString*);
f->sizeupvalues=n;
for (i=0; i<n; i++) f->upvalues[i]=NULL;
for (i=0; i<n; i++) f->upvalues[i]=LoadString(S);
}
static Proto* LoadFunction(LoadState* S, TString* p)
{
Proto* f;
if (++S->L->nCcalls > LUAI_MAXCCALLS) error(S,"code too deep");
f=luaF_newproto(S->L);
setptvalue2s(S->L,S->L->top,f); incr_top(S->L);
f->source=LoadString(S); if (f->source==NULL) f->source=p;
f->linedefined=LoadInt(S);
f->lastlinedefined=LoadInt(S);
f->nups=LoadByte(S);
f->numparams=LoadByte(S);
f->is_vararg=LoadByte(S);
f->maxstacksize=LoadByte(S);
LoadCode(S,f);
LoadConstants(S,f);
LoadDebug(S,f);
IF (!luaG_checkcode(f), "bad code");
S->L->top--;
S->L->nCcalls--;
return f;
}
static void LoadHeader(LoadState* S)
{
char h[LUAC_HEADERSIZE];
char s[LUAC_HEADERSIZE];
luaU_header(h);
LoadBlock(S,s,LUAC_HEADERSIZE);
IF (memcmp(h,s,LUAC_HEADERSIZE)!=0, "bad header");
}
/*
** load precompiled chunk
*/
Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff, const char* name)
{
LoadState S;
if (*name=='@' || *name=='=')
S.name=name+1;
else if (*name==LUA_SIGNATURE[0])
S.name="binary string";
else
S.name=name;
S.L=L;
S.Z=Z;
S.b=buff;
LoadHeader(&S);
return LoadFunction(&S,luaS_newliteral(L,"=?"));
}
/*
* make header
*/
void luaU_header (char* h)
{
int x=1;
memcpy(h,LUA_SIGNATURE,sizeof(LUA_SIGNATURE)-1);
h+=sizeof(LUA_SIGNATURE)-1;
*h++=(char)LUAC_VERSION;
*h++=(char)LUAC_FORMAT;
*h++=(char)*(char*)&x; /* endianness */
*h++=(char)sizeof(int);
*h++=(char)sizeof(size_t);
*h++=(char)sizeof(Instruction);
*h++=(char)sizeof(lua_Number);
*h++=(char)(((lua_Number)0.5)==0); /* is lua_Number integral? */
}

36
src/lua/lundump.h
View File

@ -1,36 +0,0 @@
/*
** $Id: lundump.h,v 1.37.1.1 2007/12/27 13:02:25 roberto Exp $
** load precompiled Lua chunks
** See Copyright Notice in lua.h
*/
#ifndef lundump_h
#define lundump_h
#include "lobject.h"
#include "lzio.h"
/* load one chunk; from lundump.c */
LUAI_FUNC Proto* luaU_undump (lua_State* L, ZIO* Z, Mbuffer* buff, const char* name);
/* make header; from lundump.c */
LUAI_FUNC void luaU_header (char* h);
/* dump one chunk; from ldump.c */
LUAI_FUNC int luaU_dump (lua_State* L, const Proto* f, lua_Writer w, void* data, int strip);
#ifdef luac_c
/* print one chunk; from print.c */
LUAI_FUNC void luaU_print (const Proto* f, int full);
#endif
/* for header of binary files -- this is Lua 5.1 */
#define LUAC_VERSION 0x51
/* for header of binary files -- this is the official format */
#define LUAC_FORMAT 0
/* size of header of binary files */
#define LUAC_HEADERSIZE 12
#endif

767
src/lua/lvm.c
View File

@ -1,767 +0,0 @@
/*
** $Id: lvm.c,v 2.63.1.5 2011/08/17 20:43:11 roberto Exp $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define lvm_c
#define LUA_CORE
#include "lua.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lvm.h"
/* limit for table tag-method chains (to avoid loops) */
#define MAXTAGLOOP 100
const TValue *luaV_tonumber (const TValue *obj, TValue *n) {
lua_Number num;
if (ttisnumber(obj)) return obj;
if (ttisstring(obj) && luaO_str2d(svalue(obj), &num)) {
setnvalue(n, num);
return n;
}
else
return NULL;
}
int luaV_tostring (lua_State *L, StkId obj) {
if (!ttisnumber(obj))
return 0;
else {
char s[LUAI_MAXNUMBER2STR];
lua_Number n = nvalue(obj);
lua_number2str(s, n);
setsvalue2s(L, obj, luaS_new(L, s));
return 1;
}
}
static void traceexec (lua_State *L, const Instruction *pc) {
lu_byte mask = L->hookmask;
const Instruction *oldpc = L->savedpc;
L->savedpc = pc;
if ((mask & LUA_MASKCOUNT) && L->hookcount == 0) {
resethookcount(L);
luaD_callhook(L, LUA_HOOKCOUNT, -1);
}
if (mask & LUA_MASKLINE) {
Proto *p = ci_func(L->ci)->l.p;
int npc = pcRel(pc, p);
int newline = getline(p, npc);
/* call linehook when enter a new function, when jump back (loop),
or when enter a new line */
if (npc == 0 || pc <= oldpc || newline != getline(p, pcRel(oldpc, p)))
luaD_callhook(L, LUA_HOOKLINE, newline);
}
}
static void callTMres (lua_State *L, StkId res, const TValue *f,
const TValue *p1, const TValue *p2) {
ptrdiff_t result = savestack(L, res);
setobj2s(L, L->top, f); /* push function */
setobj2s(L, L->top+1, p1); /* 1st argument */
setobj2s(L, L->top+2, p2); /* 2nd argument */
luaD_checkstack(L, 3);
L->top += 3;
luaD_call(L, L->top - 3, 1);
res = restorestack(L, result);
L->top--;
setobjs2s(L, res, L->top);
}
static void callTM (lua_State *L, const TValue *f, const TValue *p1,
const TValue *p2, const TValue *p3) {
setobj2s(L, L->top, f); /* push function */
setobj2s(L, L->top+1, p1); /* 1st argument */
setobj2s(L, L->top+2, p2); /* 2nd argument */
setobj2s(L, L->top+3, p3); /* 3th argument */
luaD_checkstack(L, 4);
L->top += 4;
luaD_call(L, L->top - 4, 0);
}
void luaV_gettable (lua_State *L, const TValue *t, TValue *key, StkId val) {
int loop;
for (loop = 0; loop < MAXTAGLOOP; loop++) {
const TValue *tm;
if (ttistable(t)) { /* `t' is a table? */
Table *h = hvalue(t);
const TValue *res = luaH_get(h, key); /* do a primitive get */
if (!ttisnil(res) || /* result is no nil? */
(tm = fasttm(L, h->metatable, TM_INDEX)) == NULL) { /* or no TM? */
setobj2s(L, val, res);
return;
}
/* else will try the tag method */
}
else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_INDEX)))
luaG_typeerror(L, t, "index");
if (ttisfunction(tm)) {
callTMres(L, val, tm, t, key);
return;
}
t = tm; /* else repeat with `tm' */
}
luaG_runerror(L, "loop in gettable");
}
void luaV_settable (lua_State *L, const TValue *t, TValue *key, StkId val) {
int loop;
TValue temp;
for (loop = 0; loop < MAXTAGLOOP; loop++) {
const TValue *tm;
if (ttistable(t)) { /* `t' is a table? */
Table *h = hvalue(t);
TValue *oldval = luaH_set(L, h, key); /* do a primitive set */
if (!ttisnil(oldval) || /* result is no nil? */
(tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) { /* or no TM? */
setobj2t(L, oldval, val);
h->flags = 0;
luaC_barriert(L, h, val);
return;
}
/* else will try the tag method */
}
else if (ttisnil(tm = luaT_gettmbyobj(L, t, TM_NEWINDEX)))
luaG_typeerror(L, t, "index");
if (ttisfunction(tm)) {
callTM(L, tm, t, key, val);
return;
}
/* else repeat with `tm' */
setobj(L, &temp, tm); /* avoid pointing inside table (may rehash) */
t = &temp;
}
luaG_runerror(L, "loop in settable");
}
static int call_binTM (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 (ttisnil(tm))
tm = luaT_gettmbyobj(L, p2, event); /* try second operand */
if (ttisnil(tm)) return 0;
callTMres(L, res, tm, p1, p2);
return 1;
}
static const TValue *get_compTM (lua_State *L, Table *mt1, Table *mt2,
TMS event) {
const TValue *tm1 = fasttm(L, mt1, event);
const TValue *tm2;
if (tm1 == NULL) return NULL; /* no metamethod */
if (mt1 == mt2) return tm1; /* same metatables => same metamethods */
tm2 = fasttm(L, mt2, event);
if (tm2 == NULL) return NULL; /* no metamethod */
if (luaO_rawequalObj(tm1, tm2)) /* same metamethods? */
return tm1;
return NULL;
}
static int call_orderTM (lua_State *L, const TValue *p1, const TValue *p2,
TMS event) {
const TValue *tm1 = luaT_gettmbyobj(L, p1, event);
const TValue *tm2;
if (ttisnil(tm1)) return -1; /* no metamethod? */
tm2 = luaT_gettmbyobj(L, p2, event);
if (!luaO_rawequalObj(tm1, tm2)) /* different metamethods? */
return -1;
callTMres(L, L->top, tm1, p1, p2);
return !l_isfalse(L->top);
}
static int l_strcmp (const TString *ls, const TString *rs) {
const char *l = getstr(ls);
size_t ll = ls->tsv.len;
const char *r = getstr(rs);
size_t lr = rs->tsv.len;
for (;;) {
int temp = strcoll(l, r);
if (temp != 0) return temp;
else { /* strings are equal up to a `\0' */
size_t len = strlen(l); /* index of first `\0' in both strings */
if (len == lr) /* r is finished? */
return (len == ll) ? 0 : 1;
else if (len == ll) /* l is finished? */
return -1; /* l is smaller than r (because r is not finished) */
/* both strings longer than `len'; go on comparing (after the `\0') */
len++;
l += len; ll -= len; r += len; lr -= len;
}
}
}
int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r) {
int res;
if (ttype(l) != ttype(r))
return luaG_ordererror(L, l, r);
else if (ttisnumber(l))
return luai_numlt(nvalue(l), nvalue(r));
else if (ttisstring(l))
return l_strcmp(rawtsvalue(l), rawtsvalue(r)) < 0;
else if ((res = call_orderTM(L, l, r, TM_LT)) != -1)
return res;
return luaG_ordererror(L, l, r);
}
static int lessequal (lua_State *L, const TValue *l, const TValue *r) {
int res;
if (ttype(l) != ttype(r))
return luaG_ordererror(L, l, r);
else if (ttisnumber(l))
return luai_numle(nvalue(l), nvalue(r));
else if (ttisstring(l))
return l_strcmp(rawtsvalue(l), rawtsvalue(r)) <= 0;
else if ((res = call_orderTM(L, l, r, TM_LE)) != -1) /* first try `le' */
return res;
else if ((res = call_orderTM(L, r, l, TM_LT)) != -1) /* else try `lt' */
return !res;
return luaG_ordererror(L, l, r);
}
int luaV_equalval (lua_State *L, const TValue *t1, const TValue *t2) {
const TValue *tm;
lua_assert(ttype(t1) == ttype(t2));
switch (ttype(t1)) {
case LUA_TNIL: return 1;
case LUA_TNUMBER: return luai_numeq(nvalue(t1), nvalue(t2));
case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2); /* true must be 1 !! */
case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
case LUA_TUSERDATA: {
if (uvalue(t1) == uvalue(t2)) return 1;
tm = get_compTM(L, uvalue(t1)->metatable, uvalue(t2)->metatable,
TM_EQ);
break; /* will try TM */
}
case LUA_TTABLE: {
if (hvalue(t1) == hvalue(t2)) return 1;
tm = get_compTM(L, hvalue(t1)->metatable, hvalue(t2)->metatable, TM_EQ);
break; /* will try TM */
}
default: return gcvalue(t1) == gcvalue(t2);
}
if (tm == NULL) return 0; /* no TM? */
callTMres(L, L->top, tm, t1, t2); /* call TM */
return !l_isfalse(L->top);
}
void luaV_concat (lua_State *L, int total, int last) {
do {
StkId top = L->base + last + 1;
int n = 2; /* number of elements handled in this pass (at least 2) */
if (!(ttisstring(top-2) || ttisnumber(top-2)) || !tostring(L, top-1)) {
if (!call_binTM(L, top-2, top-1, top-2, TM_CONCAT))
luaG_concaterror(L, top-2, top-1);
} else if (tsvalue(top-1)->len == 0) /* second op is empty? */
(void)tostring(L, top - 2); /* result is first op (as string) */
else {
/* at least two string values; get as many as possible */
size_t tl = tsvalue(top-1)->len;
char *buffer;
int i;
/* collect total length */
for (n = 1; n < total && tostring(L, top-n-1); n++) {
size_t l = tsvalue(top-n-1)->len;
if (l >= MAX_SIZET - tl) luaG_runerror(L, "string length overflow");
tl += l;
}
buffer = luaZ_openspace(L, &G(L)->buff, tl);
tl = 0;
for (i=n; i>0; i--) { /* concat all strings */
size_t l = tsvalue(top-i)->len;
memcpy(buffer+tl, svalue(top-i), l);
tl += l;
}
setsvalue2s(L, top-n, luaS_newlstr(L, buffer, tl));
}
total -= n-1; /* got `n' strings to create 1 new */
last -= n-1;
} while (total > 1); /* repeat until only 1 result left */
}
static void Arith (lua_State *L, StkId ra, const TValue *rb,
const TValue *rc, TMS op) {
TValue tempb, tempc;
const TValue *b, *c;
if ((b = luaV_tonumber(rb, &tempb)) != NULL &&
(c = luaV_tonumber(rc, &tempc)) != NULL) {
lua_Number nb = nvalue(b), nc = nvalue(c);
switch (op) {
case TM_ADD: setnvalue(ra, luai_numadd(nb, nc)); break;
case TM_SUB: setnvalue(ra, luai_numsub(nb, nc)); break;
case TM_MUL: setnvalue(ra, luai_nummul(nb, nc)); break;
case TM_DIV: setnvalue(ra, luai_numdiv(nb, nc)); break;
case TM_MOD: setnvalue(ra, luai_nummod(nb, nc)); break;
case TM_POW: setnvalue(ra, luai_numpow(nb, nc)); break;
case TM_UNM: setnvalue(ra, luai_numunm(nb)); break;
default: lua_assert(0); break;
}
}
else if (!call_binTM(L, rb, rc, ra, op))
luaG_aritherror(L, rb, rc);
}
/*
** some macros for common tasks in `luaV_execute'
*/
#define runtime_check(L, c) { if (!(c)) break; }
#define RA(i) (base+GETARG_A(i))
/* to be used after possible stack reallocation */
#define RB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgR, base+GETARG_B(i))
#define RC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgR, base+GETARG_C(i))
#define RKB(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgK, \
ISK(GETARG_B(i)) ? k+INDEXK(GETARG_B(i)) : base+GETARG_B(i))
#define RKC(i) check_exp(getCMode(GET_OPCODE(i)) == OpArgK, \
ISK(GETARG_C(i)) ? k+INDEXK(GETARG_C(i)) : base+GETARG_C(i))
#define KBx(i) check_exp(getBMode(GET_OPCODE(i)) == OpArgK, k+GETARG_Bx(i))
#define dojump(L,pc,i) {(pc) += (i); luai_threadyield(L);}
#define Protect(x) { L->savedpc = pc; {x;}; base = L->base; }
#define arith_op(op,tm) { \
TValue *rb = RKB(i); \
TValue *rc = RKC(i); \
if (ttisnumber(rb) && ttisnumber(rc)) { \
lua_Number nb = nvalue(rb), nc = nvalue(rc); \
setnvalue(ra, op(nb, nc)); \
} \
else \
Protect(Arith(L, ra, rb, rc, tm)); \
}
void luaV_execute (lua_State *L, int nexeccalls) {
LClosure *cl;
StkId base;
TValue *k;
const Instruction *pc;
reentry: /* entry point */
lua_assert(isLua(L->ci));
pc = L->savedpc;
cl = &clvalue(L->ci->func)->l;
base = L->base;
k = cl->p->k;
/* main loop of interpreter */
for (;;) {
const Instruction i = *pc++;
StkId ra;
if ((L->hookmask & (LUA_MASKLINE | LUA_MASKCOUNT)) &&
(--L->hookcount == 0 || L->hookmask & LUA_MASKLINE)) {
traceexec(L, pc);
if (L->status == LUA_YIELD) { /* did hook yield? */
L->savedpc = pc - 1;
return;
}
base = L->base;
}
/* warning!! several calls may realloc the stack and invalidate `ra' */
ra = RA(i);
lua_assert(base == L->base && L->base == L->ci->base);
lua_assert(base <= L->top && L->top <= L->stack + L->stacksize);
lua_assert(L->top == L->ci->top || luaG_checkopenop(i));
switch (GET_OPCODE(i)) {
case OP_MOVE: {
setobjs2s(L, ra, RB(i));
continue;
}
case OP_LOADK: {
setobj2s(L, ra, KBx(i));
continue;
}
case OP_LOADBOOL: {
setbvalue(ra, GETARG_B(i));
if (GETARG_C(i)) pc++; /* skip next instruction (if C) */
continue;
}
case OP_LOADNIL: {
TValue *rb = RB(i);
do {
setnilvalue(rb--);
} while (rb >= ra);
continue;
}
case OP_GETUPVAL: {
int b = GETARG_B(i);
setobj2s(L, ra, cl->upvals[b]->v);
continue;
}
case OP_GETGLOBAL: {
TValue g;
TValue *rb = KBx(i);
sethvalue(L, &g, cl->env);
lua_assert(ttisstring(rb));
Protect(luaV_gettable(L, &g, rb, ra));
continue;
}
case OP_GETTABLE: {
Protect(luaV_gettable(L, RB(i), RKC(i), ra));
continue;
}
case OP_SETGLOBAL: {
TValue g;
sethvalue(L, &g, cl->env);
lua_assert(ttisstring(KBx(i)));
Protect(luaV_settable(L, &g, KBx(i), ra));
continue;
}
case OP_SETUPVAL: {
UpVal *uv = cl->upvals[GETARG_B(i)];
setobj(L, uv->v, ra);
luaC_barrier(L, uv, ra);
continue;
}
case OP_SETTABLE: {
Protect(luaV_settable(L, ra, RKB(i), RKC(i)));
continue;
}
case OP_NEWTABLE: {
int b = GETARG_B(i);
int c = GETARG_C(i);
sethvalue(L, ra, luaH_new(L, luaO_fb2int(b), luaO_fb2int(c)));
Protect(luaC_checkGC(L));
continue;
}
case OP_SELF: {
StkId rb = RB(i);
setobjs2s(L, ra+1, rb);
Protect(luaV_gettable(L, rb, RKC(i), ra));
continue;
}
case OP_ADD: {
arith_op(luai_numadd, TM_ADD);
continue;
}
case OP_SUB: {
arith_op(luai_numsub, TM_SUB);
continue;
}
case OP_MUL: {
arith_op(luai_nummul, TM_MUL);
continue;
}
case OP_DIV: {
arith_op(luai_numdiv, TM_DIV);
continue;
}
case OP_MOD: {
arith_op(luai_nummod, TM_MOD);
continue;
}
case OP_POW: {
arith_op(luai_numpow, TM_POW);
continue;
}
case OP_UNM: {
TValue *rb = RB(i);
if (ttisnumber(rb)) {
lua_Number nb = nvalue(rb);
setnvalue(ra, luai_numunm(nb));
}
else {
Protect(Arith(L, ra, rb, rb, TM_UNM));
}
continue;
}
case OP_NOT: {
int res = l_isfalse(RB(i)); /* next assignment may change this value */
setbvalue(ra, res);
continue;
}
case OP_LEN: {
const TValue *rb = RB(i);
switch (ttype(rb)) {
case LUA_TTABLE: {
setnvalue(ra, cast_num(luaH_getn(hvalue(rb))));
break;
}
case LUA_TSTRING: {
setnvalue(ra, cast_num(tsvalue(rb)->len));
break;
}
default: { /* try metamethod */
Protect(
if (!call_binTM(L, rb, luaO_nilobject, ra, TM_LEN))
luaG_typeerror(L, rb, "get length of");
)
}
}
continue;
}
case OP_CONCAT: {
int b = GETARG_B(i);
int c = GETARG_C(i);
Protect(luaV_concat(L, c-b+1, c); luaC_checkGC(L));
setobjs2s(L, RA(i), base+b);
continue;
}
case OP_JMP: {
dojump(L, pc, GETARG_sBx(i));
continue;
}
case OP_EQ: {
TValue *rb = RKB(i);
TValue *rc = RKC(i);
Protect(
if (equalobj(L, rb, rc) == GETARG_A(i))
dojump(L, pc, GETARG_sBx(*pc));
)
pc++;
continue;
}
case OP_LT: {
Protect(
if (luaV_lessthan(L, RKB(i), RKC(i)) == GETARG_A(i))
dojump(L, pc, GETARG_sBx(*pc));
)
pc++;
continue;
}
case OP_LE: {
Protect(
if (lessequal(L, RKB(i), RKC(i)) == GETARG_A(i))
dojump(L, pc, GETARG_sBx(*pc));
)
pc++;
continue;
}
case OP_TEST: {
if (l_isfalse(ra) != GETARG_C(i))
dojump(L, pc, GETARG_sBx(*pc));
pc++;
continue;
}
case OP_TESTSET: {
TValue *rb = RB(i);
if (l_isfalse(rb) != GETARG_C(i)) {
setobjs2s(L, ra, rb);
dojump(L, pc, GETARG_sBx(*pc));
}
pc++;
continue;
}
case OP_CALL: {
int b = GETARG_B(i);
int nresults = GETARG_C(i) - 1;
if (b != 0) L->top = ra+b; /* else previous instruction set top */
L->savedpc = pc;
switch (luaD_precall(L, ra, nresults)) {
case PCRLUA: {
nexeccalls++;
goto reentry; /* restart luaV_execute over new Lua function */
}
case PCRC: {
/* it was a C function (`precall' called it); adjust results */
if (nresults >= 0) L->top = L->ci->top;
base = L->base;
continue;
}
default: {
return; /* yield */
}
}
}
case OP_TAILCALL: {
int b = GETARG_B(i);
if (b != 0) L->top = ra+b; /* else previous instruction set top */
L->savedpc = pc;
lua_assert(GETARG_C(i) - 1 == LUA_MULTRET);
switch (luaD_precall(L, ra, LUA_MULTRET)) {
case PCRLUA: {
/* tail call: put new frame in place of previous one */
CallInfo *ci = L->ci - 1; /* previous frame */
int aux;
StkId func = ci->func;
StkId pfunc = (ci+1)->func; /* previous function index */
if (L->openupval) luaF_close(L, ci->base);
L->base = ci->base = ci->func + ((ci+1)->base - pfunc);
for (aux = 0; pfunc+aux < L->top; aux++) /* move frame down */
setobjs2s(L, func+aux, pfunc+aux);
ci->top = L->top = func+aux; /* correct top */
lua_assert(L->top == L->base + clvalue(func)->l.p->maxstacksize);
ci->savedpc = L->savedpc;
ci->tailcalls++; /* one more call lost */
L->ci--; /* remove new frame */
goto reentry;
}
case PCRC: { /* it was a C function (`precall' called it) */
base = L->base;
continue;
}
default: {
return; /* yield */
}
}
}
case OP_RETURN: {
int b = GETARG_B(i);
if (b != 0) L->top = ra+b-1;
if (L->openupval) luaF_close(L, base);
L->savedpc = pc;
b = luaD_poscall(L, ra);
if (--nexeccalls == 0) /* was previous function running `here'? */
return; /* no: return */
else { /* yes: continue its execution */
if (b) L->top = L->ci->top;
lua_assert(isLua(L->ci));
lua_assert(GET_OPCODE(*((L->ci)->savedpc - 1)) == OP_CALL);
goto reentry;
}
}
case OP_FORLOOP: {
lua_Number step = nvalue(ra+2);
lua_Number idx = luai_numadd(nvalue(ra), step); /* increment index */
lua_Number limit = nvalue(ra+1);
if (luai_numlt(0, step) ? luai_numle(idx, limit)
: luai_numle(limit, idx)) {
dojump(L, pc, GETARG_sBx(i)); /* jump back */
setnvalue(ra, idx); /* update internal index... */
setnvalue(ra+3, idx); /* ...and external index */
}
continue;
}
case OP_FORPREP: {
const TValue *init = ra;
const TValue *plimit = ra+1;
const TValue *pstep = ra+2;
L->savedpc = pc; /* next steps may throw errors */
if (!tonumber(init, ra))
luaG_runerror(L, LUA_QL("for") " initial value must be a number");
else if (!tonumber(plimit, ra+1))
luaG_runerror(L, LUA_QL("for") " limit must be a number");
else if (!tonumber(pstep, ra+2))
luaG_runerror(L, LUA_QL("for") " step must be a number");
setnvalue(ra, luai_numsub(nvalue(ra), nvalue(pstep)));
dojump(L, pc, GETARG_sBx(i));
continue;
}
case OP_TFORLOOP: {
StkId cb = ra + 3; /* call base */
setobjs2s(L, cb+2, ra+2);
setobjs2s(L, cb+1, ra+1);
setobjs2s(L, cb, ra);
L->top = cb+3; /* func. + 2 args (state and index) */
Protect(luaD_call(L, cb, GETARG_C(i)));
L->top = L->ci->top;
cb = RA(i) + 3; /* previous call may change the stack */
if (!ttisnil(cb)) { /* continue loop? */
setobjs2s(L, cb-1, cb); /* save control variable */
dojump(L, pc, GETARG_sBx(*pc)); /* jump back */
}
pc++;
continue;
}
case OP_SETLIST: {
int n = GETARG_B(i);
int c = GETARG_C(i);
int last;
Table *h;
if (n == 0) {
n = cast_int(L->top - ra) - 1;
L->top = L->ci->top;
}
if (c == 0) c = cast_int(*pc++);
runtime_check(L, ttistable(ra));
h = hvalue(ra);
last = ((c-1)*LFIELDS_PER_FLUSH) + n;
if (last > h->sizearray) /* needs more space? */
luaH_resizearray(L, h, last); /* pre-alloc it at once */
for (; n > 0; n--) {
TValue *val = ra+n;
setobj2t(L, luaH_setnum(L, h, last--), val);
luaC_barriert(L, h, val);
}
continue;
}
case OP_CLOSE: {
luaF_close(L, ra);
continue;
}
case OP_CLOSURE: {
Proto *p;
Closure *ncl;
int nup, j;
p = cl->p->p[GETARG_Bx(i)];
nup = p->nups;
ncl = luaF_newLclosure(L, nup, cl->env);
ncl->l.p = p;
for (j=0; j<nup; j++, pc++) {
if (GET_OPCODE(*pc) == OP_GETUPVAL)
ncl->l.upvals[j] = cl->upvals[GETARG_B(*pc)];
else {
lua_assert(GET_OPCODE(*pc) == OP_MOVE);
ncl->l.upvals[j] = luaF_findupval(L, base + GETARG_B(*pc));
}
}
setclvalue(L, ra, ncl);
Protect(luaC_checkGC(L));
continue;
}
case OP_VARARG: {
int b = GETARG_B(i) - 1;
int j;
CallInfo *ci = L->ci;
int n = cast_int(ci->base - ci->func) - cl->p->numparams - 1;
if (b == LUA_MULTRET) {
Protect(luaD_checkstack(L, n));
ra = RA(i); /* previous call may change the stack */
b = n;
L->top = ra + n;
}
for (j = 0; j < b; j++) {
if (j < n) {
setobjs2s(L, ra + j, ci->base - n + j);
}
else {
setnilvalue(ra + j);
}
}
continue;
}
}
}
}

36
src/lua/lvm.h
View File

@ -1,36 +0,0 @@
/*
** $Id: lvm.h,v 2.5.1.1 2007/12/27 13:02:25 roberto Exp $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
#ifndef lvm_h
#define lvm_h
#include "ldo.h"
#include "lobject.h"
#include "ltm.h"
#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))
LUAI_FUNC int luaV_lessthan (lua_State *L, const TValue *l, const TValue *r);
LUAI_FUNC int luaV_equalval (lua_State *L, const TValue *t1, const TValue *t2);
LUAI_FUNC const TValue *luaV_tonumber (const TValue *obj, TValue *n);
LUAI_FUNC int luaV_tostring (lua_State *L, StkId obj);
LUAI_FUNC void luaV_gettable (lua_State *L, const TValue *t, TValue *key,
StkId val);
LUAI_FUNC void luaV_settable (lua_State *L, const TValue *t, TValue *key,
StkId val);
LUAI_FUNC void luaV_execute (lua_State *L, int nexeccalls);
LUAI_FUNC void luaV_concat (lua_State *L, int total, int last);
#endif

82
src/lua/lzio.c
View File

@ -1,82 +0,0 @@
/*
** $Id: lzio.c,v 1.31.1.1 2007/12/27 13:02:25 roberto Exp $
** a generic input stream interface
** See Copyright Notice in lua.h
*/
#include <string.h>
#define lzio_c
#define LUA_CORE
#include "lua.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;
z->p = buff;
return char2int(*(z->p++));
}
int luaZ_lookahead (ZIO *z) {
if (z->n == 0) {
if (luaZ_fill(z) == EOZ)
return EOZ;
else {
z->n++; /* luaZ_fill removed first byte; put back it */
z->p--;
}
}
return char2int(*z->p);
}
void luaZ_init (lua_State *L, ZIO *z, lua_Reader reader, void *data) {
z->L = L;
z->reader = reader;
z->data = data;
z->n = 0;
z->p = NULL;
}
/* --------------------------------------------------------------- read --- */
size_t luaZ_read (ZIO *z, void *b, size_t n) {
while (n) {
size_t m;
if (luaZ_lookahead(z) == EOZ)
return n; /* return number of missing bytes */
m = (n <= z->n) ? n : z->n; /* min. between n and z->n */
memcpy(b, z->p, m);
z->n -= m;
z->p += m;
b = (char *)b + m;
n -= m;
}
return 0;
}
/* ------------------------------------------------------------------------ */
char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n) {
if (n > buff->buffsize) {
if (n < LUA_MINBUFFER) n = LUA_MINBUFFER;
luaZ_resizebuffer(L, buff, n);
}
return buff->buffer;
}

67
src/lua/lzio.h
View File

@ -1,67 +0,0 @@
/*
** $Id: lzio.h,v 1.21.1.1 2007/12/27 13:02:25 roberto Exp $
** Buffered streams
** See Copyright Notice in lua.h
*/
#ifndef lzio_h
#define lzio_h
#include "lua.h"
#include "lmem.h"
#define EOZ (-1) /* end of stream */
typedef struct Zio ZIO;
#define char2int(c) cast(int, cast(unsigned char, (c)))
#define zgetc(z) (((z)->n--)>0 ? char2int(*(z)->p++) : luaZ_fill(z))
typedef struct Mbuffer {
char *buffer;
size_t n;
size_t buffsize;
} Mbuffer;
#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_resetbuffer(buff) ((buff)->n = 0)
#define luaZ_resizebuffer(L, buff, 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 char *luaZ_openspace (lua_State *L, Mbuffer *buff, size_t n);
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 int luaZ_lookahead (ZIO *z);
/* --------- Private Part ------------------ */
struct Zio {
size_t n; /* bytes still unread */
const char *p; /* current position in buffer */
lua_Reader reader;
void* data; /* additional data */
lua_State *L; /* Lua state (for reader) */
};
LUAI_FUNC int luaZ_fill (ZIO *z);
#endif

386
src/main.c
View File

@ -1,386 +0,0 @@
#include <signal.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define lua_c
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
static lua_State *globalL = NULL;
static const char *progname = LUA_PROGNAME;
static void lstop (lua_State *L, lua_Debug *ar) {
(void)ar; /* unused arg. */
lua_sethook(L, NULL, 0, 0);
luaL_error(L, "interrupted!");
}
static void laction (int i) {
signal(i, SIG_DFL); /* if another SIGINT happens before lstop,
terminate process (default action) */
lua_sethook(globalL, lstop, LUA_MASKCALL | LUA_MASKRET | LUA_MASKCOUNT, 1);
}
static void print_usage (void) {
fprintf(stderr,
"usage: %s [options] [script [args]].\n"
"Available options are:\n"
" -e stat execute string " LUA_QL("stat") "\n"
" -l name require library " LUA_QL("name") "\n"
" -i enter interactive mode after executing " LUA_QL("script") "\n"
" -v show version information\n"
" -- stop handling options\n"
" - execute stdin and stop handling options\n"
,
progname);
fflush(stderr);
}
static void l_message (const char *pname, const char *msg) {
if (pname) fprintf(stderr, "%s: ", pname);
fprintf(stderr, "%s\n", msg);
fflush(stderr);
}
static int report (lua_State *L, int status) {
if (status && !lua_isnil(L, -1)) {
const char *msg = lua_tostring(L, -1);
if (msg == NULL) msg = "(error object is not a string)";
l_message(progname, msg);
lua_pop(L, 1);
}
return status;
}
static int traceback (lua_State *L) {
if (!lua_isstring(L, 1)) /* 'message' not a string? */
return 1; /* keep it intact */
lua_getfield(L, LUA_GLOBALSINDEX, "debug");
if (!lua_istable(L, -1)) {
lua_pop(L, 1);
return 1;
}
lua_getfield(L, -1, "traceback");
if (!lua_isfunction(L, -1)) {
lua_pop(L, 2);
return 1;
}
lua_pushvalue(L, 1); /* pass error message */
lua_pushinteger(L, 2); /* skip this function and traceback */
lua_call(L, 2, 1); /* call debug.traceback */
return 1;
}
static int docall (lua_State *L, int narg, int clear) {
int status;
int base = lua_gettop(L) - narg; /* function index */
lua_pushcfunction(L, traceback); /* push traceback function */
lua_insert(L, base); /* put it under chunk and args */
signal(SIGINT, laction);
status = lua_pcall(L, narg, (clear ? 0 : LUA_MULTRET), base);
signal(SIGINT, SIG_DFL);
lua_remove(L, base); /* remove traceback function */
/* force a complete garbage collection in case of errors */
if (status != 0) lua_gc(L, LUA_GCCOLLECT, 0);
return status;
}
static void print_version (void) {
l_message(NULL, LUA_RELEASE " " LUA_COPYRIGHT);
}
static int getargs (lua_State *L, char **argv, int n) {
int narg;
int i;
int argc = 0;
while (argv[argc]) argc++; /* count total number of arguments */
narg = argc - (n + 1); /* number of arguments to the script */
luaL_checkstack(L, narg + 3, "too many arguments to script");
for (i=n+1; i < argc; i++)
lua_pushstring(L, argv[i]);
lua_createtable(L, narg, n + 1);
for (i=0; i < argc; i++) {
lua_pushstring(L, argv[i]);
lua_rawseti(L, -2, i - n);
}
return narg;
}
static int dofile (lua_State *L, const char *name) {
int status = luaL_loadfile(L, name) || docall(L, 0, 1);
return report(L, status);
}
static int dostring (lua_State *L, const char *s, const char *name) {
int status = luaL_loadbuffer(L, s, strlen(s), name) || docall(L, 0, 1);
return report(L, status);
}
static int dolibrary (lua_State *L, const char *name) {
lua_getglobal(L, "require");
lua_pushstring(L, name);
return report(L, docall(L, 1, 1));
}
static const char *get_prompt (lua_State *L, int firstline) {
const char *p;
lua_getfield(L, LUA_GLOBALSINDEX, firstline ? "_PROMPT" : "_PROMPT2");
p = lua_tostring(L, -1);
if (p == NULL) p = (firstline ? LUA_PROMPT : LUA_PROMPT2);
lua_pop(L, 1); /* remove global */
return p;
}
static int incomplete (lua_State *L, int status) {
if (status == LUA_ERRSYNTAX) {
size_t lmsg;
const char *msg = lua_tolstring(L, -1, &lmsg);
const char *tp = msg + lmsg - (sizeof(LUA_QL("<eof>")) - 1);
if (strstr(msg, LUA_QL("<eof>")) == tp) {
lua_pop(L, 1);
return 1;
}
}
return 0; /* else... */
}
static int pushline (lua_State *L, int firstline) {
char buffer[LUA_MAXINPUT];
char *b = buffer;
size_t l;
const char *prmt = get_prompt(L, firstline);
if (lua_readline(L, b, prmt) == 0)
return 0; /* no input */
l = strlen(b);
if (l > 0 && b[l-1] == '\n') /* line ends with newline? */
b[l-1] = '\0'; /* remove it */
if (firstline && b[0] == '=') /* first line starts with `=' ? */
lua_pushfstring(L, "return %s", b+1); /* change it to `return' */
else
lua_pushstring(L, b);
lua_freeline(L, b);
return 1;
}
static int loadline (lua_State *L) {
int status;
lua_settop(L, 0);
if (!pushline(L, 1))
return -1; /* no input */
for (;;) { /* repeat until gets a complete line */
status = luaL_loadbuffer(L, lua_tostring(L, 1), lua_strlen(L, 1), "=stdin");
if (!incomplete(L, status)) break; /* cannot try to add lines? */
if (!pushline(L, 0)) /* no more input? */
return -1;
lua_pushliteral(L, "\n"); /* add a new line... */
lua_insert(L, -2); /* ...between the two lines */
lua_concat(L, 3); /* join them */
}
lua_saveline(L, 1);
lua_remove(L, 1); /* remove line */
return status;
}
static void dotty (lua_State *L) {
int status;
const char *oldprogname = progname;
progname = NULL;
while ((status = loadline(L)) != -1) {
if (status == 0) status = docall(L, 0, 0);
report(L, status);
if (status == 0 && lua_gettop(L) > 0) { /* any result to print? */
lua_getglobal(L, "print");
lua_insert(L, 1);
if (lua_pcall(L, lua_gettop(L)-1, 0, 0) != 0)
l_message(progname, lua_pushfstring(L,
"error calling " LUA_QL("print") " (%s)",
lua_tostring(L, -1)));
}
}
lua_settop(L, 0); /* clear stack */
fputs("\n", stdout);
fflush(stdout);
progname = oldprogname;
}
static int handle_script (lua_State *L, char **argv, int n) {
int status;
const char *fname;
int narg = getargs(L, argv, n); /* collect arguments */
lua_setglobal(L, "arg");
fname = argv[n];
if (strcmp(fname, "-") == 0 && strcmp(argv[n-1], "--") != 0)
fname = NULL; /* stdin */
status = luaL_loadfile(L, fname);
lua_insert(L, -(narg+1));
if (status == 0)
status = docall(L, narg, 0);
else
lua_pop(L, narg);
return report(L, status);
}
/* check that argument has no extra characters at the end */
#define notail(x) {if ((x)[2] != '\0') return -1;}
static int collectargs (char **argv, int *pi, int *pv, int *pe) {
int i;
for (i = 1; argv[i] != NULL; i++) {
if (argv[i][0] != '-') /* not an option? */
return i;
switch (argv[i][1]) { /* option */
case '-':
notail(argv[i]);
return (argv[i+1] != NULL ? i+1 : 0);
case '\0':
return i;
case 'i':
notail(argv[i]);
*pi = 1; /* go through */
case 'v':
notail(argv[i]);
*pv = 1;
break;
case 'e':
*pe = 1; /* go through */
case 'l':
if (argv[i][2] == '\0') {
i++;
if (argv[i] == NULL) return -1;
}
break;
default: return -1; /* invalid option */
}
}
return 0;
}
static int runargs (lua_State *L, char **argv, int n) {
int i;
for (i = 1; i < n; i++) {
if (argv[i] == NULL) continue;
lua_assert(argv[i][0] == '-');
switch (argv[i][1]) { /* option */
case 'e': {
const char *chunk = argv[i] + 2;
if (*chunk == '\0') chunk = argv[++i];
lua_assert(chunk != NULL);
if (dostring(L, chunk, "=(command line)") != 0)
return 1;
break;
}
case 'l': {
const char *filename = argv[i] + 2;
if (*filename == '\0') filename = argv[++i];
lua_assert(filename != NULL);
if (dolibrary(L, filename))
return 1; /* stop if file fails */
break;
}
default: break;
}
}
return 0;
}
static int handle_luainit (lua_State *L) {
const char *init = getenv(LUA_INIT);
if (init == NULL) return 0; /* status OK */
else if (init[0] == '@')
return dofile(L, init+1);
else
return dostring(L, init, "=" LUA_INIT);
}
struct Smain {
int argc;
char **argv;
int status;
};
static int pmain (lua_State *L) {
struct Smain *s = (struct Smain *)lua_touserdata(L, 1);
char **argv = s->argv;
int script;
int has_i = 0, has_v = 0, has_e = 0;
globalL = L;
if (argv[0] && argv[0][0]) progname = argv[0];
lua_gc(L, LUA_GCSTOP, 0); /* stop collector during initialization */
luaL_openlibs(L); /* open libraries */
lua_gc(L, LUA_GCRESTART, 0);
s->status = handle_luainit(L);
if (s->status != 0) return 0;
script = collectargs(argv, &has_i, &has_v, &has_e);
if (script < 0) { /* invalid args? */
print_usage();
s->status = 1;
return 0;
}
if (has_v) print_version();
s->status = runargs(L, argv, (script > 0) ? script : s->argc);
if (s->status != 0) return 0;
if (script)
s->status = handle_script(L, argv, script);
if (s->status != 0) return 0;
if (has_i)
dotty(L);
else if (script == 0 && !has_e && !has_v) {
if (lua_stdin_is_tty()) {
print_version();
dotty(L);
}
else dofile(L, NULL); /* executes stdin as a file */
}
return 0;
}
int main (int argc, char **argv) {
int status;
struct Smain s;
lua_State *L = lua_open(); /* create state */
if (L == NULL) {
l_message(argv[0], "cannot create state: not enough memory");
return EXIT_FAILURE;
}
s.argc = argc;
s.argv = argv;
status = lua_cpcall(L, &pmain, &s);
report(L, status);
lua_close(L);
return (status || s.status) ? EXIT_FAILURE : EXIT_SUCCESS;
}

277
src/metalua.lua
View File

@ -1,277 +0,0 @@
#! /usr/bin/env lua51
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
-- Survive lack of checks
if not pcall(require, 'checks') then function package.preload.checks() function checks() end end end
-- Main file for the metalua executable
require 'metalua.loader' -- load *.mlue files
require 'metalua.compiler.globals' -- metalua-aware loadstring, dofile etc.
local alt_getopt = require 'alt_getopt'
local pp = require 'metalua.pprint'
local mlc = require 'metalua.compiler'
local M = { }
local AST_COMPILE_ERROR_NUMBER = -1
local RUNTIME_ERROR_NUMBER = -3
local alt_getopt_options = "f:l:e:o:xivaASbs"
local long_opts = {
file='f',
library='l',
literal='e',
output='o',
run='x',
interactive='i',
verbose='v',
['print-ast']='a',
['print-ast-lineinfo']='A',
['print-src']='S',
['meta-bugs']='b',
['sharp-bang']='s',
}
local chunk_options = {
library=1,
file=1,
literal=1
}
local usage=[[
Compile and/or execute metalua programs. Parameters passed to the
compiler should be prefixed with an option flag, hinting what must be
done with them: take tham as file names to compile, as library names
to load, as parameters passed to the running program... When option
flags are absent, metalua tries to adopt a "Do What I Mean" approach:
- if no code (no library, no literal expression and no file) is
specified, the first flag-less parameter is taken as a file name to
load.
- if no code and no parameter is passed, an interactive loop is
started.
- if a target file is specified with --output, the program is not
executed by default, unless a --run flag forces it to. Conversely,
if no --output target is specified, the code is run unless ++run
forbids it.
]]
function M.cmdline_parser(...)
local argv = {...}
local opts, optind, optarg =
alt_getopt.get_ordered_opts({...}, alt_getopt_options, long_opts)
--pp.printf("argv=%s; opts=%s, ending at %i, with optarg=%s",
-- argv, opts, optind, optarg)
local s2l = { } -- short to long option names conversion table
for long, short in pairs(long_opts) do s2l[short]=long end
local cfg = { chunks = { } }
for i, short in pairs(opts) do
local long = s2l[short]
if chunk_options[long] then table.insert(cfg.chunks, { tag=long, optarg[i] })
else cfg[long] = optarg[i] or true end
end
cfg.params = { select(optind, ...) }
return cfg
end
function M.main (...)
local cfg = M.cmdline_parser(...)
-------------------------------------------------------------------
-- Print messages if in verbose mode
-------------------------------------------------------------------
local function verb_print (fmt, ...)
if cfg.verbose then
return pp.printf ("[ "..fmt.." ]", ...)
end
end
if cfg.verbose then
verb_print("raw options: %s", cfg)
end
-------------------------------------------------------------------
-- If there's no chunk but there are params, interpret the first
-- param as a file name.
if not next(cfg.chunks) and next(cfg.params) then
local the_file = table.remove(cfg.params, 1)
verb_print("Param %q considered as a source file", the_file)
cfg.file={ the_file }
end
-------------------------------------------------------------------
-- If nothing to do, run REPL loop
if not next(cfg.chunks) and not cfg.interactive then
verb_print "Nothing to compile nor run, force interactive loop"
cfg.interactive=true
end
-------------------------------------------------------------------
-- Run if asked to, or if no --output has been given
-- if cfg.run==false it's been *forced* to false, don't override.
if not cfg.run and not cfg.output then
verb_print("No output file specified; I'll run the program")
cfg.run = true
end
local code = { }
-------------------------------------------------------------------
-- Get ASTs from sources
local last_file_idx
for i, x in ipairs(cfg.chunks) do
local compiler = mlc.new()
local tag, val = x.tag, x[1]
verb_print("Compiling %s", x)
local st, ast
if tag=='library' then
ast = { tag='Call',
{tag='Id', "require" },
{tag='String', val } }
elseif tag=='literal' then ast = compiler :src_to_ast(val)
elseif tag=='file' then
ast = compiler :srcfile_to_ast(val)
-- Isolate each file in a separate fenv
ast = { tag='Call',
{ tag='Function', { { tag='Dots'} }, ast },
{ tag='Dots' } }
ast.source = '@'..val
code.source = '@'..val
last_file_idx = i
else
error ("Bad option "..tag)
end
local valid = true -- TODO: check AST's correctness
if not valid then
pp.printf ("Cannot compile %s:\n%s", x, ast or "no msg")
os.exit (AST_COMPILE_ERROR_NUMBER)
end
ast.origin = x
table.insert(code, ast)
end
-- The last file returns the whole chunk's result
if last_file_idx then
-- transform +{ (function(...) -{ast} end)(...) }
-- into +{ return (function(...) -{ast} end)(...) }
local prv_ast = code[last_file_idx]
local new_ast = { tag='Return', prv_ast }
new_ast.source, new_ast.origin, prv_ast.source, prv_ast.origin =
prv_ast.source, prv_ast.origin, nil, nil
code[last_file_idx] = new_ast
end
-- Further uses of compiler won't involve AST transformations:
-- they can share the same instance.
-- TODO: reuse last instance if possible.
local compiler = mlc.new()
-------------------------------------------------------------------
-- AST printing
if cfg['print-ast'] or cfg['print-ast-lineinfo'] then
verb_print "Resulting AST:"
for _, x in ipairs(code) do
pp.printf("--- AST From %s: ---", x.source)
if x.origin and x.origin.tag=='File' then x=x[1][1][2][1] end
local pp_cfg = cfg['print-ast-lineinfo']
and { line_max=1, fix_indent=1, metalua_tag=1 }
or { line_max=1, metalua_tag=1, hide_hash=1 }
pp.print(x, pp_cfg)
end
end
-------------------------------------------------------------------
-- Source printing
if cfg['print-src'] then
verb_print "Resulting sources:"
for _, x in ipairs(code) do
printf("--- Source From %s: ---", table.tostring(x.source, 'nohash'))
if x.origin and x.origin.tag=='File' then x=x[1][1][2] end
print (compiler :ast2string (x))
end
end
-- TODO: canonize/check AST
local bytecode = compiler :ast_to_bytecode (code)
code = nil
-------------------------------------------------------------------
-- Insert #!... command
if cfg.sharpbang then
local shbang = cfg.sharpbang
verb_print ("Adding sharp-bang directive %q", shbang)
if not shbang :match'^#!' then shbang = '#!' .. shbang end
if not shbang :match'\n$' then shbang = shbang .. '\n' end
bytecode = shbang .. bytecode
end
-------------------------------------------------------------------
-- Save to file
if cfg.output then
-- FIXME: handle '-'
verb_print ("Saving to file %q", cfg.output)
local file, err_msg = io.open(cfg.output, 'wb')
if not file then error("can't open output file: "..err_msg) end
file:write(bytecode)
file:close()
if cfg.sharpbang and os.getenv "OS" ~= "Windows_NT" then
pcall(os.execute, 'chmod a+x "'..cfg.output..'"')
end
end
-------------------------------------------------------------------
-- Run compiled code
if cfg.run then
verb_print "Running"
local f = compiler :bytecode_to_function (bytecode)
bytecode = nil
-- FIXME: isolate execution in a ring
-- FIXME: check for failures
local function print_traceback (errmsg)
return errmsg .. '\n' .. debug.traceback ('',2) .. '\n'
end
local function g() return f(unpack (cfg.params)) end
local st, msg = xpcall(g, print_traceback)
if not st then
io.stderr:write(msg)
os.exit(RUNTIME_ERROR_NUMBER)
end
end
-------------------------------------------------------------------
-- Run REPL loop
if cfg.interactive then
verb_print "Starting REPL loop"
require 'metalua.repl' .run()
end
verb_print "Done"
end
return M.main(...)

29
src/metalua/bytecode.lua
View File

@ -1,29 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
local compile = require 'metalua.compiler.bytecode.compile'
local ldump = require 'metalua.compiler.bytecode.ldump'
local M = { }
M.ast_to_proto = compile.ast_to_proto
M.proto_to_bytecode = ldump.dump_string
M.proto_to_file = ldump.dump_file
return M

181
src/metalua/compiler.lua
View File

@ -1,181 +0,0 @@
---------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--
-- Convert between various code representation formats. Atomic
-- converters are written in extenso, others are composed automatically
-- by chaining the atomic ones together in a closure.
--
-- Supported formats are:
--
-- * srcfile: the name of a file containing sources.
-- * src: these sources as a single string.
-- * lexstream: a stream of lexemes.
-- * ast: an abstract syntax tree.
-- * proto: a (Yueliang) struture containing a high level
-- representation of bytecode. Largely based on the
-- Proto structure in Lua's VM
-- * bytecode: a string dump of the function, as taken by
-- loadstring() and produced by string.dump().
-- * function: an executable lua function in RAM.
--
--------------------------------------------------------------------------------
require 'checks'
local M = { }
--------------------------------------------------------------------------------
-- Order of the transformations. if 'a' is on the left of 'b', then a 'a' can
-- be transformed into a 'b' (but not the other way around).
-- M.sequence goes for numbers to format names, M.order goes from format
-- names to numbers.
--------------------------------------------------------------------------------
M.sequence = {
'srcfile', 'src', 'lexstream', 'ast', 'proto', 'bytecode', 'function' }
local arg_types = {
srcfile = { 'string', '?string' },
src = { 'string', '?string' },
lexstream = { 'lexer.stream', '?string' },
ast = { 'table', '?string' },
proto = { 'table', '?string' },
bytecode = { 'string', '?string' },
}
if false then
-- if defined, runs on every newly-generated AST
function M.check_ast(ast)
local function rec(x, n, parent)
if not x.lineinfo and parent.lineinfo then
local pp = require 'metalua.pprint'
pp.printf("WARNING: Missing lineinfo in child #%s `%s{...} of node at %s",
n, x.tag or '', tostring(parent.lineinfo))
end
for i, child in ipairs(x) do
if type(child)=='table' then rec(child, i, x) end
end
end
rec(ast, -1, { })
end
end
M.order= { }; for a,b in pairs(M.sequence) do M.order[b]=a end
local CONV = { } -- conversion metatable __index
function CONV :srcfile_to_src(x, name)
checks('metalua.compiler', 'string', '?string')
name = name or '@'..x
local f, msg = io.open (x, 'rb')
if not f then error(msg) end
local r, msg = f :read '*a'
if not r then error("Cannot read file '"..x.."': "..msg) end
f :close()
return r, name
end
function CONV :src_to_lexstream(src, name)
checks('metalua.compiler', 'string', '?string')
local r = self.parser.lexer :newstream (src, name)
return r, name
end
function CONV :lexstream_to_ast(lx, name)
checks('metalua.compiler', 'lexer.stream', '?string')
local r = self.parser.chunk(lx)
r.source = name
if M.check_ast then M.check_ast (r) end
return r, name
end
local bytecode_compiler = nil -- cache to avoid repeated `pcall(require(...))`
local function get_bytecode_compiler()
if bytecode_compiler then return bytecode_compiler else
local status, result = pcall(require, 'metalua.compiler.bytecode')
if status then
bytecode_compiler = result
return result
elseif string.match(result, "not found") then
error "Compilation only available with full Metalua"
else error (result) end
end
end
function CONV :ast_to_proto(ast, name)
checks('metalua.compiler', 'table', '?string')
return get_bytecode_compiler().ast_to_proto(ast, name), name
end
function CONV :proto_to_bytecode(proto, name)
return get_bytecode_compiler().proto_to_bytecode(proto), name
end
function CONV :bytecode_to_function(bc, name)
checks('metalua.compiler', 'string', '?string')
return loadstring(bc, name)
end
-- Create all sensible combinations
for i=1,#M.sequence do
local src = M.sequence[i]
for j=i+2, #M.sequence do
local dst = M.sequence[j]
local dst_name = src.."_to_"..dst
local my_arg_types = arg_types[src]
local functions = { }
for k=i, j-1 do
local name = M.sequence[k].."_to_"..M.sequence[k+1]
local f = assert(CONV[name], name)
table.insert (functions, f)
end
CONV[dst_name] = function(self, a, b)
checks('metalua.compiler', unpack(my_arg_types))
for _, f in ipairs(functions) do
a, b = f(self, a, b)
end
return a, b
end
--printf("Created M.%s out of %s", dst_name, table.concat(n, ', '))
end
end
--------------------------------------------------------------------------------
-- This one goes in the "wrong" direction, cannot be composed.
--------------------------------------------------------------------------------
function CONV :function_to_bytecode(...) return string.dump(...) end
function CONV :ast_to_src(...)
require 'metalua.loader' -- ast_to_string isn't written in plain lua
return require 'metalua.compiler.ast_to_src' (...)
end
local MT = { __index=CONV, __type='metalua.compiler' }
function M.new()
local parser = require 'metalua.compiler.parser' .new()
local self = { parser = parser }
setmetatable(self, MT)
return self
end
return M

693
src/metalua/compiler/ast_to_src.mlua
View File

@ -1,693 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
-{ extension ('match', ...) }
local M = { }
M.__index = M
local pp=require 'metalua.pprint'
--------------------------------------------------------------------------------
-- Instanciate a new AST->source synthetizer
--------------------------------------------------------------------------------
function M.new ()
local self = {
_acc = { }, -- Accumulates pieces of source as strings
current_indent = 0, -- Current level of line indentation
indent_step = " " -- Indentation symbol, normally spaces or '\t'
}
return setmetatable (self, M)
end
--------------------------------------------------------------------------------
-- Run a synthetizer on the `ast' arg and return the source as a string.
-- Can also be used as a static method `M.run (ast)'; in this case,
-- a temporary Metizer is instanciated on the fly.
--------------------------------------------------------------------------------
function M:run (ast)
if not ast then
self, ast = M.new(), self
end
self._acc = { }
self:node (ast)
return table.concat (self._acc)
end
--------------------------------------------------------------------------------
-- Accumulate a piece of source file in the synthetizer.
--------------------------------------------------------------------------------
function M:acc (x)
if x then table.insert (self._acc, x) end
end
--------------------------------------------------------------------------------
-- Accumulate an indented newline.
-- Jumps an extra line if indentation is 0, so that
-- toplevel definitions are separated by an extra empty line.
--------------------------------------------------------------------------------
function M:nl ()
if self.current_indent == 0 then self:acc "\n" end
self:acc ("\n" .. self.indent_step:rep (self.current_indent))
end
--------------------------------------------------------------------------------
-- Increase indentation and accumulate a new line.
--------------------------------------------------------------------------------
function M:nlindent ()
self.current_indent = self.current_indent + 1
self:nl ()
end
--------------------------------------------------------------------------------
-- Decrease indentation and accumulate a new line.
--------------------------------------------------------------------------------
function M:nldedent ()
self.current_indent = self.current_indent - 1
self:acc ("\n" .. self.indent_step:rep (self.current_indent))
end
--------------------------------------------------------------------------------
-- Keywords, which are illegal as identifiers.
--------------------------------------------------------------------------------
local keywords_list = {
"and", "break", "do", "else", "elseif",
"end", "false", "for", "function", "if",
"in", "local", "nil", "not", "or",
"repeat", "return", "then", "true", "until",
"while" }
local keywords = { }
for _, kw in pairs(keywords_list) do keywords[kw]=true end
--------------------------------------------------------------------------------
-- Return true iff string `id' is a legal identifier name.
--------------------------------------------------------------------------------
local function is_ident (id)
return string['match'](id, "^[%a_][%w_]*$") and not keywords[id]
end
--------------------------------------------------------------------------------
-- Return true iff ast represents a legal function name for
-- syntax sugar ``function foo.bar.gnat() ... end'':
-- a series of nested string indexes, with an identifier as
-- the innermost node.
--------------------------------------------------------------------------------
local function is_idx_stack (ast)
match ast with
| `Id{ _ } -> return true
| `Index{ left, `String{ _ } } -> return is_idx_stack (left)
| _ -> return false
end
end
--------------------------------------------------------------------------------
-- Operator precedences, in increasing order.
-- This is not directly used, it's used to generate op_prec below.
--------------------------------------------------------------------------------
local op_preprec = {
{ "or", "and" },
{ "lt", "le", "eq", "ne" },
{ "concat" },
{ "add", "sub" },
{ "mul", "div", "mod" },
{ "unary", "not", "len" },
{ "pow" },
{ "index" } }
--------------------------------------------------------------------------------
-- operator --> precedence table, generated from op_preprec.
--------------------------------------------------------------------------------
local op_prec = { }
for prec, ops in ipairs (op_preprec) do
for _, op in ipairs (ops) do
op_prec[op] = prec
end
end
--------------------------------------------------------------------------------
-- operator --> source representation.
--------------------------------------------------------------------------------
local op_symbol = {
add = " + ", sub = " - ", mul = " * ",
div = " / ", mod = " % ", pow = " ^ ",
concat = " .. ", eq = " == ", ne = " ~= ",
lt = " < ", le = " <= ", ["and"] = " and ",
["or"] = " or ", ["not"] = "not ", len = "# " }
--------------------------------------------------------------------------------
-- Accumulate the source representation of AST `node' in
-- the synthetizer. Most of the work is done by delegating to
-- the method having the name of the AST tag.
-- If something can't be converted to normal sources, it's
-- instead dumped as a `-{ ... }' splice in the source accumulator.
--------------------------------------------------------------------------------
function M:node (node)
assert (self~=M and self._acc)
if node==nil then self:acc'<<error>>'; return end
if not node.tag then -- tagless block.
self:list (node, self.nl)
else
local f = M[node.tag]
if type (f) == "function" then -- Delegate to tag method.
f (self, node, unpack (node))
elseif type (f) == "string" then -- tag string.
self:acc (f)
else -- No appropriate method, fall back to splice dumping.
-- This cannot happen in a plain Lua AST.
self:acc " -{ "
self:acc (pp.tostring (node, {metalua_tag=1, hide_hash=1}), 80)
self:acc " }"
end
end
end
--------------------------------------------------------------------------------
-- Convert every node in the AST list `list' passed as 1st arg.
-- `sep' is an optional separator to be accumulated between each list element,
-- it can be a string or a synth method.
-- `start' is an optional number (default == 1), indicating which is the
-- first element of list to be converted, so that we can skip the begining
-- of a list.
--------------------------------------------------------------------------------
function M:list (list, sep, start)
for i = start or 1, # list do
self:node (list[i])
if list[i + 1] then
if not sep then
elseif type (sep) == "function" then sep (self)
elseif type (sep) == "string" then self:acc (sep)
else error "Invalid list separator" end
end
end
end
--------------------------------------------------------------------------------
--
-- Tag methods.
-- ------------
--
-- Specific AST node dumping methods, associated to their node kinds
-- by their name, which is the corresponding AST tag.
-- synth:node() is in charge of delegating a node's treatment to the
-- appropriate tag method.
--
-- Such tag methods are called with the AST node as 1st arg.
-- As a convenience, the n node's children are passed as args #2 ... n+1.
--
-- There are several things that could be refactored into common subroutines
-- here: statement blocks dumping, function dumping...
-- However, given their small size and linear execution
-- (they basically perform series of :acc(), :node(), :list(),
-- :nl(), :nlindent() and :nldedent() calls), it seems more readable
-- to avoid multiplication of such tiny functions.
--
-- To make sense out of these, you need to know metalua's AST syntax, as
-- found in the reference manual or in metalua/doc/ast.txt.
--
--------------------------------------------------------------------------------
function M:Do (node)
self:acc "do"
self:nlindent ()
self:list (node, self.nl)
self:nldedent ()
self:acc "end"
end
function M:Set (node)
match node with
| `Set{ { `Index{ lhs, `String{ method } } },
{ `Function{ { `Id "self", ... } == params, body } } }
if is_idx_stack (lhs) and is_ident (method) ->
-- ``function foo:bar(...) ... end'' --
self:acc "function "
self:node (lhs)
self:acc ":"
self:acc (method)
self:acc " ("
self:list (params, ", ", 2)
self:acc ")"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
self:acc "end"
| `Set{ { lhs }, { `Function{ params, body } } } if is_idx_stack (lhs) ->
-- ``function foo(...) ... end'' --
self:acc "function "
self:node (lhs)
self:acc " ("
self:list (params, ", ")
self:acc ")"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
self:acc "end"
| `Set{ { `Id{ lhs1name } == lhs1, ... } == lhs, rhs }
if not is_ident (lhs1name) ->
-- ``foo, ... = ...'' when foo is *not* a valid identifier.
-- In that case, the spliced 1st variable must get parentheses,
-- to be distinguished from a statement splice.
-- This cannot happen in a plain Lua AST.
self:acc "("
self:node (lhs1)
self:acc ")"
if lhs[2] then -- more than one lhs variable
self:acc ", "
self:list (lhs, ", ", 2)
end
self:acc " = "
self:list (rhs, ", ")
| `Set{ lhs, rhs } ->
-- ``... = ...'', no syntax sugar --
self:list (lhs, ", ")
self:acc " = "
self:list (rhs, ", ")
| `Set{ lhs, rhs, annot } ->
-- ``... = ...'', no syntax sugar, annotation --
local n = #lhs
for i=1,n do
local ell, a = lhs[i], annot[i]
self:node (ell)
if a then
self:acc ' #'
self:node(a)
end
if i~=n then self:acc ', ' end
end
self:acc " = "
self:list (rhs, ", ")
end
end
function M:While (node, cond, body)
self:acc "while "
self:node (cond)
self:acc " do"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
self:acc "end"
end
function M:Repeat (node, body, cond)
self:acc "repeat"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
self:acc "until "
self:node (cond)
end
function M:If (node)
for i = 1, #node-1, 2 do
-- for each ``if/then'' and ``elseif/then'' pair --
local cond, body = node[i], node[i+1]
self:acc (i==1 and "if " or "elseif ")
self:node (cond)
self:acc " then"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
end
-- odd number of children --> last one is an `else' clause --
if #node%2 == 1 then
self:acc "else"
self:nlindent ()
self:list (node[#node], self.nl)
self:nldedent ()
end
self:acc "end"
end
function M:Fornum (node, var, first, last)
local body = node[#node]
self:acc "for "
self:node (var)
self:acc " = "
self:node (first)
self:acc ", "
self:node (last)
if #node==5 then -- 5 children --> child #4 is a step increment.
self:acc ", "
self:node (node[4])
end
self:acc " do"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
self:acc "end"
end
function M:Forin (node, vars, generators, body)
self:acc "for "
self:list (vars, ", ")
self:acc " in "
self:list (generators, ", ")
self:acc " do"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
self:acc "end"
end
function M:Local (node, lhs, rhs, annots)
if next (lhs) then
self:acc "local "
if annots then
local n = #lhs
for i=1, n do
self:node (lhs)
local a = annots[i]
if a then
self:acc ' #'
self:node (a)
end
if i~=n then self:acc ', ' end
end
else
self:list (lhs, ", ")
end
if rhs[1] then
self:acc " = "
self:list (rhs, ", ")
end
else -- Can't create a local statement with 0 variables in plain Lua
self:acc (table.tostring (node, 'nohash', 80))
end
end
function M:Localrec (node, lhs, rhs)
match node with
| `Localrec{ { `Id{name} }, { `Function{ params, body } } }
if is_ident (name) ->
-- ``local function name() ... end'' --
self:acc "local function "
self:acc (name)
self:acc " ("
self:list (params, ", ")
self:acc ")"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
self:acc "end"
| _ ->
-- Other localrec are unprintable ==> splice them --
-- This cannot happen in a plain Lua AST. --
self:acc "-{ "
self:acc (table.tostring (node, 'nohash', 80))
self:acc " }"
end
end
function M:Call (node, f)
-- single string or table literal arg ==> no need for parentheses. --
local parens
match node with
| `Call{ _, `String{_} }
| `Call{ _, `Table{...}} -> parens = false
| _ -> parens = true
end
self:node (f)
self:acc (parens and " (" or " ")
self:list (node, ", ", 2) -- skip `f'.
self:acc (parens and ")")
end
function M:Invoke (node, f, method)
-- single string or table literal arg ==> no need for parentheses. --
local parens
match node with
| `Invoke{ _, _, `String{_} }
| `Invoke{ _, _, `Table{...}} -> parens = false
| _ -> parens = true
end
self:node (f)
self:acc ":"
self:acc (method[1])
self:acc (parens and " (" or " ")
self:list (node, ", ", 3) -- Skip args #1 and #2, object and method name.
self:acc (parens and ")")
end
function M:Return (node)
self:acc "return "
self:list (node, ", ")
end
M.Break = "break"
M.Nil = "nil"
M.False = "false"
M.True = "true"
M.Dots = "..."
function M:Number (node, n)
self:acc (tostring (n))
end
function M:String (node, str)
-- format "%q" prints '\n' in an umpractical way IMO,
-- so this is fixed with the :gsub( ) call.
self:acc (string.format ("%q", str):gsub ("\\\n", "\\n"))
end
function M:Function (node, params, body, annots)
self:acc "function ("
if annots then
local n = #params
for i=1,n do
local p, a = params[i], annots[i]
self:node(p)
if annots then
self:acc " #"
self:node(a)
end
if i~=n then self:acc ', ' end
end
else
self:list (params, ", ")
end
self:acc ")"
self:nlindent ()
self:list (body, self.nl)
self:nldedent ()
self:acc "end"
end
function M:Table (node)
if not node[1] then self:acc "{ }" else
self:acc "{"
if #node > 1 then self:nlindent () else self:acc " " end
for i, elem in ipairs (node) do
match elem with
| `Pair{ `String{ key }, value } if is_ident (key) ->
-- ``key = value''. --
self:acc (key)
self:acc " = "
self:node (value)
| `Pair{ key, value } ->
-- ``[key] = value''. --
self:acc "["
self:node (key)
self:acc "] = "
self:node (value)
| _ ->
-- ``value''. --
self:node (elem)
end
if node [i+1] then
self:acc ","
self:nl ()
end
end
if #node > 1 then self:nldedent () else self:acc " " end
self:acc "}"
end
end
function M:Op (node, op, a, b)
-- Transform ``not (a == b)'' into ``a ~= b''. --
match node with
| `Op{ "not", `Op{ "eq", _a, _b } }
| `Op{ "not", `Paren{ `Op{ "eq", _a, _b } } } ->
op, a, b = "ne", _a, _b
| _ ->
end
if b then -- binary operator.
local left_paren, right_paren
match a with
| `Op{ op_a, ...} if op_prec[op] >= op_prec[op_a] -> left_paren = true
| _ -> left_paren = false
end
match b with -- FIXME: might not work with right assoc operators ^ and ..
| `Op{ op_b, ...} if op_prec[op] >= op_prec[op_b] -> right_paren = true
| _ -> right_paren = false
end
self:acc (left_paren and "(")
self:node (a)
self:acc (left_paren and ")")
self:acc (op_symbol [op])
self:acc (right_paren and "(")
self:node (b)
self:acc (right_paren and ")")
else -- unary operator.
local paren
match a with
| `Op{ op_a, ... } if op_prec[op] >= op_prec[op_a] -> paren = true
| _ -> paren = false
end
self:acc (op_symbol[op])
self:acc (paren and "(")
self:node (a)
self:acc (paren and ")")
end
end
function M:Paren (node, content)
self:acc "("
self:node (content)
self:acc ")"
end
function M:Index (node, table, key)
local paren_table
-- Check precedence, see if parens are needed around the table --
match table with
| `Op{ op, ... } if op_prec[op] < op_prec.index -> paren_table = true
| _ -> paren_table = false
end
self:acc (paren_table and "(")
self:node (table)
self:acc (paren_table and ")")
match key with
| `String{ field } if is_ident (field) ->
-- ``table.key''. --
self:acc "."
self:acc (field)
| _ ->
-- ``table [key]''. --
self:acc "["
self:node (key)
self:acc "]"
end
end
function M:Id (node, name)
if is_ident (name) then
self:acc (name)
else -- Unprintable identifier, fall back to splice representation.
-- This cannot happen in a plain Lua AST.
self:acc "-{`Id "
self:String (node, name)
self:acc "}"
end
end
M.TDyn = '*'
M.TDynbar = '**'
M.TPass = 'pass'
M.TField = 'field'
M.TIdbar = M.TId
M.TReturn = M.Return
function M:TId (node, name) self:acc(name) end
function M:TCatbar(node, te, tebar)
self:acc'('
self:node(te)
self:acc'|'
self:tebar(tebar)
self:acc')'
end
function M:TFunction(node, p, r)
self:tebar(p)
self:acc '->'
self:tebar(r)
end
function M:TTable (node, default, pairs)
self:acc '['
self:list (pairs, ', ')
if default.tag~='TField' then
self:acc '|'
self:node (default)
end
self:acc ']'
end
function M:TPair (node, k, v)
self:node (k)
self:acc '='
self:node (v)
end
function M:TIdbar (node, name)
self :acc (name)
end
function M:TCatbar (node, a, b)
self:node(a)
self:acc ' ++ '
self:node(b)
end
function M:tebar(node)
if node.tag then self:node(node) else
self:acc '('
self:list(node, ', ')
self:acc ')'
end
end
function M:TUnkbar(node, name)
self:acc '~~'
self:acc (name)
end
function M:TUnk(node, name)
self:acc '~'
self:acc (name)
end
for name, tag in pairs{ const='TConst', var='TVar', currently='TCurrently', just='TJust' } do
M[tag] = function(self, node, te)
self:acc (name..' ')
self:node(te)
end
end
return (|x| M.run(x))

29
src/metalua/compiler/bytecode.lua
View File

@ -1,29 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
local compile = require 'metalua.compiler.bytecode.compile'
local ldump = require 'metalua.compiler.bytecode.ldump'
local M = { }
M.ast_to_proto = compile.ast_to_proto
M.proto_to_bytecode = ldump.dump_string
M.proto_to_file = ldump.dump_file
return M

1263
src/metalua/compiler/bytecode/compile.lua
View File

File diff suppressed because it is too large Load Diff

1038
src/metalua/compiler/bytecode/lcode.lua
View File

File diff suppressed because it is too large Load Diff

448
src/metalua/compiler/bytecode/ldump.lua
View File

@ -1,448 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2005-2013 Kein-Hong Man, Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Kein-Hong Man - Initial implementation for Lua 5.0, part of Yueliang
-- Fabien Fleutot - Port to Lua 5.1, integration with Metalua
--
-------------------------------------------------------------------------------
--[[--------------------------------------------------------------------
ldump.lua
Save bytecodes in Lua
This file is part of Yueliang.
Copyright (c) 2005 Kein-Hong Man <khman@users.sf.net>
The COPYRIGHT file describes the conditions
under which this software may be distributed.
------------------------------------------------------------------------
[FF] Slightly modified, mainly to produce Lua 5.1 bytecode.
----------------------------------------------------------------------]]
--[[--------------------------------------------------------------------
-- Notes:
-- * LUA_NUMBER (double), byte order (little endian) and some other
-- header values hard-coded; see other notes below...
-- * One significant difference is that instructions are still in table
-- form (with OP/A/B/C/Bx fields) and luaP:Instruction() is needed to
-- convert them into 4-char strings
-- * Deleted:
-- luaU:DumpVector: folded into DumpLines, DumpCode
-- * Added:
-- luaU:endianness() (from lundump.c)
-- luaU:make_setS: create a chunk writer that writes to a string
-- luaU:make_setF: create a chunk writer that writes to a file
-- (lua.h contains a typedef for a Chunkwriter pointer, and
-- a Lua-based implementation exists, writer() in lstrlib.c)
-- luaU:from_double(x): encode double value for writing
-- luaU:from_int(x): encode integer value for writing
-- (error checking is limited for these conversion functions)
-- (double conversion does not support denormals or NaNs)
-- luaU:ttype(o) (from lobject.h)
----------------------------------------------------------------------]]
local luaP = require 'metalua.compiler.bytecode.lopcodes'
local M = { }
local format = { }
format.header = string.dump(function()end):sub(1, 12)
format.little_endian, format.int_size,
format.size_t_size, format.instr_size,
format.number_size, format.integral = format.header:byte(7, 12)
format.little_endian = format.little_endian~=0
format.integral = format.integral ~=0
assert(format.integral or format.number_size==8, "Number format not supported by dumper")
assert(format.little_endian, "Big endian architectures not supported by dumper")
--requires luaP
local luaU = { }
M.luaU = luaU
luaU.format = format
-- constants used by dumper
luaU.LUA_TNIL = 0
luaU.LUA_TBOOLEAN = 1
luaU.LUA_TNUMBER = 3 -- (all in lua.h)
luaU.LUA_TSTRING = 4
luaU.LUA_TNONE = -1
-- definitions for headers of binary files
--luaU.LUA_SIGNATURE = "\27Lua" -- binary files start with "<esc>Lua"
--luaU.VERSION = 81 -- 0x50; last format change was in 5.0
--luaU.FORMAT_VERSION = 0 -- 0 is official version. yeah I know I'm a liar.
-- a multiple of PI for testing native format
-- multiplying by 1E7 gives non-trivial integer values
--luaU.TEST_NUMBER = 3.14159265358979323846E7
--[[--------------------------------------------------------------------
-- Additional functions to handle chunk writing
-- * to use make_setS and make_setF, see test_ldump.lua elsewhere
----------------------------------------------------------------------]]
------------------------------------------------------------------------
-- works like the lobject.h version except that TObject used in these
-- scripts only has a 'value' field, no 'tt' field (native types used)
------------------------------------------------------------------------
function luaU:ttype(o)
local tt = type(o.value)
if tt == "number" then return self.LUA_TNUMBER
elseif tt == "string" then return self.LUA_TSTRING
elseif tt == "nil" then return self.LUA_TNIL
elseif tt == "boolean" then return self.LUA_TBOOLEAN
else
return self.LUA_TNONE -- the rest should not appear
end
end
------------------------------------------------------------------------
-- create a chunk writer that writes to a string
-- * returns the writer function and a table containing the string
-- * to get the final result, look in buff.data
------------------------------------------------------------------------
function luaU:make_setS()
local buff = {}
buff.data = ""
local writer =
function(s, buff) -- chunk writer
if not s then return end
buff.data = buff.data..s
end
return writer, buff
end
------------------------------------------------------------------------
-- create a chunk writer that writes to a file
-- * returns the writer function and a table containing the file handle
-- * if a nil is passed, then writer should close the open file
------------------------------------------------------------------------
function luaU:make_setF(filename)
local buff = {}
buff.h = io.open(filename, "wb")
if not buff.h then return nil end
local writer =
function(s, buff) -- chunk writer
if not buff.h then return end
if not s then buff.h:close(); return end
buff.h:write(s)
end
return writer, buff
end
-----------------------------------------------------------------------
-- converts a IEEE754 double number to an 8-byte little-endian string
-- * luaU:from_double() and luaU:from_int() are from ChunkBake project
-- * supports +/- Infinity, but not denormals or NaNs
-----------------------------------------------------------------------
function luaU:from_double(x)
local function grab_byte(v)
return math.floor(v / 256),
string.char(math.mod(math.floor(v), 256))
end
local sign = 0
if x < 0 then sign = 1; x = -x end
local mantissa, exponent = math.frexp(x)
if x == 0 then -- zero
mantissa, exponent = 0, 0
elseif x == 1/0 then
mantissa, exponent = 0, 2047
else
mantissa = (mantissa * 2 - 1) * math.ldexp(0.5, 53)
exponent = exponent + 1022
end
local v, byte = "" -- convert to bytes
x = mantissa
for i = 1,6 do
x, byte = grab_byte(x); v = v..byte -- 47:0
end
x, byte = grab_byte(exponent * 16 + x); v = v..byte -- 55:48
x, byte = grab_byte(sign * 128 + x); v = v..byte -- 63:56
return v
end
-----------------------------------------------------------------------
-- converts a number to a little-endian 32-bit integer string
-- * input value assumed to not overflow, can be signed/unsigned
-----------------------------------------------------------------------
function luaU:from_int(x, size)
local v = ""
x = math.floor(x)
if x >= 0 then
for i = 1, size do
v = v..string.char(math.mod(x, 256)); x = math.floor(x / 256)
end
else -- x < 0
x = -x
local carry = 1
for i = 1, size do
local c = 255 - math.mod(x, 256) + carry
if c == 256 then c = 0; carry = 1 else carry = 0 end
v = v..string.char(c); x = math.floor(x / 256)
end
end
return v
end
--[[--------------------------------------------------------------------
-- Functions to make a binary chunk
-- * many functions have the size parameter removed, since output is
-- in the form of a string and some sizes are implicit or hard-coded
-- * luaU:DumpVector has been deleted (used in DumpCode & DumpLines)
----------------------------------------------------------------------]]
------------------------------------------------------------------------
-- dump a block of literal bytes
------------------------------------------------------------------------
function luaU:DumpLiteral(s, D) self:DumpBlock(s, D) end
--[[--------------------------------------------------------------------
-- struct DumpState:
-- L -- lua_State (not used in this script)
-- write -- lua_Chunkwriter (chunk writer function)
-- data -- void* (chunk writer context or data already written)
----------------------------------------------------------------------]]
------------------------------------------------------------------------
-- dumps a block of bytes
-- * lua_unlock(D.L), lua_lock(D.L) deleted
------------------------------------------------------------------------
function luaU:DumpBlock(b, D) D.write(b, D.data) end
------------------------------------------------------------------------
-- dumps a single byte
------------------------------------------------------------------------
function luaU:DumpByte(y, D)
self:DumpBlock(string.char(y), D)
end
------------------------------------------------------------------------
-- dumps a signed integer of size `format.int_size` (for int)
------------------------------------------------------------------------
function luaU:DumpInt(x, D)
self:DumpBlock(self:from_int(x, format.int_size), D)
end
------------------------------------------------------------------------
-- dumps an unsigned integer of size `format.size_t_size` (for size_t)
------------------------------------------------------------------------
function luaU:DumpSize(x, D)
self:DumpBlock(self:from_int(x, format.size_t_size), D)
end
------------------------------------------------------------------------
-- dumps a LUA_NUMBER; can be an int or double depending on the VM.
------------------------------------------------------------------------
function luaU:DumpNumber(x, D)
if format.integral then
self:DumpBlock(self:from_int(x, format.number_size), D)
else
self:DumpBlock(self:from_double(x), D)
end
end
------------------------------------------------------------------------
-- dumps a Lua string
------------------------------------------------------------------------
function luaU:DumpString(s, D)
if s == nil then
self:DumpSize(0, D)
else
s = s.."\0" -- include trailing '\0'
self:DumpSize(string.len(s), D)
self:DumpBlock(s, D)
end
end
------------------------------------------------------------------------
-- dumps instruction block from function prototype
------------------------------------------------------------------------
function luaU:DumpCode(f, D)
local n = f.sizecode
self:DumpInt(n, D)
--was DumpVector
for i = 0, n - 1 do
self:DumpBlock(luaP:Instruction(f.code[i]), D)
end
end
------------------------------------------------------------------------
-- dumps local variable names from function prototype
------------------------------------------------------------------------
function luaU:DumpLocals(f, D)
local n = f.sizelocvars
self:DumpInt(n, D)
for i = 0, n - 1 do
-- Dirty temporary fix:
-- `Stat{ } keeps properly count of the number of local vars,
-- but fails to keep score of their debug info (names).
-- It therefore might happen that #f.localvars < f.sizelocvars, or
-- that a variable's startpc and endpc fields are left unset.
-- FIXME: This might not be needed anymore, check the bug report
-- by J. Belmonte.
local var = f.locvars[i]
if not var then break end
-- printf("[DUMPLOCALS] dumping local var #%i = %s", i, table.tostring(var))
self:DumpString(var.varname, D)
self:DumpInt(var.startpc or 0, D)
self:DumpInt(var.endpc or 0, D)
end
end
------------------------------------------------------------------------
-- dumps line information from function prototype
------------------------------------------------------------------------
function luaU:DumpLines(f, D)
local n = f.sizelineinfo
self:DumpInt(n, D)
--was DumpVector
for i = 0, n - 1 do
self:DumpInt(f.lineinfo[i], D) -- was DumpBlock
--print(i, f.lineinfo[i])
end
end
------------------------------------------------------------------------
-- dump upvalue names from function prototype
------------------------------------------------------------------------
function luaU:DumpUpvalues(f, D)
local n = f.sizeupvalues
self:DumpInt(n, D)
for i = 0, n - 1 do
self:DumpString(f.upvalues[i], D)
end
end
------------------------------------------------------------------------
-- dump constant pool from function prototype
-- * nvalue(o) and tsvalue(o) macros removed
------------------------------------------------------------------------
function luaU:DumpConstants(f, D)
local n = f.sizek
self:DumpInt(n, D)
for i = 0, n - 1 do
local o = f.k[i] -- TObject
local tt = self:ttype(o)
assert (tt >= 0)
self:DumpByte(tt, D)
if tt == self.LUA_TNUMBER then
self:DumpNumber(o.value, D)
elseif tt == self.LUA_TSTRING then
self:DumpString(o.value, D)
elseif tt == self.LUA_TBOOLEAN then
self:DumpByte (o.value and 1 or 0, D)
elseif tt == self.LUA_TNIL then
else
assert(false) -- cannot happen
end
end
end
function luaU:DumpProtos (f, D)
local n = f.sizep
assert (n)
self:DumpInt(n, D)
for i = 0, n - 1 do
self:DumpFunction(f.p[i], f.source, D)
end
end
function luaU:DumpDebug(f, D)
self:DumpLines(f, D)
self:DumpLocals(f, D)
self:DumpUpvalues(f, D)
end
------------------------------------------------------------------------
-- dump child function prototypes from function prototype
--FF completely reworked for 5.1 format
------------------------------------------------------------------------
function luaU:DumpFunction(f, p, D)
-- print "Dumping function:"
-- table.print(f, 60)
local source = f.source
if source == p then source = nil end
self:DumpString(source, D)
self:DumpInt(f.lineDefined, D)
self:DumpInt(f.lastLineDefined or 42, D)
self:DumpByte(f.nups, D)
self:DumpByte(f.numparams, D)
self:DumpByte(f.is_vararg, D)
self:DumpByte(f.maxstacksize, D)
self:DumpCode(f, D)
self:DumpConstants(f, D)
self:DumpProtos( f, D)
self:DumpDebug(f, D)
end
------------------------------------------------------------------------
-- dump Lua header section (some sizes hard-coded)
--FF: updated for version 5.1
------------------------------------------------------------------------
function luaU:DumpHeader(D)
self:DumpLiteral(format.header, D)
end
------------------------------------------------------------------------
-- dump function as precompiled chunk
-- * w, data are created from make_setS, make_setF
--FF: suppressed extraneous [L] param
------------------------------------------------------------------------
function luaU:dump (Main, w, data)
local D = {} -- DumpState
D.write = w
D.data = data
self:DumpHeader(D)
self:DumpFunction(Main, nil, D)
-- added: for a chunk writer writing to a file, this final call with
-- nil data is to indicate to the writer to close the file
D.write(nil, D.data)
end
------------------------------------------------------------------------
-- find byte order (from lundump.c)
-- * hard-coded to little-endian
------------------------------------------------------------------------
function luaU:endianness()
return 1
end
-- FIXME: ugly concat-base generation in [make_setS], bufferize properly!
function M.dump_string (proto)
local writer, buff = luaU:make_setS()
luaU:dump (proto, writer, buff)
return buff.data
end
-- FIXME: [make_setS] sucks, perform synchronous file writing
-- Now unused
function M.dump_file (proto, filename)
local writer, buff = luaU:make_setS()
luaU:dump (proto, writer, buff)
local file = io.open (filename, "wb")
file:write (buff.data)
io.close(file)
--if UNIX_SHARPBANG then os.execute ("chmod a+x "..filename) end
end
return M

442
src/metalua/compiler/bytecode/lopcodes.lua
View File

@ -1,442 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2005-2013 Kein-Hong Man, Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Kein-Hong Man - Initial implementation for Lua 5.0, part of Yueliang
-- Fabien Fleutot - Port to Lua 5.1, integration with Metalua
--
-------------------------------------------------------------------------------
--[[--------------------------------------------------------------------
$Id$
lopcodes.lua
Lua 5 virtual machine opcodes in Lua
This file is part of Yueliang.
Copyright (c) 2005 Kein-Hong Man <khman@users.sf.net>
The COPYRIGHT file describes the conditions
under which this software may be distributed.
See the ChangeLog for more information.
------------------------------------------------------------------------
[FF] Slightly modified, mainly to produce Lua 5.1 bytecode.
----------------------------------------------------------------------]]
--[[--------------------------------------------------------------------
-- Notes:
-- * an Instruction is a table with OP, A, B, C, Bx elements; this
-- should allow instruction handling to work with doubles and ints
-- * Added:
-- luaP:Instruction(i): convert field elements to a 4-char string
-- luaP:DecodeInst(x): convert 4-char string into field elements
-- * WARNING luaP:Instruction outputs instructions encoded in little-
-- endian form and field size and positions are hard-coded
----------------------------------------------------------------------]]
local function debugf() end
local luaP = { }
--[[
===========================================================================
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
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.
===========================================================================
--]]
luaP.OpMode = {"iABC", "iABx", "iAsBx"} -- basic instruction format
------------------------------------------------------------------------
-- size and position of opcode arguments.
-- * WARNING size and position is hard-coded elsewhere in this script
------------------------------------------------------------------------
luaP.SIZE_C = 9
luaP.SIZE_B = 9
luaP.SIZE_Bx = luaP.SIZE_C + luaP.SIZE_B
luaP.SIZE_A = 8
luaP.SIZE_OP = 6
luaP.POS_C = luaP.SIZE_OP
luaP.POS_B = luaP.POS_C + luaP.SIZE_C
luaP.POS_Bx = luaP.POS_C
luaP.POS_A = luaP.POS_B + luaP.SIZE_B
--FF from 5.1
luaP.BITRK = 2^(luaP.SIZE_B - 1)
function luaP:ISK(x) return x >= self.BITRK end
luaP.MAXINDEXRK = luaP.BITRK - 1
function luaP:RKASK(x)
if x < self.BITRK then return x+self.BITRK else return x end
end
------------------------------------------------------------------------
-- limits for opcode arguments.
-- we use (signed) int to manipulate most arguments,
-- so they must fit in BITS_INT-1 bits (-1 for sign)
------------------------------------------------------------------------
-- removed "#if SIZE_Bx < BITS_INT-1" test, assume this script is
-- running on a Lua VM with double or int as LUA_NUMBER
luaP.MAXARG_Bx = math.ldexp(1, luaP.SIZE_Bx) - 1
luaP.MAXARG_sBx = math.floor(luaP.MAXARG_Bx / 2) -- 'sBx' is signed
luaP.MAXARG_A = math.ldexp(1, luaP.SIZE_A) - 1
luaP.MAXARG_B = math.ldexp(1, luaP.SIZE_B) - 1
luaP.MAXARG_C = math.ldexp(1, luaP.SIZE_C) - 1
-- creates a mask with 'n' 1 bits at position 'p'
-- MASK1(n,p) deleted
-- creates a mask with 'n' 0 bits at position 'p'
-- MASK0(n,p) deleted
--[[--------------------------------------------------------------------
Visual representation for reference:
31 | | | 0 bit position
+-----+-----+-----+----------+
| B | C | A | Opcode | iABC format
+-----+-----+-----+----------+
- 9 - 9 - 8 - 6 - field sizes
+-----+-----+-----+----------+
| [s]Bx | A | Opcode | iABx | iAsBx format
+-----+-----+-----+----------+
----------------------------------------------------------------------]]
------------------------------------------------------------------------
-- the following macros help to manipulate instructions
-- * changed to a table object representation, very clean compared to
-- the [nightmare] alternatives of using a number or a string
------------------------------------------------------------------------
-- these accept or return opcodes in the form of string names
function luaP:GET_OPCODE(i) return self.ROpCode[i.OP] end
function luaP:SET_OPCODE(i, o) i.OP = self.OpCode[o] end
function luaP:GETARG_A(i) return i.A end
function luaP:SETARG_A(i, u) i.A = u end
function luaP:GETARG_B(i) return i.B end
function luaP:SETARG_B(i, b) i.B = b end
function luaP:GETARG_C(i) return i.C end
function luaP:SETARG_C(i, b) i.C = b end
function luaP:GETARG_Bx(i) return i.Bx end
function luaP:SETARG_Bx(i, b) i.Bx = b end
function luaP:GETARG_sBx(i) return i.Bx - self.MAXARG_sBx end
function luaP:SETARG_sBx(i, b) i.Bx = b + self.MAXARG_sBx end
function luaP:CREATE_ABC(o,a,b,c)
return {OP = self.OpCode[o], A = a, B = b, C = c}
end
function luaP:CREATE_ABx(o,a,bc)
return {OP = self.OpCode[o], A = a, Bx = bc}
end
------------------------------------------------------------------------
-- Bit shuffling stuffs
------------------------------------------------------------------------
if false and pcall (require, 'bit') then
------------------------------------------------------------------------
-- Return a 4-char string little-endian encoded form of an instruction
------------------------------------------------------------------------
function luaP:Instruction(i)
--FIXME
end
else
------------------------------------------------------------------------
-- Version without bit manipulation library.
------------------------------------------------------------------------
local p2 = {1,2,4,8,16,32,64,128,256, 512, 1024, 2048, 4096}
-- keeps [n] bits from [x]
local function keep (x, n) return x % p2[n+1] end
-- shifts bits of [x] [n] places to the right
local function srb (x,n) return math.floor (x / p2[n+1]) end
-- shifts bits of [x] [n] places to the left
local function slb (x,n) return x * p2[n+1] end
------------------------------------------------------------------------
-- Return a 4-char string little-endian encoded form of an instruction
------------------------------------------------------------------------
function luaP:Instruction(i)
-- printf("Instr->string: %s %s", self.opnames[i.OP], table.tostring(i))
local c0, c1, c2, c3
-- change to OP/A/B/C format if needed
if i.Bx then i.C = keep (i.Bx, 9); i.B = srb (i.Bx, 9) end
-- c0 = 6B from opcode + 2LSB from A (flushed to MSB)
c0 = i.OP + slb (keep (i.A, 2), 6)
-- c1 = 6MSB from A + 2LSB from C (flushed to MSB)
c1 = srb (i.A, 2) + slb (keep (i.C, 2), 6)
-- c2 = 7MSB from C + 1LSB from B (flushed to MSB)
c2 = srb (i.C, 2) + slb (keep (i.B, 1), 7)
-- c3 = 8MSB from B
c3 = srb (i.B, 1)
--printf ("Instruction: %s %s", self.opnames[i.OP], tostringv (i))
--printf ("Bin encoding: %x %x %x %x", c0, c1, c2, c3)
return string.char(c0, c1, c2, c3)
end
end
------------------------------------------------------------------------
-- decodes a 4-char little-endian string into an instruction struct
------------------------------------------------------------------------
function luaP:DecodeInst(x)
error "Not implemented"
end
------------------------------------------------------------------------
-- invalid register that fits in 8 bits
------------------------------------------------------------------------
luaP.NO_REG = luaP.MAXARG_A
------------------------------------------------------------------------
-- 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 these enums
------------------------------------------------------------------------
--[[--------------------------------------------------------------------
Lua virtual machine opcodes (enum OpCode):
------------------------------------------------------------------------
name args description
------------------------------------------------------------------------
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_GETGLOBAL A Bx R(A) := Gbl[Kst(Bx)]
OP_GETTABLE A B C R(A) := R(B)[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 B C R(A) := {} (size = B,C)
OP_SELF A B C R(A+1) := R(B); R(A) := R(B)[RK(C)]
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_CONCAT A B C R(A) := R(B).. ... ..R(C)
OP_JMP sBx PC += sBx
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_TEST A B C if (R(B) <=> C) then R(A) := R(B) else pc++
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_FORLOOP A sBx R(A)+=R(A+2); if R(A) <?= R(A+1) then PC+= sBx
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_SETLIST A Bx R(A)[Bx-Bx%FPF+i] := R(A+i), 1 <= i <= Bx%FPF+1
OP_SETLISTO A Bx (see note)
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))
----------------------------------------------------------------------]]
luaP.opnames = {} -- opcode names
luaP.OpCode = {} -- lookup name -> number
luaP.ROpCode = {} -- lookup number -> name
local i = 0
for v in string.gfind([[
MOVE -- 0
LOADK
LOADBOOL
LOADNIL
GETUPVAL
GETGLOBAL -- 5
GETTABLE
SETGLOBAL
SETUPVAL
SETTABLE
NEWTABLE -- 10
SELF
ADD
SUB
MUL
DIV -- 15
MOD
POW
UNM
NOT
LEN -- 20
CONCAT
JMP
EQ
LT
LE -- 25
TEST
TESTSET
CALL
TAILCALL
RETURN -- 30
FORLOOP
FORPREP
TFORLOOP
SETLIST
CLOSE -- 35
CLOSURE
VARARG
]], "[%a]+") do
local n = "OP_"..v
luaP.opnames[i] = v
luaP.OpCode[n] = i
luaP.ROpCode[i] = n
i = i + 1
end
luaP.NUM_OPCODES = i
--[[
===========================================================================
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'.
(2) In OP_RETURN, if (B == 0) then return up to 'top'
(3) For comparisons, B specifies what conditions the test should accept.
(4) All 'skips' (pc++) assume that next instruction is a jump
(5) OP_SETLISTO is used when the last item in a table constructor is a
function, so the number of elements set is up to top of stack
===========================================================================
--]]
------------------------------------------------------------------------
-- masks for instruction properties
------------------------------------------------------------------------
-- was enum OpModeMask:
luaP.OpModeBreg = 2 -- B is a register
luaP.OpModeBrk = 3 -- B is a register/constant
luaP.OpModeCrk = 4 -- C is a register/constant
luaP.OpModesetA = 5 -- instruction set register A
luaP.OpModeK = 6 -- Bx is a constant
luaP.OpModeT = 1 -- operator is a test
------------------------------------------------------------------------
-- get opcode mode, e.g. "iABC"
------------------------------------------------------------------------
function luaP:getOpMode(m)
--printv(m)
--printv(self.OpCode[m])
--printv(self.opmodes [self.OpCode[m]+1])
return self.OpMode[tonumber(string.sub(self.opmodes[self.OpCode[m] + 1], 7, 7))]
end
------------------------------------------------------------------------
-- test an instruction property flag
-- * b is a string, e.g. "OpModeBreg"
------------------------------------------------------------------------
function luaP:testOpMode(m, b)
return (string.sub(self.opmodes[self.OpCode[m] + 1], self[b], self[b]) == "1")
end
-- number of list items to accumulate before a SETLIST instruction
-- (must be a power of 2)
-- * used in lparser, lvm, ldebug, ltests
luaP.LFIELDS_PER_FLUSH = 50 --FF updated to match 5.1
-- luaP_opnames[] is set above, as the luaP.opnames table
-- opmode(t,b,bk,ck,sa,k,m) deleted
--[[--------------------------------------------------------------------
Legend for luaP:opmodes:
1 T -> T (is a test?)
2 B -> B is a register
3 b -> B is an RK register/constant combination
4 C -> C is an RK register/constant combination
5 A -> register A is set by the opcode
6 K -> Bx is a constant
7 m -> 1 if iABC layout,
2 if iABx layout,
3 if iAsBx layout
----------------------------------------------------------------------]]
luaP.opmodes = {
-- TBbCAKm opcode
"0100101", -- OP_MOVE 0
"0000112", -- OP_LOADK
"0000101", -- OP_LOADBOOL
"0100101", -- OP_LOADNIL
"0000101", -- OP_GETUPVAL
"0000112", -- OP_GETGLOBAL 5
"0101101", -- OP_GETTABLE
"0000012", -- OP_SETGLOBAL
"0000001", -- OP_SETUPVAL
"0011001", -- OP_SETTABLE
"0000101", -- OP_NEWTABLE 10
"0101101", -- OP_SELF
"0011101", -- OP_ADD
"0011101", -- OP_SUB
"0011101", -- OP_MUL
"0011101", -- OP_DIV 15
"0011101", -- OP_MOD
"0011101", -- OP_POW
"0100101", -- OP_UNM
"0100101", -- OP_NOT
"0100101", -- OP_LEN 20
"0101101", -- OP_CONCAT
"0000003", -- OP_JMP
"1011001", -- OP_EQ
"1011001", -- OP_LT
"1011001", -- OP_LE 25
"1000101", -- OP_TEST
"1100101", -- OP_TESTSET
"0000001", -- OP_CALL
"0000001", -- OP_TAILCALL
"0000001", -- OP_RETURN 30
"0000003", -- OP_FORLOOP
"0000103", -- OP_FORPREP
"1000101", -- OP_TFORLOOP
"0000001", -- OP_SETLIST
"0000001", -- OP_CLOSE 35
"0000102", -- OP_CLOSURE
"0000101" -- OP_VARARG
}
return luaP

86
src/metalua/compiler/globals.lua
View File

@ -1,86 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
--*-lua-*-----------------------------------------------------------------------
-- Override Lua's default compilation functions, so that they support Metalua
-- rather than only plain Lua
--------------------------------------------------------------------------------
local mlc = require 'metalua.compiler'
local M = { }
-- Original versions
local original_lua_versions = {
load = load,
loadfile = loadfile,
loadstring = loadstring,
dofile = dofile }
local lua_loadstring = loadstring
local lua_loadfile = loadfile
function M.loadstring(str, name)
if type(str) ~= 'string' then error 'string expected' end
if str:match '^\027LuaQ' then return lua_loadstring(str) end
local n = str:match '^#![^\n]*\n()'
if n then str=str:sub(n, -1) end
-- FIXME: handle erroneous returns (return nil + error msg)
return mlc.new():src_to_function(str, name)
end
function M.loadfile(filename)
local f, err_msg = io.open(filename, 'rb')
if not f then return nil, err_msg end
local success, src = pcall( f.read, f, '*a')
pcall(f.close, f)
if success then return M.loadstring (src, '@'..filename)
else return nil, src end
end
function M.load(f, name)
local acc = { }
while true do
local x = f()
if not x then break end
assert(type(x)=='string', "function passed to load() must return strings")
table.insert(acc, x)
end
return M.loadstring(table.concat(acc))
end
function M.dostring(src)
local f, msg = M.loadstring(src)
if not f then error(msg) end
return f()
end
function M.dofile(name)
local f, msg = M.loadfile(name)
if not f then error(msg) end
return f()
end
-- Export replacement functions as globals
for name, f in pairs(M) do _G[name] = f end
-- To be done *after* exportation
M.lua = original_lua_versions
return M

42
src/metalua/compiler/parser.lua
View File

@ -1,42 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
-- Export all public APIs from sub-modules, squashed into a flat spacename
local MT = { __type='metalua.compiler.parser' }
local MODULE_REL_NAMES = { "annot.grammar", "expr", "meta", "misc",
"stat", "table", "ext" }
local function new()
local M = {
lexer = require "metalua.compiler.parser.lexer" ();
extensions = { } }
for _, rel_name in ipairs(MODULE_REL_NAMES) do
local abs_name = "metalua.compiler.parser."..rel_name
local extender = require (abs_name)
if not M.extensions[abs_name] then
if type (extender) == 'function' then extender(M) end
M.extensions[abs_name] = extender
end
end
return setmetatable(M, MT)
end
return { new = new }

48
src/metalua/compiler/parser/annot/generator.lua
View File

@ -1,48 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
require 'checks'
local gg = require 'metalua.grammar.generator'
local M = { }
function M.opt(mlc, primary, a_type)
checks('table', 'table|function', 'string')
return gg.sequence{
primary,
gg.onkeyword{ "#", function() return assert(mlc.annot[a_type]) end },
builder = function(x)
local t, annot = unpack(x)
return annot and { tag='Annot', t, annot } or t
end }
end
-- split a list of "foo" and "`Annot{foo, annot}" into a list of "foo"
-- and a list of "annot".
-- No annot list is returned if none of the elements were annotated.
function M.split(lst)
local x, a, some = { }, { }, false
for i, p in ipairs(lst) do
if p.tag=='Annot' then
some, x[i], a[i] = true, unpack(p)
else x[i] = p end
end
if some then return x, a else return lst end
end
return M

112
src/metalua/compiler/parser/annot/grammar.lua
View File

@ -1,112 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
local gg = require 'metalua.grammar.generator'
return function(M)
local _M = gg.future(M)
M.lexer :add '->'
local A = { }
local _A = gg.future(A)
M.annot = A
-- Type identifier: Lua keywords such as `"nil"` allowed.
function M.annot.tid(lx)
local w = lx :next()
local t = w.tag
if t=='Keyword' and w[1] :match '^[%a_][%w_]*$' or w.tag=='Id'
then return {tag='TId'; lineinfo=w.lineinfo; w[1]}
else return gg.parse_error (lx, 'tid expected') end
end
local field_types = { var='TVar'; const='TConst';
currently='TCurrently'; field='TField' }
-- TODO check lineinfo
function M.annot.tf(lx)
local tk = lx:next()
local w = tk[1]
local tag = field_types[w]
if not tag then error ('Invalid field type '..w)
elseif tag=='TField' then return {tag='TField'} else
local te = M.te(lx)
return {tag=tag; te}
end
end
M.annot.tebar_content = gg.list{
name = 'tebar content',
primary = _A.te,
separators = { ",", ";" },
terminators = ")" }
M.annot.tebar = gg.multisequence{
name = 'annot.tebar',
--{ '*', builder = 'TDynbar' }, -- maybe not user-available
{ '(', _A.tebar_content, ')',
builder = function(x) return x[1] end },
{ _A.te }
}
M.annot.te = gg.multisequence{
name = 'annot.te',
{ _A.tid, builder=function(x) return x[1] end },
{ '*', builder = 'TDyn' },
{ "[",
gg.list{
primary = gg.sequence{
_M.expr, "=", _A.tf,
builder = 'TPair'
},
separators = { ",", ";" },
terminators = { "]", "|" } },
gg.onkeyword{ "|", _A.tf },
"]",
builder = function(x)
local fields, other = unpack(x)
return { tag='TTable', other or {tag='TField'}, fields }
end }, -- "[ ... ]"
{ '(', _A.tebar_content, ')', '->', '(', _A.tebar_content, ')',
builder = function(x)
local p, r = unpack(x)
return {tag='TFunction', p, r }
end } }
M.annot.ts = gg.multisequence{
name = 'annot.ts',
{ 'return', _A.tebar_content, builder='TReturn' },
{ _A.tid, builder = function(x)
if x[1][1]=='pass' then return {tag='TPass'}
else error "Bad statement type" end
end } }
-- TODO: add parsers for statements:
-- #return tebar
-- #alias = te
-- #ell = tf
--[[
M.annot.stat_annot = gg.sequence{
gg.list{ primary=_A.tid, separators='.' },
'=',
XXX??,
builder = 'Annot' }
--]]
return M.annot
end

27
src/metalua/compiler/parser/common.lua
View File

@ -1,27 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
-- Shared common parser table. It will be filled by parser.init(),
-- and every other module will be able to call its elements at runtime.
--
-- If the table was directly created in parser.init, a circular
-- dependency would be created: parser.init depends on other modules to fill the table,
-- so other modules can't simultaneously depend on it.
return { }

206
src/metalua/compiler/parser/expr.lua
View File

@ -1,206 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Exported API:
-- * [mlp.expr()]
-- * [mlp.expr_list()]
-- * [mlp.func_val()]
--
-------------------------------------------------------------------------------
local pp = require 'metalua.pprint'
local gg = require 'metalua.grammar.generator'
local annot = require 'metalua.compiler.parser.annot.generator'
return function(M)
local _M = gg.future(M)
local _table = gg.future(M, 'table')
local _meta = gg.future(M, 'meta') -- TODO move to ext?
local _annot = gg.future(M, 'annot') -- TODO move to annot
--------------------------------------------------------------------------------
-- Non-empty expression list. Actually, this isn't used here, but that's
-- handy to give to users.
--------------------------------------------------------------------------------
M.expr_list = gg.list{ primary=_M.expr, separators="," }
--------------------------------------------------------------------------------
-- Helpers for function applications / method applications
--------------------------------------------------------------------------------
M.func_args_content = gg.list{
name = "function arguments",
primary = _M.expr,
separators = ",",
terminators = ")" }
-- Used to parse methods
M.method_args = gg.multisequence{
name = "function argument(s)",
{ "{", _table.content, "}" },
{ "(", _M.func_args_content, ")", builder = unpack },
{ "+{", _meta.quote_content, "}" },
-- TODO lineinfo?
function(lx) local r = M.opt_string(lx); return r and {r} or { } end }
--------------------------------------------------------------------------------
-- [func_val] parses a function, from opening parameters parenthese to
-- "end" keyword included. Used for anonymous functions as well as
-- function declaration statements (both local and global).
--
-- It's wrapped in a [_func_val] eta expansion, so that when expr
-- parser uses the latter, they will notice updates of [func_val]
-- definitions.
--------------------------------------------------------------------------------
M.func_params_content = gg.list{
name="function parameters",
gg.multisequence{ { "...", builder = "Dots" }, annot.opt(M, _M.id, 'te') },
separators = ",", terminators = {")", "|"} }
-- TODO move to annot
M.func_val = gg.sequence{
name = "function body",
"(", _M.func_params_content, ")", _M.block, "end",
builder = function(x)
local params, body = unpack(x)
local annots, some = { }, false
for i, p in ipairs(params) do
if p.tag=='Annot' then
params[i], annots[i], some = p[1], p[2], true
else annots[i] = false end
end
if some then return { tag='Function', params, body, annots }
else return { tag='Function', params, body } end
end }
local func_val = function(lx) return M.func_val(lx) end
--------------------------------------------------------------------------------
-- Default parser for primary expressions
--------------------------------------------------------------------------------
function M.id_or_literal (lx)
local a = lx:next()
if a.tag~="Id" and a.tag~="String" and a.tag~="Number" then
local msg
if a.tag=='Eof' then
msg = "End of file reached when an expression was expected"
elseif a.tag=='Keyword' then
msg = "An expression was expected, and `"..a[1]..
"' can't start an expression"
else
msg = "Unexpected expr token " .. pp.tostring (a)
end
gg.parse_error (lx, msg)
end
return a
end
--------------------------------------------------------------------------------
-- Builder generator for operators. Wouldn't be worth it if "|x|" notation
-- were allowed, but then lua 5.1 wouldn't compile it
--------------------------------------------------------------------------------
-- opf1 = |op| |_,a| `Op{ op, a }
local function opf1 (op) return
function (_,a) return { tag="Op", op, a } end end
-- opf2 = |op| |a,_,b| `Op{ op, a, b }
local function opf2 (op) return
function (a,_,b) return { tag="Op", op, a, b } end end
-- opf2r = |op| |a,_,b| `Op{ op, b, a } -- (args reversed)
local function opf2r (op) return
function (a,_,b) return { tag="Op", op, b, a } end end
local function op_ne(a, _, b)
-- This version allows to remove the "ne" operator from the AST definition.
-- However, it doesn't always produce the exact same bytecode as Lua 5.1.
return { tag="Op", "not",
{ tag="Op", "eq", a, b, lineinfo= {
first = a.lineinfo.first, last = b.lineinfo.last } } }
end
--------------------------------------------------------------------------------
--
-- complete expression
--
--------------------------------------------------------------------------------
-- FIXME: set line number. In [expr] transformers probably
M.expr = gg.expr {
name = "expression",
primary = gg.multisequence{
name = "expr primary",
{ "(", _M.expr, ")", builder = "Paren" },
{ "function", _M.func_val, builder = unpack },
{ "-{", _meta.splice_content, "}", builder = unpack },
{ "+{", _meta.quote_content, "}", builder = unpack },
{ "nil", builder = "Nil" },
{ "true", builder = "True" },
{ "false", builder = "False" },
{ "...", builder = "Dots" },
{ "{", _table.content, "}", builder = unpack },
_M.id_or_literal },
infix = {
name = "expr infix op",
{ "+", prec = 60, builder = opf2 "add" },
{ "-", prec = 60, builder = opf2 "sub" },
{ "*", prec = 70, builder = opf2 "mul" },
{ "/", prec = 70, builder = opf2 "div" },
{ "%", prec = 70, builder = opf2 "mod" },
{ "^", prec = 90, builder = opf2 "pow", assoc = "right" },
{ "..", prec = 40, builder = opf2 "concat", assoc = "right" },
{ "==", prec = 30, builder = opf2 "eq" },
{ "~=", prec = 30, builder = op_ne },
{ "<", prec = 30, builder = opf2 "lt" },
{ "<=", prec = 30, builder = opf2 "le" },
{ ">", prec = 30, builder = opf2r "lt" },
{ ">=", prec = 30, builder = opf2r "le" },
{ "and",prec = 20, builder = opf2 "and" },
{ "or", prec = 10, builder = opf2 "or" } },
prefix = {
name = "expr prefix op",
{ "not", prec = 80, builder = opf1 "not" },
{ "#", prec = 80, builder = opf1 "len" },
{ "-", prec = 80, builder = opf1 "unm" } },
suffix = {
name = "expr suffix op",
{ "[", _M.expr, "]", builder = function (tab, idx)
return {tag="Index", tab, idx[1]} end},
{ ".", _M.id, builder = function (tab, field)
return {tag="Index", tab, _M.id2string(field[1])} end },
{ "(", _M.func_args_content, ")", builder = function(f, args)
return {tag="Call", f, unpack(args[1])} end },
{ "{", _table.content, "}", builder = function (f, arg)
return {tag="Call", f, arg[1]} end},
{ ":", _M.id, _M.method_args, builder = function (obj, post)
local m_name, args = unpack(post)
return {tag="Invoke", obj, _M.id2string(m_name), unpack(args)} end},
{ "+{", _meta.quote_content, "}", builder = function (f, arg)
return {tag="Call", f, arg[1] } end },
default = { name="opt_string_arg", parse = _M.opt_string, builder = function(f, arg)
return {tag="Call", f, arg } end } } }
return M
end

96
src/metalua/compiler/parser/ext.lua
View File

@ -1,96 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--
-- Non-Lua syntax extensions
--
--------------------------------------------------------------------------------
local gg = require 'metalua.grammar.generator'
return function(M)
local _M = gg.future(M)
---------------------------------------------------------------------------
-- Algebraic Datatypes
----------------------------------------------------------------------------
local function adt (lx)
local node = _M.id (lx)
local tagval = node[1]
-- tagkey = `Pair{ `String "key", `String{ -{tagval} } }
local tagkey = { tag="Pair", {tag="String", "tag"}, {tag="String", tagval} }
if lx:peek().tag == "String" or lx:peek().tag == "Number" then
-- TODO support boolean litterals
return { tag="Table", tagkey, lx:next() }
elseif lx:is_keyword (lx:peek(), "{") then
local x = M.table.table (lx)
table.insert (x, 1, tagkey)
return x
else return { tag="Table", tagkey } end
end
M.adt = gg.sequence{ "`", adt, builder = unpack }
M.expr.primary :add(M.adt)
----------------------------------------------------------------------------
-- Anonymous lambda
----------------------------------------------------------------------------
M.lambda_expr = gg.sequence{
"|", _M.func_params_content, "|", _M.expr,
builder = function (x)
local li = x[2].lineinfo
return { tag="Function", x[1],
{ {tag="Return", x[2], lineinfo=li }, lineinfo=li } }
end }
M.expr.primary :add (M.lambda_expr)
--------------------------------------------------------------------------------
-- Allows to write "a `f` b" instead of "f(a, b)". Taken from Haskell.
--------------------------------------------------------------------------------
function M.expr_in_backquotes (lx) return M.expr(lx, 35) end -- 35=limited precedence
M.expr.infix :add{ name = "infix function",
"`", _M.expr_in_backquotes, "`", prec = 35, assoc="left",
builder = function(a, op, b) return {tag="Call", op[1], a, b} end }
--------------------------------------------------------------------------------
-- C-style op+assignments
-- TODO: no protection against side-effects in LHS vars.
--------------------------------------------------------------------------------
local function op_assign(kw, op)
local function rhs(a, b) return { tag="Op", op, a, b } end
local function f(a,b)
if #a ~= #b then gg.parse_error "assymetric operator+assignment" end
local right = { }
local r = { tag="Set", a, right }
for i=1, #a do right[i] = { tag="Op", op, a[i], b[i] } end
return r
end
M.lexer :add (kw)
M.assignments[kw] = f
end
local ops = { add='+='; sub='-='; mul='*='; div='/=' }
for ast_op_name, keyword in pairs(ops) do op_assign(keyword, ast_op_name) end
return M
end

43
src/metalua/compiler/parser/lexer.lua
View File

@ -1,43 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2014 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
----------------------------------------------------------------------
-- Generate a new lua-specific lexer, derived from the generic lexer.
----------------------------------------------------------------------
local generic_lexer = require 'metalua.grammar.lexer'
return function()
local lexer = generic_lexer.lexer :clone()
local keywords = {
"and", "break", "do", "else", "elseif",
"end", "false", "for", "function",
"goto", -- Lua5.2
"if",
"in", "local", "nil", "not", "or", "repeat",
"return", "then", "true", "until", "while",
"...", "..", "==", ">=", "<=", "~=",
"::", -- Lua5,2
"+{", "-{" } -- Metalua
for _, w in ipairs(keywords) do lexer :add (w) end
return lexer
end

138
src/metalua/compiler/parser/meta.lua
View File

@ -1,138 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2014 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
-- Compile-time metaprogramming features: splicing ASTs generated during compilation,
-- AST quasi-quoting helpers.
local gg = require 'metalua.grammar.generator'
return function(M)
local _M = gg.future(M)
M.meta={ }
local _MM = gg.future(M.meta)
--------------------------------------------------------------------------------
-- External splicing: compile an AST into a chunk, load and evaluate
-- that chunk, and replace the chunk by its result (which must also be
-- an AST).
--------------------------------------------------------------------------------
-- TODO: that's not part of the parser
function M.meta.eval (ast)
-- TODO: should there be one mlc per splice, or per parser instance?
local mlc = require 'metalua.compiler'.new()
local f = mlc :ast_to_function (ast, '=splice')
local result=f(M) -- splices act on the current parser
return result
end
----------------------------------------------------------------------------
-- Going from an AST to an AST representing that AST
-- the only hash-part key being lifted is `"tag"`.
-- Doesn't lift subtrees protected inside a `Splice{ ... }.
-- e.g. change `Foo{ 123 } into
-- `Table{ `Pair{ `String "tag", `String "foo" }, `Number 123 }
----------------------------------------------------------------------------
local function lift (t)
--print("QUOTING:", table.tostring(t, 60,'nohash'))
local cases = { }
function cases.table (t)
local mt = { tag = "Table" }
--table.insert (mt, { tag = "Pair", quote "quote", { tag = "True" } })
if t.tag == "Splice" then
assert (#t==1, "Invalid splice")
local sp = t[1]
return sp
elseif t.tag then
table.insert (mt, { tag="Pair", lift "tag", lift(t.tag) })
end
for _, v in ipairs (t) do
table.insert (mt, lift(v))
end
return mt
end
function cases.number (t) return { tag = "Number", t, quote = true } end
function cases.string (t) return { tag = "String", t, quote = true } end
function cases.boolean (t) return { tag = t and "True" or "False", t, quote = true } end
local f = cases [type(t)]
if f then return f(t) else error ("Cannot quote an AST containing "..tostring(t)) end
end
M.meta.lift = lift
--------------------------------------------------------------------------------
-- when this variable is false, code inside [-{...}] is compiled and
-- avaluated immediately. When it's true (supposedly when we're
-- parsing data inside a quasiquote), [-{foo}] is replaced by
-- [`Splice{foo}], which will be unpacked by [quote()].
--------------------------------------------------------------------------------
local in_a_quote = false
--------------------------------------------------------------------------------
-- Parse the inside of a "-{ ... }"
--------------------------------------------------------------------------------
function M.meta.splice_content (lx)
local parser_name = "expr"
if lx:is_keyword (lx:peek(2), ":") then
local a = lx:next()
lx:next() -- skip ":"
assert (a.tag=="Id", "Invalid splice parser name")
parser_name = a[1]
end
-- TODO FIXME running a new parser with the old lexer?!
local parser = require 'metalua.compiler.parser'.new()
local ast = parser [parser_name](lx)
if in_a_quote then -- only prevent quotation in this subtree
--printf("SPLICE_IN_QUOTE:\n%s", _G.table.tostring(ast, "nohash", 60))
return { tag="Splice", ast }
else -- convert in a block, eval, replace with result
if parser_name == "expr" then ast = { { tag="Return", ast } }
elseif parser_name == "stat" then ast = { ast }
elseif parser_name ~= "block" then
error ("splice content must be an expr, stat or block") end
--printf("EXEC THIS SPLICE:\n%s", _G.table.tostring(ast, "nohash", 60))
return M.meta.eval (ast)
end
end
M.meta.splice = gg.sequence{ "-{", _MM.splice_content, "}", builder=unpack }
--------------------------------------------------------------------------------
-- Parse the inside of a "+{ ... }"
--------------------------------------------------------------------------------
function M.meta.quote_content (lx)
local parser
if lx:is_keyword (lx:peek(2), ":") then -- +{parser: content }
local parser_name = M.id(lx)[1]
parser = M[parser_name]
lx:next() -- skip ":"
else -- +{ content }
parser = M.expr
end
local prev_iq = in_a_quote
in_a_quote = true
--print("IN_A_QUOTE")
local content = parser (lx)
local q_content = M.meta.lift (content)
in_a_quote = prev_iq
return q_content
end
return M
end

175
src/metalua/compiler/parser/misc.lua
View File

@ -1,175 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Summary: metalua parser, miscellaneous utility functions.
--
-------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--
-- Exported API:
-- * [mlp.fget()]
-- * [mlp.id()]
-- * [mlp.opt_id()]
-- * [mlp.id_list()]
-- * [mlp.string()]
-- * [mlp.opt_string()]
-- * [mlp.id2string()]
--
--------------------------------------------------------------------------------
local gg = require 'metalua.grammar.generator'
-- TODO: replace splice-aware versions with naive ones, move etensions in ./meta
return function(M)
local _M = gg.future(M)
--[[ metaprog-free versions:
function M.id(lx)
if lx:peek().tag~='Id' then gg.parse_error(lx, "Identifier expected")
else return lx:next() end
end
function M.opt_id(lx)
if lx:peek().tag~='Id' then return lx:next() else return false end
end
function M.string(lx)
if lx:peek().tag~='String' then gg.parse_error(lx, "String expected")
else return lx:next() end
end
function M.opt_string(lx)
if lx:peek().tag~='String' then return lx:next() else return false end
end
--------------------------------------------------------------------------------
-- Converts an identifier into a string. Hopefully one day it'll handle
-- splices gracefully, but that proves quite tricky.
--------------------------------------------------------------------------------
function M.id2string (id)
if id.tag == "Id" then id.tag = "String"; return id
else error ("Identifier expected: "..table.tostring(id, 'nohash')) end
end
--]]
--------------------------------------------------------------------------------
-- Try to read an identifier (possibly as a splice), or return [false] if no
-- id is found.
--------------------------------------------------------------------------------
function M.opt_id (lx)
local a = lx:peek();
if lx:is_keyword (a, "-{") then
local v = M.meta.splice(lx)
if v.tag ~= "Id" and v.tag ~= "Splice" then
gg.parse_error(lx, "Bad id splice")
end
return v
elseif a.tag == "Id" then return lx:next()
else return false end
end
--------------------------------------------------------------------------------
-- Mandatory reading of an id: causes an error if it can't read one.
--------------------------------------------------------------------------------
function M.id (lx)
return M.opt_id (lx) or gg.parse_error(lx,"Identifier expected")
end
--------------------------------------------------------------------------------
-- Common helper function
--------------------------------------------------------------------------------
M.id_list = gg.list { primary = _M.id, separators = "," }
--------------------------------------------------------------------------------
-- Converts an identifier into a string. Hopefully one day it'll handle
-- splices gracefully, but that proves quite tricky.
--------------------------------------------------------------------------------
function M.id2string (id)
--print("id2string:", disp.ast(id))
if id.tag == "Id" then id.tag = "String"; return id
elseif id.tag == "Splice" then
error ("id2string on splice not implemented")
-- Evaluating id[1] will produce `Id{ xxx },
-- and we want it to produce `String{ xxx }.
-- The following is the plain notation of:
-- +{ `String{ `Index{ `Splice{ -{id[1]} }, `Number 1 } } }
return { tag="String", { tag="Index", { tag="Splice", id[1] },
{ tag="Number", 1 } } }
else error ("Identifier expected: "..table.tostring(id, 'nohash')) end
end
--------------------------------------------------------------------------------
-- Read a string, possibly spliced, or return an error if it can't
--------------------------------------------------------------------------------
function M.string (lx)
local a = lx:peek()
if lx:is_keyword (a, "-{") then
local v = M.meta.splice(lx)
if v.tag ~= "String" and v.tag ~= "Splice" then
gg.parse_error(lx,"Bad string splice")
end
return v
elseif a.tag == "String" then return lx:next()
else error "String expected" end
end
--------------------------------------------------------------------------------
-- Try to read a string, or return false if it can't. No splice allowed.
--------------------------------------------------------------------------------
function M.opt_string (lx)
return lx:peek().tag == "String" and lx:next()
end
--------------------------------------------------------------------------------
-- Chunk reader: block + Eof
--------------------------------------------------------------------------------
function M.skip_initial_sharp_comment (lx)
-- Dirty hack: I'm happily fondling lexer's private parts
-- FIXME: redundant with lexer:newstream()
lx :sync()
local i = lx.src:match ("^#.-\n()", lx.i)
if i then
lx.i = i
lx.column_offset = i
lx.line = lx.line and lx.line + 1 or 1
end
end
local function chunk (lx)
if lx:peek().tag == 'Eof' then
return { } -- handle empty files
else
M.skip_initial_sharp_comment (lx)
local chunk = M.block (lx)
if lx:peek().tag ~= "Eof" then
gg.parse_error(lx, "End-of-file expected")
end
return chunk
end
end
-- chunk is wrapped in a sequence so that it has a "transformer" field.
M.chunk = gg.sequence { chunk, builder = unpack }
return M
end

279
src/metalua/compiler/parser/stat.lua
View File

@ -1,279 +0,0 @@
------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Summary: metalua parser, statement/block parser. This is part of the
-- definition of module [mlp].
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Exports API:
-- * [mlp.stat()]
-- * [mlp.block()]
-- * [mlp.for_header()]
--
-------------------------------------------------------------------------------
local lexer = require 'metalua.grammar.lexer'
local gg = require 'metalua.grammar.generator'
local annot = require 'metalua.compiler.parser.annot.generator'
--------------------------------------------------------------------------------
-- List of all keywords that indicate the end of a statement block. Users are
-- likely to extend this list when designing extensions.
--------------------------------------------------------------------------------
return function(M)
local _M = gg.future(M)
M.block_terminators = { "else", "elseif", "end", "until", ")", "}", "]" }
-- FIXME: this must be handled from within GG!!!
-- FIXME: there's no :add method in the list anyway. Added by gg.list?!
function M.block_terminators :add(x)
if type (x) == "table" then for _, y in ipairs(x) do self :add (y) end
else table.insert (self, x) end
end
----------------------------------------------------------------------------
-- list of statements, possibly followed by semicolons
----------------------------------------------------------------------------
M.block = gg.list {
name = "statements block",
terminators = M.block_terminators,
primary = function (lx)
-- FIXME use gg.optkeyword()
local x = M.stat (lx)
if lx:is_keyword (lx:peek(), ";") then lx:next() end
return x
end }
----------------------------------------------------------------------------
-- Helper function for "return <expr_list>" parsing.
-- Called when parsing return statements.
-- The specific test for initial ";" is because it's not a block terminator,
-- so without it gg.list would choke on "return ;" statements.
-- We don't make a modified copy of block_terminators because this list
-- is sometimes modified at runtime, and the return parser would get out of
-- sync if it was relying on a copy.
----------------------------------------------------------------------------
local return_expr_list_parser = gg.multisequence{
{ ";" , builder = function() return { } end },
default = gg.list {
_M.expr, separators = ",", terminators = M.block_terminators } }
local for_vars_list = gg.list{
name = "for variables list",
primary = _M.id,
separators = ",",
terminators = "in" }
----------------------------------------------------------------------------
-- for header, between [for] and [do] (exclusive).
-- Return the `Forxxx{...} AST, without the body element (the last one).
----------------------------------------------------------------------------
function M.for_header (lx)
local vars = M.id_list(lx)
if lx :is_keyword (lx:peek(), "=") then
if #vars ~= 1 then
gg.parse_error (lx, "numeric for only accepts one variable")
end
lx:next() -- skip "="
local exprs = M.expr_list (lx)
if #exprs < 2 or #exprs > 3 then
gg.parse_error (lx, "numeric for requires 2 or 3 boundaries")
end
return { tag="Fornum", vars[1], unpack (exprs) }
else
if not lx :is_keyword (lx :next(), "in") then
gg.parse_error (lx, '"=" or "in" expected in for loop')
end
local exprs = M.expr_list (lx)
return { tag="Forin", vars, exprs }
end
end
----------------------------------------------------------------------------
-- Function def parser helper: id ( . id ) *
----------------------------------------------------------------------------
local function fn_builder (list)
local acc = list[1]
local first = acc.lineinfo.first
for i = 2, #list do
local index = M.id2string(list[i])
local li = lexer.new_lineinfo(first, index.lineinfo.last)
acc = { tag="Index", acc, index, lineinfo=li }
end
return acc
end
local func_name = gg.list{ _M.id, separators = ".", builder = fn_builder }
----------------------------------------------------------------------------
-- Function def parser helper: ( : id )?
----------------------------------------------------------------------------
local method_name = gg.onkeyword{ name = "method invocation", ":", _M.id,
transformers = { function(x) return x and x.tag=='Id' and M.id2string(x) end } }
----------------------------------------------------------------------------
-- Function def builder
----------------------------------------------------------------------------
local function funcdef_builder(x)
local name, method, func = unpack(x)
if method then
name = { tag="Index", name, method,
lineinfo = {
first = name.lineinfo.first,
last = method.lineinfo.last } }
table.insert (func[1], 1, {tag="Id", "self"})
end
local r = { tag="Set", {name}, {func} }
r[1].lineinfo = name.lineinfo
r[2].lineinfo = func.lineinfo
return r
end
----------------------------------------------------------------------------
-- if statement builder
----------------------------------------------------------------------------
local function if_builder (x)
local cond_block_pairs, else_block, r = x[1], x[2], {tag="If"}
local n_pairs = #cond_block_pairs
for i = 1, n_pairs do
local cond, block = unpack(cond_block_pairs[i])
r[2*i-1], r[2*i] = cond, block
end
if else_block then table.insert(r, #r+1, else_block) end
return r
end
--------------------------------------------------------------------------------
-- produce a list of (expr,block) pairs
--------------------------------------------------------------------------------
local elseifs_parser = gg.list {
gg.sequence { _M.expr, "then", _M.block , name='elseif parser' },
separators = "elseif",
terminators = { "else", "end" }
}
local annot_expr = gg.sequence {
_M.expr,
gg.onkeyword{ "#", gg.future(M, 'annot').tf },
builder = function(x)
local e, a = unpack(x)
if a then return { tag='Annot', e, a }
else return e end
end }
local annot_expr_list = gg.list {
primary = annot.opt(M, _M.expr, 'tf'), separators = ',' }
------------------------------------------------------------------------
-- assignments and calls: statements that don't start with a keyword
------------------------------------------------------------------------
local function assign_or_call_stat_parser (lx)
local e = annot_expr_list (lx)
local a = lx:is_keyword(lx:peek())
local op = a and M.assignments[a]
-- TODO: refactor annotations
if op then
--FIXME: check that [e] is a LHS
lx :next()
local annots
e, annots = annot.split(e)
local v = M.expr_list (lx)
if type(op)=="string" then return { tag=op, e, v, annots }
else return op (e, v) end
else
assert (#e > 0)
if #e > 1 then
gg.parse_error (lx,
"comma is not a valid statement separator; statement can be "..
"separated by semicolons, or not separated at all")
elseif e[1].tag ~= "Call" and e[1].tag ~= "Invoke" then
local typename
if e[1].tag == 'Id' then
typename = '("'..e[1][1]..'") is an identifier'
elseif e[1].tag == 'Op' then
typename = "is an arithmetic operation"
else typename = "is of type '"..(e[1].tag or "<list>").."'" end
gg.parse_error (lx,
"This expression %s; "..
"a statement was expected, and only function and method call "..
"expressions can be used as statements", typename);
end
return e[1]
end
end
M.local_stat_parser = gg.multisequence{
-- local function <name> <func_val>
{ "function", _M.id, _M.func_val, builder =
function(x)
local vars = { x[1], lineinfo = x[1].lineinfo }
local vals = { x[2], lineinfo = x[2].lineinfo }
return { tag="Localrec", vars, vals }
end },
-- local <id_list> ( = <expr_list> )?
default = gg.sequence{
gg.list{
primary = annot.opt(M, _M.id, 'tf'),
separators = ',' },
gg.onkeyword{ "=", _M.expr_list },
builder = function(x)
local annotated_left, right = unpack(x)
local left, annotations = annot.split(annotated_left)
return {tag="Local", left, right or { }, annotations }
end } }
------------------------------------------------------------------------
-- statement
------------------------------------------------------------------------
M.stat = gg.multisequence {
name = "statement",
{ "do", _M.block, "end", builder =
function (x) return { tag="Do", unpack (x[1]) } end },
{ "for", _M.for_header, "do", _M.block, "end", builder =
function (x) x[1][#x[1]+1] = x[2]; return x[1] end },
{ "function", func_name, method_name, _M.func_val, builder=funcdef_builder },
{ "while", _M.expr, "do", _M.block, "end", builder = "While" },
{ "repeat", _M.block, "until", _M.expr, builder = "Repeat" },
{ "local", _M.local_stat_parser, builder = unpack },
{ "return", return_expr_list_parser, builder =
function(x) x[1].tag='Return'; return x[1] end },
{ "break", builder = function() return { tag="Break" } end },
{ "-{", gg.future(M, 'meta').splice_content, "}", builder = unpack },
{ "if", gg.nonempty(elseifs_parser), gg.onkeyword{ "else", M.block }, "end",
builder = if_builder },
default = assign_or_call_stat_parser }
M.assignments = {
["="] = "Set"
}
function M.assignments:add(k, v) self[k] = v end
return M
end

77
src/metalua/compiler/parser/table.lua
View File

@ -1,77 +0,0 @@
--------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--
-- Exported API:
-- * [M.table_bracket_field()]
-- * [M.table_field()]
-- * [M.table_content()]
-- * [M.table()]
--
-- KNOWN BUG: doesn't handle final ";" or "," before final "}"
--
--------------------------------------------------------------------------------
local gg = require 'metalua.grammar.generator'
return function(M)
M.table = { }
local _table = gg.future(M.table)
local _expr = gg.future(M).expr
--------------------------------------------------------------------------------
-- `[key] = value` table field definition
--------------------------------------------------------------------------------
M.table.bracket_pair = gg.sequence{ "[", _expr, "]", "=", _expr, builder = "Pair" }
--------------------------------------------------------------------------------
-- table element parser: list value, `id = value` pair or `[value] = value` pair.
--------------------------------------------------------------------------------
function M.table.element (lx)
if lx :is_keyword (lx :peek(), "[") then return M.table.bracket_pair(lx) end
local e = M.expr (lx)
if not lx :is_keyword (lx :peek(), "=") then return e end
lx :next(); -- skip the "="
local key = M.id2string(e) -- will fail on non-identifiers
local val = M.expr(lx)
local r = { tag="Pair", key, val }
r.lineinfo = { first = key.lineinfo.first, last = val.lineinfo.last }
return r
end
-----------------------------------------------------------------------------
-- table constructor, without enclosing braces; returns a full table object
-----------------------------------------------------------------------------
M.table.content = gg.list {
-- eta expansion to allow patching the element definition
primary = _table.element,
separators = { ",", ";" },
terminators = "}",
builder = "Table" }
--------------------------------------------------------------------------------
-- complete table constructor including [{...}]
--------------------------------------------------------------------------------
-- TODO beware, stat and expr use only table.content, this can't be patched.
M.table.table = gg.sequence{ "{", _table.content, "}", builder = unpack }
return M
end

31
src/metalua/dollar.mlua
View File

@ -1,31 +0,0 @@
-{ extension ('match', ...) }
local M = { }
M.register = { }
local function dollar_builder(e)
match e with
| `Call{ `Id{name}, ... } ->
local entry = M.register[name] or error ("No macro "..name.." registered")
return entry(select(2, unpack(e)))
| `Id{name} ->
local entry = dollar[name] or error ("No macro "..name.." registered")
match type(entry) with
| 'function' -> return entry()
| 'table' -> return entry -- constant AST
| t -> error ("Invalid macro type "..t)
end
| _ -> error "Invalid $macro, '$' must be followed by an identifier or function call"
end
end
function M.extend(M)
local M = require 'metalua.grammar.generator' .future(M)
M.expr.prefix :add {
'$', prec = 100, builder = |_, x| dollar_builder(x) }
M.stat:add{
'$', _M.expr, builder = |x| dollar_builder(x[1]) }
end
return M

282
src/metalua/extension/comprehension.mlua
View File

@ -1,282 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
--
-- This extension implements list comprehensions, similar to Haskell and
-- Python syntax, to easily describe lists.
--
-- * x[a ... b] is the list { x[a], x[a+1], ..., x[b] }
-- * { f()..., b } contains all the elements returned by f(), then b
-- (allows to expand list fields other than the last one)
-- * list comprehensions a la python, with "for" and "if" suffixes:
-- {i+10*j for i=1,3 for j=1,3 if i~=j} is { 21, 31, 12, 32, 13, 23 }
--
-------------------------------------------------------------------------------
-{ extension ("match", ...) }
local SUPPORT_IMPROVED_LOOPS = true
local SUPPORT_IMPROVED_INDEXES = false -- depends on deprecated table.isub
local SUPPORT_CONTINUE = true
local SUPPORT_COMP_LISTS = true
assert (SUPPORT_IMPROVED_LOOPS or not SUPPORT_CONTINUE,
"Can't support 'continue' without improved loop headers")
local gg = require 'metalua.grammar.generator'
local Q = require 'metalua.treequery'
local function dots_list_suffix_builder (x) return `DotsSuffix{ x } end
local function for_list_suffix_builder (list_element, suffix)
local new_header = suffix[1]
match list_element with
| `Comp{ _, acc } -> table.insert (acc, new_header); return list_element
| _ -> return `Comp{ list_element, { new_header } }
end
end
local function if_list_suffix_builder (list_element, suffix)
local new_header = `If{ suffix[1] }
match list_element with
| `Comp{ _, acc } -> table.insert (acc, new_header); return list_element
| _ -> return `Comp{ list_element, { new_header } }
end
end
-- Builds a statement from a table element, which adds this element to
-- a table `t`, potentially thanks to an alias `tinsert` to
-- `table.insert`.
-- @param core the part around which the loops are built.
-- either `DotsSuffix{expr}, `Pair{ expr } or a plain expression
-- @param list comprehension suffixes, in the order in which they appear
-- either `Forin{ ... } or `Fornum{ ...} or `If{ ... }. In each case,
-- it misses a last child node as its body.
-- @param t a variable containing the table to fill
-- @param tinsert a variable containing `table.insert`.
--
-- @return fill a statement which fills empty table `t` with the denoted element
local function comp_list_builder(core, list, t, tinsert)
local filler
-- 1 - Build the loop's core: if it has suffix "...", every elements of the
-- multi-return must be inserted, hence the extra [for] loop.
match core with
| `DotsSuffix{ element } ->
local x = gg.gensym()
filler = +{stat: for _, -{x} in pairs{ -{element} } do (-{tinsert})(-{t}, -{x}) end }
| `Pair{ key, value } ->
--filler = +{ -{t}[-{key}] = -{value} }
filler = `Set{ { `Index{ t, key } }, { value } }
| _ -> filler = +{ (-{tinsert})(-{t}, -{core}) }
end
-- 2 - Stack the `if` and `for` control structures, from outside to inside.
-- This is done in a destructive way for the elements of [list].
for i = #list, 1, -1 do
table.insert (list[i], {filler})
filler = list[i]
end
return filler
end
local function table_content_builder (list)
local special = false -- Does the table need a special builder?
for _, element in ipairs(list) do
local etag = element.tag
if etag=='Comp' or etag=='DotsSuffix' then special=true; break end
end
if not special then list.tag='Table'; return list end
local t, tinsert = gg.gensym 'table', gg.gensym 'table_insert'
local filler_block = { +{stat: local -{t}, -{tinsert} = { }, table.insert } }
for _, element in ipairs(list) do
local filler
match element with
| `Comp{ core, comp } -> filler = comp_list_builder(core, comp, t, tinsert)
| _ -> filler = comp_list_builder(element, { }, t, tinsert)
end
table.insert(filler_block, filler)
end
return `Stat{ filler_block, t }
end
--------------------------------------------------------------------------------
-- Back-end for improved index operator.
local function index_builder(a, suffix)
match suffix[1] with
-- Single index, no range: keep the native semantics
| { { e, false } } -> return `Index{ a, e }
-- Either a range, or multiple indexes, or both
| ranges ->
local r = `Call{ +{table.isub}, a }
local function acc (x,y) table.insert (r,x); table.insert (r,y) end
for _, seq in ipairs (ranges) do
match seq with
| { e, false } -> acc(e,e)
| { e, f } -> acc(e,f)
end
end
return r
end
end
-------------------------------------------------------------------
-- Find continue statements in a loop body, change them into goto
-- end-of-body.
local function transform_continue_statements(body)
local continue_statements = Q(body)
:if_unknown() -- tolerate unknown 'Continue' statements
:not_under ('Forin', 'Fornum', 'While', 'Repeat')
:filter ('Continue')
:list()
if next(continue_statements) then
local continue_label = gg.gensym 'continue' [1]
table.insert(body, `Label{ continue_label })
for _, statement in ipairs(continue_statements) do
statement.tag = 'Goto'
statement[1] = continue_label
end
return true
else return false end
end
-------------------------------------------------------------------------------
-- Back-end for loops with a multi-element header
local function loop_builder(x)
local first, elements, body = unpack(x)
-- Change continue statements into gotos.
if SUPPORT_CONTINUE then transform_continue_statements(body) end
-------------------------------------------------------------------
-- If it's a regular loop, don't bloat the code
if not next(elements) then
table.insert(first, body)
return first
end
-------------------------------------------------------------------
-- There's no reason to treat the first element in a special way
table.insert(elements, 1, first)
-------------------------------------------------------------------
-- Change breaks into gotos that escape all loops at once.
local exit_label = nil
local function break_to_goto(break_node)
if not exit_label then exit_label = gg.gensym 'break' [1] end
break_node = break_node or { }
break_node.tag = 'Goto'
break_node[1] = exit_label
return break_node
end
Q(body)
:not_under('Function', 'Forin', 'Fornum', 'While', 'Repeat')
:filter('Break')
:foreach (break_to_goto)
-------------------------------------------------------------------
-- Compile all headers elements, from last to first.
-- invariant: `body` is a block (not a statement)
local result = body
for i = #elements, 1, -1 do
local e = elements[i]
match e with
| `If{ cond } ->
result = { `If{ cond, result } }
| `Until{ cond } ->
result = +{block: if -{cond} then -{break_to_goto()} else -{result} end }
| `While{ cond } ->
if i==1 then result = { `While{ cond, result } } -- top-level while
else result = +{block: if -{cond} then -{result} else -{break_to_goto()} end } end
| `Forin{ ... } | `Fornum{ ... } ->
table.insert (e, result); result={e}
| _-> require'metalua.pprint'.printf("Bad loop header element %s", e)
end
end
-------------------------------------------------------------------
-- If some breaks had to be changed into gotos, insert the label
if exit_label then result = { result, `Label{ exit_label } } end
return result
end
--------------------------------------------------------------------------------
-- Improved "[...]" index operator:
-- * support for multi-indexes ("foo[bar, gnat]")
-- * support for ranges ("foo[bar ... gnat]")
--------------------------------------------------------------------------------
local function extend(M)
local _M = gg.future(M)
if SUPPORT_COMP_LISTS then
-- support for "for" / "if" comprehension suffixes in literal tables
local original_table_element = M.table.element
M.table.element = gg.expr{ name="table cell",
primary = original_table_element,
suffix = { name="table cell suffix",
{ "...", builder = dots_list_suffix_builder },
{ "for", _M.for_header, builder = for_list_suffix_builder },
{ "if", _M.expr, builder = if_list_suffix_builder } } }
M.table.content.builder = table_content_builder
end
if SUPPORT_IMPROVED_INDEXES then
-- Support for ranges and multiple indices in bracket suffixes
M.expr.suffix:del '['
M.expr.suffix:add{ name="table index/range",
"[", gg.list{
gg.sequence { _M.expr, gg.onkeyword{ "...", _M.expr } } ,
separators = { ",", ";" } },
"]", builder = index_builder }
end
if SUPPORT_IMPROVED_LOOPS then
local original_for_header = M.for_header
M.stat :del 'for'
M.stat :del 'while'
M.loop_suffix = gg.multisequence{
{ 'while', _M.expr, builder = |x| `Until{ `Op{ 'not', x[1] } } },
{ 'until', _M.expr, builder = |x| `Until{ x[1] } },
{ 'if', _M.expr, builder = |x| `If{ x[1] } },
{ 'for', original_for_header, builder = |x| x[1] } }
M.loop_suffix_list = gg.list{ _M.loop_suffix, terminators='do' }
M.stat :add{
'for', original_for_header, _M.loop_suffix_list, 'do', _M.block, 'end',
builder = loop_builder }
M.stat :add{
'while', _M.expr, _M.loop_suffix_list, 'do', _M.block, 'end',
builder = |x| loop_builder{ `While{x[1]}, x[2], x[3] } }
end
if SUPPORT_CONTINUE then
M.lexer :add 'continue'
M.stat :add{ 'continue', builder='Continue' }
end
end
return extend

51
src/metalua/extension/l65.mlua
View File

@ -1,51 +0,0 @@
-- -{ extension("comprehension", ...) }
-{ extension("match", ...) }
local bit = require 'bit'
local gg = require 'metalua.grammar.generator'
--local M = {}
--M.program = {}
local function extend(M)
local _M = gg.future(M)
local function op_assign(kw, op)
local function f(a, b)
if #a ~= #b then gg.parse_error "assymetric operator+assignment" end
--local right = { }
local right = +{ bit[op](-{a}, -{b}) }
print(right)
--for i=1,#a do right[i] = +{ bit[op](-{a[i]},-{b[i]}) } end
--for i=1,#a do right[i] = `Call{`Index{bit, `Id{op}}, a[i], b[i]} end
--for i=1, #a do right[i] = { tag="Op", op, a[i], b[i] } end
return { tag="Set", a, right }
end
M.lexer:add(kw)
M.assignments[kw] = f
end
local ops = {
lshift='<<=',
rshift='>>='
}
for ast_op_name, keyword in pairs(ops) do op_assign(keyword, ast_op_name) end
M.lexer:add{ '//', '<<<', '>>>', '<<', '>>' }
M.expr.infix:add{ '//', prec=70, builder = |a,_,b| +{ bit.idiv(-{a}, -{b}) }}
M.expr.infix:add{ '<<', prec=34, builder = |a,_,b| +{ bit.lshift(-{a}, -{b}) }}
M.expr.infix:add{ '>>', prec=34, builder = |a,_,b| +{ bit.rshift(-{a}, -{b}) }}
M.expr.infix:add{ '<<<', prec=34, builder = |a,_,b| +{ bit.rol(-{a}, -{b}) }}
M.expr.infix:add{ '>>>', prec=34, builder = |a,_,b| +{ bit.ror(-{a}, -{b}) }}
M.expr.infix:add{ '&', prec=33, builder = |a,_,b| +{ bit.band(-{a}, -{b}) }}
M.expr.infix:add{ '~', prec=32, builder = |a,_,b| +{ bit.bxor(-{a}, -{b}) }}
M.expr.infix:add{ '|', prec=31, builder = |a,_,b| +{ bit.bor(-{a}, -{b}) }}
M.expr.prefix:add{ '~', prec=80, builder = |_,b| +{ bit.bnot(-{b}) }}
M.lexer:add{ 'c', '\\' }
M.stat:add{ "\\", builder = |x| +{ print("nop") } }
M.stat:add{ "\\", M.expr, builder = |x| +{ print("nop*" .. -{x[1]}) } }
M.stat:add{ "c", '+', builder = |x| +{ print("sec") } }
end
return extend

400
src/metalua/extension/match.mlua
View File

@ -1,400 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Glossary:
--
-- * term_seq: the tested stuff, a sequence of terms
-- * pattern_element: might match one term of a term seq. Represented
-- as expression ASTs.
-- * pattern_seq: might match a term_seq
-- * pattern_group: several pattern seqs, one of them might match
-- the term seq.
-- * case: pattern_group * guard option * block
-- * match_statement: tested term_seq * case list
--
-- Hence a complete match statement is a:
--
-- { list(expr), list{ list(list(expr)), expr or false, block } }
--
-- Implementation hints
-- ====================
--
-- The implementation is made as modular as possible, so that parts
-- can be reused in other extensions. The priviledged way to share
-- contextual information across functions is through the 'cfg' table
-- argument. Its fields include:
--
-- * code: code generated from pattern. A pattern_(element|seq|group)
-- is compiled as a sequence of instructions which will jump to
-- label [cfg.on_failure] if the tested term doesn't match.
--
-- * on_failure: name of the label where the code will jump if the
-- pattern doesn't match
--
-- * locals: names of local variables used by the pattern. This
-- includes bound variables, and temporary variables used to
-- destructure tables. Names are stored as keys of the table,
-- values are meaningless.
--
-- * after_success: label where the code must jump after a pattern
-- succeeded to capture a term, and the guard suceeded if there is
-- any, and the conditional block has run.
--
-- * ntmp: number of temporary variables used to destructurate table
-- in the current case.
--
-- Code generation is performed by acc_xxx() functions, which accumulate
-- code in cfg.code:
--
-- * acc_test(test, cfg) will generate a jump to cfg.on_failure
-- *when the test returns TRUE*
--
-- * acc_stat accumulates a statement
--
-- * acc_assign accumulate an assignment statement, and makes sure that
-- the LHS variable the registered as local in cfg.locals.
--
-------------------------------------------------------------------------------
-- TODO: hygiene wrt type()
-- TODO: cfg.ntmp isn't reset as often as it could. I'm not even sure
-- the corresponding locals are declared.
local gg = require 'metalua.grammar.generator'
local pp = require 'metalua.pprint'
----------------------------------------------------------------------
-- This would have been best done through library 'metalua.walk',
-- but walk depends on match, so we have to break the dependency.
-- It replaces all instances of `...' in `ast' with `term', unless
-- it appears in a function.
----------------------------------------------------------------------
local function replace_dots (ast, term)
local function rec (node)
for i, child in ipairs(node) do
if type(child)~="table" then -- pass
elseif child.tag=='Dots' then
if term=='ambiguous' then
error ("You can't use `...' on the right of a match case when it appears "..
"more than once on the left")
else node[i] = term end
elseif child.tag=='Function' then return nil
else rec(child) end
end
end
return rec(ast)
end
local tmpvar_base = gg.gensym 'submatch.' [1]
local function next_tmpvar(cfg)
assert (cfg.ntmp, "No cfg.ntmp imbrication level in the match compiler")
cfg.ntmp = cfg.ntmp+1
return `Id{ tmpvar_base .. cfg.ntmp }
end
-- Code accumulators
local acc_stat = |x,cfg| table.insert (cfg.code, x)
local acc_test = |x,cfg| acc_stat(+{stat: if -{x} then -{`Goto{cfg.on_failure}} end}, cfg)
-- lhs :: `Id{ string }
-- rhs :: expr
local function acc_assign (lhs, rhs, cfg)
assert(lhs.tag=='Id')
cfg.locals[lhs[1]] = true
acc_stat (`Set{ {lhs}, {rhs} }, cfg)
end
local literal_tags = { String=1, Number=1, True=1, False=1, Nil=1 }
-- pattern :: `Id{ string }
-- term :: expr
local function id_pattern_element_builder (pattern, term, cfg)
assert (pattern.tag == "Id")
if pattern[1] == "_" then
-- "_" is used as a dummy var ==> no assignment, no == checking
cfg.locals._ = true
elseif cfg.locals[pattern[1]] then
-- This var is already bound ==> test for equality
acc_test (+{ -{term} ~= -{pattern} }, cfg)
else
-- Free var ==> bind it, and remember it for latter linearity checking
acc_assign (pattern, term, cfg)
cfg.locals[pattern[1]] = true
end
end
-- mutually recursive with table_pattern_element_builder
local pattern_element_builder
-- pattern :: pattern and `Table{ }
-- term :: expr
local function table_pattern_element_builder (pattern, term, cfg)
local seen_dots, len = false, 0
acc_test (+{ type( -{term} ) ~= "table" }, cfg)
for i = 1, #pattern do
local key, sub_pattern
if pattern[i].tag=="Pair" then -- Explicit key/value pair
key, sub_pattern = unpack (pattern[i])
assert (literal_tags[key.tag], "Invalid key")
else -- Implicit key
len, key, sub_pattern = len+1, `Number{ len+1 }, pattern[i]
end
-- '...' can only appear in final position
-- Could be fixed actually...
assert (not seen_dots, "Wrongly placed `...' ")
if sub_pattern.tag == "Id" then
-- Optimization: save a useless [ v(n+1)=v(n).key ]
id_pattern_element_builder (sub_pattern, `Index{ term, key }, cfg)
if sub_pattern[1] ~= "_" then
acc_test (+{ -{sub_pattern} == nil }, cfg)
end
elseif sub_pattern.tag == "Dots" then
-- Remember where the capture is, and thatt arity checking shouldn't occur
seen_dots = true
else
-- Business as usual:
local v2 = next_tmpvar(cfg)
acc_assign (v2, `Index{ term, key }, cfg)
pattern_element_builder (sub_pattern, v2, cfg)
-- TODO: restore ntmp?
end
end
if seen_dots then -- remember how to retrieve `...'
-- FIXME: check, but there might be cases where the variable -{term}
-- will be overridden in contrieved tables.
-- ==> save it now, and clean the setting statement if unused
if cfg.dots_replacement then cfg.dots_replacement = 'ambiguous'
else cfg.dots_replacement = +{ select (-{`Number{len}}, unpack(-{term})) } end
else -- Check arity
acc_test (+{ #-{term} ~= -{`Number{len}} }, cfg)
end
end
-- mutually recursive with pattern_element_builder
local eq_pattern_element_builder, regexp_pattern_element_builder
-- Concatenate code in [cfg.code], that will jump to label
-- [cfg.on_failure] if [pattern] doesn't match [term]. [pattern]
-- should be an identifier, or at least cheap to compute and
-- side-effects free.
--
-- pattern :: pattern_element
-- term :: expr
function pattern_element_builder (pattern, term, cfg)
if literal_tags[pattern.tag] then
acc_test (+{ -{term} ~= -{pattern} }, cfg)
elseif "Id" == pattern.tag then
id_pattern_element_builder (pattern, term, cfg)
elseif "Op" == pattern.tag and "div" == pattern[1] then
regexp_pattern_element_builder (pattern, term, cfg)
elseif "Op" == pattern.tag and "eq" == pattern[1] then
eq_pattern_element_builder (pattern, term, cfg)
elseif "Table" == pattern.tag then
table_pattern_element_builder (pattern, term, cfg)
else
error ("Invalid pattern at "..
tostring(pattern.lineinfo)..
": "..pp.tostring(pattern, {hide_hash=true}))
end
end
function eq_pattern_element_builder (pattern, term, cfg)
local _, pat1, pat2 = unpack (pattern)
local ntmp_save = cfg.ntmp
pattern_element_builder (pat1, term, cfg)
cfg.ntmp = ntmp_save
pattern_element_builder (pat2, term, cfg)
end
-- pattern :: `Op{ 'div', string, list{`Id string} or `Id{ string }}
-- term :: expr
local function regexp_pattern_element_builder (pattern, term, cfg)
local op, regexp, sub_pattern = unpack(pattern)
-- Sanity checks --
assert (op=='div', "Don't know what to do with that op in a pattern")
assert (regexp.tag=="String",
"Left hand side operand for '/' in a pattern must be "..
"a literal string representing a regular expression")
if sub_pattern.tag=="Table" then
for _, x in ipairs(sub_pattern) do
assert (x.tag=="Id" or x.tag=='Dots',
"Right hand side operand for '/' in a pattern must be "..
"a list of identifiers")
end
else
assert (sub_pattern.tag=="Id",
"Right hand side operand for '/' in a pattern must be "..
"an identifier or a list of identifiers")
end
-- Regexp patterns can only match strings
acc_test (+{ type(-{term}) ~= 'string' }, cfg)
-- put all captures in a list
local capt_list = +{ { string.strmatch(-{term}, -{regexp}) } }
-- save them in a var_n for recursive decomposition
local v2 = next_tmpvar(cfg)
acc_stat (+{stat: local -{v2} = -{capt_list} }, cfg)
-- was capture successful?
acc_test (+{ not next (-{v2}) }, cfg)
pattern_element_builder (sub_pattern, v2, cfg)
end
-- Jumps to [cfg.on_faliure] if pattern_seq doesn't match
-- term_seq.
local function pattern_seq_builder (pattern_seq, term_seq, cfg)
if #pattern_seq ~= #term_seq then error ("Bad seq arity") end
cfg.locals = { } -- reset bound variables between alternatives
for i=1, #pattern_seq do
cfg.ntmp = 1 -- reset the tmp var generator
pattern_element_builder(pattern_seq[i], term_seq[i], cfg)
end
end
--------------------------------------------------
-- for each case i:
-- pattern_seq_builder_i:
-- * on failure, go to on_failure_i
-- * on success, go to on_success
-- label on_success:
-- block
-- goto after_success
-- label on_failure_i
--------------------------------------------------
local function case_builder (case, term_seq, cfg)
local patterns_group, guard, block = unpack(case)
local on_success = gg.gensym 'on_success' [1]
for i = 1, #patterns_group do
local pattern_seq = patterns_group[i]
cfg.on_failure = gg.gensym 'match_fail' [1]
cfg.dots_replacement = false
pattern_seq_builder (pattern_seq, term_seq, cfg)
if i<#patterns_group then
acc_stat (`Goto{on_success}, cfg)
acc_stat (`Label{cfg.on_failure}, cfg)
end
end
acc_stat (`Label{on_success}, cfg)
if guard then acc_test (+{not -{guard}}, cfg) end
if cfg.dots_replacement then
replace_dots (block, cfg.dots_replacement)
end
block.tag = 'Do'
acc_stat (block, cfg)
acc_stat (`Goto{cfg.after_success}, cfg)
acc_stat (`Label{cfg.on_failure}, cfg)
end
local function match_builder (x)
local term_seq, cases = unpack(x)
local cfg = {
code = `Do{ },
after_success = gg.gensym "_after_success" }
-- Some sharing issues occur when modifying term_seq,
-- so it's replaced by a copy new_term_seq.
-- TODO: clean that up, and re-suppress the useless copies
-- (cf. remarks about capture bug below).
local new_term_seq = { }
local match_locals
-- Make sure that all tested terms are variables or literals
for i=1, #term_seq do
local t = term_seq[i]
-- Capture problem: the following would compile wrongly:
-- `match x with x -> end'
-- Temporary workaround: suppress the condition, so that
-- all external variables are copied into unique names.
--if t.tag ~= 'Id' and not literal_tags[t.tag] then
local v = gg.gensym 'v'
if not match_locals then match_locals = `Local{ {v}, {t} } else
table.insert(match_locals[1], v)
table.insert(match_locals[2], t)
end
new_term_seq[i] = v
--end
end
term_seq = new_term_seq
if match_locals then acc_stat(match_locals, cfg) end
for i=1, #cases do
local case_cfg = {
after_success = cfg.after_success,
code = `Do{ }
-- locals = { } -- unnecessary, done by pattern_seq_builder
}
case_builder (cases[i], term_seq, case_cfg)
if next (case_cfg.locals) then
local case_locals = { }
table.insert (case_cfg.code, 1, `Local{ case_locals, { } })
for v, _ in pairs (case_cfg.locals) do
table.insert (case_locals, `Id{ v })
end
end
acc_stat(case_cfg.code, cfg)
end
local li = `String{tostring(cases.lineinfo)}
acc_stat(+{error('mismatch at '..-{li})}, cfg)
acc_stat(`Label{cfg.after_success}, cfg)
return cfg.code
end
----------------------------------------------------------------------
-- Syntactical front-end
----------------------------------------------------------------------
local function extend(M)
local _M = gg.future(M)
checks('metalua.compiler.parser')
M.lexer:add{ "match", "with", "->" }
M.block.terminators:add "|"
local match_cases_list_parser = gg.list{ name = "match cases list",
gg.sequence{ name = "match case",
gg.list{ name = "match case patterns list",
primary = _M.expr_list,
separators = "|",
terminators = { "->", "if" } },
gg.onkeyword{ "if", _M.expr, consume = true },
"->",
_M.block },
separators = "|",
terminators = "end" }
M.stat:add{ name = "match statement",
"match",
_M.expr_list,
"with", gg.optkeyword "|",
match_cases_list_parser,
"end",
builder = |x| match_builder{ x[1], x[3] } }
end
return extend

232
src/metalua/extension/xmatch.mlua
View File

@ -1,232 +0,0 @@
-------------------------------------------------------------------------------
-- Copyright (c) 2006-2013 Fabien Fleutot and others.
--
-- All rights reserved.
--
-- This program and the accompanying materials are made available
-- under the terms of the Eclipse Public License v1.0 which
-- accompanies this distribution, and is available at
-- http://www.eclipse.org/legal/epl-v10.html
--
-- This program and the accompanying materials are also made available
-- under the terms of the MIT public license which accompanies this
-- distribution, and is available at http://www.lua.org/license.html
--
-- Contributors:
-- Fabien Fleutot - API and implementation
--
-------------------------------------------------------------------------------
require 'metalua.extension.match'
module ('spmatch', package.seeall)
require 'metalua.walk.id'
----------------------------------------------------------------------
-- Back-end for statements
-- "match function ..." and "local match function...".
-- Tag must be either "Localrec" or "Set".
----------------------------------------------------------------------
named_match_function_builder = |tag| function (x)
local func_name, _, cases = unpack(x)
local arity = #cases[1][1][1]
if arity==0 then
error "There must be at least 1 case in match function"
end
local args = { }
for i=1, arity do args[i] = mlp.gensym("arg."..i) end
local body = match_builder{args, cases}
return { tag=tag, {func_name}, { `Function{ args, {body} } } }
end
-- Get rid of the former parser, it will be blended in a multiseq:
mlp.stat:del 'match'
----------------------------------------------------------------------
-- "match function", "match ... with"
----------------------------------------------------------------------
mlp.stat:add{ 'match',
gg.multisequence{
----------------------------------------------------------------
-- Shortcut for declaration of functions containing only a match:
-- "function f($1) match $1 with $2 end end" can be written:
-- "match function f $2 end"
----------------------------------------------------------------
{ 'function', mlp.expr, gg.optkeyword '|',
match_cases_list_parser, 'end',
builder = named_match_function_builder 'Set' },
----------------------------------------------------------------
-- Reintroduce the original match statement:
----------------------------------------------------------------
default = gg.sequence{
mlp.expr_list, 'with', gg.optkeyword '|',
match_cases_list_parser, 'end',
builder = |x| match_builder{ x[1], x[3] } } } }
----------------------------------------------------------------------
-- Shortcut: "local match function f $cases end" translates to:
-- "local function f($args) match $args with $cases end end"
----------------------------------------------------------------------
mlp.stat:get'local'[2]:add{
'match', 'function', mlp.expr, gg.optkeyword '|',
match_cases_list_parser, 'end',
builder = named_match_function_builder 'Localrec' }
----------------------------------------------------------------------
-- "match...with" expressions and "match function..."
----------------------------------------------------------------------
mlp.expr:add{ 'match', builder = |x| x[1], gg.multisequence{
----------------------------------------------------------------
-- Anonymous match functions:
-- "function ($1) match $1 with $2 end end" can be written:
-- "match function $2 end"
----------------------------------------------------------------
{ 'function', gg.optkeyword '|',
match_cases_list_parser,
'end',
builder = function(x)
local _, cases = unpack(x)
local v = mlp.gensym()
local body = match_builder{v, cases}
return `Function{ {v}, {body} }
end },
----------------------------------------------------------------
-- match expressions: you can put a match where an expression
-- is expected. The case bodies are then expected to be
-- expressions, not blocks.
----------------------------------------------------------------
default = gg.sequence{
mlp.expr_list, 'with', gg.optkeyword '|',
gg.list{ name = "match cases list",
gg.sequence{ name = "match expr case",
gg.list{ name = "match expr case patterns list",
primary = mlp.expr_list,
separators = "|",
terminators = { "->", "if" } },
gg.onkeyword{ "if", mlp.expr, consume = true },
"->",
mlp.expr }, -- Notice: expression, not block!
separators = "|" },
-- Notice: no "end" keyword!
builder = function (x)
local tested_term_seq, _, cases = unpack(x)
local v = mlp.gensym 'match_expr'
-- Replace expressions with blocks
for _, case in ipairs (cases) do
local body = case[3]
case[3] = { `Set{ {v}, {body} } }
end
local m = match_builder { tested_term_seq, cases }
return `Stat{ { `Local{{v}}; m }, v }
end } } }
function bind (x)
local patterns, values = unpack(x)
-------------------------------------------------------------------
-- Generate pattern code: "bind vars = vals" translates to:
-- do
-- pattern matching code, goto 'fail' on mismatch
-- goto 'success'
-- label 'fail': error "..."
-- label success
-- end
-- vars is the set of variables used by the pattern
-------------------------------------------------------------------
local code, vars do
local match_cfg = {
on_failure = mlp.gensym 'mismatch' [1],
locals = { },
code = { } }
pattern_seq_builder(patterns, values, match_cfg)
local on_success = mlp.gensym 'on_success' [1]
code = {
match_cfg.code;
`Goto{ on_success };
`Label{ match_cfg.on_failure };
+{error "bind error"};
`Label{ on_success } }
vars = match_cfg.locals
end
-------------------------------------------------------------------
-- variables that actually appear in the pattern:
-------------------------------------------------------------------
local vars_in_pattern do
vars_in_pattern = { }
local walk_cfg = { id = { } }
function walk_cfg.id.free(v) vars_in_pattern[v[1]]=true end
walk_id.expr_list(walk_cfg, patterns)
end
-------------------------------------------------------------------
-- temp variables that are generated for destructuring,
-- but aren't explicitly typed by the user. These must be made
-- local.
-------------------------------------------------------------------
local vars_not_in_pattern do
vars_not_in_pattern = { }
for k, _ in pairs(vars) do
if not vars_in_pattern[k] then
vars_not_in_pattern[k] = true
end
end
end
-------------------------------------------------------------------
-- Declare the temp variables as local to the statement.
-------------------------------------------------------------------
if next(vars_not_in_pattern) then
local loc = { }
for k, _ in pairs(vars_not_in_pattern) do
table.insert (loc, `Id{k})
end
table.insert (code, 1, `Local{ loc, { } })
end
-------------------------------------------------------------------
-- Transform the set of pattern variable names into a list of `Id{}
-------------------------------------------------------------------
local decl_list do
decl_list = { }
for k, _ in pairs(vars_in_pattern) do
table.insert (decl_list, `Id{k})
end
end
return code, decl_list
end
function local_bind(x)
local code, vars = bind (x)
return { `Local{ vars, { } }; code }
end
function non_local_bind(x)
local code, _ = bind (x)
code.tag = 'Do'
return code
end
----------------------------------------------------------------------
-- Syntax front-end
----------------------------------------------------------------------
mlp.lexer:add 'bind'
----------------------------------------------------------------------
-- bind patterns = vars
----------------------------------------------------------------------
mlp.stat:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
builder = non_local_bind }
----------------------------------------------------------------------
-- local bind patterns = vars
-- Some monkey-patching of "local ..." must take place
----------------------------------------------------------------------
mlp.stat:get'local'[2]:add{ 'bind', mlp.expr_list, '=', mlp.expr_list,
builder = local_bind }

Some files were not shown because too many files have changed in this diff Show More