Working

luprex/syscpp/lpx-classdb.cpp

@@ -9,54 +9,39 @@
 //   if classname is not present, create and initialize it.
 //
 int lpx_classdb_get(lua_State *L) {
-    const int db = lua_gettop(L) - 1;
-    const int cname = lua_gettop(L);
+    LpxArg db, classname;
+    LpxRet classtab;
+    LpxVar action;
+    LpxStackManager LSM(L, db, classname, classtab, action);
 
-    luaL_checktype(L, db, LUA_TTABLE);
-    luaL_checktype(L, cname, LUA_TSTRING);
-    lua_pushvalue(L, cname);
-    lua_rawget(L, db);
-    if (lua_istable(L, -1)) {
-        return 1;
-    } else if (!lua_isnil(L, -1)) {
-        lua_pushfstring(L, "%s is not a class", lua_tostring(L, cname));
-        lua_error(L);
+    LSM.checknometa(db);
+    luaL_checktype(L, classname, LUA_TSTRING);
+    LSM.rawget(classtab, db, classname);
+    if (lua_istable(L, classtab)) {
+        return LSM.retval();
+    } else if (!lua_isnil(L, classtab)) {
+        luaL_error(L, "%s is not a class", lua_tostring(L, classname));
     }
-    lua_pop(L, 1);
-    lua_newtable(L);
-    int cls = lua_gettop(L);
-    lua_pushvalue(L, cname);
-    lua_pushvalue(L, cls);
-    lua_rawset(L, db);
-    lua_pushstring(L, "__index");
-    lua_pushvalue(L, cls);
-    lua_rawset(L, cls);
-    lua_pushstring(L, "__class");
-    lua_pushvalue(L, cname);
-    lua_rawset(L, cls);
-    lua_pushstring(L, "action");
-    lua_newtable(L);
-    lua_rawset(L, cls);
-
-    // Remove arguments, leaving new table on stack.
-    lua_replace(L, db);
-    lua_settop(L, db);
-    return 1;
+    LSM.newtable(classtab);
+    LSM.rawset(db, classname, classtab);
+    LSM.setfield(classtab, "__index", classtab);
+    LSM.setfield(classtab, "__class", classname);
+    LSM.newtable(action);
+    LSM.setfield(classtab, "action", action);
+    return LSM.retval();
 }
 
 // Curried version of classdb.get where db is stored in an upvalue.
 //
 static int lpx_classdb_class(lua_State *L) {
-    const int cname = lua_gettop(L);
     lua_pushvalue(L, lua_upvalueindex(1));
-    lua_insert(L, cname);
+    lua_insert(L, -2);
     return lpx_classdb_get(L);
 }
 
 int lpx_classdb_accessor(lua_State *L) {
-    const int db = lua_gettop(L);
-    luaL_checktype(L, db, LUA_TTABLE);
-    lua_pushcclosure(L, lpx_classdb_class, 1);
+    luaL_checktype(L, -1, LUA_TTABLE);
+    lua_pushcclosure(L, LpxArgCheck<1, lpx_classdb_class>, 1);
     return 1;
 }
 
@@ -69,63 +54,47 @@ int lpx_classdb_accessor(lua_State *L) {
 //   Caution: do not reset the global class database!
 //
 int lpx_classdb_reset(lua_State *L) {
-    const int db = lua_gettop(L);
+    LpxArg db;
+    LpxVar classname, classtab, action, key;
+    LpxStackManager LSM(L, db, classname, classtab, action, key);
+
     luaL_checktype(L, db, LUA_TTABLE);
-    lua_pushnil(L);
-    while (lua_next(L, db) != 0) {
-        int cname = lua_gettop(L) - 1;
-        int cls = lua_gettop(L);
-        if (lua_istable(L, cls)) {
-            lua_pushstring(L, "action");
-            lua_rawget(L, cls);
-            int actn = lua_gettop(L);
-            if (lua_istable(L, actn)) {
-                lua_pushvalue(L, actn);
+    LSM.setnil(classname);
+    while (LSM.next(db, classname, classtab) != 0) {
+        if (lua_istable(L, classtab)) {
+            LSM.setstring(key, "action");
+            LSM.rawget(action, classtab, key);
+            if (lua_istable(L, action)) {
+                lua_pushvalue(L, action);
                 lpx_table_clear(L);
             } else {
-                lua_pop(L, 1);
-                lua_newtable(L);
+                LSM.newtable(action);
             }
-            lua_pushvalue(L, cls);
+            lua_pushvalue(L, classtab);
             lpx_table_clear(L);
-            lua_pushstring(L, "__index");
-            lua_pushvalue(L, cls);
-            lua_rawset(L, cls);
-            lua_pushstring(L, "__class");
-            lua_pushvalue(L, cname);
-            lua_rawset(L, cls);
-            lua_pushstring(L, "action");
-            lua_pushvalue(L, actn);
-            lua_rawset(L, cls);
+            LSM.setfield(classtab, "__index", classtab);
+            LSM.setfield(classtab, "__class", classname);
+            LSM.setfield(classtab, "action", action);
         }
-        lua_settop(L, cname);
     }
-    // Remove arguments, leave nothing on stack.
-    lua_settop(L, db - 1);
-    return 0;
+    return LSM.retval();
 }
 
-// Create the global function 'class'.
-//
-//   This version of 'class' creates classes in the global environment.
-//   Note that this is lua 5.1 specific.
-//
-static int lpx_create_global_class(lua_State *L) {
+// Create a classdb.  That's just an empty table.
+int lpx_classdb_create(lua_State *L) {
+    lua_newtable(L);
+    return 1;
+}
+
+void luaopen_lpx_classdb(lua_State *L) {
+    LpxStackManager::reg(L, "classdb", "get", LpxArgCheck<2, lpx_classdb_get>);
+    LpxStackManager::reg(L, "classdb", "accessor", LpxArgCheck<1, lpx_classdb_accessor>);
+    LpxStackManager::reg(L, "classdb", "reset", LpxArgCheck<1, lpx_classdb_reset>);
+    LpxStackManager::reg(L, "classdb", "create", LpxArgCheck<0, lpx_classdb_create>);
+
+    // Insert the global function 'class', which is a closure with an upvalue.
     lua_pushstring(L, "class");
     lua_pushvalue(L, LUA_GLOBALSINDEX);
     lpx_classdb_accessor(L);
     lua_rawset(L, LUA_GLOBALSINDEX);
 }
-
-static const struct luaL_Reg lpx_classdb_lib [] = {
-    {"get", lpx_classdb_get},
-    {"accessor", lpx_classdb_accessor},
-    {"reset", lpx_classdb_reset},
-    {NULL, NULL}  /* sentinel */
-};
-
-int luaopen_lpx_classdb(lua_State *L) {
-    luaL_openlib(L, "classdb", lpx_classdb_lib, 0);
-    lpx_create_global_class(L);
-    return 1;
-}

luprex/syscpp/lpx-classdb.hpp

@@ -1,12 +1,21 @@
+// ClassDB - code to manipulate class databases.
+//
+// It would have been easier to write this in Lua, but since every
+// lua module in the system depends on it, it's safer to have it
+// preloaded before we even open any of the lua files.
+//
+
 #ifndef LPX_CLASSDB_HPP
 #define LPX_CLASSDB_HPP
 
-#include "lua-headers.hpp"
+#include "lpx-stack-manager.hpp"
 
 int lpx_classdb_get(lua_State *L);
 int lpx_classdb_reset(lua_State *L);
 int lpx_classdb_accessor(lua_State *L);
-int luaopen_lpx_classdb(lua_State *L);
+int lpx_classdb_create(lua_State *L);
+
+void luaopen_lpx_classdb(lua_State *L);
 
 #endif // LPX_CLASSDB_HPP
 

luprex/syscpp/lpx-stack-manager.hpp

@@ -0,0 +1,269 @@
+
+
+#ifndef LPX_STACK_MANAGER_HPP
+#define LPX_STACK_MANAGER_HPP
+
+extern "C" {
+#include "lua.h"
+#include "lauxlib.h"
+#include "lualib.h"
+#include "luajit.h"
+}
+
+// LpxArgCheck
+//
+// This is a template that, when given a lua_CFunction that doesn't
+// verify the number of arguments on the stack, returns a new lua_CFunction
+// that *does* verify the number of arguments on the stack.
+//
+// In general, your lua_CFunctions should not verify the number of
+// arguments on the stack.  Instead, they should assume that the stack
+// contains arbitrary stuff underneath the arguments.  That makes your
+// lua_CFunctions callable from both C and Lua.  But it is desirable to
+// check arguments (only when calling from lua), so it is useful to use
+// LpxArgCheck when turning a lua_CFunction into a lua closure.
+//
+template<int N, lua_CFunction FN>
+int LpxArgCheck(lua_State *L) {
+    if (lua_gettop(L) != N) {
+        lua_pushfstring(L, "expected %d arguments, got %d", N, lua_gettop(L));
+        lua_error(L);
+    }
+    FN(L);
+}
+
+// LpxSlot
+//
+// An LpxSlot contains a lua stack index.  It is initialized by the
+// LpxStackManager and contains the same index until the LpxStackManager
+// is destroyed.  You can convert an LpxSlot into a lua stack index
+// by simply coercing it to 'int'.
+//
+// There are three variants of LpxSlot that you can use: LpxArg (function
+// argument), LpxRet (function return value), and LpxVar (function local
+// variable).
+//
+class LpxSlot {
+private:
+    int index_;
+    LpxSlot *next_;
+
+public:
+    inline operator int() const {
+        return index_;
+    }
+
+    LpxSlot() {
+        index_ = 0;
+        next_ = 0;
+    }
+    friend class LpxStackManager;
+};
+
+class LpxArg : public LpxSlot {};
+class LpxRet : public LpxSlot {};
+class LpxVar : public LpxSlot {};
+
+class LpxStackManager {
+private:
+    using SSList = LpxSlot*;
+
+    SSList arg_;
+    SSList ret_;
+    SSList var_;
+
+    int argtop_;
+    int gaptop_;
+    int vartop_;
+    int rettop_;
+    int finaltop_;
+    
+    int narg_;
+    int ngap_;
+    int nvar_;
+    int nret_;
+
+    lua_State *L_;
+
+    static int sscount(SSList l) {
+        int total = 0;
+        while (l != 0) {
+            total += 1;
+            l = l->next_;
+        }
+        return total;
+    }
+
+    void ck() {
+        if (lua_gettop(L_) != rettop_) {
+            lua_pushstring(L_, "LpxStackManager: stack is not right");
+            lua_error(L_);
+        }
+    }
+
+    template<class... SS>
+    void record(LpxArg &v, SS & ... stackslots)
+    {
+        v.next_ = arg_; arg_ = &v;
+        record(stackslots...);
+    }
+
+    template<class... SS>
+    void record(LpxRet &v, SS & ... stackslots)
+    {
+        v.next_ = ret_; ret_ = &v;
+        record(stackslots...);
+    }
+
+    template<class... SS>
+    void record(LpxVar &v, SS & ... stackslots)
+    {
+        v.next_ = var_; var_ = &v;
+        record(stackslots...);
+    }
+
+    void record()
+    {
+    }
+
+public:
+    template<class... SS>
+    LpxStackManager(lua_State *L, SS & ... stackslots) {
+        L_ = L;
+        arg_ = 0;
+        ret_ = 0;
+        var_ = 0;
+
+        record(stackslots...);
+        
+        int narg = sscount(arg_);
+        int nvar = sscount(var_);
+        int nret = sscount(ret_);
+        int ngap = (nret - nvar - narg);
+        if (ngap < 0) ngap = 0;
+
+        argtop_ = lua_gettop(L_);
+        gaptop_ = argtop_ + ngap;
+        vartop_ = gaptop_ + nvar;
+        rettop_ = vartop_ + nret;
+        finaltop_ = argtop_ - narg + nret;
+        
+        int i = argtop_;
+        for (LpxSlot *v = arg_; v != 0; v = v->next_) {
+            v->index_ = i;
+            i -= 1;
+        }
+        i = vartop_;
+        for (LpxSlot *v = var_; v != 0; v = v->next_) {
+            v->index_ = i;
+            i -= 1;
+        }
+        i = rettop_;
+        for (LpxSlot *v = ret_; v != 0; v = v->next_) {
+            v->index_ = i;
+            i -= 1;
+        }
+
+        // Initialize vars and rets to NIL.
+        // I could conceivably do a Lpx_settop instead.
+        for (int i = argtop_; i < rettop_; i++) {
+            lua_pushnil(L_);
+        }
+    }
+
+    ~LpxStackManager() {
+        ck();
+        int i = finaltop_;
+        for (LpxSlot *v = ret_; v != 0; v = v->next_) {
+            lua_replace(L_, i);
+            i -= 1;
+        }
+        lua_settop(L_, finaltop_);
+    }
+
+    int retval() {
+        return rettop_ - vartop_;
+    }
+
+    static void reg(lua_State *L, const char *classname, const char *funcname, lua_CFunction fn) {
+        luaL_Reg reg;
+        reg.name = funcname;
+        reg.func = fn;
+        luaL_register(L, classname, &reg);
+    }
+
+public:
+    // The following functions are 'register-machine' variants
+    // of the core lua functions.  They do not read from the stack,
+    // or leave results on the stack.
+
+    void setnil(int target) {
+        lua_pushnil(L_);
+        lua_replace(L_, target);
+    }
+
+    void setstring(int target, const char *str) {
+        lua_pushstring(L_, str);
+        lua_replace(L_, target);
+    }
+
+    void setlstring(int target, const char *str, int len) {
+        lua_pushlstring(L_, str, len);
+        lua_replace(L_, target);
+    }
+
+    void setnumber(int target, double value) {
+        lua_pushnumber(L_, value);
+        lua_replace(L_, target);
+    }
+
+    int next(int tab, int key, int value) {
+        lua_pushvalue(L_, key);
+        int ret = lua_next(L_, tab);
+        if (ret != 0) {
+            lua_replace(L_, value);
+            lua_replace(L_, key);
+        }
+        return ret;
+    }
+    
+    void rawget(int target, int tab, int key) {
+        lua_pushvalue(L_, key);
+        lua_rawget(L_, tab);
+        lua_replace(L_, target);
+    }
+
+    void rawset(int tab, int key, int value) {
+        lua_pushvalue(L_, key);
+        lua_pushvalue(L_, value);
+        lua_rawset(L_, tab);
+    }
+
+    void setfield(int tab, const char *field, int value) {
+        lua_pushvalue(L_, value);
+        lua_setfield(L_, tab, field);
+    }
+
+    void getfield(int target, int tab, const char *field) {
+        lua_getfield(L_, tab, field);
+        lua_replace(L_, target);
+    }
+
+    void newtable(int target) {
+        lua_newtable(L_);
+        lua_replace(L_, target);
+    }
+
+    void checknometa(int index) {
+        if (lua_istable(L_, index)) {
+            if (!lua_getmetatable(L_, index)) {
+                return;
+            }
+        }
+        luaL_error(L_, "expected simple table with no metatable");
+    }
+};
+
+
+
+#endif // LPX_STACK_MANAGER_HPP

luprex/syscpp/lpx-table.cpp

@@ -2,7 +2,9 @@
 
 // Clear the table.  Removes metatable and all key-value pairs.
 int lpx_table_clear(lua_State *L) {
-    const int tab = lua_gettop(L);
+    LpxArg tab;
+    LpxStackManager LSM(L, tab);
+
     luaL_checktype(L, tab, LUA_TTABLE);
 
     // Clear the metatable.
@@ -18,9 +20,7 @@ int lpx_table_clear(lua_State *L) {
         lua_settable(L, tab);
     }
     
-    // Remove the arguments and return nothing.
-    lua_remove(L, tab);
-    return 0;
+    return LSM.retval();
 }
 
 int lpx_table_coerce(lua_State *L) {
@@ -31,13 +31,7 @@ int lpx_table_coerce(lua_State *L) {
     return 1;
 }
 
-static const struct luaL_Reg lpx_table_lib [] = {
-    {"clear", lpx_table_clear},
-    {"coerce", lpx_table_coerce},
-    {NULL, NULL}  /* sentinel */
-};
-
-int luaopen_lpx_table (lua_State *L) {
-    luaL_openlib(L, "table", lpx_table_lib, 0);
-    return 1;
+void luaopen_lpx_table (lua_State *L) {
+    LpxStackManager::reg(L, "table", "clear", LpxArgCheck<1, lpx_table_clear>);
+    LpxStackManager::reg(L, "table", "coerce", LpxArgCheck<1, lpx_table_coerce>);
 }

luprex/syscpp/lpx-table.hpp

@@ -1,10 +1,11 @@
 #ifndef LPX_TABLE_HPP
 #define LPX_TABLE_HPP
 
-#include "lua-headers.hpp"
+#include "lpx-stack-manager.hpp"
 
 int lpx_table_clear(lua_State *L);
 int lpx_table_coerce(lua_State *L);
-int luaopen_lpx_table (lua_State *L);
+
+void luaopen_lpx_table (lua_State *L);
 
 #endif // LPX_TABLE_HPP

luprex/syscpp/lua-headers.hpp

@@ -1,9 +0,0 @@
-#ifndef LUA_HEADERS_HPP
-#define LUA_HEADERS_HPP
-extern "C" {
-#include "lua.h"
-#include "lauxlib.h"
-#include "lualib.h"
-#include "luajit.h"
-}
-#endif // LUA_HEADERS_HPP

luprex/syscpp/main.cpp

@@ -12,7 +12,7 @@
 #include <signal.h>
 #include <vector>
 #include <string>
-#include "lua-headers.hpp"
+#include "lpx-stack-manager.hpp"
 #include "util.hpp"
 #include "lpx-table.hpp"
 #include "lpx-classdb.hpp"
@@ -174,7 +174,11 @@ static void dotty(lua_State *L)
         report(L, status);
         if (status == LUA_OK && lua_gettop(L) > 0)
         { /* any result to print? */
-            lua_getglobal(L, "print");
+            lua_getglobal(L, "iprint");
+            if (lua_isnil(L, -1)) {
+                lua_pop(L, 1);
+                lua_getglobal(L, "print");
+            }
             lua_insert(L, 1);
             if (lua_pcall(L, lua_gettop(L) - 1, 0, 0) != 0)
             {

luprex/syslua/control.lst

@@ -4,5 +4,7 @@
 #
 
 inspect.lua
-main.lua
+globaldb.lua
+model.lua
+
 

luprex/syslua/globaldb.lua

@@ -0,0 +1,22 @@
+local globaldb=class('globaldb')
+
+function globaldb.get(db, key)
+    local result = db[key]
+    if type(result) == 'table' then
+        return result
+    else
+        result = {}
+        db[key] = result
+    end
+    return result
+end
+
+function globaldb.accessor(db)
+    return function(key)
+        return globaldb.get(db, key)
+    end
+end
+
+function globaldb.create()
+    return {}
+end

luprex/syslua/inspect.lua

@@ -28,12 +28,12 @@
 -- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 --
 
-local inspect = class('inspect')
+local inspect = {}
 
 local tostring = tostring
 
-inspect.KEY       = setmetatable({}, {__tostring = function() return 'inspect.KEY' end})
-inspect.METATABLE = setmetatable({}, {__tostring = function() return 'inspect.METATABLE' end})
+inspect.KEY       = {}
+inspect.METATABLE = {}
 
 local function rawpairs(t)
   return next, t, nil
@@ -236,8 +236,10 @@ function Inspector:putKey(k)
 end
 
 function Inspector:putTable(t)
-  if t == inspect.KEY or t == inspect.METATABLE then
-    self:puts(tostring(t))
+  if t == inspect.KEY then
+    self:puts("inspect.KEY")
+  elseif t == inspect.METATABLE then
+    self:puts("inspect.METATABLE")
   elseif self:alreadyVisited(t) then
     self:puts('<table ', self:getId(t), '>')
   elseif self.level >= self.depth then
@@ -331,5 +333,12 @@ function inspect.inspect(root, options)
   return table.concat(inspector.buffer)
 end
 
-_G.inspect = inspect.inspect
+function inspect.iprint(...)
+    local n = select("#", ...)
+    for i = 1,n do
+        local v = select(i, ...)
+        print(inspect.inspect(v))
+    end
+end
 
+_G.iprint = inspect.iprint

luprex/syslua/main.lua

@@ -1,48 +0,0 @@
-
--- given a global_db, makes an accessor that fetches named
--- tables from that global_db.
-function make_global_accessor(db)
-    return function(name)
-        local global = rawget(db, name)
-        if type(global) ~= "table" then
-            global = {}
-            rawset(db, name, global)
-        end
-        return global
-    end
-end
-
--- The sandbox list - a list of the builtin functions that gets imported
--- into world models.  This is a very weak form of sandboxing, a world
--- model can still easily use functions that are not on this list.  If you
--- want stronger sandboxing, you need to not link in certain builtins at all.
---
--- Omitted from this list: "debug", "dofile", "getfenv", "io", "jit",
--- "load", "loadfile", "loadstring", "module", "newproxy", "os", "package",
--- "pcall", "require", "xpcall"
---
-local sandbox_list = { "assert", "bit", "error", "getmetatable", "inspect",
-    "ipairs", "math", "next", "pairs", "print", "rawequal", "rawget", "rawset",
-    "select", "setmetatable", "tonumber", "tostring", "type", "unpack" }
-
--- Make a world model.
---
-function make_world_model()
-    genv = {}
-    genv._G = genv
-    meta = {}
-    meta.class_db = {}
-    meta.global_db = {}
-    meta.source_db = {}
-    meta.tangible_db = {}
-    meta.__newindex = function() error("Global environment is read-only") end
-    -- meta.__metatable = false
-    genv.class = classdb.accessor(meta.class_db)
-    genv.global = make_global_accessor(meta.global_db)
-    for i,name in ipairs(sandbox_list) do
-        genv[name] = _G[name]
-    end
-    setmetatable(genv, meta)
-    return genv
-end
-

luprex/syslua/model.lua

@@ -0,0 +1,41 @@
+local model=class('model')
+local globaldb=class('globaldb')
+
+-- The global environment contents for a model.  A list of the builtin
+-- functions and classes that get installed in the global environment of
+-- a world model.
+--
+-- This barely counts as 'sandboxing' - it's more just a mechanism to
+-- keep the user from unintentionally thinking that some functionality is
+-- available when it's not.  For true sandboxing, you need to not import
+-- functions into the lua interpreter at all.
+--
+-- Omitted from this list: debug, dofile, getfenv, io, jit,
+-- load, loadfile, loadstring, module, newproxy, os, package,
+-- pcall, require, xpcall
+--
+
+model.global_contents = { "assert", "bit", "error", "getmetatable", "inspect",
+    "ipairs", "math", "next", "pairs", "print", "rawequal", "rawget", "rawset",
+    "select", "setmetatable", "tonumber", "tostring", "type", "unpack" }
+
+-- make a world model.
+--
+function model.make()
+    genv = {}
+    genv._G = genv
+    meta = {}
+    meta.class_db = classdb.create()
+    meta.global_db = globaldb.create()
+    meta.source_db = {}
+    meta.tangible_db = {}
+    meta.__newindex = function() error("world model global environment is read-only") end
+    -- meta.__metatable = false
+    genv.class = classdb.accessor(meta.class_db)
+    genv.global = make_global_accessor(meta.global_db)
+    for i,name in ipairs(world.global_contents) do
+        genv[name] = _G[name]
+    end
+    setmetatable(genv, meta)
+    return genv
+end