packages feed

hslua (empty) → 0.1

raw patch · 63 files changed

+18221/−0 lines, 63 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

@@ -0,0 +1,35 @@+Lua License+-----------++Lua is licensed under the terms of the MIT license reproduced below.+This means that Lua is free software and can be used for both academic+and commercial purposes at absolutely no cost.++For details and rationale, see http://www.lua.org/license.html .++===============================================================================++Copyright (C) 1994-2007 Lua.org, PUC-Rio.+Copyright (C) 2007 Gracjan Polak++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.++===============================================================================++(end of COPYRIGHT)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ hslua.cabal view
@@ -0,0 +1,31 @@+Name: hslua+Version: 0.1+Stability: alpha+Exposed-modules: Scripting.Lua+License: BSD3+License-File: COPYRIGHT+Copyright: 2007-2007, Gracjan Polak+Author: Gracjan Polak <gracjanpolak@gmail.com>+Maintainer: Gracjan Polak <gracjanpolak@gmail.com>+Homepage: http://home.agh.edu.pl/~gpolak/hslua+Synopsis: A Lua language interpreter embedding in Haskell+Description:+        The Scripting.Lua module is a wrapper of Lua language interpreter+        as described in http://www.lua.org/.+        .+        The package is standalone: full Lua interpreter is distributed in this+        package as well.+Category: Scripting+Build-depends: base+Hs-source-dirs: src+C-sources: src/lapi.c, src/lauxlib.c, src/lbaselib.c, src/lcode.c, src/ldblib.c,+           src/ldebug.c, src/ldo.c, src/ldump.c, src/lfunc.c, src/lgc.c,+           src/linit.c, src/liolib.c, src/llex.c, src/lmathlib.c, src/lmem.c,+           src/loadlib.c, src/lobject.c, src/lopcodes.c, src/loslib.c,+           src/lparser.c, src/lstate.c, src/lstring.c, src/lstrlib.c,+           src/ltable.c, src/ltablib.c, src/ltm.c, src/lundump.c, src/lvm.c,+           src/lzio.c,+           src/ntrljmp.c+Ghc-options: -O2+CC-options: -O2+Include-dirs: src
+ src/HsLuaMain.hs view
@@ -0,0 +1,46 @@+
+{-# OPTIONS_GHC -fffi -fglasgow-exts #-}
+module Main where
+import qualified Scripting.Lua as Lua
+import Foreign.C.Types
+import Foreign.Ptr
+
+foreign export ccall hs_lua_c_func :: Lua.LuaState -> IO CInt
+foreign import ccall "&hs_lua_c_func" hs_lua_c_func_addr :: FunPtr Lua.LuaCFunction
+
+hs_lua_c_func l = do
+    putStrLn "from haskell"
+    return 0
+
+
+main = do
+    l <- Lua.newstate
+    Lua.openlibs l
+    Lua.getglobal l "print"
+    Lua.pushstring l "from print"
+    putStrLn "NEXT: from print"
+    Lua.call l 1 0
+    Lua.register l "kill" hs_lua_c_func_addr
+    Lua.getglobal l "kill"
+    putStrLn "NEXT: from haskell"
+    Lua.call l 0 0
+    c <- Lua.load l "print \"preparation\"; function f () print \"in lua def fun\"; end" "inline code"
+    putStrLn "NEXT: result 0"
+    putStrLn ("result " ++ show c)
+    putStrLn "NEXT: preparation"
+    Lua.call l 0 Lua.multret
+    Lua.getglobal l "f"
+    putStrLn "NEXT: in lua def fun"
+    Lua.call l 0 0
+    Lua.getglobal l "print"
+    Lua.push l (42::Int)
+    putStrLn "NEXT: 42"
+    Lua.call l 1 0
+    Lua.push l (42::Int)
+    putStrLn "NEXT: number 42"
+    Just (x::Int) <- Lua.peek l (-1)
+    putStrLn ("number " ++ show x)
+    putStrLn "NEXT: string 42"
+    Just (x::String) <- Lua.peek l (-1)
+    putStrLn ("string " ++ x)
+    Lua.close l
+ src/Scripting/Lua.hs view
@@ -0,0 +1,1053 @@+
+{-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances #-}
+-- |
+-- Module      : Scripting.Lua
+-- Copyright   : (c) Gracjan Polak 2007
+--
+-- License     : BSD3-style
+--
+-- Maintainer  : gracjanpolak@gmail.com
+-- Stability   : alpha
+-- Portability : portable, ffi
+--
+-- A Haskell wrapper library for a scripting language Lua.
+-- See @http:\/\/www.lua.org\/@ for more details.
+--
+-- This module is intended to be imported @qualified@, eg.
+--
+-- > import qualified Scripting.Lua as Lua
+--
+-- This way we use Haskell module hierarchy to make Lua names shorter.
+-- Haskell functions are named after Lua functions, but the @lua_@ or
+-- @luaL_@ prefix.
+--
+-- Lua types are mapped to Haskell types as in the following table:
+--
+-- > int (stack index)        Int
+-- > lua_Integer              LuaInteger
+-- > lua_Number               LuaNumber
+-- > int (bool result)        Bool
+-- > const char * (string)    String
+-- > void *                   Ptr ()
+-- > lua_State *              LuaState
+--
+-- Most functions are one-to-one mappings.
+-- Rare special cases are clearly marked in this document.
+--
+-- Minmal sample embedding:
+--
+-- > import qualified Scripting.Lua as Lua
+--
+-- > main = do
+-- >     l <- Lua.newstate
+-- >     Lua.openlibs l
+-- >     Lua.callproc l "print" "Hello from Lua"
+-- >     Lua.close l
+
+module Scripting.Lua
+(
+    -- * Basic Lua types
+    LuaState(..),
+    LuaCFunction,
+    LuaInteger,
+    LuaNumber,
+
+    -- * Constants and enumerations
+    GCCONTROL(..),
+    LTYPE(..),
+    multret,
+    registryindex,
+    environindex,
+    globalsindex,
+
+    -- * lua_* functions
+    atpanic,
+    call,
+    checkstack,
+    close,
+    concat,
+    cpcall,
+    createtable,
+    dump,
+    equal,
+    --error,    -- cannot import this one, as this uses setjmp/longjmp
+    gc,
+    --getallocf,
+    getfenv,
+    getfield,
+    getglobal,
+    --gethook,
+    --gethookcount,
+    --gethookmask,
+    --getinfo,
+    --getlocal,
+    getmetatable,
+    --getstack,
+    gettable,
+    gettop,
+    getupvalue,
+    insert,
+    isboolean,
+    iscfunction,
+    isfunction,
+    islightuserdata,
+    isnil,
+    isnumber,
+    isstring,
+    istable,
+    isthread,
+    isuserdata,
+    lessthan,
+    --load,
+    newstate,
+    newtable,
+    newthread,
+    newuserdata,
+    next,
+    objlen,
+    pcall,
+    pop,
+    pushboolean,
+    pushcclosure,
+    pushcfunction,
+    --pushfstring,
+    pushinteger,
+    pushlightuserdata,
+    --pushlstring,
+    pushnil,
+    pushnumber,
+    pushstring,
+    pushthread,
+    pushvalue,
+    --pushvfstring,
+    rawequal,
+    rawget,
+    rawgeti,
+    rawset,
+    rawseti,
+    register,
+    remove,
+    replace,
+    resume,
+    --setallocf,
+    setfenv,
+    setfield,
+    setglobal,
+    --sethook,
+    --setlocal,
+    setmetatable,
+    settable,
+    settop,
+    setupvalue,
+    status,
+    toboolean,
+    tocfunction,
+    tointeger,
+    --tolstring,
+    tonumber,
+    topointer,
+    tostring,
+    tothread,
+    touserdata,
+    ltype,
+    typename,
+    upvalueindex,
+    xmove,
+    yield,
+
+    -- * luaL_* functions
+    openlibs,
+    loadfile,
+    loadstring,
+    newmetatable,
+
+    -- * Haskell extensions
+    StackValue(..),
+    callproc,
+    callfunc,
+    getglobal2,
+    newcfunction,
+    freecfunction,
+    luaimport,
+    pushhsfunction
+)
+where
+import Prelude hiding (error,concat)
+import qualified Prelude
+import Foreign.C
+import Foreign.Ptr
+import Foreign.StablePtr
+import Control.Monad
+import Foreign.Marshal.Alloc
+import Data.IORef
+import qualified Foreign.Storable as F
+import qualified Data.List as L
+import Data.Maybe
+
+-- | Wrapper for @lua_State *@. See @lua_State@ in Lua Reference Manual.
+newtype LuaState = LuaState (Ptr ())
+-- | Wrapper for @lua_Alloc@. See @lua_Alloc@ in Lua Reference Manual.
+type LuaAlloc = Ptr () -> Ptr () -> CInt -> CInt -> IO (Ptr ())
+-- | Wrapper for @lua_Reader@. See @lua_Reader@ in Lua Reference Manual.
+type LuaReader = Ptr () -> Ptr () -> Ptr CInt -> IO (Ptr CChar)
+
+-- | Wrapper for @lua_Writer@. See @lua_Writer@ in Lua Reference Manual.
+type LuaWriter = LuaState -> Ptr CChar -> CInt -> Ptr () -> IO CInt
+-- | Wrapper for @lua_CFunction@. See @lua_CFunction@ in Lua Reference Manual.
+type LuaCFunction = LuaState -> IO CInt
+-- | Wrapper for @lua_Integer@. See @lua_Integer@ in Lua Reference Manual.
+-- HsLua uses C @ptrdiff_t@ as @lua_Integer@.
+type LuaInteger = CPtrdiff
+-- | Wrapper for @lua_Number@. See @lua_Number@ in Lua Reference Manual.
+-- HsLua uses C @double@ as @lua_Integer@.
+type LuaNumber = CDouble
+
+
+-- | Enumeration used as type tag. See @lua_type@ in Lua Reference Manual.
+data LTYPE = TNONE
+           | TNIL
+           | TBOOLEAN
+           | TLIGHTUSERDATA
+           | TNUMBER
+           | TSTRING
+           | TTABLE
+           | TFUNCTION
+           | TUSERDATA
+           | TTHREAD
+           deriving (Eq,Show,Ord)
+
+instance Enum LTYPE where
+    fromEnum TNONE           = -1
+    fromEnum TNIL            = 0
+    fromEnum TBOOLEAN        = 1
+    fromEnum TLIGHTUSERDATA  = 2
+    fromEnum TNUMBER         = 3
+    fromEnum TSTRING         = 4
+    fromEnum TTABLE          = 5
+    fromEnum TFUNCTION       = 6
+    fromEnum TUSERDATA       = 7
+    fromEnum TTHREAD         = 8
+    toEnum (-1) = TNONE
+    toEnum 0 = TNIL
+    toEnum 1 = TBOOLEAN
+    toEnum 2 = TLIGHTUSERDATA
+    toEnum 3 = TNUMBER
+    toEnum 4 = TSTRING
+    toEnum 5 = TTABLE
+    toEnum 6 = TFUNCTION
+    toEnum 7 = TUSERDATA
+    toEnum 8 = TTHREAD
+
+-- | Enumeration used by @gc@ function.
+data GCCONTROL  = GCSTOP
+                | GCRESTART
+                | GCCOLLECT
+                | GCCOUNT
+                | GCCOUNTB
+                | GCSTEP
+                | GCSETPAUSE
+                | GCSETSTEPMUL
+                deriving (Eq,Ord,Show,Enum)
+
+-- | See @LUA_MULTRET@ in Lua Reference Manual.
+multret :: Int
+multret = -1
+
+{-
+
+It is unknown which of the imported function may trigger garbage collector.
+GC may in turn call some finalizars that will require come back to
+the Haskell world.
+
+This means we must declare almost all functions as 'safe'. This is slow, so
+some functions known not to call gc are marked with faster 'unsafe' modifier.
+
+-}
+foreign import ccall "lua.h lua_close" c_lua_close :: LuaState -> IO ()
+foreign import ccall "lua.h lua_newstate" c_lua_newstate :: FunPtr LuaAlloc -> Ptr () -> IO LuaState
+foreign import ccall "lua.h lua_newthread" c_lua_newthread :: LuaState -> IO LuaState
+foreign import ccall "lua.h lua_atpanic" c_lua_atpanic :: LuaState -> FunPtr LuaCFunction -> IO (FunPtr LuaCFunction)
+
+
+foreign import ccall "lua.h lua_gettop" c_lua_gettop :: LuaState -> IO CInt
+foreign import ccall "lua.h lua_settop" c_lua_settop :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_pushvalue" c_lua_pushvalue :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_remove" c_lua_remove :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_insert" c_lua_insert :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_replace" c_lua_replace :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_checkstack" c_lua_checkstack :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_xmove" c_lua_xmove :: LuaState -> LuaState -> CInt -> IO ()
+
+
+foreign import ccall "lua.h lua_isnumber" c_lua_isnumber :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_isstring" c_lua_isstring :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_iscfunction" c_lua_iscfunction :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_isuserdata" c_lua_isuserdata :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_type" c_lua_type :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_typename" c_lua_typename :: LuaState -> CInt -> IO (Ptr CChar)
+
+foreign import ccall "lua.h lua_equal" c_lua_equal :: LuaState -> CInt -> CInt -> IO CInt
+foreign import ccall "lua.h lua_rawequal" c_lua_rawequal :: LuaState -> CInt -> CInt -> IO CInt
+foreign import ccall "lua.h lua_lessthan" c_lua_lessthan :: LuaState -> CInt -> CInt -> IO CInt
+
+foreign import ccall "lua.h lua_tonumber" c_lua_tonumber :: LuaState -> CInt -> IO LuaNumber
+foreign import ccall "lua.h lua_tointeger" c_lua_tointeger :: LuaState -> CInt -> IO LuaInteger
+foreign import ccall "lua.h lua_toboolean" c_lua_toboolean :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_tolstring" c_lua_tolstring :: LuaState -> CInt -> Ptr CInt -> IO (Ptr CChar)
+foreign import ccall "lua.h lua_objlen" c_lua_objlen :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_tocfunction" c_lua_tocfunction :: LuaState -> CInt -> IO (FunPtr LuaCFunction)
+foreign import ccall "lua.h lua_touserdata" c_lua_touserdata :: LuaState -> CInt -> IO (Ptr a)
+foreign import ccall "lua.h lua_tothread" c_lua_tothread :: LuaState -> CInt -> IO LuaState
+foreign import ccall "lua.h lua_topointer" c_lua_topointer :: LuaState -> CInt -> IO (Ptr ())
+
+
+foreign import ccall "lua.h lua_pushnil" c_lua_pushnil :: LuaState -> IO ()
+foreign import ccall "lua.h lua_pushnumber" c_lua_pushnumber :: LuaState -> LuaNumber -> IO ()
+foreign import ccall "lua.h lua_pushinteger" c_lua_pushinteger :: LuaState -> LuaInteger -> IO ()
+foreign import ccall "lua.h lua_pushlstring" c_lua_pushlstring :: LuaState -> Ptr CChar -> CInt -> IO ()
+foreign import ccall "lua.h lua_pushstring" c_lua_pushstring :: LuaState -> Ptr CChar -> IO ()
+{-
+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, ...);
+-}
+foreign import ccall "lua.h lua_pushcclosure" c_lua_pushcclosure :: LuaState -> FunPtr LuaCFunction -> CInt -> IO ()
+foreign import ccall "lua.h lua_pushboolean" c_lua_pushboolean :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_pushlightuserdata" c_lua_pushlightuserdata :: LuaState -> Ptr a -> IO ()
+foreign import ccall "lua.h lua_pushthread" c_lua_pushthread :: LuaState -> IO CInt
+
+
+foreign import ccall "lua.h lua_gettable" c_lua_gettable :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_getfield" c_lua_getfield :: LuaState -> CInt -> Ptr CChar -> IO ()
+foreign import ccall "lua.h lua_rawget" c_lua_rawget :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_rawgeti" c_lua_rawgeti :: LuaState -> CInt -> CInt -> IO ()
+foreign import ccall "lua.h lua_createtable" c_lua_createtable :: LuaState -> CInt -> CInt -> IO ()
+foreign import ccall "lua.h lua_newuserdata" c_lua_newuserdata :: LuaState -> CInt -> IO (Ptr ())
+foreign import ccall "lua.h lua_getmetatable" c_lua_getmetatable :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_getfenv" c_lua_getfenv :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_getupvalue" c_lua_getupvalue :: LuaState -> CInt -> CInt -> IO (Ptr CChar)
+foreign import ccall "lua.h lua_setupvalue" c_lua_setupvalue :: LuaState -> CInt -> CInt -> IO (Ptr CChar)
+
+
+foreign import ccall "lua.h lua_settable" c_lua_settable :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_setfield" c_lua_setfield :: LuaState -> CInt -> Ptr CChar -> IO ()
+foreign import ccall "lua.h lua_rawset" c_lua_rawset :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_rawseti" c_lua_rawseti :: LuaState -> CInt -> CInt -> IO ()
+foreign import ccall "lua.h lua_setmetatable" c_lua_setmetatable :: LuaState -> CInt -> IO ()
+foreign import ccall "lua.h lua_setfenv" c_lua_setfenv :: LuaState -> CInt -> IO CInt
+
+
+foreign import ccall "lua.h lua_call" c_lua_call :: LuaState -> CInt -> CInt -> IO ()
+foreign import ccall "lua.h lua_pcall" c_lua_pcall :: LuaState -> CInt -> CInt -> CInt -> IO CInt
+foreign import ccall "lua.h lua_cpcall" c_lua_cpcall :: LuaState -> FunPtr LuaCFunction -> Ptr a -> IO CInt
+
+foreign import ccall "lua.h lua_load" c_lua_load :: LuaState -> FunPtr LuaReader -> Ptr () -> Ptr CChar -> IO CInt
+
+foreign import ccall "lua.h lua_dump" c_lua_dump :: LuaState -> FunPtr LuaWriter -> Ptr () -> IO ()
+
+foreign import ccall "lua.h lua_yield" c_lua_yield :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_resume" c_lua_resume :: LuaState -> CInt -> IO CInt
+foreign import ccall "lua.h lua_status" c_lua_status :: LuaState -> IO CInt
+
+foreign import ccall "lua.h lua_gc" c_lua_gc :: LuaState -> CInt -> CInt -> IO CInt
+
+foreign import ccall "lua.h lua_error" c_lua_error :: LuaState -> IO CInt
+
+foreign import ccall "lua.h lua_next" c_lua_next :: LuaState -> CInt -> IO CInt
+
+foreign import ccall "lua.h lua_concat" c_lua_concat :: LuaState -> CInt -> IO ()
+
+foreign import ccall "lualib.h luaL_openlibs" c_luaL_openlibs :: LuaState -> IO ()
+foreign import ccall "lauxlib.h luaL_newstate" c_luaL_newstate :: IO LuaState
+foreign import ccall "lauxlib.h luaL_newmetatable" c_luaL_newmetatable :: LuaState -> Ptr CChar -> IO CInt
+
+foreign import ccall "ntrljmp.h lua_neutralize_longjmp" c_lua_neutralize_longjmp :: LuaState -> IO CInt
+foreign import ccall "ntrljmp.h &lua_neutralize_longjmp" c_lua_neutralize_longjmp_addr :: FunPtr (LuaState -> IO CInt) 
+
+
+-- | See @lua_settop@ in Lua Reference Manual.
+settop :: LuaState -> Int -> IO ()
+settop l n = c_lua_settop l (fromIntegral n)
+
+-- | See @lua_createtable@ in Lua Reference Manual.
+createtable :: LuaState -> Int -> Int -> IO ()
+createtable l s z = c_lua_createtable l (fromIntegral s) (fromIntegral z)
+
+-- | See @lua_objlen@ in Lua Reference Manual.
+objlen :: LuaState -> Int -> IO Int
+objlen l n = liftM fromIntegral (c_lua_objlen l (fromIntegral n))
+
+-- | See @lua_pop@ in Lua Reference Manual.
+pop :: LuaState -> Int -> IO ()
+pop l n = settop l (-n-1)
+
+
+-- | See @lua_newtable@ in Lua Reference Manual.
+newtable :: LuaState -> IO ()
+newtable l = createtable l 0 0
+
+-- | See @lua_pushcclosure@ in Lua Reference Manual.
+pushcclosure :: LuaState -> FunPtr LuaCFunction -> Int -> IO ()
+pushcclosure l f n = c_lua_pushcclosure l f (fromIntegral n)
+
+-- | See @lua_pushcfunction@ in Lua Reference Manual.
+pushcfunction :: LuaState -> FunPtr LuaCFunction -> IO ()
+pushcfunction l f = pushcclosure l f 0
+
+
+-- | See @lua_strlen@ in Lua Reference Manual.
+strlen :: LuaState -> Int -> IO Int
+strlen l i =  objlen l i
+
+-- | See @lua_type@ in Lua Reference Manual.
+ltype :: LuaState -> Int -> IO LTYPE
+ltype l n = liftM (toEnum . fromIntegral) (c_lua_type l (fromIntegral n))
+
+-- | See @lua_isfunction@ in Lua Reference Manual.
+isfunction :: LuaState -> Int -> IO Bool
+isfunction l n = liftM (==TFUNCTION) (ltype l n)
+
+-- | See @lua_istable@ in Lua Reference Manual.
+istable :: LuaState -> Int -> IO Bool
+istable l n = liftM (==TTABLE) (ltype l n)
+
+-- | See @lua_islightuserdata@ in Lua Reference Manual.
+islightuserdata :: LuaState -> Int -> IO Bool
+islightuserdata l n = liftM (==TLIGHTUSERDATA) (ltype l n)
+
+-- | See @lua_isnil@ in Lua Reference Manual.
+isnil :: LuaState -> Int -> IO Bool
+isnil l n = liftM (==TNIL) (ltype l n)
+
+-- | See @lua_isboolean@ in Lua Reference Manual.
+isboolean :: LuaState -> Int -> IO Bool
+isboolean l n = liftM (==TBOOLEAN) (ltype l n)
+
+-- | See @lua_isthread@ in Lua Reference Manual.
+isthread :: LuaState -> Int -> IO Bool
+isthread l n = liftM (==TTHREAD) (ltype l n)
+
+-- | See @lua_none@ in Lua Reference Manual.
+isnone :: LuaState -> Int -> IO Bool
+isnone l n = liftM (==TNONE) (ltype l n)
+
+-- | See @lua_noneornil@ in Lua Reference Manual.
+isnoneornil :: LuaState -> Int -> IO Bool
+isnoneornil l n = liftM (<=TNIL) (ltype l n)
+
+-- | See @LUA_REGISTRYINDEX@ in Lua Reference Manual.
+registryindex :: Int
+registryindex = (-10000)
+
+-- | See @LUA_ENVIRONINDEX@ in Lua Reference Manual.
+environindex :: Int
+environindex = (-10001)
+
+-- | See @LUA_GLOBALSINDEX@ in Lua Reference Manual.
+globalsindex :: Int
+globalsindex = (-10002)
+
+-- | See @lua_upvalueindex@ in Lua Reference Manual.
+upvalueindex :: Int -> Int
+upvalueindex i = (globalsindex-(i))
+
+{-
+The following seem to be really bad idea, as calls from C
+back to Haskell land are costly.
+
+Use standard Lua malloc based allocator.
+
+foreign export ccall "hslua_alloc" hslua_alloc :: Ptr () -> Ptr () -> CInt -> CInt -> IO (Ptr ())
+foreign import ccall "&hslua_alloc" hslua_alloc_addr :: FunPtr LuaAlloc
+
+hslua_alloc :: Ptr () -> Ptr () -> CInt -> CInt -> IO (Ptr ())
+hslua_alloc ud ptr osize nsize = reallocBytes ptr (fromIntegral nsize)
+
+static void *l_alloc (void *ud, void *ptr, size_t osize,
+                                                size_t nsize) {
+       (void)ud;  (void)osize;  /* not used */
+       if (nsize == 0) {
+         free(ptr);
+         return NULL;
+       }
+       else
+         return realloc(ptr, nsize);
+     }
+-}
+
+-- | See @lua_atpanic@ in Lua Reference Manual.
+atpanic :: LuaState -> FunPtr LuaCFunction -> IO (FunPtr LuaCFunction)
+atpanic = c_lua_atpanic
+
+-- | See @lua_tostring@ in Lua Reference Manual.
+tostring :: LuaState -> Int -> IO String
+tostring l n = c_lua_tolstring l (fromIntegral n) nullPtr >>= peekCString
+
+-- | See @lua_tothread@ in Lua Reference Manual.
+tothread :: LuaState -> Int -> IO LuaState
+tothread l n = c_lua_tothread l (fromIntegral n)
+
+-- | See @lua_touserdata@ in Lua Reference Manual.
+touserdata :: LuaState -> Int -> IO (Ptr a)
+touserdata l n = c_lua_touserdata l (fromIntegral n)
+
+-- | See @lua_typename@ in Lua Reference Manual.
+typename :: LuaState -> LTYPE -> IO String
+typename l n = c_lua_typename l (fromIntegral (fromEnum n)) >>= peekCString
+
+-- | See @lua_xmove@ in Lua Reference Manual.
+xmove :: LuaState -> LuaState -> Int -> IO ()
+xmove l1 l2 n = c_lua_xmove l1 l2 (fromIntegral n)
+
+-- | See @lua_yield@ in Lua Reference Manual.
+yield :: LuaState -> Int -> IO Int
+yield l n = liftM fromIntegral (c_lua_yield l (fromIntegral n))
+
+-- | See @lua_checkstack@ in Lua Reference Manual.
+checkstack :: LuaState -> Int -> IO Bool
+checkstack l n = liftM (/=0) (c_lua_checkstack l (fromIntegral n))
+
+-- | See @lua_newstate@ and @luaL_newstate@ in Lua Reference Manual.
+newstate :: IO LuaState
+newstate = c_luaL_newstate
+
+-- | See @lua_close@ in Lua Reference Manual.
+close :: LuaState -> IO ()
+close = c_lua_close
+
+-- | See @lua_concat@ in Lua Reference Manual.
+concat :: LuaState -> Int -> IO ()
+concat l n = c_lua_concat l (fromIntegral n)
+
+
+
+-- | See @lua_call@ and @lua_call@ in Lua Reference Manual. This is 
+-- a wrapper over @lua_pcall@, as @lua_call@ is unsafe in controlled environment
+-- like Haskell VM.
+call :: LuaState -> Int -> Int -> IO Int
+call l a b = liftM fromIntegral (c_lua_pcall l (fromIntegral a) (fromIntegral b) 0)
+
+-- | See @lua_pcall@ in Lua Reference Manual.
+pcall :: LuaState -> Int -> Int -> Int -> IO Int
+pcall l a b c = liftM fromIntegral (c_lua_pcall l (fromIntegral a) (fromIntegral b) (fromIntegral c))
+
+-- | See @lua_cpcall@ in Lua Reference Manual.
+cpcall :: LuaState -> FunPtr LuaCFunction -> Ptr a -> IO Int
+cpcall l a c = liftM fromIntegral (c_lua_cpcall l a c)
+
+-- | See @lua_getfield@ in Lua Reference Manual.
+getfield :: LuaState -> Int -> String -> IO ()
+getfield l i n = withCString n $ \n -> c_lua_getfield l (fromIntegral i) n
+
+-- | See @lua_setfield@ in Lua Reference Manual.
+setfield :: LuaState -> Int -> String -> IO ()
+setfield l i n = withCString n $ \n -> c_lua_setfield l (fromIntegral i) n
+
+-- | See @lua_getglobal@ in Lua Reference Manual.
+getglobal :: LuaState -> String -> IO ()
+getglobal l n = getfield l globalsindex n
+
+-- | See @lua_setglobal@ in Lua Reference Manual.
+setglobal :: LuaState -> String -> IO ()
+setglobal l n = setfield l globalsindex n
+
+-- | See @luaL_openlibs@ in Lua Reference Manual.
+openlibs :: LuaState -> IO ()
+openlibs = c_luaL_openlibs
+
+foreign import ccall "wrapper" mkStringWriter :: LuaWriter -> IO (FunPtr LuaWriter)
+
+dump :: LuaState -> IO String
+dump l = do
+    r <- newIORef ""
+    let wr :: LuaWriter
+        wr l p s d = do
+               k <- peekCStringLen (p,fromIntegral s)
+               modifyIORef r (++k)
+               return 0
+    writer <- mkStringWriter wr
+    c_lua_dump l writer nullPtr
+    freeHaskellFunPtr writer
+    readIORef r
+
+-- | See @lua_equal@ in Lua Reference Manual.
+equal :: LuaState -> Int -> Int -> IO Bool
+equal l i j = liftM (/=0) (c_lua_equal l (fromIntegral i) (fromIntegral j))
+
+-- | See @lua_error@ in Lua Reference Manual.
+--error :: LuaState -> IO Int
+--error l = liftM fromIntegral (c_lua_error l)
+
+-- | See @lua_gc@ in Lua Reference Manual.
+gc :: LuaState -> GCCONTROL -> Int -> IO Int
+gc l i j= liftM fromIntegral (c_lua_gc l (fromIntegral (fromEnum i)) (fromIntegral j))
+
+-- | See @lua_getfenv@ in Lua Reference Manual.
+getfenv :: LuaState -> Int -> IO ()
+getfenv l n = c_lua_getfenv l (fromIntegral n)
+
+-- | See @lua_getmetatable@ in Lua Reference Manual.
+getmetatable :: LuaState -> Int -> IO Bool
+getmetatable l n = liftM (/=0) (c_lua_getmetatable l (fromIntegral n))
+
+-- | See @lua_gettable@ in Lua Reference Manual.
+gettable :: LuaState -> Int -> IO ()
+gettable l n = c_lua_gettable l (fromIntegral n)
+
+-- | See @lua_gettop@ in Lua Reference Manual.
+gettop :: LuaState -> IO Int
+gettop l = liftM fromIntegral (c_lua_gettop l)
+
+-- | See @lua_getupvalue@ in Lua Reference Manual.
+getupvalue :: LuaState -> Int -> Int -> IO String
+getupvalue l funcindex n = c_lua_getupvalue l (fromIntegral funcindex) (fromIntegral n) >>= peekCString
+
+-- | See @lua_insert@ in Lua Reference Manual.
+insert :: LuaState -> Int -> IO ()
+insert l n  = c_lua_insert l (fromIntegral n)
+
+-- | See @lua_iscfunction@ in Lua Reference Manual.
+iscfunction :: LuaState -> Int -> IO Bool
+iscfunction l n = liftM (/=0) (c_lua_iscfunction l (fromIntegral n))
+
+-- | See @lua_isnumber@ in Lua Reference Manual.
+isnumber :: LuaState -> Int -> IO Bool
+isnumber l n = liftM (/=0) (c_lua_isnumber l (fromIntegral n))
+
+-- | See @lua_isstring@ in Lua Reference Manual.
+isstring :: LuaState -> Int -> IO Bool
+isstring l n = liftM (/=0) (c_lua_isstring l (fromIntegral n))
+
+-- | See @lua_isuserdata@ in Lua Reference Manual.
+isuserdata :: LuaState -> Int -> IO Bool
+isuserdata l n = liftM (/=0) (c_lua_isuserdata l (fromIntegral n))
+
+-- | See @lua_lessthan@ in Lua Reference Manual.
+lessthan :: LuaState -> Int -> Int -> IO Bool
+lessthan l i j = liftM (/=0) (c_lua_lessthan l (fromIntegral i) (fromIntegral j))
+
+
+-- | See @luaL_loadfile@ in Lua Reference Manual.
+loadfile :: LuaState -> String -> IO Int
+loadfile l f = readFile f >>= \c -> loadstring l c f
+
+
+foreign import ccall "wrapper" mkStringReader :: LuaReader -> IO (FunPtr LuaReader)
+
+-- | See @luaL_loadstring@ in Lua Reference Manual.
+loadstring :: LuaState -> String -> String -> IO Int
+loadstring l script cn = do
+    w <- newIORef nullPtr
+    let rd :: LuaReader
+        rd l d ps = do
+               k <- readIORef w
+               if k==nullPtr
+                   then do
+                       (k,l) <- newCStringLen script
+                       writeIORef w k
+                       F.poke ps (fromIntegral l)
+                       return k
+                   else do
+                       return nullPtr
+    writer <- mkStringReader rd
+    res <- withCString cn $ \cn -> c_lua_load l writer nullPtr cn
+    freeHaskellFunPtr writer
+    k <- readIORef w
+    free k
+    return (fromIntegral res)
+
+-- | See @lua_newthread@ in Lua Reference Manual.
+newthread :: LuaState -> IO LuaState
+newthread l = c_lua_newthread l
+
+-- | See @lua_newuserdata@ in Lua Reference Manual.
+newuserdata :: LuaState -> Int -> IO (Ptr ())
+newuserdata l s = c_lua_newuserdata l (fromIntegral s)
+
+-- | See @lua_next@ in Lua Reference Manual.
+next :: LuaState -> Int -> IO Bool
+next l i = liftM (/=0) (c_lua_next l (fromIntegral i))
+
+-- | See @lua_pushboolean@ in Lua Reference Manual.
+pushboolean :: LuaState -> Bool -> IO ()
+pushboolean l v = c_lua_pushboolean l (fromIntegral (fromEnum v))
+
+-- | See @lua_pushinteger@ in Lua Reference Manual.
+pushinteger :: LuaState -> LuaInteger -> IO ()
+pushinteger = c_lua_pushinteger
+
+-- | See @lua_pushlightuserdata@ in Lua Reference Manual.
+pushlightuserdata :: LuaState -> Ptr a -> IO ()
+pushlightuserdata = c_lua_pushlightuserdata
+
+-- | See @lua_pushnil@ in Lua Reference Manual.
+pushnil :: LuaState -> IO ()
+pushnil = c_lua_pushnil
+
+-- | See @lua_pushnumber@ in Lua Reference Manual.
+pushnumber :: LuaState -> LuaNumber -> IO ()
+pushnumber = c_lua_pushnumber
+
+-- | See @lua_pushstring@ in Lua Reference Manual.
+pushstring :: LuaState -> String -> IO ()
+pushstring l s = withCStringLen s $ \(s,z) -> c_lua_pushlstring l s (fromIntegral z)
+
+-- | See @lua_pushthread@ in Lua Reference Manual.
+pushthread :: LuaState -> IO Bool
+pushthread l = liftM (/=0) (c_lua_pushthread l)
+
+-- | See @lua_pushvalue@ in Lua Reference Manual.
+pushvalue :: LuaState -> Int -> IO ()
+pushvalue l n = c_lua_pushvalue l (fromIntegral n)
+
+-- | See @lua_rawequal@ in Lua Reference Manual.
+rawequal :: LuaState -> Int -> Int -> IO Bool
+rawequal l n m = liftM (/=0) (c_lua_rawequal l (fromIntegral n) (fromIntegral m))
+
+-- | See @lua_rawget@ in Lua Reference Manual.
+rawget :: LuaState -> Int -> IO ()
+rawget l n = c_lua_rawget l (fromIntegral n)
+
+-- | See @lua_rawgeti@ in Lua Reference Manual.
+rawgeti :: LuaState -> Int -> Int -> IO ()
+rawgeti l k m = c_lua_rawgeti l (fromIntegral k) (fromIntegral m)
+
+-- | See @lua_rawset@ in Lua Reference Manual.
+rawset :: LuaState -> Int -> IO ()
+rawset l n = c_lua_rawset l (fromIntegral n)
+
+-- | See @lua_rawseti@ in Lua Reference Manual.
+rawseti :: LuaState -> Int -> Int -> IO ()
+rawseti l k m = c_lua_rawseti l (fromIntegral k) (fromIntegral m)
+
+-- | See @lua_remove@ in Lua Reference Manual.
+remove :: LuaState -> Int -> IO ()
+remove l n = c_lua_remove l (fromIntegral n)
+
+-- | See @lua_replace@ in Lua Reference Manual.
+replace :: LuaState -> Int -> IO ()
+replace l n = c_lua_replace l (fromIntegral n)
+
+-- | See @lua_resume@ in Lua Reference Manual.
+resume :: LuaState -> Int -> IO Int
+resume l n = liftM fromIntegral (c_lua_resume l (fromIntegral n))
+
+-- | See @lua_setfenv@ in Lua Reference Manual.
+setfenv :: LuaState -> Int -> IO Int
+setfenv l n = liftM fromIntegral (c_lua_setfenv l (fromIntegral n))
+
+-- | See @lua_setmetatable@ in Lua Reference Manual.
+setmetatable :: LuaState -> Int -> IO ()
+setmetatable l n = c_lua_setmetatable l (fromIntegral n)
+
+-- | See @lua_settable@ in Lua Reference Manual.
+settable :: LuaState -> Int -> IO ()
+settable l index = c_lua_settable l (fromIntegral index)
+
+
+-- | See @lua_setupvalue@ in Lua Reference Manual.
+setupvalue :: LuaState -> Int -> Int -> IO String
+setupvalue l funcindex n = c_lua_setupvalue l (fromIntegral funcindex) (fromIntegral n) >>= peekCString
+
+-- | See @lua_status@ in Lua Reference Manual.
+status :: LuaState -> IO Int
+status l = liftM fromIntegral (c_lua_status l)
+
+-- | See @lua_toboolean@ in Lua Reference Manual.
+toboolean :: LuaState -> Int -> IO Bool
+toboolean l n = liftM (/=0) (c_lua_toboolean l (fromIntegral n))
+
+-- | See @lua_tocfunction@ in Lua Reference Manual.
+tocfunction :: LuaState -> Int -> IO (FunPtr LuaCFunction)
+tocfunction l n = c_lua_tocfunction l (fromIntegral n)
+
+-- | See @lua_tointeger@ in Lua Reference Manual.
+tointeger :: LuaState -> Int -> IO LuaInteger
+tointeger l n = c_lua_tointeger l (fromIntegral n)
+
+-- | See @lua_tonumber@ in Lua Reference Manual.
+tonumber :: LuaState -> Int -> IO CDouble
+tonumber l n = c_lua_tonumber l (fromIntegral n)
+
+-- | See @lua_topointer@ in Lua Reference Manual.
+topointer :: LuaState -> Int -> IO (Ptr ())
+topointer l n = c_lua_topointer l (fromIntegral n)
+
+-- | See @lua_register@ in Lua Reference Manual.
+register :: LuaState -> String -> FunPtr LuaCFunction -> IO ()
+register l n f = do
+    pushcclosure l f 0
+    setglobal l n
+
+newmetatable :: LuaState -> String -> IO Int
+newmetatable l s = withCString s $ \s -> liftM fromIntegral (c_luaL_newmetatable l s)
+
+
+-- | A value that can be pushed and poped from the Lua stack.
+-- All instances are natural, except following:
+--
+--  * @LuaState@ push ignores its argument, pushes current state
+--
+--  * @()@ push ignores its argument, just pushes nil
+--
+--  * @Ptr ()@ pushes light user data, peek checks for lightuserdata or userdata
+class StackValue a where
+    -- | Pushes a value onto Lua stack, casting it into meaningfully nearest Lua type.
+    push :: LuaState -> a -> IO ()
+    -- | Check if at index @n@ there is a convertible Lua value and if so return it
+    -- wrapped in @Just@. Return @Nothing@ otherwise.
+    peek :: LuaState -> Int -> IO (Maybe a)
+    -- | Lua type id code of the vaule expected. Parameter is unused.
+    valuetype :: a -> LTYPE
+
+maybepeek l n test peek = do
+    v <- test l n
+    if v
+        then liftM Just (peek l n)
+        else return Nothing
+
+instance StackValue LuaInteger where
+    push l x = pushinteger l x
+    peek l n = maybepeek l n isnumber tointeger
+    valuetype _ = TNUMBER
+
+instance StackValue LuaNumber where
+    push l x = pushnumber l x
+    peek l n = maybepeek l n isnumber tonumber
+    valuetype _ = TNUMBER
+
+instance StackValue Int where
+    push l x = pushinteger l (fromIntegral x)
+    peek l n = maybepeek l n isnumber (\l n -> liftM fromIntegral (tointeger l n))
+    valuetype _ = TNUMBER
+
+instance StackValue Double where
+    push l x = pushnumber l (realToFrac x)
+    peek l n = maybepeek l n isnumber (\l n -> liftM realToFrac (tonumber l n))
+    valuetype _ = TNUMBER
+
+instance StackValue String where
+    push l x = pushstring l x
+    peek l n = maybepeek l n isstring tostring
+    valuetype _ = TSTRING
+
+instance StackValue Bool where
+    push l x = pushboolean l x
+    peek l n = maybepeek l n isboolean toboolean
+    valuetype _ = TBOOLEAN
+
+instance StackValue (FunPtr LuaCFunction) where
+    push l x = pushcfunction l x
+    peek l n = maybepeek l n iscfunction tocfunction
+    valuetype _ = TFUNCTION
+
+-- watch out for the asymetry here
+instance StackValue (Ptr a) where
+    push l x = pushlightuserdata l x
+    peek l n = maybepeek l n isuserdata touserdata
+    valuetype _ = TUSERDATA
+
+-- watch out for push here
+instance StackValue LuaState where
+    push l _ = pushthread l >> return ()
+    peek l n = maybepeek l n isthread tothread
+    valuetype _ = TTHREAD
+
+instance StackValue () where
+    push l _ = pushnil l
+    peek l n = maybepeek l n isnil (\l n -> return ())
+    valuetype _ = TNIL
+
+
+{-
+-- | Argument wrapper, to be used in connection with @callproc@ and @callfunc@.
+arg :: StackValue a => a -> LuaState -> IO ()
+arg a l = push l a
+
+-- | Call a Lua procedure. Use as:
+-- > callproc l "proc" [arg "abc", arg 1, arg 5]
+callproc :: LuaState -> String -> [LuaState -> IO ()] -> IO ()
+callproc l f as = do
+    getglobal2 l f
+    mapM_ ($ l) as
+    call l (length as) 0
+
+-- | Call a Lua function. Use as:
+-- > v <- callfunc l "proc" [arg "abc", arg 1, arg 5]
+callfunc :: StackValue a => LuaState -> String -> [LuaState -> IO ()] -> IO (Maybe a)
+callfunc l f as = do
+    getglobal2 l f
+    mapM_ ($ l) as
+    call l (length as) 1
+    z <- peek l (-1)
+    pop l 1
+    return z
+-}
+
+-- | Like @getglobal@, but knows about packages. e. g.
+--
+-- > getglobal l "math.sin"
+--
+-- returns correct result
+getglobal2 :: LuaState -> String -> IO ()
+getglobal2 l n = do
+    getglobal l x
+    mapM_ dotable xs
+    where (x:xs) = splitdot n
+          splitdot = filter (/=".") . L.groupBy (\a b -> a/='.' && b/='.')
+          dotable x = getfield l (-1) x >> gettop l >>= \n -> remove l (n-1)
+typenameindex l n = ltype l n >>= typename l
+
+class LuaImport a where
+    luaimport' :: Int -> a -> LuaCFunction
+    luaimportargerror :: String -> a -> LuaCFunction
+
+instance (StackValue a) => LuaImport (IO a) where
+    luaimportargerror msg x l = push l msg >> return (-1)
+    luaimport' narg x l = x >>= push l >> return 1
+
+instance (StackValue a,LuaImport b) => LuaImport (a -> b) where
+    luaimportargerror msg x l = luaimportargerror msg (x undefined) l
+    {-
+     - FIXME: Cannot catch this exception here, because we are called from C,
+     - and error propagation, stack unwinding, etc does not work.
+     - Cannot call lua_error, because it uses longjmp and would skip two layers of abstraction.
+     -}
+    luaimport' narg x l = do
+        arg <- peek l narg
+        case arg of
+            Just v -> luaimport' (narg+1) (x v) l
+            Nothing -> do
+                t <- ltype l narg
+                exp <- typename l (valuetype (fromJust arg))
+                got <- typename l t
+                luaimportargerror ("Incorrect argument #" ++ show narg ++
+                                   " expected " ++ exp ++
+                                   " got " ++ got) (x undefined) l
+
+foreign import ccall "wrapper" mkWrapper :: LuaCFunction -> IO (FunPtr LuaCFunction)
+
+-- | Create new foreign Lua function. Function created can be called
+-- by Lua engine. Remeber to free the pointer with @freecfunction@.
+newcfunction :: LuaImport a => a -> IO (FunPtr LuaCFunction)
+newcfunction = mkWrapper . luaimport
+
+-- | Convert a Haskell function to Lua function. Any Haskell function
+-- can be converted provided that:
+--
+--   * all arguments are instances of StackValue
+--   * return type is IO t, where t is an instance of StackValue
+--
+-- Any Haskell exception will be converted to a string and returned
+-- as Lua error.
+luaimport :: LuaImport a => a -> LuaCFunction
+luaimport a l = luaimport' 1 a l `catch` (\e -> push l (show e) >> return (-1))
+
+-- | Free function pointer created with @newcfunction@.
+freecfunction :: FunPtr LuaCFunction -> IO ()
+freecfunction = freeHaskellFunPtr
+
+class LuaCallProc a where
+    callproc' :: LuaState -> String -> IO () -> Int -> a
+
+-- | Call a Lua procedure. Use as:
+--
+-- > callproc l "proc" "abc" (1::Int) (5.0::Double)
+--
+callproc :: (LuaCallProc a) => LuaState -> String -> a
+callproc l f = callproc' l f (return ()) 0
+
+class LuaCallFunc a where
+    callfunc' :: LuaState -> String -> IO () -> Int -> a
+
+-- | Call a Lua function. Use as:
+--
+-- > Just v <- callfunc l "proc" "abc" (1::Int) (5.0::Double)
+callfunc :: (LuaCallFunc a) => LuaState -> String -> a
+callfunc l f = callfunc' l f (return ()) 0
+
+instance LuaCallProc (IO t) where
+    callproc' l f a k = do
+        getglobal2 l f
+        a
+        z <- pcall l k 0 0
+        if z/=0
+            then do
+                Just msg <- peek l (-1)
+                pop l 1
+                Prelude.fail msg
+            else do
+                return undefined
+
+instance (StackValue t) => LuaCallFunc (IO t) where
+    callfunc' l f a k = do
+        getglobal2 l f
+        a
+        z <- pcall l k 1 0
+        if z/=0
+            then do
+                Just msg <- peek l (-1)
+                pop l 1
+                Prelude.fail msg
+            else do
+                r <- peek l (-1)
+                pop l 1
+                case r of
+                    Just x -> return x
+                    Nothing -> do
+                        exp <- typename l (valuetype (fromJust r))
+                        t <- ltype l (-1)
+                        got <- typename l t
+                        Prelude.fail ("Incorrect result type (" ++ exp ++ " expected, got " ++ got ++ ")")
+
+instance (StackValue t,LuaCallProc b) => LuaCallProc (t -> b) where
+    callproc' l f a k x = callproc' l f (a >> push l x) (k+1)
+
+instance (StackValue t,LuaCallFunc b) => LuaCallFunc (t -> b) where
+    callfunc' l f a k x = callfunc' l f (a >> push l x) (k+1)
+
+
+foreign export ccall hsmethod__gc :: LuaState -> IO CInt
+foreign import ccall "&hsmethod__gc" hsmethod__gc_addr :: FunPtr LuaCFunction
+
+foreign export ccall hsmethod__call :: LuaState -> IO CInt
+foreign import ccall "&hsmethod__call" hsmethod__call_addr :: FunPtr LuaCFunction
+
+hsmethod__gc :: LuaState -> IO CInt
+hsmethod__gc l = do
+    Just ptr <- peek l (-1)
+    stableptr <- F.peek (castPtr ptr)
+    freeStablePtr stableptr
+    return 0
+
+hsmethod__call :: LuaState -> IO CInt
+hsmethod__call l = do
+    Just ptr <- peek l (1)
+    remove l 1
+    stableptr <- F.peek (castPtr ptr)
+    f <- deRefStablePtr stableptr
+    f l
+
+-- | Pushes Haskell function converted to a Lua function.
+-- All values created will be garbage collected. Use as:
+--
+-- > Lua.pushhsfunction l myfun
+-- > Lua.setglobal l "myfun"
+--
+-- You are not allowed to use @lua_error@ anywhere, but
+-- use an error code of (-1) to the same effect. Push
+-- error message as the sole return value.
+pushhsfunction :: LuaImport a => LuaState -> a -> IO ()
+pushhsfunction l f = do
+    stableptr <- newStablePtr (luaimport f)
+    p <- newuserdata l (F.sizeOf stableptr);
+    F.poke (castPtr p) stableptr
+    v <- newmetatable l "HaskellImportedFunction"
+    when (v/=0) $ do
+        -- create new metatable, fill it with two entries __gc and __call
+        push l hsmethod__gc_addr
+        setfield l (-2) "__gc"
+        push l c_lua_neutralize_longjmp_addr
+        setfield l (-2) "__call"
+    setmetatable l (-2)
+    return ()
+ src/lapi.c view
@@ -0,0 +1,1080 @@+/*+** $Id: lapi.c,v 2.55 2006/06/07 12:37:17 roberto Exp $+** Lua API+** See Copyright Notice in lua.h+*/+++#include <assert.h>+#include <math.h>+#include <stdarg.h>+#include <string.h>++#define lapi_c+#define LUA_CORE++#include "lua.h"++#include "lapi.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"+#include "lundump.h"+#include "lvm.h"++++const char lua_ident[] =+  "$Lua: " LUA_RELEASE " " LUA_COPYRIGHT " $\n"+  "$Authors: " LUA_AUTHORS " $\n"+  "$URL: www.lua.org $\n";++++#define api_checknelems(L, n)	api_check(L, (n) <= (L->top - L->base))++#define api_checkvalidindex(L, i)	api_check(L, (i) != luaO_nilobject)++#define api_incr_top(L)   {api_check(L, L->top < L->ci->top); L->top++;}++++static TValue *index2adr (lua_State *L, int idx) {+  if (idx > 0) {+    TValue *o = L->base + (idx - 1);+    api_check(L, idx <= L->ci->top - L->base);+    if (o >= L->top) return cast(TValue *, luaO_nilobject);+    else return o;+  }+  else if (idx > LUA_REGISTRYINDEX) {+    api_check(L, idx != 0 && -idx <= L->top - L->base);+    return L->top + idx;+  }+  else switch (idx) {  /* pseudo-indices */+    case LUA_REGISTRYINDEX: return registry(L);+    case LUA_ENVIRONINDEX: {+      Closure *func = curr_func(L);+      sethvalue(L, &L->env, func->c.env);+      return &L->env;+    }+    case LUA_GLOBALSINDEX: return gt(L);+    default: {+      Closure *func = curr_func(L);+      idx = LUA_GLOBALSINDEX - idx;+      return (idx <= func->c.nupvalues)+                ? &func->c.upvalue[idx-1]+                : cast(TValue *, luaO_nilobject);+    }+  }+}+++static Table *getcurrenv (lua_State *L) {+  if (L->ci == L->base_ci)  /* no enclosing function? */+    return hvalue(gt(L));  /* use global table as environment */+  else {+    Closure *func = curr_func(L);+    return func->c.env;+  }+}+++void luaA_pushobject (lua_State *L, const TValue *o) {+  setobj2s(L, L->top, o);+  api_incr_top(L);+}+++LUA_API int lua_checkstack (lua_State *L, int size) {+  int res;+  lua_lock(L);+  if ((L->top - L->base + size) > LUAI_MAXCSTACK)+    res = 0;  /* stack overflow */+  else {+    luaD_checkstack(L, size);+    if (L->ci->top < L->top + size)+      L->ci->top = L->top + size;+    res = 1;+  }+  lua_unlock(L);+  return res;+}+++LUA_API void lua_xmove (lua_State *from, lua_State *to, int n) {+  int i;+  if (from == to) return;+  lua_lock(to);+  api_checknelems(from, n);+  api_check(from, G(from) == G(to));+  api_check(from, to->ci->top - to->top >= n);+  from->top -= n;+  for (i = 0; i < n; i++) {+    setobj2s(to, to->top++, from->top + i);+  }+  lua_unlock(to);+}+++LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {+  lua_CFunction old;+  lua_lock(L);+  old = G(L)->panic;+  G(L)->panic = panicf;+  lua_unlock(L);+  return old;+}+++LUA_API lua_State *lua_newthread (lua_State *L) {+  lua_State *L1;+  lua_lock(L);+  luaC_checkGC(L);+  L1 = luaE_newthread(L);+  setthvalue(L, L->top, L1);+  api_incr_top(L);+  lua_unlock(L);+  luai_userstatethread(L, L1);+  return L1;+}++++/*+** basic stack manipulation+*/+++LUA_API int lua_gettop (lua_State *L) {+  return cast_int(L->top - L->base);+}+++LUA_API void lua_settop (lua_State *L, int idx) {+  lua_lock(L);+  if (idx >= 0) {+    api_check(L, idx <= L->stack_last - L->base);+    while (L->top < L->base + idx)+      setnilvalue(L->top++);+    L->top = L->base + idx;+  }+  else {+    api_check(L, -(idx+1) <= (L->top - L->base));+    L->top += idx+1;  /* `subtract' index (index is negative) */+  }+  lua_unlock(L);+}+++LUA_API void lua_remove (lua_State *L, int idx) {+  StkId p;+  lua_lock(L);+  p = index2adr(L, idx);+  api_checkvalidindex(L, p);+  while (++p < L->top) setobjs2s(L, p-1, p);+  L->top--;+  lua_unlock(L);+}+++LUA_API void lua_insert (lua_State *L, int idx) {+  StkId p;+  StkId q;+  lua_lock(L);+  p = index2adr(L, idx);+  api_checkvalidindex(L, p);+  for (q = L->top; q>p; q--) setobjs2s(L, q, q-1);+  setobjs2s(L, p, L->top);+  lua_unlock(L);+}+++LUA_API void lua_replace (lua_State *L, int idx) {+  StkId o;+  lua_lock(L);+  /* explicit test for incompatible code */+  if (idx == LUA_ENVIRONINDEX && L->ci == L->base_ci)+    luaG_runerror(L, "no calling environment");+  api_checknelems(L, 1);+  o = index2adr(L, idx);+  api_checkvalidindex(L, o);+  if (idx == LUA_ENVIRONINDEX) {+    Closure *func = curr_func(L);+    api_check(L, ttistable(L->top - 1)); +    func->c.env = hvalue(L->top - 1);+    luaC_barrier(L, func, L->top - 1);+  }+  else {+    setobj(L, o, L->top - 1);+    if (idx < LUA_GLOBALSINDEX)  /* function upvalue? */+      luaC_barrier(L, curr_func(L), L->top - 1);+  }+  L->top--;+  lua_unlock(L);+}+++LUA_API void lua_pushvalue (lua_State *L, int idx) {+  lua_lock(L);+  setobj2s(L, L->top, index2adr(L, idx));+  api_incr_top(L);+  lua_unlock(L);+}++++/*+** access functions (stack -> C)+*/+++LUA_API int lua_type (lua_State *L, int idx) {+  StkId o = index2adr(L, idx);+  return (o == luaO_nilobject) ? LUA_TNONE : ttype(o);+}+++LUA_API const char *lua_typename (lua_State *L, int t) {+  UNUSED(L);+  return (t == LUA_TNONE) ? "no value" : luaT_typenames[t];+}+++LUA_API int lua_iscfunction (lua_State *L, int idx) {+  StkId o = index2adr(L, idx);+  return iscfunction(o);+}+++LUA_API int lua_isnumber (lua_State *L, int idx) {+  TValue n;+  const TValue *o = index2adr(L, idx);+  return tonumber(o, &n);+}+++LUA_API int lua_isstring (lua_State *L, int idx) {+  int t = lua_type(L, idx);+  return (t == LUA_TSTRING || t == LUA_TNUMBER);+}+++LUA_API int lua_isuserdata (lua_State *L, int idx) {+  const TValue *o = index2adr(L, idx);+  return (ttisuserdata(o) || ttislightuserdata(o));+}+++LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {+  StkId o1 = index2adr(L, index1);+  StkId o2 = index2adr(L, index2);+  return (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0+         : luaO_rawequalObj(o1, o2);+}+++LUA_API int lua_equal (lua_State *L, int index1, int index2) {+  StkId o1, o2;+  int i;+  lua_lock(L);  /* may call tag method */+  o1 = index2adr(L, index1);+  o2 = index2adr(L, index2);+  i = (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0 : equalobj(L, o1, o2);+  lua_unlock(L);+  return i;+}+++LUA_API int lua_lessthan (lua_State *L, int index1, int index2) {+  StkId o1, o2;+  int i;+  lua_lock(L);  /* may call tag method */+  o1 = index2adr(L, index1);+  o2 = index2adr(L, index2);+  i = (o1 == luaO_nilobject || o2 == luaO_nilobject) ? 0+       : luaV_lessthan(L, o1, o2);+  lua_unlock(L);+  return i;+}++++LUA_API lua_Number lua_tonumber (lua_State *L, int idx) {+  TValue n;+  const TValue *o = index2adr(L, idx);+  if (tonumber(o, &n))+    return nvalue(o);+  else+    return 0;+}+++LUA_API lua_Integer lua_tointeger (lua_State *L, int idx) {+  TValue n;+  const TValue *o = index2adr(L, idx);+  if (tonumber(o, &n)) {+    lua_Integer res;+    lua_Number num = nvalue(o);+    lua_number2integer(res, num);+    return res;+  }+  else+    return 0;+}+++LUA_API int lua_toboolean (lua_State *L, int idx) {+  const TValue *o = index2adr(L, idx);+  return !l_isfalse(o);+}+++LUA_API const char *lua_tolstring (lua_State *L, int idx, size_t *len) {+  StkId o = index2adr(L, idx);+  if (!ttisstring(o)) {+    lua_lock(L);  /* `luaV_tostring' may create a new string */+    if (!luaV_tostring(L, o)) {  /* conversion failed? */+      if (len != NULL) *len = 0;+      lua_unlock(L);+      return NULL;+    }+    luaC_checkGC(L);+    o = index2adr(L, idx);  /* previous call may reallocate the stack */+    lua_unlock(L);+  }+  if (len != NULL) *len = tsvalue(o)->len;+  return svalue(o);+}+++LUA_API size_t lua_objlen (lua_State *L, int idx) {+  StkId o = index2adr(L, idx);+  switch (ttype(o)) {+    case LUA_TSTRING: return tsvalue(o)->len;+    case LUA_TUSERDATA: return uvalue(o)->len;+    case LUA_TTABLE: return luaH_getn(hvalue(o));+    case LUA_TNUMBER: {+      size_t l;+      lua_lock(L);  /* `luaV_tostring' may create a new string */+      l = (luaV_tostring(L, o) ? tsvalue(o)->len : 0);+      lua_unlock(L);+      return l;+    }+    default: return 0;+  }+}+++LUA_API lua_CFunction lua_tocfunction (lua_State *L, int idx) {+  StkId o = index2adr(L, idx);+  return (!iscfunction(o)) ? NULL : clvalue(o)->c.f;+}+++LUA_API void *lua_touserdata (lua_State *L, int idx) {+  StkId o = index2adr(L, idx);+  switch (ttype(o)) {+    case LUA_TUSERDATA: return (rawuvalue(o) + 1);+    case LUA_TLIGHTUSERDATA: return pvalue(o);+    default: return NULL;+  }+}+++LUA_API lua_State *lua_tothread (lua_State *L, int idx) {+  StkId o = index2adr(L, idx);+  return (!ttisthread(o)) ? NULL : thvalue(o);+}+++LUA_API const void *lua_topointer (lua_State *L, int idx) {+  StkId o = index2adr(L, idx);+  switch (ttype(o)) {+    case LUA_TTABLE: return hvalue(o);+    case LUA_TFUNCTION: return clvalue(o);+    case LUA_TTHREAD: return thvalue(o);+    case LUA_TUSERDATA:+    case LUA_TLIGHTUSERDATA:+      return lua_touserdata(L, idx);+    default: return NULL;+  }+}++++/*+** push functions (C -> stack)+*/+++LUA_API void lua_pushnil (lua_State *L) {+  lua_lock(L);+  setnilvalue(L->top);+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API void lua_pushnumber (lua_State *L, lua_Number n) {+  lua_lock(L);+  setnvalue(L->top, n);+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API void lua_pushinteger (lua_State *L, lua_Integer n) {+  lua_lock(L);+  setnvalue(L->top, cast_num(n));+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API void lua_pushlstring (lua_State *L, const char *s, size_t len) {+  lua_lock(L);+  luaC_checkGC(L);+  setsvalue2s(L, L->top, luaS_newlstr(L, s, len));+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API void lua_pushstring (lua_State *L, const char *s) {+  if (s == NULL)+    lua_pushnil(L);+  else+    lua_pushlstring(L, s, strlen(s));+}+++LUA_API const char *lua_pushvfstring (lua_State *L, const char *fmt,+                                      va_list argp) {+  const char *ret;+  lua_lock(L);+  luaC_checkGC(L);+  ret = luaO_pushvfstring(L, fmt, argp);+  lua_unlock(L);+  return ret;+}+++LUA_API const char *lua_pushfstring (lua_State *L, const char *fmt, ...) {+  const char *ret;+  va_list argp;+  lua_lock(L);+  luaC_checkGC(L);+  va_start(argp, fmt);+  ret = luaO_pushvfstring(L, fmt, argp);+  va_end(argp);+  lua_unlock(L);+  return ret;+}+++LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {+  Closure *cl;+  lua_lock(L);+  luaC_checkGC(L);+  api_checknelems(L, n);+  cl = luaF_newCclosure(L, n, getcurrenv(L));+  cl->c.f = fn;+  L->top -= n;+  while (n--)+    setobj2n(L, &cl->c.upvalue[n], L->top+n);+  setclvalue(L, L->top, cl);+  lua_assert(iswhite(obj2gco(cl)));+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API void lua_pushboolean (lua_State *L, int b) {+  lua_lock(L);+  setbvalue(L->top, (b != 0));  /* ensure that true is 1 */+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API void lua_pushlightuserdata (lua_State *L, void *p) {+  lua_lock(L);+  setpvalue(L->top, p);+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API int lua_pushthread (lua_State *L) {+  lua_lock(L);+  setthvalue(L, L->top, L);+  api_incr_top(L);+  lua_unlock(L);+  return (G(L)->mainthread == L);+}++++/*+** get functions (Lua -> stack)+*/+++LUA_API void lua_gettable (lua_State *L, int idx) {+  StkId t;+  lua_lock(L);+  t = index2adr(L, idx);+  api_checkvalidindex(L, t);+  luaV_gettable(L, t, L->top - 1, L->top - 1);+  lua_unlock(L);+}+++LUA_API void lua_getfield (lua_State *L, int idx, const char *k) {+  StkId t;+  TValue key;+  lua_lock(L);+  t = index2adr(L, idx);+  api_checkvalidindex(L, t);+  setsvalue(L, &key, luaS_new(L, k));+  luaV_gettable(L, t, &key, L->top);+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API void lua_rawget (lua_State *L, int idx) {+  StkId t;+  lua_lock(L);+  t = index2adr(L, idx);+  api_check(L, ttistable(t));+  setobj2s(L, L->top - 1, luaH_get(hvalue(t), L->top - 1));+  lua_unlock(L);+}+++LUA_API void lua_rawgeti (lua_State *L, int idx, int n) {+  StkId o;+  lua_lock(L);+  o = index2adr(L, idx);+  api_check(L, ttistable(o));+  setobj2s(L, L->top, luaH_getnum(hvalue(o), n));+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API void lua_createtable (lua_State *L, int narray, int nrec) {+  lua_lock(L);+  luaC_checkGC(L);+  sethvalue(L, L->top, luaH_new(L, narray, nrec));+  api_incr_top(L);+  lua_unlock(L);+}+++LUA_API int lua_getmetatable (lua_State *L, int objindex) {+  const TValue *obj;+  Table *mt = NULL;+  int res;+  lua_lock(L);+  obj = index2adr(L, objindex);+  switch (ttype(obj)) {+    case LUA_TTABLE:+      mt = hvalue(obj)->metatable;+      break;+    case LUA_TUSERDATA:+      mt = uvalue(obj)->metatable;+      break;+    default:+      mt = G(L)->mt[ttype(obj)];+      break;+  }+  if (mt == NULL)+    res = 0;+  else {+    sethvalue(L, L->top, mt);+    api_incr_top(L);+    res = 1;+  }+  lua_unlock(L);+  return res;+}+++LUA_API void lua_getfenv (lua_State *L, int idx) {+  StkId o;+  lua_lock(L);+  o = index2adr(L, idx);+  api_checkvalidindex(L, o);+  switch (ttype(o)) {+    case LUA_TFUNCTION:+      sethvalue(L, L->top, clvalue(o)->c.env);+      break;+    case LUA_TUSERDATA:+      sethvalue(L, L->top, uvalue(o)->env);+      break;+    case LUA_TTHREAD:+      setobj2s(L, L->top,  gt(thvalue(o)));+      break;+    default:+      setnilvalue(L->top);+      break;+  }+  api_incr_top(L);+  lua_unlock(L);+}+++/*+** set functions (stack -> Lua)+*/+++LUA_API void lua_settable (lua_State *L, int idx) {+  StkId t;+  lua_lock(L);+  api_checknelems(L, 2);+  t = index2adr(L, idx);+  api_checkvalidindex(L, t);+  luaV_settable(L, t, L->top - 2, L->top - 1);+  L->top -= 2;  /* pop index and value */+  lua_unlock(L);+}+++LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {+  StkId t;+  TValue key;+  lua_lock(L);+  api_checknelems(L, 1);+  t = index2adr(L, idx);+  api_checkvalidindex(L, t);+  setsvalue(L, &key, luaS_new(L, k));+  luaV_settable(L, t, &key, L->top - 1);+  L->top--;  /* pop value */+  lua_unlock(L);+}+++LUA_API void lua_rawset (lua_State *L, int idx) {+  StkId t;+  lua_lock(L);+  api_checknelems(L, 2);+  t = index2adr(L, idx);+  api_check(L, ttistable(t));+  setobj2t(L, luaH_set(L, hvalue(t), L->top-2), L->top-1);+  luaC_barriert(L, hvalue(t), L->top-1);+  L->top -= 2;+  lua_unlock(L);+}+++LUA_API void lua_rawseti (lua_State *L, int idx, int n) {+  StkId o;+  lua_lock(L);+  api_checknelems(L, 1);+  o = index2adr(L, idx);+  api_check(L, ttistable(o));+  setobj2t(L, luaH_setnum(L, hvalue(o), n), L->top-1);+  luaC_barriert(L, hvalue(o), L->top-1);+  L->top--;+  lua_unlock(L);+}+++LUA_API int lua_setmetatable (lua_State *L, int objindex) {+  TValue *obj;+  Table *mt;+  lua_lock(L);+  api_checknelems(L, 1);+  obj = index2adr(L, objindex);+  api_checkvalidindex(L, obj);+  if (ttisnil(L->top - 1))+    mt = NULL;+  else {+    api_check(L, ttistable(L->top - 1));+    mt = hvalue(L->top - 1);+  }+  switch (ttype(obj)) {+    case LUA_TTABLE: {+      hvalue(obj)->metatable = mt;+      if (mt)+        luaC_objbarriert(L, hvalue(obj), mt);+      break;+    }+    case LUA_TUSERDATA: {+      uvalue(obj)->metatable = mt;+      if (mt)+        luaC_objbarrier(L, rawuvalue(obj), mt);+      break;+    }+    default: {+      G(L)->mt[ttype(obj)] = mt;+      break;+    }+  }+  L->top--;+  lua_unlock(L);+  return 1;+}+++LUA_API int lua_setfenv (lua_State *L, int idx) {+  StkId o;+  int res = 1;+  lua_lock(L);+  api_checknelems(L, 1);+  o = index2adr(L, idx);+  api_checkvalidindex(L, o);+  api_check(L, ttistable(L->top - 1));+  switch (ttype(o)) {+    case LUA_TFUNCTION:+      clvalue(o)->c.env = hvalue(L->top - 1);+      break;+    case LUA_TUSERDATA:+      uvalue(o)->env = hvalue(L->top - 1);+      break;+    case LUA_TTHREAD:+      sethvalue(L, gt(thvalue(o)), hvalue(L->top - 1));+      break;+    default:+      res = 0;+      break;+  }+  luaC_objbarrier(L, gcvalue(o), hvalue(L->top - 1));+  L->top--;+  lua_unlock(L);+  return res;+}+++/*+** `load' and `call' functions (run Lua code)+*/+++#define adjustresults(L,nres) \+    { if (nres == LUA_MULTRET && L->top >= L->ci->top) L->ci->top = L->top; }+++#define checkresults(L,na,nr) \+     api_check(L, (nr) == LUA_MULTRET || (L->ci->top - L->top >= (nr) - (na)))+	++LUA_API void lua_call (lua_State *L, int nargs, int nresults) {+  StkId func;+  lua_lock(L);+  api_checknelems(L, nargs+1);+  checkresults(L, nargs, nresults);+  func = L->top - (nargs+1);+  luaD_call(L, func, nresults);+  adjustresults(L, nresults);+  lua_unlock(L);+}++++/*+** Execute a protected call.+*/+struct CallS {  /* data to `f_call' */+  StkId func;+  int nresults;+};+++static void f_call (lua_State *L, void *ud) {+  struct CallS *c = cast(struct CallS *, ud);+  luaD_call(L, c->func, c->nresults);+}++++LUA_API int lua_pcall (lua_State *L, int nargs, int nresults, int errfunc) {+  struct CallS c;+  int status;+  ptrdiff_t func;+  lua_lock(L);+  api_checknelems(L, nargs+1);+  checkresults(L, nargs, nresults);+  if (errfunc == 0)+    func = 0;+  else {+    StkId o = index2adr(L, errfunc);+    api_checkvalidindex(L, o);+    func = savestack(L, o);+  }+  c.func = L->top - (nargs+1);  /* function to be called */+  c.nresults = nresults;+  status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);+  adjustresults(L, nresults);+  lua_unlock(L);+  return status;+}+++/*+** Execute a protected C call.+*/+struct CCallS {  /* data to `f_Ccall' */+  lua_CFunction func;+  void *ud;+};+++static void f_Ccall (lua_State *L, void *ud) {+  struct CCallS *c = cast(struct CCallS *, ud);+  Closure *cl;+  cl = luaF_newCclosure(L, 0, getcurrenv(L));+  cl->c.f = c->func;+  setclvalue(L, L->top, cl);  /* push function */+  api_incr_top(L);+  setpvalue(L->top, c->ud);  /* push only argument */+  api_incr_top(L);+  luaD_call(L, L->top - 2, 0);+}+++LUA_API int lua_cpcall (lua_State *L, lua_CFunction func, void *ud) {+  struct CCallS c;+  int status;+  lua_lock(L);+  c.func = func;+  c.ud = ud;+  status = luaD_pcall(L, f_Ccall, &c, savestack(L, L->top), 0);+  lua_unlock(L);+  return status;+}+++LUA_API int lua_load (lua_State *L, lua_Reader reader, void *data,+                      const char *chunkname) {+  ZIO z;+  int status;+  lua_lock(L);+  if (!chunkname) chunkname = "?";+  luaZ_init(L, &z, reader, data);+  status = luaD_protectedparser(L, &z, chunkname);+  lua_unlock(L);+  return status;+}+++LUA_API int lua_dump (lua_State *L, lua_Writer writer, void *data) {+  int status;+  TValue *o;+  lua_lock(L);+  api_checknelems(L, 1);+  o = L->top - 1;+  if (isLfunction(o))+    status = luaU_dump(L, clvalue(o)->l.p, writer, data, 0);+  else+    status = 1;+  lua_unlock(L);+  return status;+}+++LUA_API int  lua_status (lua_State *L) {+  return L->status;+}+++/*+** Garbage-collection function+*/++LUA_API int lua_gc (lua_State *L, int what, int data) {+  int res = 0;+  global_State *g;+  lua_lock(L);+  g = G(L);+  switch (what) {+    case LUA_GCSTOP: {+      g->GCthreshold = MAX_LUMEM;+      break;+    }+    case LUA_GCRESTART: {+      g->GCthreshold = g->totalbytes;+      break;+    }+    case LUA_GCCOLLECT: {+      luaC_fullgc(L);+      break;+    }+    case LUA_GCCOUNT: {+      /* GC values are expressed in Kbytes: #bytes/2^10 */+      res = cast_int(g->totalbytes >> 10);+      break;+    }+    case LUA_GCCOUNTB: {+      res = cast_int(g->totalbytes & 0x3ff);+      break;+    }+    case LUA_GCSTEP: {+      lu_mem a = (cast(lu_mem, data) << 10);+      if (a <= g->totalbytes)+        g->GCthreshold = g->totalbytes - a;+      else+        g->GCthreshold = 0;+      while (g->GCthreshold <= g->totalbytes)+        luaC_step(L);+      if (g->gcstate == GCSpause)  /* end of cycle? */+        res = 1;  /* signal it */+      break;+    }+    case LUA_GCSETPAUSE: {+      res = g->gcpause;+      g->gcpause = data;+      break;+    }+    case LUA_GCSETSTEPMUL: {+      res = g->gcstepmul;+      g->gcstepmul = data;+      break;+    }+    default: res = -1;  /* invalid option */+  }+  lua_unlock(L);+  return res;+}++++/*+** miscellaneous functions+*/+++LUA_API int lua_error (lua_State *L) {+  lua_lock(L);+  api_checknelems(L, 1);+  luaG_errormsg(L);+  lua_unlock(L);+  return 0;  /* to avoid warnings */+}+++LUA_API int lua_next (lua_State *L, int idx) {+  StkId t;+  int more;+  lua_lock(L);+  t = index2adr(L, idx);+  api_check(L, ttistable(t));+  more = luaH_next(L, hvalue(t), L->top - 1);+  if (more) {+    api_incr_top(L);+  }+  else  /* no more elements */+    L->top -= 1;  /* remove key */+  lua_unlock(L);+  return more;+}+++LUA_API void lua_concat (lua_State *L, int n) {+  lua_lock(L);+  api_checknelems(L, n);+  if (n >= 2) {+    luaC_checkGC(L);+    luaV_concat(L, n, cast_int(L->top - L->base) - 1);+    L->top -= (n-1);+  }+  else if (n == 0) {  /* push empty string */+    setsvalue2s(L, L->top, luaS_newlstr(L, "", 0));+    api_incr_top(L);+  }+  /* else n == 1; nothing to do */+  lua_unlock(L);+}+++LUA_API lua_Alloc lua_getallocf (lua_State *L, void **ud) {+  lua_Alloc f;+  lua_lock(L);+  if (ud) *ud = G(L)->ud;+  f = G(L)->frealloc;+  lua_unlock(L);+  return f;+}+++LUA_API void lua_setallocf (lua_State *L, lua_Alloc f, void *ud) {+  lua_lock(L);+  G(L)->ud = ud;+  G(L)->frealloc = f;+  lua_unlock(L);+}+++LUA_API void *lua_newuserdata (lua_State *L, size_t size) {+  Udata *u;+  lua_lock(L);+  luaC_checkGC(L);+  u = luaS_newudata(L, size, getcurrenv(L));+  setuvalue(L, L->top, u);+  api_incr_top(L);+  lua_unlock(L);+  return u + 1;+}+++++static const char *aux_upvalue (StkId fi, int n, TValue **val) {+  Closure *f;+  if (!ttisfunction(fi)) return NULL;+  f = clvalue(fi);+  if (f->c.isC) {+    if (!(1 <= n && n <= f->c.nupvalues)) return NULL;+    *val = &f->c.upvalue[n-1];+    return "";+  }+  else {+    Proto *p = f->l.p;+    if (!(1 <= n && n <= p->sizeupvalues)) return NULL;+    *val = f->l.upvals[n-1]->v;+    return getstr(p->upvalues[n-1]);+  }+}+++LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {+  const char *name;+  TValue *val;+  lua_lock(L);+  name = aux_upvalue(index2adr(L, funcindex), n, &val);+  if (name) {+    setobj2s(L, L->top, val);+    api_incr_top(L);+  }+  lua_unlock(L);+  return name;+}+++LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {+  const char *name;+  TValue *val;+  StkId fi;+  lua_lock(L);+  fi = index2adr(L, funcindex);+  api_checknelems(L, 1);+  name = aux_upvalue(fi, n, &val);+  if (name) {+    L->top--;+    setobj(L, val, L->top);+    luaC_barrier(L, clvalue(fi), L->top);+  }+  lua_unlock(L);+  return name;+}+
+ src/lapi.h view
@@ -0,0 +1,16 @@+/*+** $Id: lapi.h,v 2.2 2005/04/25 19:24:10 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
+ src/lauxlib.c view
@@ -0,0 +1,653 @@+/*+** $Id: lauxlib.c,v 1.159 2006/03/21 19:31:09 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", size);+    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, LUAL_BUFFERSIZE, 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] && lf.f != stdin) {  /* binary file? */+    fclose(lf.f);+    lf.f = fopen(filename, "rb");  /* 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 (lf.f != stdin) 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;+}+
+ src/lauxlib.h view
@@ -0,0 +1,174 @@+/*+** $Id: lauxlib.h,v 1.88 2006/04/12 20:31:15 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++
+ src/lbaselib.c view
@@ -0,0 +1,643 @@+/*+** $Id: lbaselib.c,v 1.191a 2006/06/02 15:34:00 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));+  n = e - i + 1;  /* number of elements */+  if (n <= 0) return 0;  /* empty range */+  luaL_checkstack(L, n, "table too big to unpack");+  for (; i<=e; i++)  /* push arg[i...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+** =======================================================+*/++static int auxresume (lua_State *L, lua_State *co, int narg) {+  int status;+  if (!lua_checkstack(co, narg))+    luaL_error(L, "too many arguments to resume");+  if (lua_status(co) == 0 && lua_gettop(co) == 0) {+    lua_pushliteral(L, "cannot resume dead coroutine");+    return -1;  /* error flag */+  }+  lua_xmove(L, co, narg);+  status = lua_resume(co, narg);+  if (status == 0 || status == LUA_YIELD) {+    int nres = lua_gettop(co);+    if (!lua_checkstack(L, nres))+      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_costatus (lua_State *L) {+  lua_State *co = lua_tothread(L, 1);+  luaL_argcheck(L, co, 1, "coroutine expected");+  if (L == co) lua_pushliteral(L, "running");+  else {+    switch (lua_status(co)) {+      case LUA_YIELD:+        lua_pushliteral(L, "suspended");+        break;+      case 0: {+        lua_Debug ar;+        if (lua_getstack(co, 0, &ar) > 0)  /* does it have frames? */+          lua_pushliteral(L, "normal");  /* it is running */+        else if (lua_gettop(co) == 0)+            lua_pushliteral(L, "dead");+        else+          lua_pushliteral(L, "suspended");  /* initial state */+        break;+      }+      default:  /* some error occured */+        lua_pushliteral(L, "dead");+        break;+    }+  }+  return 1;+}+++static int luaB_corunning (lua_State *L) {+  if (lua_pushthread(L))+    return 0;  /* main thread is not a coroutine */+  else+    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 auxliliary 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;+}+
+ src/lcode.c view
@@ -0,0 +1,839 @@+/*+** $Id: lcode.c,v 2.25a 2006/03/21 19:28:49 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 VFALSE: {+      pc = luaK_jump(fs);  /* always jump */+      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 VTRUE: {+      pc = luaK_jump(fs);  /* always jump */+      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 (e->k == VK)+        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 */+}+
+ src/lcode.h view
@@ -0,0 +1,76 @@+/*+** $Id: lcode.h,v 1.48 2006/03/21 19:28:03 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
+ src/ldblib.c view
@@ -0,0 +1,397 @@+/*+** $Id: ldblib.c,v 1.104 2005/12/29 15:32:11 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) {+  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;+  lua_State *L1 = getthread(L, &arg);+  if (lua_isnoneornil(L, arg+1)) {+    lua_settop(L, arg+1);+    lua_sethook(L1, NULL, 0, 0);  /* turn off hooks */+  }+  else {+    const char *smask = luaL_checkstring(L, arg+2);+    int count = luaL_optint(L, arg+3, 0);+    luaL_checktype(L, arg+1, LUA_TFUNCTION);+    lua_sethook(L1, hookf, makemask(smask, count), count);+  }+  gethooktable(L1);+  lua_pushlightuserdata(L1, L1);+  lua_pushvalue(L, arg+1);+  lua_xmove(L, L1, 1);+  lua_rawset(L1, -3);  /* set new hook */+  lua_pop(L1, 1);  /* remove hook table */+  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(L1);+    lua_pushlightuserdata(L1, L1);+    lua_rawget(L1, -2);   /* get hook */+    lua_remove(L1, -2);  /* remove hook table */+    lua_xmove(L1, L, 1);+  }+  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;+}+
+ src/ldebug.c view
@@ -0,0 +1,622 @@+/*+** $Id: ldebug.c,v 2.29a 2005/12/22 16:19:56 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);+  lua_assert(pt->numparams+(pt->is_vararg & VARARG_HASARG) <= pt->maxstacksize);+  lua_assert(!(pt->is_vararg & VARARG_NEEDSARG) ||+              (pt->is_vararg & VARARG_HASARG));+  check(pt->sizeupvalues <= pt->nups);+  check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0);+  check(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) {+            /* cannot jump to a setlist count */+            Instruction d = pt->code[dest-1];+            check(!(GET_OPCODE(d) == OP_SETLIST && GETARG_C(d) == 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: {+        check(c == 0 || pc+2 < pt->sizecode);  /* check its jump */+        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++;+        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)) p1 = p2;+  lua_assert(!ttisstring(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);+}+
+ src/ldebug.h view
@@ -0,0 +1,33 @@+/*+** $Id: ldebug.h,v 2.3 2005/04/25 19:24:10 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
+ src/ldo.c view
@@ -0,0 +1,516 @@+/*+** $Id: ldo.c,v 2.38 2006/06/05 19:36:14 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 = 0;+  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);+    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->ci->tailcalls--)  /* call hook for eventual 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) {+    if (L->status != 0)+      return resume_error(L, "cannot resume dead coroutine");+    else if (L->ci != L->base_ci)+      return resume_error(L, "cannot resume non-suspended coroutine");+  }+  luai_userstateresume(L, nargs);+  lua_assert(L->errfunc == 0 && L->nCcalls == 0);+  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+    status = L->status;+  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 > 0)+    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;+}++
+ src/ldo.h view
@@ -0,0 +1,57 @@+/*+** $Id: ldo.h,v 2.7 2005/08/24 16:15:49 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+
+ src/ldump.c view
@@ -0,0 +1,164 @@+/*+** $Id: ldump.c,v 1.15 2006/02/16 15:53:49 lhf 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;+}
+ src/lfunc.c view
@@ -0,0 +1,174 @@+/*+** $Id: lfunc.c,v 2.12a 2005/12/22 16:19:56 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 */+}+
+ src/lfunc.h view
@@ -0,0 +1,34 @@+/*+** $Id: lfunc.h,v 2.4 2005/04/25 19:24:10 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
+ src/lgc.c view
@@ -0,0 +1,711 @@+/*+** $Id: lgc.c,v 2.38 2006/05/24 14:34:06 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 {+    lua_assert(g->totalbytes >= g->estimate);+    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);+    }+  }+}+
+ src/lgc.h view
@@ -0,0 +1,110 @@+/*+** $Id: lgc.h,v 2.15 2005/08/24 16:15:49 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
+ src/linit.c view
@@ -0,0 +1,38 @@+/*+** $Id: linit.c,v 1.14 2005/12/29 15:32:11 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},+  {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);+  }+}+
+ src/liolib.c view
@@ -0,0 +1,532 @@+/*+** $Id: liolib.c,v 2.73 2006/05/08 20:14:16 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 topfile(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 = topfile(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;+}+++/*+** this function has a separated environment, which defines the+** correct __close for 'popen' files+*/+static int io_pclose (lua_State *L) {+  FILE **p = topfile(L);+  int ok = lua_pclose(L, *p);+  *p = NULL;+  return pushresult(L, ok, NULL);+}+++static int io_fclose (lua_State *L) {+  FILE **p = topfile(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 = *topfile(L);+  /* ignore closed files and standard files */+  if (f != NULL && f != stdin && f != stdout && f != stderr)+    aux_close(L);+  return 0;+}+++static int io_tostring (lua_State *L) {+  FILE *f = *topfile(L);+  if (f == NULL)+    lua_pushstring(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;+}+++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 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_strlen(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_strlen(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_setfield(L, -2, fname);+}+++LUALIB_API int luaopen_io (lua_State *L) {+  createmeta(L);+  /* create (private) environment (with fields IO_INPUT, IO_OUTPUT, __close) */+  lua_createtable(L, 2, 1);+  lua_replace(L, LUA_ENVIRONINDEX);+  /* open library */+  luaL_register(L, LUA_IOLIBNAME, iolib);+  /* create (and set) default files */+  createstdfile(L, stdin, IO_INPUT, "stdin");+  createstdfile(L, stdout, IO_OUTPUT, "stdout");+  createstdfile(L, stderr, 0, "stderr");+  /* create environment for 'popen' */+  lua_getfield(L, -1, "popen");+  lua_createtable(L, 0, 1);+  lua_pushcfunction(L, io_pclose);+  lua_setfield(L, -2, "__close");+  lua_setfenv(L, -2);+  lua_pop(L, 1);  /* pop 'popen' */+  /* set default close function */+  lua_pushcfunction(L, io_fclose);+  lua_setfield(L, LUA_ENVIRONINDEX, "__close");+  return 1;+}+
+ src/llex.c view
@@ -0,0 +1,461 @@+/*+** $Id: llex.c,v 2.20 2006/03/09 18:14:31 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 */+  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);+}+
+ src/llex.h view
@@ -0,0 +1,81 @@+/*+** $Id: llex.h,v 1.58 2006/03/23 18:23:32 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
+ src/llimits.h view
@@ -0,0 +1,128 @@+/*+** $Id: llimits.h,v 1.69 2005/12/27 17:12:00 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
+ src/lmathlib.c view
@@ -0,0 +1,263 @@+/*+** $Id: lmathlib.c,v 1.67 2005/08/26 17:36:32 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;+}+
+ src/lmem.c view
@@ -0,0 +1,86 @@+/*+** $Id: lmem.c,v 1.70 2005/12/26 13:35:47 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;+}+
+ src/lmem.h view
@@ -0,0 +1,49 @@+/*+** $Id: lmem.h,v 1.31 2005/04/25 19:24:10 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+
+ src/loadlib.c view
@@ -0,0 +1,664 @@+/*+** $Id: loadlib.c,v 1.54a 2006/07/03 20:16:49 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;+  lua_getstack(L, 1, &ar);+  lua_getinfo(L, "f", &ar);+  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, 0, sizeof(loaders)/sizeof(loaders[0]) - 1);+  /* 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 */+}+
+ src/lobject.c view
@@ -0,0 +1,214 @@+/*+** $Id: lobject.c,v 2.22 2006/02/10 17:43:52 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, "\"]");+    }+  }+}
+ src/lobject.h view
@@ -0,0 +1,381 @@+/*+** $Id: lobject.h,v 2.20 2006/01/18 11:37:34 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(tsvalue(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+
+ src/lopcodes.c view
@@ -0,0 +1,102 @@+/*+** $Id: lopcodes.c,v 1.37 2005/11/08 19:45:36 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 */+};+
+ src/lopcodes.h view
@@ -0,0 +1,268 @@+/*+** $Id: lopcodes.h,v 1.125 2006/03/14 19:04:44 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
+ src/loslib.c view
@@ -0,0 +1,244 @@+/*+** $Id: loslib.c,v 1.20 2006/09/19 13:57:08 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));+  return 0;  /* to avoid warnings */+}++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;+}+
+ src/lparser.c view
@@ -0,0 +1,1337 @@+/*+** $Id: lparser.c,v 2.42a 2006/06/05 15:57:59 roberto Exp $+** Lua Parser+** See Copyright Notice in lua.h+*/+++#include <string.h>++#define lparser_c+#define LUA_CORE++#include "lua.h"++#include "lcode.h"+#include "ldebug.h"+#include "ldo.h"+#include "lfunc.h"+#include "llex.h"+#include "lmem.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lparser.h"+#include "lstate.h"+#include "lstring.h"+#include "ltable.h"++++#define hasmultret(k)		((k) == VCALL || (k) == VVARARG)++#define getlocvar(fs, i)	((fs)->f->locvars[(fs)->actvar[i]])++#define luaY_checklimit(fs,v,l,m)	if ((v)>(l)) errorlimit(fs,l,m)+++/*+** nodes for block list (list of active blocks)+*/+typedef struct BlockCnt {+  struct BlockCnt *previous;  /* chain */+  int breaklist;  /* list of jumps out of this loop */+  lu_byte nactvar;  /* # active locals outside the breakable structure */+  lu_byte upval;  /* true if some variable in the block is an upvalue */+  lu_byte isbreakable;  /* true if `block' is a loop */+} BlockCnt;++++/*+** prototypes for recursive non-terminal functions+*/+static void chunk (LexState *ls);+static void expr (LexState *ls, expdesc *v);+++static void anchor_token (LexState *ls) {+  if (ls->t.token == TK_NAME || ls->t.token == TK_STRING) {+    TString *ts = ls->t.seminfo.ts;+    luaX_newstring(ls, getstr(ts), ts->tsv.len);+  }+}+++static void error_expected (LexState *ls, int token) {+  luaX_syntaxerror(ls,+      luaO_pushfstring(ls->L, LUA_QS " expected", luaX_token2str(ls, token)));+}+++static void errorlimit (FuncState *fs, int limit, const char *what) {+  const char *msg = (fs->f->linedefined == 0) ?+    luaO_pushfstring(fs->L, "main function has more than %d %s", limit, what) :+    luaO_pushfstring(fs->L, "function at line %d has more than %d %s",+                            fs->f->linedefined, limit, what);+  luaX_lexerror(fs->ls, msg, 0);+}+++static int testnext (LexState *ls, int c) {+  if (ls->t.token == c) {+    luaX_next(ls);+    return 1;+  }+  else return 0;+}+++static void check (LexState *ls, int c) {+  if (ls->t.token != c)+    error_expected(ls, c);+}++static void checknext (LexState *ls, int c) {+  check(ls, c);+  luaX_next(ls);+}+++#define check_condition(ls,c,msg)	{ if (!(c)) luaX_syntaxerror(ls, msg); }++++static void check_match (LexState *ls, int what, int who, int where) {+  if (!testnext(ls, what)) {+    if (where == ls->linenumber)+      error_expected(ls, what);+    else {+      luaX_syntaxerror(ls, luaO_pushfstring(ls->L,+             LUA_QS " expected (to close " LUA_QS " at line %d)",+              luaX_token2str(ls, what), luaX_token2str(ls, who), where));+    }+  }+}+++static TString *str_checkname (LexState *ls) {+  TString *ts;+  check(ls, TK_NAME);+  ts = ls->t.seminfo.ts;+  luaX_next(ls);+  return ts;+}+++static void init_exp (expdesc *e, expkind k, int i) {+  e->f = e->t = NO_JUMP;+  e->k = k;+  e->u.s.info = i;+}+++static void codestring (LexState *ls, expdesc *e, TString *s) {+  init_exp(e, VK, luaK_stringK(ls->fs, s));+}+++static void checkname(LexState *ls, expdesc *e) {+  codestring(ls, e, str_checkname(ls));+}+++static int registerlocalvar (LexState *ls, TString *varname) {+  FuncState *fs = ls->fs;+  Proto *f = fs->f;+  int oldsize = f->sizelocvars;+  luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars,+                  LocVar, SHRT_MAX, "too many local variables");+  while (oldsize < f->sizelocvars) f->locvars[oldsize++].varname = NULL;+  f->locvars[fs->nlocvars].varname = varname;+  luaC_objbarrier(ls->L, f, varname);+  return fs->nlocvars++;+}+++#define new_localvarliteral(ls,v,n) \+  new_localvar(ls, luaX_newstring(ls, "" v, (sizeof(v)/sizeof(char))-1), n)+++static void new_localvar (LexState *ls, TString *name, int n) {+  FuncState *fs = ls->fs;+  luaY_checklimit(fs, fs->nactvar+n+1, LUAI_MAXVARS, "local variables");+  fs->actvar[fs->nactvar+n] = cast(unsigned short, registerlocalvar(ls, name));+}+++static void adjustlocalvars (LexState *ls, int nvars) {+  FuncState *fs = ls->fs;+  fs->nactvar = cast_byte(fs->nactvar + nvars);+  for (; nvars; nvars--) {+    getlocvar(fs, fs->nactvar - nvars).startpc = fs->pc;+  }+}+++static void removevars (LexState *ls, int tolevel) {+  FuncState *fs = ls->fs;+  while (fs->nactvar > tolevel)+    getlocvar(fs, --fs->nactvar).endpc = fs->pc;+}+++static int indexupvalue (FuncState *fs, TString *name, expdesc *v) {+  int i;+  Proto *f = fs->f;+  int oldsize = f->sizeupvalues;+  for (i=0; i<f->nups; i++) {+    if (fs->upvalues[i].k == v->k && fs->upvalues[i].info == v->u.s.info) {+      lua_assert(f->upvalues[i] == name);+      return i;+    }+  }+  /* new one */+  luaY_checklimit(fs, f->nups + 1, LUAI_MAXUPVALUES, "upvalues");+  luaM_growvector(fs->L, f->upvalues, f->nups, f->sizeupvalues,+                  TString *, MAX_INT, "");+  while (oldsize < f->sizeupvalues) f->upvalues[oldsize++] = NULL;+  f->upvalues[f->nups] = name;+  luaC_objbarrier(fs->L, f, name);+  lua_assert(v->k == VLOCAL || v->k == VUPVAL);+  fs->upvalues[f->nups].k = cast_byte(v->k);+  fs->upvalues[f->nups].info = cast_byte(v->u.s.info);+  return f->nups++;+}+++static int searchvar (FuncState *fs, TString *n) {+  int i;+  for (i=fs->nactvar-1; i >= 0; i--) {+    if (n == getlocvar(fs, i).varname)+      return i;+  }+  return -1;  /* not found */+}+++static void markupval (FuncState *fs, int level) {+  BlockCnt *bl = fs->bl;+  while (bl && bl->nactvar > level) bl = bl->previous;+  if (bl) bl->upval = 1;+}+++static int singlevaraux (FuncState *fs, TString *n, expdesc *var, int base) {+  if (fs == NULL) {  /* no more levels? */+    init_exp(var, VGLOBAL, NO_REG);  /* default is global variable */+    return VGLOBAL;+  }+  else {+    int v = searchvar(fs, n);  /* look up at current level */+    if (v >= 0) {+      init_exp(var, VLOCAL, v);+      if (!base)+        markupval(fs, v);  /* local will be used as an upval */+      return VLOCAL;+    }+    else {  /* not found at current level; try upper one */+      if (singlevaraux(fs->prev, n, var, 0) == VGLOBAL)+        return VGLOBAL;+      var->u.s.info = indexupvalue(fs, n, var);  /* else was LOCAL or UPVAL */+      var->k = VUPVAL;  /* upvalue in this level */+      return VUPVAL;+    }+  }+}+++static void singlevar (LexState *ls, expdesc *var) {+  TString *varname = str_checkname(ls);+  FuncState *fs = ls->fs;+  if (singlevaraux(fs, varname, var, 1) == VGLOBAL)+    var->u.s.info = luaK_stringK(fs, varname);  /* info points to global name */+}+++static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) {+  FuncState *fs = ls->fs;+  int extra = nvars - nexps;+  if (hasmultret(e->k)) {+    extra++;  /* includes call itself */+    if (extra < 0) extra = 0;+    luaK_setreturns(fs, e, extra);  /* last exp. provides the difference */+    if (extra > 1) luaK_reserveregs(fs, extra-1);+  }+  else {+    if (e->k != VVOID) luaK_exp2nextreg(fs, e);  /* close last expression */+    if (extra > 0) {+      int reg = fs->freereg;+      luaK_reserveregs(fs, extra);+      luaK_nil(fs, reg, extra);+    }+  }+}+++static void enterlevel (LexState *ls) {+  if (++ls->L->nCcalls > LUAI_MAXCCALLS)+	luaX_lexerror(ls, "chunk has too many syntax levels", 0);+}+++#define leavelevel(ls)	((ls)->L->nCcalls--)+++static void enterblock (FuncState *fs, BlockCnt *bl, lu_byte isbreakable) {+  bl->breaklist = NO_JUMP;+  bl->isbreakable = isbreakable;+  bl->nactvar = fs->nactvar;+  bl->upval = 0;+  bl->previous = fs->bl;+  fs->bl = bl;+  lua_assert(fs->freereg == fs->nactvar);+}+++static void leaveblock (FuncState *fs) {+  BlockCnt *bl = fs->bl;+  fs->bl = bl->previous;+  removevars(fs->ls, bl->nactvar);+  if (bl->upval)+    luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0);+  /* a block either controls scope or breaks (never both) */+  lua_assert(!bl->isbreakable || !bl->upval);+  lua_assert(bl->nactvar == fs->nactvar);+  fs->freereg = fs->nactvar;  /* free registers */+  luaK_patchtohere(fs, bl->breaklist);+}+++static void pushclosure (LexState *ls, FuncState *func, expdesc *v) {+  FuncState *fs = ls->fs;+  Proto *f = fs->f;+  int oldsize = f->sizep;+  int i;+  luaM_growvector(ls->L, f->p, fs->np, f->sizep, Proto *,+                  MAXARG_Bx, "constant table overflow");+  while (oldsize < f->sizep) f->p[oldsize++] = NULL;+  f->p[fs->np++] = func->f;+  luaC_objbarrier(ls->L, f, func->f);+  init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np-1));+  for (i=0; i<func->f->nups; i++) {+    OpCode o = (func->upvalues[i].k == VLOCAL) ? OP_MOVE : OP_GETUPVAL;+    luaK_codeABC(fs, o, 0, func->upvalues[i].info, 0);+  }+}+++static void open_func (LexState *ls, FuncState *fs) {+  lua_State *L = ls->L;+  Proto *f = luaF_newproto(L);+  fs->f = f;+  fs->prev = ls->fs;  /* linked list of funcstates */+  fs->ls = ls;+  fs->L = L;+  ls->fs = fs;+  fs->pc = 0;+  fs->lasttarget = -1;+  fs->jpc = NO_JUMP;+  fs->freereg = 0;+  fs->nk = 0;+  fs->np = 0;+  fs->nlocvars = 0;+  fs->nactvar = 0;+  fs->bl = NULL;+  f->source = ls->source;+  f->maxstacksize = 2;  /* registers 0/1 are always valid */+  fs->h = luaH_new(L, 0, 0);+  /* anchor table of constants and prototype (to avoid being collected) */+  sethvalue2s(L, L->top, fs->h);+  incr_top(L);+  setptvalue2s(L, L->top, f);+  incr_top(L);+}+++static void close_func (LexState *ls) {+  lua_State *L = ls->L;+  FuncState *fs = ls->fs;+  Proto *f = fs->f;+  removevars(ls, 0);+  luaK_ret(fs, 0, 0);  /* final return */+  luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction);+  f->sizecode = fs->pc;+  luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int);+  f->sizelineinfo = fs->pc;+  luaM_reallocvector(L, f->k, f->sizek, fs->nk, TValue);+  f->sizek = fs->nk;+  luaM_reallocvector(L, f->p, f->sizep, fs->np, Proto *);+  f->sizep = fs->np;+  luaM_reallocvector(L, f->locvars, f->sizelocvars, fs->nlocvars, LocVar);+  f->sizelocvars = fs->nlocvars;+  luaM_reallocvector(L, f->upvalues, f->sizeupvalues, f->nups, TString *);+  f->sizeupvalues = f->nups;+  lua_assert(luaG_checkcode(f));+  lua_assert(fs->bl == NULL);+  ls->fs = fs->prev;+  L->top -= 2;  /* remove table and prototype from the stack */+  /* last token read was anchored in defunct function; must reanchor it */+  if (fs) anchor_token(ls);+}+++Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, const char *name) {+  struct LexState lexstate;+  struct FuncState funcstate;+  lexstate.buff = buff;+  luaX_setinput(L, &lexstate, z, luaS_new(L, name));+  open_func(&lexstate, &funcstate);+  funcstate.f->is_vararg = VARARG_ISVARARG;  /* main func. is always vararg */+  luaX_next(&lexstate);  /* read first token */+  chunk(&lexstate);+  check(&lexstate, TK_EOS);+  close_func(&lexstate);+  lua_assert(funcstate.prev == NULL);+  lua_assert(funcstate.f->nups == 0);+  lua_assert(lexstate.fs == NULL);+  return funcstate.f;+}++++/*============================================================*/+/* GRAMMAR RULES */+/*============================================================*/+++static void field (LexState *ls, expdesc *v) {+  /* field -> ['.' | ':'] NAME */+  FuncState *fs = ls->fs;+  expdesc key;+  luaK_exp2anyreg(fs, v);+  luaX_next(ls);  /* skip the dot or colon */+  checkname(ls, &key);+  luaK_indexed(fs, v, &key);+}+++static void yindex (LexState *ls, expdesc *v) {+  /* index -> '[' expr ']' */+  luaX_next(ls);  /* skip the '[' */+  expr(ls, v);+  luaK_exp2val(ls->fs, v);+  checknext(ls, ']');+}+++/*+** {======================================================================+** Rules for Constructors+** =======================================================================+*/+++struct ConsControl {+  expdesc v;  /* last list item read */+  expdesc *t;  /* table descriptor */+  int nh;  /* total number of `record' elements */+  int na;  /* total number of array elements */+  int tostore;  /* number of array elements pending to be stored */+};+++static void recfield (LexState *ls, struct ConsControl *cc) {+  /* recfield -> (NAME | `['exp1`]') = exp1 */+  FuncState *fs = ls->fs;+  int reg = ls->fs->freereg;+  expdesc key, val;+  int rkkey;+  if (ls->t.token == TK_NAME) {+    luaY_checklimit(fs, cc->nh, MAX_INT, "items in a constructor");+    checkname(ls, &key);+  }+  else  /* ls->t.token == '[' */+    yindex(ls, &key);+  cc->nh++;+  checknext(ls, '=');+  rkkey = luaK_exp2RK(fs, &key);+  expr(ls, &val);+  luaK_codeABC(fs, OP_SETTABLE, cc->t->u.s.info, rkkey, luaK_exp2RK(fs, &val));+  fs->freereg = reg;  /* free registers */+}+++static void closelistfield (FuncState *fs, struct ConsControl *cc) {+  if (cc->v.k == VVOID) return;  /* there is no list item */+  luaK_exp2nextreg(fs, &cc->v);+  cc->v.k = VVOID;+  if (cc->tostore == LFIELDS_PER_FLUSH) {+    luaK_setlist(fs, cc->t->u.s.info, cc->na, cc->tostore);  /* flush */+    cc->tostore = 0;  /* no more items pending */+  }+}+++static void lastlistfield (FuncState *fs, struct ConsControl *cc) {+  if (cc->tostore == 0) return;+  if (hasmultret(cc->v.k)) {+    luaK_setmultret(fs, &cc->v);+    luaK_setlist(fs, cc->t->u.s.info, cc->na, LUA_MULTRET);+    cc->na--;  /* do not count last expression (unknown number of elements) */+  }+  else {+    if (cc->v.k != VVOID)+      luaK_exp2nextreg(fs, &cc->v);+    luaK_setlist(fs, cc->t->u.s.info, cc->na, cc->tostore);+  }+}+++static void listfield (LexState *ls, struct ConsControl *cc) {+  expr(ls, &cc->v);+  luaY_checklimit(ls->fs, cc->na, MAX_INT, "items in a constructor");+  cc->na++;+  cc->tostore++;+}+++static void constructor (LexState *ls, expdesc *t) {+  /* constructor -> ?? */+  FuncState *fs = ls->fs;+  int line = ls->linenumber;+  int pc = luaK_codeABC(fs, OP_NEWTABLE, 0, 0, 0);+  struct ConsControl cc;+  cc.na = cc.nh = cc.tostore = 0;+  cc.t = t;+  init_exp(t, VRELOCABLE, pc);+  init_exp(&cc.v, VVOID, 0);  /* no value (yet) */+  luaK_exp2nextreg(ls->fs, t);  /* fix it at stack top (for gc) */+  checknext(ls, '{');+  do {+    lua_assert(cc.v.k == VVOID || cc.tostore > 0);+    if (ls->t.token == '}') break;+    closelistfield(fs, &cc);+    switch(ls->t.token) {+      case TK_NAME: {  /* may be listfields or recfields */+        luaX_lookahead(ls);+        if (ls->lookahead.token != '=')  /* expression? */+          listfield(ls, &cc);+        else+          recfield(ls, &cc);+        break;+      }+      case '[': {  /* constructor_item -> recfield */+        recfield(ls, &cc);+        break;+      }+      default: {  /* constructor_part -> listfield */+        listfield(ls, &cc);+        break;+      }+    }+  } while (testnext(ls, ',') || testnext(ls, ';'));+  check_match(ls, '}', '{', line);+  lastlistfield(fs, &cc);+  SETARG_B(fs->f->code[pc], luaO_int2fb(cc.na)); /* set initial array size */+  SETARG_C(fs->f->code[pc], luaO_int2fb(cc.nh));  /* set initial table size */+}++/* }====================================================================== */++++static void parlist (LexState *ls) {+  /* parlist -> [ param { `,' param } ] */+  FuncState *fs = ls->fs;+  Proto *f = fs->f;+  int nparams = 0;+  f->is_vararg = 0;+  if (ls->t.token != ')') {  /* is `parlist' not empty? */+    do {+      switch (ls->t.token) {+        case TK_NAME: {  /* param -> NAME */+          new_localvar(ls, str_checkname(ls), nparams++);+          break;+        }+        case TK_DOTS: {  /* param -> `...' */+          luaX_next(ls);+#if defined(LUA_COMPAT_VARARG)+          /* use `arg' as default name */+          new_localvarliteral(ls, "arg", nparams++);+          f->is_vararg = VARARG_HASARG | VARARG_NEEDSARG;+#endif+          f->is_vararg |= VARARG_ISVARARG;+          break;+        }+        default: luaX_syntaxerror(ls, "<name> or " LUA_QL("...") " expected");+      }+    } while (!f->is_vararg && testnext(ls, ','));+  }+  adjustlocalvars(ls, nparams);+  f->numparams = cast_byte(fs->nactvar - (f->is_vararg & VARARG_HASARG));+  luaK_reserveregs(fs, fs->nactvar);  /* reserve register for parameters */+}+++static void body (LexState *ls, expdesc *e, int needself, int line) {+  /* body ->  `(' parlist `)' chunk END */+  FuncState new_fs;+  open_func(ls, &new_fs);+  new_fs.f->linedefined = line;+  checknext(ls, '(');+  if (needself) {+    new_localvarliteral(ls, "self", 0);+    adjustlocalvars(ls, 1);+  }+  parlist(ls);+  checknext(ls, ')');+  chunk(ls);+  new_fs.f->lastlinedefined = ls->linenumber;+  check_match(ls, TK_END, TK_FUNCTION, line);+  close_func(ls);+  pushclosure(ls, &new_fs, e);+}+++static int explist1 (LexState *ls, expdesc *v) {+  /* explist1 -> expr { `,' expr } */+  int n = 1;  /* at least one expression */+  expr(ls, v);+  while (testnext(ls, ',')) {+    luaK_exp2nextreg(ls->fs, v);+    expr(ls, v);+    n++;+  }+  return n;+}+++static void funcargs (LexState *ls, expdesc *f) {+  FuncState *fs = ls->fs;+  expdesc args;+  int base, nparams;+  int line = ls->linenumber;+  switch (ls->t.token) {+    case '(': {  /* funcargs -> `(' [ explist1 ] `)' */+      if (line != ls->lastline)+        luaX_syntaxerror(ls,"ambiguous syntax (function call x new statement)");+      luaX_next(ls);+      if (ls->t.token == ')')  /* arg list is empty? */+        args.k = VVOID;+      else {+        explist1(ls, &args);+        luaK_setmultret(fs, &args);+      }+      check_match(ls, ')', '(', line);+      break;+    }+    case '{': {  /* funcargs -> constructor */+      constructor(ls, &args);+      break;+    }+    case TK_STRING: {  /* funcargs -> STRING */+      codestring(ls, &args, ls->t.seminfo.ts);+      luaX_next(ls);  /* must use `seminfo' before `next' */+      break;+    }+    default: {+      luaX_syntaxerror(ls, "function arguments expected");+      return;+    }+  }+  lua_assert(f->k == VNONRELOC);+  base = f->u.s.info;  /* base register for call */+  if (hasmultret(args.k))+    nparams = LUA_MULTRET;  /* open call */+  else {+    if (args.k != VVOID)+      luaK_exp2nextreg(fs, &args);  /* close last argument */+    nparams = fs->freereg - (base+1);+  }+  init_exp(f, VCALL, luaK_codeABC(fs, OP_CALL, base, nparams+1, 2));+  luaK_fixline(fs, line);+  fs->freereg = base+1;  /* call remove function and arguments and leaves+                            (unless changed) one result */+}+++++/*+** {======================================================================+** Expression parsing+** =======================================================================+*/+++static void prefixexp (LexState *ls, expdesc *v) {+  /* prefixexp -> NAME | '(' expr ')' */+  switch (ls->t.token) {+    case '(': {+      int line = ls->linenumber;+      luaX_next(ls);+      expr(ls, v);+      check_match(ls, ')', '(', line);+      luaK_dischargevars(ls->fs, v);+      return;+    }+    case TK_NAME: {+      singlevar(ls, v);+      return;+    }+    default: {+      luaX_syntaxerror(ls, "unexpected symbol");+      return;+    }+  }+}+++static void primaryexp (LexState *ls, expdesc *v) {+  /* primaryexp ->+        prefixexp { `.' NAME | `[' exp `]' | `:' NAME funcargs | funcargs } */+  FuncState *fs = ls->fs;+  prefixexp(ls, v);+  for (;;) {+    switch (ls->t.token) {+      case '.': {  /* field */+        field(ls, v);+        break;+      }+      case '[': {  /* `[' exp1 `]' */+        expdesc key;+        luaK_exp2anyreg(fs, v);+        yindex(ls, &key);+        luaK_indexed(fs, v, &key);+        break;+      }+      case ':': {  /* `:' NAME funcargs */+        expdesc key;+        luaX_next(ls);+        checkname(ls, &key);+        luaK_self(fs, v, &key);+        funcargs(ls, v);+        break;+      }+      case '(': case TK_STRING: case '{': {  /* funcargs */+        luaK_exp2nextreg(fs, v);+        funcargs(ls, v);+        break;+      }+      default: return;+    }+  }+}+++static void simpleexp (LexState *ls, expdesc *v) {+  /* simpleexp -> NUMBER | STRING | NIL | true | false | ... |+                  constructor | FUNCTION body | primaryexp */+  switch (ls->t.token) {+    case TK_NUMBER: {+      init_exp(v, VKNUM, 0);+      v->u.nval = ls->t.seminfo.r;+      break;+    }+    case TK_STRING: {+      codestring(ls, v, ls->t.seminfo.ts);+      break;+    }+    case TK_NIL: {+      init_exp(v, VNIL, 0);+      break;+    }+    case TK_TRUE: {+      init_exp(v, VTRUE, 0);+      break;+    }+    case TK_FALSE: {+      init_exp(v, VFALSE, 0);+      break;+    }+    case TK_DOTS: {  /* vararg */+      FuncState *fs = ls->fs;+      check_condition(ls, fs->f->is_vararg,+                      "cannot use " LUA_QL("...") " outside a vararg function");+      fs->f->is_vararg &= ~VARARG_NEEDSARG;  /* don't need 'arg' */+      init_exp(v, VVARARG, luaK_codeABC(fs, OP_VARARG, 0, 1, 0));+      break;+    }+    case '{': {  /* constructor */+      constructor(ls, v);+      return;+    }+    case TK_FUNCTION: {+      luaX_next(ls);+      body(ls, v, 0, ls->linenumber);+      return;+    }+    default: {+      primaryexp(ls, v);+      return;+    }+  }+  luaX_next(ls);+}+++static UnOpr getunopr (int op) {+  switch (op) {+    case TK_NOT: return OPR_NOT;+    case '-': return OPR_MINUS;+    case '#': return OPR_LEN;+    default: return OPR_NOUNOPR;+  }+}+++static BinOpr getbinopr (int op) {+  switch (op) {+    case '+': return OPR_ADD;+    case '-': return OPR_SUB;+    case '*': return OPR_MUL;+    case '/': return OPR_DIV;+    case '%': return OPR_MOD;+    case '^': return OPR_POW;+    case TK_CONCAT: return OPR_CONCAT;+    case TK_NE: return OPR_NE;+    case TK_EQ: return OPR_EQ;+    case '<': return OPR_LT;+    case TK_LE: return OPR_LE;+    case '>': return OPR_GT;+    case TK_GE: return OPR_GE;+    case TK_AND: return OPR_AND;+    case TK_OR: return OPR_OR;+    default: return OPR_NOBINOPR;+  }+}+++static const struct {+  lu_byte left;  /* left priority for each binary operator */+  lu_byte right; /* right priority */+} priority[] = {  /* ORDER OPR */+   {6, 6}, {6, 6}, {7, 7}, {7, 7}, {7, 7},  /* `+' `-' `/' `%' */+   {10, 9}, {5, 4},                 /* power and concat (right associative) */+   {3, 3}, {3, 3},                  /* equality and inequality */+   {3, 3}, {3, 3}, {3, 3}, {3, 3},  /* order */+   {2, 2}, {1, 1}                   /* logical (and/or) */+};++#define UNARY_PRIORITY	8  /* priority for unary operators */+++/*+** subexpr -> (simpleexp | unop subexpr) { binop subexpr }+** where `binop' is any binary operator with a priority higher than `limit'+*/+static BinOpr subexpr (LexState *ls, expdesc *v, unsigned int limit) {+  BinOpr op;+  UnOpr uop;+  enterlevel(ls);+  uop = getunopr(ls->t.token);+  if (uop != OPR_NOUNOPR) {+    luaX_next(ls);+    subexpr(ls, v, UNARY_PRIORITY);+    luaK_prefix(ls->fs, uop, v);+  }+  else simpleexp(ls, v);+  /* expand while operators have priorities higher than `limit' */+  op = getbinopr(ls->t.token);+  while (op != OPR_NOBINOPR && priority[op].left > limit) {+    expdesc v2;+    BinOpr nextop;+    luaX_next(ls);+    luaK_infix(ls->fs, op, v);+    /* read sub-expression with higher priority */+    nextop = subexpr(ls, &v2, priority[op].right);+    luaK_posfix(ls->fs, op, v, &v2);+    op = nextop;+  }+  leavelevel(ls);+  return op;  /* return first untreated operator */+}+++static void expr (LexState *ls, expdesc *v) {+  subexpr(ls, v, 0);+}++/* }==================================================================== */++++/*+** {======================================================================+** Rules for Statements+** =======================================================================+*/+++static int block_follow (int token) {+  switch (token) {+    case TK_ELSE: case TK_ELSEIF: case TK_END:+    case TK_UNTIL: case TK_EOS:+      return 1;+    default: return 0;+  }+}+++static void block (LexState *ls) {+  /* block -> chunk */+  FuncState *fs = ls->fs;+  BlockCnt bl;+  enterblock(fs, &bl, 0);+  chunk(ls);+  lua_assert(bl.breaklist == NO_JUMP);+  leaveblock(fs);+}+++/*+** structure to chain all variables in the left-hand side of an+** assignment+*/+struct LHS_assign {+  struct LHS_assign *prev;+  expdesc v;  /* variable (global, local, upvalue, or indexed) */+};+++/*+** check whether, in an assignment to a local variable, the local variable+** is needed in a previous assignment (to a table). If so, save original+** local value in a safe place and use this safe copy in the previous+** assignment.+*/+static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) {+  FuncState *fs = ls->fs;+  int extra = fs->freereg;  /* eventual position to save local variable */+  int conflict = 0;+  for (; lh; lh = lh->prev) {+    if (lh->v.k == VINDEXED) {+      if (lh->v.u.s.info == v->u.s.info) {  /* conflict? */+        conflict = 1;+        lh->v.u.s.info = extra;  /* previous assignment will use safe copy */+      }+      if (lh->v.u.s.aux == v->u.s.info) {  /* conflict? */+        conflict = 1;+        lh->v.u.s.aux = extra;  /* previous assignment will use safe copy */+      }+    }+  }+  if (conflict) {+    luaK_codeABC(fs, OP_MOVE, fs->freereg, v->u.s.info, 0);  /* make copy */+    luaK_reserveregs(fs, 1);+  }+}+++static void assignment (LexState *ls, struct LHS_assign *lh, int nvars) {+  expdesc e;+  check_condition(ls, VLOCAL <= lh->v.k && lh->v.k <= VINDEXED,+                      "syntax error");+  if (testnext(ls, ',')) {  /* assignment -> `,' primaryexp assignment */+    struct LHS_assign nv;+    nv.prev = lh;+    primaryexp(ls, &nv.v);+    if (nv.v.k == VLOCAL)+      check_conflict(ls, lh, &nv.v);+    assignment(ls, &nv, nvars+1);+  }+  else {  /* assignment -> `=' explist1 */+    int nexps;+    checknext(ls, '=');+    nexps = explist1(ls, &e);+    if (nexps != nvars) {+      adjust_assign(ls, nvars, nexps, &e);+      if (nexps > nvars)+        ls->fs->freereg -= nexps - nvars;  /* remove extra values */+    }+    else {+      luaK_setoneret(ls->fs, &e);  /* close last expression */+      luaK_storevar(ls->fs, &lh->v, &e);+      return;  /* avoid default */+    }+  }+  init_exp(&e, VNONRELOC, ls->fs->freereg-1);  /* default assignment */+  luaK_storevar(ls->fs, &lh->v, &e);+}+++static int cond (LexState *ls) {+  /* cond -> exp */+  expdesc v;+  expr(ls, &v);  /* read condition */+  if (v.k == VNIL) v.k = VFALSE;  /* `falses' are all equal here */+  luaK_goiftrue(ls->fs, &v);+  return v.f;+}+++static void breakstat (LexState *ls) {+  FuncState *fs = ls->fs;+  BlockCnt *bl = fs->bl;+  int upval = 0;+  while (bl && !bl->isbreakable) {+    upval |= bl->upval;+    bl = bl->previous;+  }+  if (!bl)+    luaX_syntaxerror(ls, "no loop to break");+  if (upval)+    luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0);+  luaK_concat(fs, &bl->breaklist, luaK_jump(fs));+}+++static void whilestat (LexState *ls, int line) {+  /* whilestat -> WHILE cond DO block END */+  FuncState *fs = ls->fs;+  int whileinit;+  int condexit;+  BlockCnt bl;+  luaX_next(ls);  /* skip WHILE */+  whileinit = luaK_getlabel(fs);+  condexit = cond(ls);+  enterblock(fs, &bl, 1);+  checknext(ls, TK_DO);+  block(ls);+  luaK_patchlist(fs, luaK_jump(fs), whileinit);+  check_match(ls, TK_END, TK_WHILE, line);+  leaveblock(fs);+  luaK_patchtohere(fs, condexit);  /* false conditions finish the loop */+}+++static void repeatstat (LexState *ls, int line) {+  /* repeatstat -> REPEAT block UNTIL cond */+  int condexit;+  FuncState *fs = ls->fs;+  int repeat_init = luaK_getlabel(fs);+  BlockCnt bl1, bl2;+  enterblock(fs, &bl1, 1);  /* loop block */+  enterblock(fs, &bl2, 0);  /* scope block */+  luaX_next(ls);  /* skip REPEAT */+  chunk(ls);+  check_match(ls, TK_UNTIL, TK_REPEAT, line);+  condexit = cond(ls);  /* read condition (inside scope block) */+  if (!bl2.upval) {  /* no upvalues? */+    leaveblock(fs);  /* finish scope */+    luaK_patchlist(ls->fs, condexit, repeat_init);  /* close the loop */+  }+  else {  /* complete semantics when there are upvalues */+    breakstat(ls);  /* if condition then break */+    luaK_patchtohere(ls->fs, condexit);  /* else... */+    leaveblock(fs);  /* finish scope... */+    luaK_patchlist(ls->fs, luaK_jump(fs), repeat_init);  /* and repeat */+  }+  leaveblock(fs);  /* finish loop */+}+++static int exp1 (LexState *ls) {+  expdesc e;+  int k;+  expr(ls, &e);+  k = e.k;+  luaK_exp2nextreg(ls->fs, &e);+  return k;+}+++static void forbody (LexState *ls, int base, int line, int nvars, int isnum) {+  /* forbody -> DO block */+  BlockCnt bl;+  FuncState *fs = ls->fs;+  int prep, endfor;+  adjustlocalvars(ls, 3);  /* control variables */+  checknext(ls, TK_DO);+  prep = isnum ? luaK_codeAsBx(fs, OP_FORPREP, base, NO_JUMP) : luaK_jump(fs);+  enterblock(fs, &bl, 0);  /* scope for declared variables */+  adjustlocalvars(ls, nvars);+  luaK_reserveregs(fs, nvars);+  block(ls);+  leaveblock(fs);  /* end of scope for declared variables */+  luaK_patchtohere(fs, prep);+  endfor = (isnum) ? luaK_codeAsBx(fs, OP_FORLOOP, base, NO_JUMP) :+                     luaK_codeABC(fs, OP_TFORLOOP, base, 0, nvars);+  luaK_fixline(fs, line);  /* pretend that `OP_FOR' starts the loop */+  luaK_patchlist(fs, (isnum ? endfor : luaK_jump(fs)), prep + 1);+}+++static void fornum (LexState *ls, TString *varname, int line) {+  /* fornum -> NAME = exp1,exp1[,exp1] forbody */+  FuncState *fs = ls->fs;+  int base = fs->freereg;+  new_localvarliteral(ls, "(for index)", 0);+  new_localvarliteral(ls, "(for limit)", 1);+  new_localvarliteral(ls, "(for step)", 2);+  new_localvar(ls, varname, 3);+  checknext(ls, '=');+  exp1(ls);  /* initial value */+  checknext(ls, ',');+  exp1(ls);  /* limit */+  if (testnext(ls, ','))+    exp1(ls);  /* optional step */+  else {  /* default step = 1 */+    luaK_codeABx(fs, OP_LOADK, fs->freereg, luaK_numberK(fs, 1));+    luaK_reserveregs(fs, 1);+  }+  forbody(ls, base, line, 1, 1);+}+++static void forlist (LexState *ls, TString *indexname) {+  /* forlist -> NAME {,NAME} IN explist1 forbody */+  FuncState *fs = ls->fs;+  expdesc e;+  int nvars = 0;+  int line;+  int base = fs->freereg;+  /* create control variables */+  new_localvarliteral(ls, "(for generator)", nvars++);+  new_localvarliteral(ls, "(for state)", nvars++);+  new_localvarliteral(ls, "(for control)", nvars++);+  /* create declared variables */+  new_localvar(ls, indexname, nvars++);+  while (testnext(ls, ','))+    new_localvar(ls, str_checkname(ls), nvars++);+  checknext(ls, TK_IN);+  line = ls->linenumber;+  adjust_assign(ls, 3, explist1(ls, &e), &e);+  luaK_checkstack(fs, 3);  /* extra space to call generator */+  forbody(ls, base, line, nvars - 3, 0);+}+++static void forstat (LexState *ls, int line) {+  /* forstat -> FOR (fornum | forlist) END */+  FuncState *fs = ls->fs;+  TString *varname;+  BlockCnt bl;+  enterblock(fs, &bl, 1);  /* scope for loop and control variables */+  luaX_next(ls);  /* skip `for' */+  varname = str_checkname(ls);  /* first variable name */+  switch (ls->t.token) {+    case '=': fornum(ls, varname, line); break;+    case ',': case TK_IN: forlist(ls, varname); break;+    default: luaX_syntaxerror(ls, LUA_QL("=") " or " LUA_QL("in") " expected");+  }+  check_match(ls, TK_END, TK_FOR, line);+  leaveblock(fs);  /* loop scope (`break' jumps to this point) */+}+++static int test_then_block (LexState *ls) {+  /* test_then_block -> [IF | ELSEIF] cond THEN block */+  int condexit;+  luaX_next(ls);  /* skip IF or ELSEIF */+  condexit = cond(ls);+  checknext(ls, TK_THEN);+  block(ls);  /* `then' part */+  return condexit;+}+++static void ifstat (LexState *ls, int line) {+  /* ifstat -> IF cond THEN block {ELSEIF cond THEN block} [ELSE block] END */+  FuncState *fs = ls->fs;+  int flist;+  int escapelist = NO_JUMP;+  flist = test_then_block(ls);  /* IF cond THEN block */+  while (ls->t.token == TK_ELSEIF) {+    luaK_concat(fs, &escapelist, luaK_jump(fs));+    luaK_patchtohere(fs, flist);+    flist = test_then_block(ls);  /* ELSEIF cond THEN block */+  }+  if (ls->t.token == TK_ELSE) {+    luaK_concat(fs, &escapelist, luaK_jump(fs));+    luaK_patchtohere(fs, flist);+    luaX_next(ls);  /* skip ELSE (after patch, for correct line info) */+    block(ls);  /* `else' part */+  }+  else+    luaK_concat(fs, &escapelist, flist);+  luaK_patchtohere(fs, escapelist);+  check_match(ls, TK_END, TK_IF, line);+}+++static void localfunc (LexState *ls) {+  expdesc v, b;+  FuncState *fs = ls->fs;+  new_localvar(ls, str_checkname(ls), 0);+  init_exp(&v, VLOCAL, fs->freereg);+  luaK_reserveregs(fs, 1);+  adjustlocalvars(ls, 1);+  body(ls, &b, 0, ls->linenumber);+  luaK_storevar(fs, &v, &b);+  /* debug information will only see the variable after this point! */+  getlocvar(fs, fs->nactvar - 1).startpc = fs->pc;+}+++static void localstat (LexState *ls) {+  /* stat -> LOCAL NAME {`,' NAME} [`=' explist1] */+  int nvars = 0;+  int nexps;+  expdesc e;+  do {+    new_localvar(ls, str_checkname(ls), nvars++);+  } while (testnext(ls, ','));+  if (testnext(ls, '='))+    nexps = explist1(ls, &e);+  else {+    e.k = VVOID;+    nexps = 0;+  }+  adjust_assign(ls, nvars, nexps, &e);+  adjustlocalvars(ls, nvars);+}+++static int funcname (LexState *ls, expdesc *v) {+  /* funcname -> NAME {field} [`:' NAME] */+  int needself = 0;+  singlevar(ls, v);+  while (ls->t.token == '.')+    field(ls, v);+  if (ls->t.token == ':') {+    needself = 1;+    field(ls, v);+  }+  return needself;+}+++static void funcstat (LexState *ls, int line) {+  /* funcstat -> FUNCTION funcname body */+  int needself;+  expdesc v, b;+  luaX_next(ls);  /* skip FUNCTION */+  needself = funcname(ls, &v);+  body(ls, &b, needself, line);+  luaK_storevar(ls->fs, &v, &b);+  luaK_fixline(ls->fs, line);  /* definition `happens' in the first line */+}+++static void exprstat (LexState *ls) {+  /* stat -> func | assignment */+  FuncState *fs = ls->fs;+  struct LHS_assign v;+  primaryexp(ls, &v.v);+  if (v.v.k == VCALL)  /* stat -> func */+    SETARG_C(getcode(fs, &v.v), 1);  /* call statement uses no results */+  else {  /* stat -> assignment */+    v.prev = NULL;+    assignment(ls, &v, 1);+  }+}+++static void retstat (LexState *ls) {+  /* stat -> RETURN explist */+  FuncState *fs = ls->fs;+  expdesc e;+  int first, nret;  /* registers with returned values */+  luaX_next(ls);  /* skip RETURN */+  if (block_follow(ls->t.token) || ls->t.token == ';')+    first = nret = 0;  /* return no values */+  else {+    nret = explist1(ls, &e);  /* optional return values */+    if (hasmultret(e.k)) {+      luaK_setmultret(fs, &e);+      if (e.k == VCALL && nret == 1) {  /* tail call? */+        SET_OPCODE(getcode(fs,&e), OP_TAILCALL);+        lua_assert(GETARG_A(getcode(fs,&e)) == fs->nactvar);+      }+      first = fs->nactvar;+      nret = LUA_MULTRET;  /* return all values */+    }+    else {+      if (nret == 1)  /* only one single value? */+        first = luaK_exp2anyreg(fs, &e);+      else {+        luaK_exp2nextreg(fs, &e);  /* values must go to the `stack' */+        first = fs->nactvar;  /* return all `active' values */+        lua_assert(nret == fs->freereg - first);+      }+    }+  }+  luaK_ret(fs, first, nret);+}+++static int statement (LexState *ls) {+  int line = ls->linenumber;  /* may be needed for error messages */+  switch (ls->t.token) {+    case TK_IF: {  /* stat -> ifstat */+      ifstat(ls, line);+      return 0;+    }+    case TK_WHILE: {  /* stat -> whilestat */+      whilestat(ls, line);+      return 0;+    }+    case TK_DO: {  /* stat -> DO block END */+      luaX_next(ls);  /* skip DO */+      block(ls);+      check_match(ls, TK_END, TK_DO, line);+      return 0;+    }+    case TK_FOR: {  /* stat -> forstat */+      forstat(ls, line);+      return 0;+    }+    case TK_REPEAT: {  /* stat -> repeatstat */+      repeatstat(ls, line);+      return 0;+    }+    case TK_FUNCTION: {+      funcstat(ls, line);  /* stat -> funcstat */+      return 0;+    }+    case TK_LOCAL: {  /* stat -> localstat */+      luaX_next(ls);  /* skip LOCAL */+      if (testnext(ls, TK_FUNCTION))  /* local function? */+        localfunc(ls);+      else+        localstat(ls);+      return 0;+    }+    case TK_RETURN: {  /* stat -> retstat */+      retstat(ls);+      return 1;  /* must be last statement */+    }+    case TK_BREAK: {  /* stat -> breakstat */+      luaX_next(ls);  /* skip BREAK */+      breakstat(ls);+      return 1;  /* must be last statement */+    }+    default: {+      exprstat(ls);+      return 0;  /* to avoid warnings */+    }+  }+}+++static void chunk (LexState *ls) {+  /* chunk -> { stat [`;'] } */+  int islast = 0;+  enterlevel(ls);+  while (!islast && !block_follow(ls->t.token)) {+    islast = statement(ls);+    testnext(ls, ';');+    lua_assert(ls->fs->f->maxstacksize >= ls->fs->freereg &&+               ls->fs->freereg >= ls->fs->nactvar);+    ls->fs->freereg = ls->fs->nactvar;  /* free registers */+  }+  leavelevel(ls);+}++/* }====================================================================== */
+ src/lparser.h view
@@ -0,0 +1,82 @@+/*+** $Id: lparser.h,v 1.57 2006/03/09 18:14:31 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
+ src/lstate.c view
@@ -0,0 +1,214 @@+/*+** $Id: lstate.c,v 2.36 2006/05/24 14:15:50 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 = 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 = 0;+  } while (luaD_rawrunprotected(L, callallgcTM, NULL) != 0);+  lua_assert(G(L)->tmudata == NULL);+  luai_userstateclose(L);+  close_state(L);+}+
+ src/lstate.h view
@@ -0,0 +1,168 @@+/*+** $Id: lstate.h,v 2.24 2006/02/06 18:27:59 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 */+  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+
+ src/lstring.c view
@@ -0,0 +1,111 @@+/*+** $Id: lstring.c,v 2.8 2005/12/22 16:19:56 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;+}+
+ src/lstring.h view
@@ -0,0 +1,31 @@+/*+** $Id: lstring.h,v 1.43 2005/04/25 19:24:10 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
+ src/lstrlib.c view
@@ -0,0 +1,868 @@+/*+** $Id: lstrlib.c,v 1.132a 2006/04/26 20:41: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 */+  return (pos>=0) ? pos : (ptrdiff_t)len+pos+1;+}+++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;+    }+    default: {+      luaL_argerror(L, 3, "string/function/table expected"); +      return;+    }+  }+  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 max_s = luaL_optint(L, 4, srcl+1);+  int anchor = (*p == '^') ? (p++, 1) : 0;+  int n = 0;+  MatchState ms;+  luaL_Buffer b;+  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 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 */+      arg++;+      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;+}+
+ src/ltable.c view
@@ -0,0 +1,588 @@+/*+** $Id: ltable.c,v 2.32 2006/01/18 11:49:02 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;+  n += 1;  /* normalize number (avoid -0) */+  lua_assert(sizeof(a) <= sizeof(n));+  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
+ src/ltable.h view
@@ -0,0 +1,40 @@+/*+** $Id: ltable.h,v 2.10 2006/01/10 13:13:06 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
+ src/ltablib.c view
@@ -0,0 +1,278 @@+/*+** $Id: ltablib.c,v 1.38 2005/10/23 17:38:15 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 (e == 0) return 0;  /* table is `empty' */+  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 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++) {+    lua_rawgeti(L, 1, i);+    luaL_argcheck(L, lua_isstring(L, -1), 1, "table contains non-strings");+    luaL_addvalue(&b);+    if (i != last)+      luaL_addlstring(&b, sep, lsep);+  }+  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;+}+
+ src/ltm.c view
@@ -0,0 +1,75 @@+/*+** $Id: ltm.c,v 2.8 2006/01/10 12:50:00 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);+}+
+ src/ltm.h view
@@ -0,0 +1,54 @@+/*+** $Id: ltm.h,v 2.6 2005/06/06 13:30: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
+ src/lua.c view
@@ -0,0 +1,390 @@+/*+** $Id: lua.c,v 1.160 2006/06/02 15:34:00 roberto Exp $+** Lua stand-alone interpreter+** See Copyright Notice in lua.h+*/+++#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) {+  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, lua_pcall(L, 1, 0, 0));+}+++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;+}+
+ src/lua.h view
@@ -0,0 +1,385 @@+/*+** $Id: lua.h,v 1.218a 2006/06/02 15:34:00 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.2"+#define LUA_VERSION_NUM	501+#define LUA_COPYRIGHT	"Copyright (C) 1994-2007 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++++/*+** {======================================================================+** 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-2007 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
+ src/luac.c view
@@ -0,0 +1,200 @@+/*+** $Id: luac.c,v 1.54 2006/06/02 17:37:11 lhf Exp $+** Lua compiler (saves bytecodes to files; also list bytecodes)+** See Copyright Notice in lua.h+*/++#include <errno.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>++#define luac_c+#define LUA_CORE++#include "lua.h"+#include "lauxlib.h"++#include "ldo.h"+#include "lfunc.h"+#include "lmem.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lstring.h"+#include "lundump.h"++#define PROGNAME	"luac"		/* default program name */+#define	OUTPUT		PROGNAME ".out"	/* default output file */++static int listing=0;			/* list bytecodes? */+static int dumping=1;			/* dump bytecodes? */+static int stripping=0;			/* strip debug information? */+static char Output[]={ OUTPUT };	/* default output file name */+static const char* output=Output;	/* actual output file name */+static const char* progname=PROGNAME;	/* actual program name */++static void fatal(const char* message)+{+ fprintf(stderr,"%s: %s\n",progname,message);+ exit(EXIT_FAILURE);+}++static void cannot(const char* what)+{+ fprintf(stderr,"%s: cannot %s %s: %s\n",progname,what,output,strerror(errno));+ exit(EXIT_FAILURE);+}++static void usage(const char* message)+{+ if (*message=='-')+  fprintf(stderr,"%s: unrecognized option " LUA_QS "\n",progname,message);+ else+  fprintf(stderr,"%s: %s\n",progname,message);+ fprintf(stderr,+ "usage: %s [options] [filenames].\n"+ "Available options are:\n"+ "  -        process stdin\n"+ "  -l       list\n"+ "  -o name  output to file " LUA_QL("name") " (default is \"%s\")\n"+ "  -p       parse only\n"+ "  -s       strip debug information\n"+ "  -v       show version information\n"+ "  --       stop handling options\n",+ progname,Output);+ exit(EXIT_FAILURE);+}++#define	IS(s)	(strcmp(argv[i],s)==0)++static int doargs(int argc, char* argv[])+{+ int i;+ int version=0;+ if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0];+ for (i=1; i<argc; i++)+ {+  if (*argv[i]!='-')			/* end of options; keep it */+   break;+  else if (IS("--"))			/* end of options; skip it */+  {+   ++i;+   if (version) ++version;+   break;+  }+  else if (IS("-"))			/* end of options; use stdin */+   break;+  else if (IS("-l"))			/* list */+   ++listing;+  else if (IS("-o"))			/* output file */+  {+   output=argv[++i];+   if (output==NULL || *output==0) usage(LUA_QL("-o") " needs argument");+   if (IS("-")) output=NULL;+  }+  else if (IS("-p"))			/* parse only */+   dumping=0;+  else if (IS("-s"))			/* strip debug information */+   stripping=1;+  else if (IS("-v"))			/* show version */+   ++version;+  else					/* unknown option */+   usage(argv[i]);+ }+ if (i==argc && (listing || !dumping))+ {+  dumping=0;+  argv[--i]=Output;+ }+ if (version)+ {+  printf("%s  %s\n",LUA_RELEASE,LUA_COPYRIGHT);+  if (version==argc-1) exit(EXIT_SUCCESS);+ }+ return i;+}++#define toproto(L,i) (clvalue(L->top+(i))->l.p)++static const Proto* combine(lua_State* L, int n)+{+ if (n==1)+  return toproto(L,-1);+ else+ {+  int i,pc;+  Proto* f=luaF_newproto(L);+  setptvalue2s(L,L->top,f); incr_top(L);+  f->source=luaS_newliteral(L,"=(" PROGNAME ")");+  f->maxstacksize=1;+  pc=2*n+1;+  f->code=luaM_newvector(L,pc,Instruction);+  f->sizecode=pc;+  f->p=luaM_newvector(L,n,Proto*);+  f->sizep=n;+  pc=0;+  for (i=0; i<n; i++)+  {+   f->p[i]=toproto(L,i-n-1);+   f->code[pc++]=CREATE_ABx(OP_CLOSURE,0,i);+   f->code[pc++]=CREATE_ABC(OP_CALL,0,1,1);+  }+  f->code[pc++]=CREATE_ABC(OP_RETURN,0,1,0);+  return f;+ }+}++static int writer(lua_State* L, const void* p, size_t size, void* u)+{+ UNUSED(L);+ return (fwrite(p,size,1,(FILE*)u)!=1) && (size!=0);+}++struct Smain {+ int argc;+ char** argv;+};++static int pmain(lua_State* L)+{+ struct Smain* s = (struct Smain*)lua_touserdata(L, 1);+ int argc=s->argc;+ char** argv=s->argv;+ const Proto* f;+ int i;+ if (!lua_checkstack(L,argc)) fatal("too many input files");+ for (i=0; i<argc; i++)+ {+  const char* filename=IS("-") ? NULL : argv[i];+  if (luaL_loadfile(L,filename)!=0) fatal(lua_tostring(L,-1));+ }+ f=combine(L,argc);+ if (listing) luaU_print(f,listing>1);+ if (dumping)+ {+  FILE* D= (output==NULL) ? stdout : fopen(output,"wb");+  if (D==NULL) cannot("open");+  lua_lock(L);+  luaU_dump(L,f,writer,D,stripping);+  lua_unlock(L);+  if (ferror(D)) cannot("write");+  if (fclose(D)) cannot("close");+ }+ return 0;+}++int main(int argc, char* argv[])+{+ lua_State* L;+ struct Smain s;+ int i=doargs(argc,argv);+ argc-=i; argv+=i;+ if (argc<=0) usage("no input files given");+ L=lua_open();+ if (L==NULL) fatal("not enough memory for state");+ s.argc=argc;+ s.argv=argv;+ if (lua_cpcall(L,pmain,&s)!=0) fatal(lua_tostring(L,-1));+ lua_close(L);+ return EXIT_SUCCESS;+}
+ src/luaconf.h view
@@ -0,0 +1,762 @@+/*+** $Id: luaconf.h,v 1.82a 2006/04/10 18:27:23 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.+*/+#define LUAI_MAXCSTACK	2048++++/*+** {==================================================================+** 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, 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+
+ src/lualib.h view
@@ -0,0 +1,53 @@+/*+** $Id: lualib.h,v 1.36 2005/12/27 17:12:00 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);+++/* open all previous libraries */+LUALIB_API void (luaL_openlibs) (lua_State *L); ++++#ifndef lua_assert+#define lua_assert(x)	((void)0)+#endif+++#endif
+ src/lundump.c view
@@ -0,0 +1,223 @@+/*+** $Id: lundump.c,v 1.60 2006/02/16 15:53:49 lhf 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)+#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));+	break;+   case LUA_TNUMBER:+	setnvalue(o,LoadNumber(S));+	break;+   case LUA_TSTRING:+	setsvalue2n(S->L,o,LoadString(S));+	break;+   default:+	IF (1, "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=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--;+ 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? */+}
+ src/lundump.h view
@@ -0,0 +1,36 @@+/*+** $Id: lundump.h,v 1.40 2005/11/11 14:03:13 lhf 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
+ src/lvm.c view
@@ -0,0 +1,765 @@+/*+** $Id: lvm.c,v 2.63a 2006/06/05 15:58:59 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_MASKLINE) {  /* instruction-hook set? */+    if (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;+  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);+        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;+    }+    t = tm;  /* else repeat with `tm' */ +  }+  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;+      }+    }+  }+}+
+ src/lvm.h view
@@ -0,0 +1,36 @@+/*+** $Id: lvm.h,v 2.5 2005/08/22 18:54:49 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
+ src/lzio.c view
@@ -0,0 +1,82 @@+/*+** $Id: lzio.c,v 1.31 2005/06/03 20:15:29 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;+}++
+ src/lzio.h view
@@ -0,0 +1,67 @@+/*+** $Id: lzio.h,v 1.21 2005/05/17 19:49:15 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
+ src/ntrljmp.c view
@@ -0,0 +1,25 @@+/*+** See Copyright Notice in lua.h+*/++#include <ctype.h>+#include <stdio.h>++#define luac_c+#define LUA_CORE++#include "ldebug.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lundump.h"++extern int hsmethod__call( lua_State *state );++LUAI_FUNC int lua_neutralize_longjmp( lua_State *state )+{+    int result;+    result = hsmethod__call(state);+    if( result <0 )+        return lua_error(state);+    return result;+}
+ src/ntrljmp.h view
@@ -0,0 +1,19 @@+/*+** Lua virtual machine+** See Copyright Notice in lua.h+*/++#ifndef lvm_h+#define lvm_h+++#define luac_c+#define LUA_CORE++#include "lua.h"+#include "lobject.h"+#include "ltm.h"++LUAI_FUNC int lua_neutralize_longjmp(lua_State *state);++#endif
+ src/print.c view
@@ -0,0 +1,227 @@+/*+** $Id: print.c,v 1.55a 2006/05/31 13:30:05 lhf Exp $+** print bytecodes+** See Copyright Notice in lua.h+*/++#include <ctype.h>+#include <stdio.h>++#define luac_c+#define LUA_CORE++#include "ldebug.h"+#include "lobject.h"+#include "lopcodes.h"+#include "lundump.h"++#define PrintFunction	luaU_print++#define Sizeof(x)	((int)sizeof(x))+#define VOID(p)		((const void*)(p))++static void PrintString(const TString* ts)+{+ const char* s=getstr(ts);+ size_t i,n=ts->tsv.len;+ putchar('"');+ for (i=0; i<n; i++)+ {+  int c=s[i];+  switch (c)+  {+   case '"': printf("\\\""); break;+   case '\\': printf("\\\\"); break;+   case '\a': printf("\\a"); break;+   case '\b': printf("\\b"); break;+   case '\f': printf("\\f"); break;+   case '\n': printf("\\n"); break;+   case '\r': printf("\\r"); break;+   case '\t': printf("\\t"); break;+   case '\v': printf("\\v"); break;+   default:	if (isprint((unsigned char)c))+   			putchar(c);+		else+			printf("\\%03u",(unsigned char)c);+  }+ }+ putchar('"');+}++static void PrintConstant(const Proto* f, int i)+{+ const TValue* o=&f->k[i];+ switch (ttype(o))+ {+  case LUA_TNIL:+	printf("nil");+	break;+  case LUA_TBOOLEAN:+	printf(bvalue(o) ? "true" : "false");+	break;+  case LUA_TNUMBER:+	printf(LUA_NUMBER_FMT,nvalue(o));+	break;+  case LUA_TSTRING:+	PrintString(rawtsvalue(o));+	break;+  default:				/* cannot happen */+	printf("? type=%d",ttype(o));+	break;+ }+}++static void PrintCode(const Proto* f)+{+ const Instruction* code=f->code;+ int pc,n=f->sizecode;+ for (pc=0; pc<n; pc++)+ {+  Instruction i=code[pc];+  OpCode o=GET_OPCODE(i);+  int a=GETARG_A(i);+  int b=GETARG_B(i);+  int c=GETARG_C(i);+  int bx=GETARG_Bx(i);+  int sbx=GETARG_sBx(i);+  int line=getline(f,pc);+  printf("\t%d\t",pc+1);+  if (line>0) printf("[%d]\t",line); else printf("[-]\t");+  printf("%-9s\t",luaP_opnames[o]);+  switch (getOpMode(o))+  {+   case iABC:+    printf("%d",a);+    if (getBMode(o)!=OpArgN) printf(" %d",ISK(b) ? (-1-INDEXK(b)) : b);+    if (getCMode(o)!=OpArgN) printf(" %d",ISK(c) ? (-1-INDEXK(c)) : c);+    break;+   case iABx:+    if (getBMode(o)==OpArgK) printf("%d %d",a,-1-bx); else printf("%d %d",a,bx);+    break;+   case iAsBx:+    if (o==OP_JMP) printf("%d",sbx); else printf("%d %d",a,sbx);+    break;+  }+  switch (o)+  {+   case OP_LOADK:+    printf("\t; "); PrintConstant(f,bx);+    break;+   case OP_GETUPVAL:+   case OP_SETUPVAL:+    printf("\t; %s", (f->sizeupvalues>0) ? getstr(f->upvalues[b]) : "-");+    break;+   case OP_GETGLOBAL:+   case OP_SETGLOBAL:+    printf("\t; %s",svalue(&f->k[bx]));+    break;+   case OP_GETTABLE:+   case OP_SELF:+    if (ISK(c)) { printf("\t; "); PrintConstant(f,INDEXK(c)); }+    break;+   case OP_SETTABLE:+   case OP_ADD:+   case OP_SUB:+   case OP_MUL:+   case OP_DIV:+   case OP_POW:+   case OP_EQ:+   case OP_LT:+   case OP_LE:+    if (ISK(b) || ISK(c))+    {+     printf("\t; ");+     if (ISK(b)) PrintConstant(f,INDEXK(b)); else printf("-");+     printf(" ");+     if (ISK(c)) PrintConstant(f,INDEXK(c)); else printf("-");+    }+    break;+   case OP_JMP:+   case OP_FORLOOP:+   case OP_FORPREP:+    printf("\t; to %d",sbx+pc+2);+    break;+   case OP_CLOSURE:+    printf("\t; %p",VOID(f->p[bx]));+    break;+   case OP_SETLIST:+    if (c==0) printf("\t; %d",(int)code[++pc]);+    else printf("\t; %d",c);+    break;+   default:+    break;+  }+  printf("\n");+ }+}++#define SS(x)	(x==1)?"":"s"+#define S(x)	x,SS(x)++static void PrintHeader(const Proto* f)+{+ const char* s=getstr(f->source);+ if (*s=='@' || *s=='=')+  s++;+ else if (*s==LUA_SIGNATURE[0])+  s="(bstring)";+ else+  s="(string)";+ printf("\n%s <%s:%d,%d> (%d instruction%s, %d bytes at %p)\n",+ 	(f->linedefined==0)?"main":"function",s,+	f->linedefined,f->lastlinedefined,+	S(f->sizecode),f->sizecode*Sizeof(Instruction),VOID(f));+ printf("%d%s param%s, %d slot%s, %d upvalue%s, ",+	f->numparams,f->is_vararg?"+":"",SS(f->numparams),+	S(f->maxstacksize),S(f->nups));+ printf("%d local%s, %d constant%s, %d function%s\n",+	S(f->sizelocvars),S(f->sizek),S(f->sizep));+}++static void PrintConstants(const Proto* f)+{+ int i,n=f->sizek;+ printf("constants (%d) for %p:\n",n,VOID(f));+ for (i=0; i<n; i++)+ {+  printf("\t%d\t",i+1);+  PrintConstant(f,i);+  printf("\n");+ }+}++static void PrintLocals(const Proto* f)+{+ int i,n=f->sizelocvars;+ printf("locals (%d) for %p:\n",n,VOID(f));+ for (i=0; i<n; i++)+ {+  printf("\t%d\t%s\t%d\t%d\n",+  i,getstr(f->locvars[i].varname),f->locvars[i].startpc+1,f->locvars[i].endpc+1);+ }+}++static void PrintUpvalues(const Proto* f)+{+ int i,n=f->sizeupvalues;+ printf("upvalues (%d) for %p:\n",n,VOID(f));+ if (f->upvalues==NULL) return;+ for (i=0; i<n; i++)+ {+  printf("\t%d\t%s\n",i,getstr(f->upvalues[i]));+ }+}++void PrintFunction(const Proto* f, int full)+{+ int i,n=f->sizep;+ PrintHeader(f);+ PrintCode(f);+ if (full)+ {+  PrintConstants(f);+  PrintLocals(f);+  PrintUpvalues(f);+ }+ for (i=0; i<n; i++) PrintFunction(f->p[i],full);+}
+ tests/HsLuaMain.hs view
@@ -0,0 +1,128 @@+
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Main where
+import qualified Scripting.Lua as Lua
+import Foreign.C.Types
+import Foreign.Storable
+import Foreign.StablePtr
+import Foreign.Ptr
+import Data.List
+import Control.Monad
+
+foreign export ccall hs_lua_c_func :: Lua.LuaState -> IO CInt
+foreign import ccall "&hs_lua_c_func" hs_lua_c_func_addr :: FunPtr Lua.LuaCFunction
+
+hs_lua_c_func l = do
+    putStrLn "from haskell"
+    return 0
+
+test1 :: Int -> String -> IO Int
+test1 a b = do
+    putStrLn ("Got " ++ show a ++ " " ++ b)
+    return 15
+
+test2 :: IO Int
+test2 = do
+    fail "expected error"
+    return 15
+
+
+main = do
+    l <- Lua.newstate
+    Lua.openlibs l
+    Lua.getglobal l "print"
+    Lua.pushstring l "from print"
+    putStrLn "NEXT: from print"
+    Lua.call l 1 0
+    Lua.register l "kill" hs_lua_c_func_addr
+    Lua.getglobal l "kill"
+    putStrLn "NEXT: from haskell"
+    Lua.call l 0 0
+    c <- Lua.loadstring l "print \"preparation\"; function f () print \"in lua def fun\"; end" "inline code"
+    putStrLn "NEXT: result 0"
+    putStrLn ("result " ++ show c)
+    putStrLn "NEXT: preparation"
+    Lua.call l 0 Lua.multret
+    Lua.getglobal l "f"
+    putStrLn "NEXT: in lua def fun"
+    Lua.call l 0 0
+    Lua.getglobal l "print"
+    Lua.push l (42::Int)
+    putStrLn "NEXT: 42"
+    Lua.call l 1 0
+    Lua.push l (42::Int)
+    putStrLn "NEXT: number 42"
+    Just (x::Int) <- Lua.peek l (-1)
+    putStrLn ("number " ++ show x)
+    putStrLn "NEXT: string 42"
+    Just (x::String) <- Lua.peek l (-1)
+    putStrLn ("string " ++ x)
+    Lua.pop l 1     
+
+    putStrLn "NEXT: "
+    Lua.callproc l "print"
+    putStrLn "NEXT: arg1"
+    Lua.callproc l "print"  "arg1"
+    putStrLn "NEXT: arg1    arg2"
+    Lua.callproc l "print" "arg1" "arg2"
+
+    putStrLn $ "NEXT: " ++ show (sin 2)
+    Lua.getglobal l "math"
+    Lua.getfield l (-1) "sin"
+    Lua.gettop l >>= \n -> Lua.remove l (n-1)
+    Lua.push l (2.0::Double)
+    Lua.call l 1 1
+    Just (x::Double) <- Lua.peek l (-1)
+    print x
+    Lua.pop l 1
+
+    putStrLn $ "NEXT: " ++ show (sin 3)
+    Lua.getglobal2 l "math.sin"
+    Lua.push l (3.0::Double)
+    Lua.call l 1 1
+    Just (x::Double) <- Lua.peek l (-1)
+    print x
+    Lua.pop l 1
+
+    putStrLn $ "NEXT: " ++ show (sin 1)
+    (x::Double) <- Lua.callfunc l "math.sin" (1.0::Double)
+    print x
+
+    putStrLn $ "NEXT: " ++ show (sin 5)
+    (x::Double) <- Lua.callfunc l "math.sin" (5.0::Double) (6.0::Double) (7.0::Double)
+    print x
+
+    v <- Lua.newcfunction test1
+    Lua.push l v
+    Lua.setglobal l "test1"
+
+    putStrLn "NEXT: Got 1 test1"
+    Lua.callproc l "test1"  (1.0::Double) "test1"
+
+    Lua.freecfunction v
+
+    Lua.pushhsfunction l test1
+    Lua.setglobal l "test2"
+
+    putStrLn "NEXT: Got 2 test2 ex"
+    (m :: Int) <- Lua.callfunc l "test2"  (2.0::Double) "test2 ex"
+    putStrLn "NEXT: 15"
+    print m
+
+    putStrLn "NEXT: Error ignored"
+    Lua.callproc l "math.sin" "notanumber" `catch` (\e -> putStrLn ("Error caught " ++ show e))
+
+    putStrLn "NEXT: Error ignored 2"
+    Lua.callproc l "test2" "notanumber" "notanumber" `catch` (\e -> putStrLn ("Error caught 2 " ++ show e))
+
+    Lua.pushhsfunction l test2
+    Lua.setglobal l "testexception"
+    putStrLn "NEXT: user error (user error (expected error))"
+    Lua.callproc l "testexception" `catch` (\e -> print e)
+
+    putStrLn "NEXT: 0"
+    k <- Lua.gettop l
+    print k
+    Lua.close l
+