From: visor <visor@users.sourceforge.jp>
Date: Wed, 18 Nov 2009 15:30:31 +0000 (+0900)
Subject: allow nesting block functions.
X-Git-Url: http://git.osdn.net/view?a=commitdiff_plain;h=f8dc89573018b3510a619ddd39414d22f5bf95b6;p=hmh%2Fhhml.git

allow nesting block functions.
---

diff --git a/bin/MKTABLE.pl b/bin/MKTABLE.pl
index 499b374..bf4aa8c 100755
--- a/bin/MKTABLE.pl
+++ b/bin/MKTABLE.pl
@@ -60,7 +60,7 @@ sub  p {
 	    $ffn = 1;
 	} elsif (/^\/\/\#MFUNC\s+/) {
 	    @a = split (/\s+/, $');
-	    push (@MD, [$a[0], $a[1]]);
+	    push (@MD, [$a[0], $a[1], $a[2]]);
 	    $md = $a[0];
 	    $ffn = 1;
 	} elsif (/^\/\/\#SFUNC\s+/) {
@@ -94,24 +94,23 @@ sub  p {
 }
 
 sub  ftable {
-
-    print OUT "static FTableSupport::ftable_t  ftable[] = {\n";
+    print OUT "static FTableVal  ftable[] = {\n";
     foreach (@FN) {
 	print OUT "    {CharConst (\"$_->[0]\"), NULL, 0, $_->[1]},\n";
     }
     print OUT "    {NULL, 0, NULL, 0, NULL},\n";
     print OUT "};\n";
 
-    print OUT "static FTableSupport::ftable_t  mtable[] = {\n";
+    print OUT "static FTableVal  mtable[] = {\n";
     foreach (@MD) {
-	print OUT "    {CharConst (\"$_->[0]\"), NULL, 0, $_->[1]},\n";
+	print OUT "    {CharConst (\"$_->[0]\"), NULL, 0, $_->[1], $_->[2]},\n";
     }
     print OUT "    {NULL, 0, NULL, 0, NULL},\n";
     print OUT "};\n";
 
-    print OUT "static FTableSupport::ftable_t  stable[] = {\n";
+    print OUT "static FTableVal  stable[] = {\n";
     foreach (@SF) {
-	print OUT "    {CharConst (\"$_->[0]\"), CharConst (\"$_->[2]\"), $_->[1]},\n";
+	print OUT "    {CharConst (\"$_->[0]\"), CharConst (\"$_->[2]\"), (MNode*(*)(MNode*,MlEnv*))$_->[1]},\n";
     }
     print OUT "    {NULL, 0, NULL, 0, NULL},\n";
     print OUT "};\n";
@@ -120,8 +119,7 @@ sub  ftable {
 }
 
 sub  mftable {
-
-    print OUT "static MFTableSupport::mftable_t  mftable[] = {\n";
+    print OUT "static MFTableVal  mftable[] = {\n";
     foreach (@MTFN) {
 	print OUT "    {CharConst (\"$_->[0]\"), $_->[1]},\n";
     }
@@ -132,7 +130,7 @@ sub  mftable {
 }
 
 sub  wikiftable {
-    print OUT "static FTableSupport::ftable_t  wikiftable[] = {\n";
+    print OUT "static FTableVal  wikiftable[] = {\n";
     foreach (@WFN) {
 	print OUT "    {CharConst (\"$_->[0]\"), NULL, 0, $_->[1]},\n";
     }
diff --git a/lib/expr.cc b/lib/expr.cc
index 67078fc..40ead09 100644
--- a/lib/expr.cc
+++ b/lib/expr.cc
@@ -13,44 +13,65 @@
 #include <stdlib.h>
 #include <assert.h>
 
-using namespace  std;
+static bool  searchMTable (const ustring& name, MlEnv* mlenv, FTableVal*& ans) {
+    FTable::iterator  it;
+    int  i;
 
-static MNode*  call_func (MNode* cell, MlEnv* mlenv) {
+    if (mlenv->mtable && (it = mlenv->mtable->find (name)) != mlenv->mtable->end ()) {
+	ans = it->second;
+	for (i = mlenv->mstack.size () - 1; i >= 0; i --) {
+	    if (mlenv->mstack[i].mfunc->mlid == ans->mlid) {
+		// nested error.
+		throw (name + ": forbidden.");
+		return false;
+	    }
+	}
+	return true;
+    }
+    return false;
+}
+
+static bool  searchSTable (const ustring& name, MlEnv* mlenv, FTableVal*& ans, MLFunc*& mobj) {
+    int  i;
+    MlEnv::MStackVal*  t;
+    FTable::iterator  it;
+
+    for (i = mlenv->mstack.size () - 1; i >= 0; i --) {
+	t = &mlenv->mstack[i];
+	if (t->mobj && t->mfunc->stable && (it = t->mfunc->stable->find (name)) != t->mfunc->stable->end ()) {
+	    ans = it->second;
+	    mobj = t->mobj;
+	    return true;
+	}
+    }
+
+    return false;
+}
+
+static MNode*  callFunc (MNode* cell, MlEnv* mlenv) {
     MNodePtr  ans;
     FTable::iterator  it;
-    ustring*  c = cell->car ()->sym;
+    FTableVal*  t;
+    MLFunc*  u;
+    ustring*  name = cell->car ()->sym;
     MNodePtr  bcell;
     MNode*  sexp;
 
-    if (mlenv->ftable && (it = mlenv->ftable->find (*c)) != mlenv->ftable->end ()) {
+    bcell = mlenv->currentCell;
+    mlenv->currentCell = cell;
+
+    if (mlenv->ftable && (it = mlenv->ftable->find (*name)) != mlenv->ftable->end ()) {
 	// normal function.
-	bcell = mlenv->currentCell;
-	mlenv->currentCell = cell;
 	ans = it->second->fn (cell, mlenv);
-	mlenv->currentCell = bcell;
-    } else if (mlenv->moduleStatus == MlEnv::M_NONE && mlenv->mtable && (it = mlenv->mtable->find (*c)) != mlenv->mtable->end ()) {
+    } else if (searchMTable (*name, mlenv, t)) {
 	// module function.
-	boost::unordered_map<ustring, FTable*>::iterator  it2;
-	mlenv->moduleStatus = MlEnv::M_START;
-	if ((it2 = mlenv->mtable->iSTableM.find (*c)) != mlenv->mtable->iSTableM.end ()) {
-	    mlenv->stable = it2->second;
-	} else {
-	    mlenv->stable = NULL;
-	}
-	bcell = mlenv->currentCell;
-	mlenv->currentCell = cell;
-	ans = it->second->fn (cell, mlenv);
-	mlenv->currentCell = bcell;
-	mlenv->moduleStatus = MlEnv::M_NONE;
-	mlenv->stable = NULL;
-	mlenv->module = NULL;
-    } else if (mlenv->moduleStatus == MlEnv::M_EXEC && mlenv->stable && (it = mlenv->stable->find (*c)) != mlenv->stable->end ()) {
+	mlenv->mstack.push_back (MlEnv::MStackVal (t));
+	ans = t->fn (cell, mlenv);
+	mlenv->mstack.pop_back ();
+    } else if (searchSTable (*name, mlenv, t, u)) {
 	// subfunction.
-	bcell = mlenv->currentCell;
-	mlenv->currentCell = cell;
-	ans = it->second->fn (cell, mlenv);
-	mlenv->currentCell = bcell;
-    } else if ((sexp = mlenv->getVar (*c))) {
+	ans = t->sfn (cell, mlenv, u);
+    } else if ((sexp = mlenv->getVar (*name))) {
 	if (isLambda (sexp)) {
 	    MNodeList  list;
 	    MNode*  a = cell->cdr ();
@@ -58,16 +79,14 @@ static MNode*  call_func (MNode* cell, MlEnv* mlenv) {
 		list.append (eval (a->car (), mlenv));
 		nextNode (a);
 	    }
-	    bcell = mlenv->currentCell;
-	    mlenv->currentCell = cell;
 	    ans = execDefun (mlenv, sexp, list ());
-	    mlenv->currentCell = bcell;
 	}
     } else {
 	// not found
-	mlenv->currentCell = cell;
 	throw (ustring ("undefined function"));
     }
+    mlenv->currentCell = bcell;
+
     return ans.release ();
 }
 
@@ -81,7 +100,7 @@ MNode*  eval (MNode* cell, MlEnv* mlenv) {
 	if (cell->car ()
 	    && cell->car ()->isSym ()
 	    && (cell->cdr () == NULL || cell->cdr ()->isCons ())) {
-	    return call_func (cell, mlenv);
+	    return callFunc (cell, mlenv);
 	} else {
 	    throw (cell->dump_string_short () + ustring (": error"));
 	}
diff --git a/lib/ftable.h b/lib/ftable.h
index f413fae..52d236d 100644
--- a/lib/ftable.h
+++ b/lib/ftable.h
@@ -7,22 +7,26 @@
 
 class  MNode;
 class  MlEnv;
+class  MLFunc;
+class  FTable;
 
-namespace FTableSupport {
-    typedef struct {
-	const char*  name;
-	size_t  namelen;
-	const char*  module;
-	size_t  modlen;
+typedef struct {
+    const char*  name;
+    size_t  namelen;
+    const char*  module;
+    size_t  modlen;
+    union {
 	MNode*  (*fn) (MNode* arg, MlEnv* mlenv);
-    }  ftable_t;
-}
+	MNode*  (*sfn) (MNode* arg, MlEnv* mlenv, MLFunc* mobj);
+    };
+    int  mlid;
+    FTable*  stable;
+}  FTableVal;
 
-class  FTable: public boost::unordered_map<ustring, FTableSupport::ftable_t*> {
+class  FTable: public boost::unordered_map<ustring, FTableVal*> {
 public:
-
     FTable () {};
-    FTable (FTableSupport::ftable_t* t) {
+    FTable (FTableVal* t) {
 	int  i;
 	for (i = 0; t[i].name; i ++) {
 	    insert (FTable::value_type (ustring (t[i].name, t[i].namelen), &t[i]));
@@ -34,24 +38,23 @@ public:
 class  MTable: public FTable {
 public:
     boost::ptr_vector<FTable>  iSTableV;
-    boost::unordered_map<ustring, FTable*>  iSTableM;
 
-    MTable (FTableSupport::ftable_t* t, FTableSupport::ftable_t* s): FTable (t) {
+    MTable (FTableVal* t, FTableVal* s): FTable (t) {
 	int  i;
 	FTable*  f;
 	ustring  p;
-	boost::unordered_map<ustring, FTable*>::iterator  it;
+	iterator  it;
 	
 	for (i = 0; t[i].name; i ++) {
 	    f = new FTable;
 	    iSTableV.push_back (f);
-	    iSTableM.insert (boost::unordered_map<ustring, FTable*>::value_type (ustring (t[i].name, t[i].namelen), f));
+	    t[i].stable = f;
 	}
 	for (i = 0; s[i].name; i ++) {
 	    p = ustring (s[i].module, s[i].modlen);
-	    it = iSTableM.find (p);
-	    if (it != iSTableM.end ()) {
-		it->second->insert (FTable::value_type (ustring (s[i].name, s[i].namelen), &s[i]));
+	    it = find (p);
+	    if (it != end ()) {
+		it->second->stable->insert (FTable::value_type (ustring (s[i].name, s[i].namelen), &s[i]));
 	    }
 	}
     };
diff --git a/lib/mftable.h b/lib/mftable.h
index 2d6e57b..4f8afd5 100644
--- a/lib/mftable.h
+++ b/lib/mftable.h
@@ -3,26 +3,24 @@
 
 #include "ustring.h"
 #include <boost/unordered_map.hpp>
-//#include <boost/ptr_container/ptr_vector.hpp>
+#include <boost/ptr_container/ptr_vector.hpp>
 #include <vector>
 
 class  MlEnv;
 
-namespace MFTableSupport {
-    typedef  struct {
-	const char*  name;
-	int  namelen;
-	void  (*fn) (std::vector<ustring>& args, MlEnv* mlenv);
-    }  mftable_t;
-}
+typedef  struct {
+    const char*  name;
+    int  namelen;
+    void  (*fn) (std::vector<ustring>& args, MlEnv* mlenv);
+}  MFTableVal;
 
-class  MFTable: public boost::unordered_map<ustring, MFTableSupport::mftable_t*> {
+class  MFTable: public boost::unordered_map<ustring, MFTableVal*> {
 public:
     boost::ptr_vector<MFTable>  iSTableV;
     boost::unordered_map<ustring, MFTable*>  iSTableM;
 
     MFTable () {};
-    MFTable (MFTableSupport::mftable_t* t) {
+    MFTable (MFTableVal* t) {
 	int  i;
 	for (i = 0; t[i].name; i ++) {
 	    insert (MFTable::value_type (ustring (t[i].name, t[i].namelen), &t[i]));
diff --git a/lib/ml.h b/lib/ml.h
index 86b4821..ed749ce 100644
--- a/lib/ml.h
+++ b/lib/ml.h
@@ -377,8 +377,11 @@ class  MLFunc {
 
     MLFunc (int v): id (v) {};
     virtual  ~MLFunc () {};
-    
 };
+template <class T> inline T*  MObjRef (MLFunc* mobj, int id) {
+    assert (mobj && mobj->id == id);
+    return (T*)mobj;
+}
 
 void  nextNode (MNode*& arg);
 void  nextNodeNonNil (MNode*& arg);
diff --git a/lib/mlenv.cc b/lib/mlenv.cc
index 38aa379..bd9765e 100644
--- a/lib/mlenv.cc
+++ b/lib/mlenv.cc
@@ -411,3 +411,10 @@ void  MlEnv::logSexp (MNode* c) {
     }
 }
 
+void  MlEnv::setMStack (MLFunc* mobj) {
+    MStackVal*  t = &mstack.back ();
+
+    assert (t->mobj == NULL);
+    t->mobj = mobj;
+}
+
diff --git a/lib/mlenv.h b/lib/mlenv.h
index da12454..a56fc77 100644
--- a/lib/mlenv.h
+++ b/lib/mlenv.h
@@ -5,6 +5,7 @@
 #include "motorvar.h"
 #include <boost/unordered_map.hpp>
 #include <boost/ptr_container/ptr_vector.hpp>
+#include <vector>
 #include <iostream>
 
 class  MNode;
@@ -19,13 +20,15 @@ class  MlEnv {
     MNodePtr  currentCell;
     FTable*  ftable;
     MTable*  mtable;
-    enum {
-	M_NONE,
-	M_START,
-	M_EXEC,
-    }  moduleStatus;
-    FTable*  stable;
-    MLFunc*  module;
+    class  MStackVal {
+    public:
+	FTableVal*  mfunc;
+	MLFunc*  mobj;
+
+	MStackVal (FTableVal* mf): mfunc (mf), mobj (NULL) {};
+	virtual  ~MStackVal () {};
+    };
+    std::vector<MStackVal>  mstack;
     time_t  starttime;
     time_t  limittime;
     int  includeCount;
@@ -39,9 +42,6 @@ class  MlEnv {
     MlEnv () {
 	ftable = NULL;
 	mtable = NULL;
-	moduleStatus = M_NONE;
-	stable = NULL;
-	module = NULL;
 	includeCount = 0;
 	env = NULL;
 	log = NULL;
@@ -101,6 +101,7 @@ class  MlEnv {
     virtual void  push_linenum (MNode* c, int ln);
     virtual void  logLinenum (MNode* c);
     virtual void  logSexp (MNode* c);
+    virtual void  setMStack (MLFunc* mobj);
 };
 
 template<class T>  class  AutoDelete {
diff --git a/modules/ml-cookielogin.cc b/modules/ml-cookielogin.cc
index cc7e8dd..20147e0 100644
--- a/modules/ml-cookielogin.cc
+++ b/modules/ml-cookielogin.cc
@@ -20,11 +20,6 @@
 
 */
 
-static MLCookieLogin*  objref (MlEnv* mlenv) {
-    assert (mlenv->module->id == cMLCookieLoginID);
-    return (MLCookieLogin*)mlenv->module;
-}
-
 /*
   session record:
   key: <SessionKey>
@@ -133,14 +128,13 @@ void  MLCookieLogin::closedb () {
 SESSIONKEY, SESSIONKEY+"N"
 */
 
-//#MFUNC	$login-cookie	ml_cookielogin
+//#MFUNC	$login-cookie	ml_cookielogin	cMLCookieLoginID
 MNode*  ml_cookielogin (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
     MLCookieLogin  obj;
     ustring  name;
     MNodePtr  ans;
 
-    mlenv->module = &obj;
     if (! arg)
 	throw (uErrorWrongNumber);
 
@@ -158,7 +152,7 @@ MNode*  ml_cookielogin (MNode* cell, MlEnv* mlenv) {
 	SigSafe  sig;
 	obj.dbpath = mlenv->env->path_to_auth (name);
 
-	mlenv->moduleStatus = MlEnv::M_EXEC;
+	mlenv->setMStack (&obj);
 //	obj.opendb (dbpath);
 	ans = progn (arg, mlenv);
 	if (mlenv->breaksym ()
@@ -181,9 +175,9 @@ MNode*  ml_cookielogin (MNode* cell, MlEnv* mlenv) {
 
 */
 //#SFUNC	login	ml_cookielogin_login
-MNode*  ml_cookielogin_login (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_cookielogin_login (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLCookieLogin*  obj = objref (mlenv);
+    MLCookieLogin*  obj = MObjRef<MLCookieLogin> (mobj, cMLCookieLoginID);
     ustring  id;
     ustring  sessionval;
     time_t  avail = 0;
@@ -265,9 +259,9 @@ MNode*  ml_cookielogin_login (MNode* cell, MlEnv* mlenv) {
 
 */
 //#SFUNC	logout	ml_cookielogin_logout
-MNode*  ml_cookielogin_logout (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_cookielogin_logout (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLCookieLogin*  obj = objref (mlenv);
+    MLCookieLogin*  obj = MObjRef<MLCookieLogin> (mobj, cMLCookieLoginID);
     ustring  key, id;
     int  rc;
 
@@ -292,9 +286,9 @@ MNode*  ml_cookielogin_logout (MNode* cell, MlEnv* mlenv) {
 
 */
 //#SFUNC	check	ml_cookielogin_check
-MNode*  ml_cookielogin_check (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_cookielogin_check (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLCookieLogin*  obj = objref (mlenv);
+    MLCookieLogin*  obj = MObjRef<MLCookieLogin> (mobj, cMLCookieLoginID);
     bool  fsecure = false;
     ustring*  u;
     ustring  key;
@@ -355,9 +349,9 @@ MNode*  ml_cookielogin_check (MNode* cell, MlEnv* mlenv) {
 
 */
 //#SFUNC	delete	ml_cookielogin_delete
-MNode*  ml_cookielogin_delete (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_cookielogin_delete (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLCookieLogin*  obj = objref (mlenv);
+    MLCookieLogin*  obj = MObjRef<MLCookieLogin> (mobj, cMLCookieLoginID);
     ustring  key, val;
     umatch  m;
     ustring  id;
@@ -394,9 +388,9 @@ MNode*  ml_cookielogin_delete (MNode* cell, MlEnv* mlenv) {
 
 */
 //#SFUNC	clear	ml_cookielogin_clear
-MNode*  ml_cookielogin_clear (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_cookielogin_clear (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLCookieLogin*  obj = objref (mlenv);
+    MLCookieLogin*  obj = MObjRef<MLCookieLogin> (mobj, cMLCookieLoginID);
     ustring  key, val;
     ustring  id, limit, avail, group, ip;
     time_t  t;
diff --git a/modules/ml-cookielogin.h b/modules/ml-cookielogin.h
index 37a4e89..7d1aa7b 100644
--- a/modules/ml-cookielogin.h
+++ b/modules/ml-cookielogin.h
@@ -26,11 +26,11 @@ class  MLCookieLogin: public MLFunc {
 };
 
 MNode*  ml_cookielogin (MNode* cell, MlEnv* mlenv);
-MNode*  ml_cookielogin_login (MNode* cell, MlEnv* mlenv);
-MNode*  ml_cookielogin_login_dual (MNode* cell, MlEnv* mlenv);
-MNode*  ml_cookielogin_logout (MNode* cell, MlEnv* mlenv);
-MNode*  ml_cookielogin_check (MNode* cell, MlEnv* mlenv);
-MNode*  ml_cookielogin_delete (MNode* cell, MlEnv* mlenv);
-MNode*  ml_cookielogin_clear (MNode* cell, MlEnv* mlenv);
+MNode*  ml_cookielogin_login (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+//MNode*  ml_cookielogin_login_dual (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_cookielogin_logout (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_cookielogin_check (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_cookielogin_delete (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_cookielogin_clear (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
 
 #endif /* ML_COOKIELOGIN_H */
diff --git a/modules/ml-db.cc b/modules/ml-db.cc
index aacb451..fcc72a5 100644
--- a/modules/ml-db.cc
+++ b/modules/ml-db.cc
@@ -16,11 +16,6 @@
 
 */
 
-static MLDb*  objref (MlEnv* mlenv) {
-    assert (mlenv->module->id == cMLDbID);
-    return (MLDb*)mlenv->module;
-}
-
 void  MLDb::dbPath (const ustring& name, bool fxserial, ustring& dbpath, ustring& lockpath, MlEnv* mlenv) {
     if (fxserial) {
 	dbpath = mlenv->env->path_store_file (name, kEXT_BTREE);
@@ -74,7 +69,6 @@ static MNode*  ml_db_sub (MNode* cell, MlEnv* mlenv, DBFUNC fn) {
 	{NULL, 0, 0}
     };
 
-    mlenv->module = &obj;
     setParams (arg, 1, &params, kwlist, &keywords, &rest);
     name = eval_str (params[0], mlenv);
     obj.limit = eval_int (keywords[0], mlenv);
@@ -100,7 +94,7 @@ static MNode*  ml_db_sub (MNode* cell, MlEnv* mlenv, DBFUNC fn) {
 	assert (0);
     }
 
-    mlenv->moduleStatus = MlEnv::M_EXEC;
+    mlenv->setMStack (&obj);
     ans = progn (rest, mlenv);
     if (mlenv->breaksym ()
 	&& (mlenv->breaksym ()->isNil () || eq (mlenv->breaksym (), cell->car ()))) {
@@ -114,7 +108,7 @@ static MNode*  ml_db_sub (MNode* cell, MlEnv* mlenv, DBFUNC fn) {
  ($db-read NAME [:limit NUM] [#xserial | :xserial BOOL] [SUBFUNCTION...])
 
 */
-//#MFUNC	$db-read	ml_db_read
+//#MFUNC	$db-read	ml_db_read	cMLDbID
 MNode*  ml_db_read (MNode* cell, MlEnv* mlenv) {
     return ml_db_sub (cell, mlenv, FN_READ);
 }
@@ -124,7 +118,7 @@ MNode*  ml_db_read (MNode* cell, MlEnv* mlenv) {
  ($db-rw NAME [:limit NUM] [#xserial | :xserial BOOL] [SUBFUNCTION...])
 
 */
-//#MFUNC	$db-rw	ml_db_rw
+//#MFUNC	$db-rw	ml_db_rw	cMLDbID
 MNode*  ml_db_rw (MNode* cell, MlEnv* mlenv) {
     return ml_db_sub (cell, mlenv, FN_RW);
 }
@@ -140,9 +134,9 @@ MNode*  ml_db_rw (MNode* cell, MlEnv* mlenv) {
 */
 //#SFUNC	read	ml_db_x_read	$db-read
 //#SFUNC	read	ml_db_x_read	$db-rw
-MNode*  ml_db_x_read (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_db_x_read (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLDb*  obj = objref (mlenv);
+    MLDb*  obj = MObjRef<MLDb> (mobj, cMLDbID);
     ustring  key;
     ustring  val;
 
@@ -178,11 +172,10 @@ MNode*  ml_db_x_read (MNode* cell, MlEnv* mlenv) {
  (write KEY VALUES...) -> NIL
 
 */
-//#SFUNC	write	ml_db_x_write	$db-read
 //#SFUNC	write	ml_db_x_write	$db-rw
-MNode*  ml_db_x_write (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_db_x_write (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLDb*  obj = objref (mlenv);
+    MLDb*  obj = MObjRef<MLDb> (mobj, cMLDbID);
     ustring  key;
     std::vector<ustring>  values;
     ustring  v;
@@ -297,9 +290,9 @@ static void  set_read_arys (ustring& val, std::vector<ustring>& vars, std::vecto
 */
 //#SFUNC	read-array	ml_db_x_read_array	$db-read
 //#SFUNC	read-array	ml_db_x_read_array	$db-rw
-MNode*  ml_db_x_read_array (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_db_x_read_array (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLDb*  obj = objref (mlenv);
+    MLDb*  obj = MObjRef<MLDb> (mobj, cMLDbID);
     ustring  key;
     ustring  val;
     ustring  v;
@@ -341,11 +334,10 @@ MNode*  ml_db_x_read_array (MNode* cell, MlEnv* mlenv) {
  (write-array KEY VARIABLE_OR_ARRAYVARIABLE...) -> NIL
 
 */
-//#SFUNC	write-array	ml_db_x_write_array	$db-read
 //#SFUNC	write-array	ml_db_x_write_array	$db-rw
-MNode*  ml_db_x_write_array (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_db_x_write_array (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLDb*  obj = objref (mlenv);
+    MLDb*  obj = MObjRef<MLDb> (mobj, cMLDbID);
     ustring  key;
     ustring  val;
     std::vector<ustring>  vars;
@@ -416,9 +408,9 @@ MNode*  ml_db_x_write_array (MNode* cell, MlEnv* mlenv) {
 */
 //#SFUNC	read-select	ml_db_x_select	$db-read
 //#SFUNC	read-select	ml_db_x_select	$db-rw
-MNode*  ml_db_x_select (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_db_x_select (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLDb*  obj = objref (mlenv);
+    MLDb*  obj = MObjRef<MLDb> (mobj, cMLDbID);
     MNodePtr  lambda;
     std::vector<ustring>  vars;
     ustring  v;
diff --git a/modules/ml-db.h b/modules/ml-db.h
index 5d3ae5d..ce1b47c 100644
--- a/modules/ml-db.h
+++ b/modules/ml-db.h
@@ -31,11 +31,11 @@ class  MLDb: public MLFunc {
 
 MNode*  ml_db_read (MNode* cell, MlEnv* mlenv);
 MNode*  ml_db_rw (MNode* cell, MlEnv* mlenv);
-MNode*  ml_db_x_read (MNode* cell, MlEnv* mlenv);
-MNode*  ml_db_x_write (MNode* cell, MlEnv* mlenv);
-MNode*  ml_db_x_read_array (MNode* cell, MlEnv* mlenv);
-MNode*  ml_db_x_write_array (MNode* cell, MlEnv* mlenv);
-MNode*  ml_db_x_select (MNode* cell, MlEnv* mlenv);
+MNode*  ml_db_x_read (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_db_x_write (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_db_x_read_array (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_db_x_write_array (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_db_x_select (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
 MNode*  ml_temp_read (MNode* cell, MlEnv* mlenv);
 MNode*  ml_temp_write (MNode* cell, MlEnv* mlenv);
 
diff --git a/modules/ml-sqlite3.cc b/modules/ml-sqlite3.cc
index 39f1327..911c46d 100644
--- a/modules/ml-sqlite3.cc
+++ b/modules/ml-sqlite3.cc
@@ -15,11 +15,6 @@
 
 */
 
-static MLSqlite3*  objref (MlEnv* mlenv) {
-    assert (mlenv->module->id == cMLSqlite3ID);
-    return (MLSqlite3*)mlenv->module;
-}
-
 int  MLSqlite3::open (ustring& name) {
     int  rc;
 
@@ -233,7 +228,7 @@ sqlite3_int64  MLSqlite3::rowid () {
  ($sqlite3 DB [:limit NUM] [#create | :create BOOL] [SUBFUNCTION...])
 
 */
-//#MFUNC	$sqlite3	ml_sqlite3
+//#MFUNC	$sqlite3	ml_sqlite3	cMLSqlite3ID
 MNode*  ml_sqlite3 (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
     MLSqlite3  obj;
@@ -249,7 +244,6 @@ MNode*  ml_sqlite3 (MNode* cell, MlEnv* mlenv) {
 	{NULL, 0, 0}
     };
 
-    mlenv->module = &obj;
     setParams (arg, 1, &params, kwlist, &keywords, &rest);
     db = eval_str (params[0], mlenv);
     if (keywords[0]) {
@@ -267,7 +261,7 @@ MNode*  ml_sqlite3 (MNode* cell, MlEnv* mlenv) {
     if (! obj.open (dbfile))
 	throw (ustring ("unable to open database file."));
 
-    mlenv->moduleStatus = MlEnv::M_EXEC;
+    mlenv->setMStack (&obj);
     ans = progn (rest, mlenv);
     if (mlenv->breaksym ()
 	&& (mlenv->breaksym ()->isNil () || eq (mlenv->breaksym (), cell->car ()))) {
@@ -305,14 +299,12 @@ static void  pushAnswer (MlEnv* mlenv, MNode* cell, MNode*& arg, MLSqlite3::name
 ===subfunctions of $sqlite3===
 
 */
-static MNode*  ml_sqlite3_sql_main (MNode* cell, MlEnv* mlenv, MLSqlite3::fsqlParam& par) {
+static MNode*  ml_sqlite3_sql_main (MNode* cell, MlEnv* mlenv, MLSqlite3::fsqlParam& par, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLSqlite3*  obj = objref (mlenv);
+    MLSqlite3*  obj = MObjRef<MLSqlite3> (mobj, cMLSqlite3ID);
     int  rc;
     MNodePtr  ans;
     int  mode;
-//    ustring*  u;
-//    ustring*  u2;
     AutoDelete<ustring>  u;
     AutoDelete<ustring>  u2;
     umatch  m;
@@ -462,16 +454,16 @@ static MNode*  ml_sqlite3_sql_main (MNode* cell, MlEnv* mlenv, MLSqlite3::fsqlPa
 */
 //#SFUNC	sql	ml_sqlite3_sql
 //#SFUNC	sql@	ml_sqlite3_sql_ary
-MNode*  ml_sqlite3_sql (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_sqlite3_sql (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MLSqlite3::fsqlParam  par;
 
-    return ml_sqlite3_sql_main (cell, mlenv, par);
+    return ml_sqlite3_sql_main (cell, mlenv, par, mobj);
 }
-MNode*  ml_sqlite3_sql_ary (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_sqlite3_sql_ary (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MLSqlite3::fsqlParam  par;
 
     par.answerisary = 1;
-    return ml_sqlite3_sql_main (cell, mlenv, par);
+    return ml_sqlite3_sql_main (cell, mlenv, par, mobj);
 }
 
 /*DOC:
@@ -480,9 +472,9 @@ MNode*  ml_sqlite3_sql_ary (MNode* cell, MlEnv* mlenv) {
 
 */
 //#SFUNC	rowid	ml_sqlite3_rowid
-MNode*  ml_sqlite3_rowid (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_sqlite3_rowid (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLSqlite3*  obj = objref (mlenv);
+    MLSqlite3*  obj = MObjRef<MLSqlite3> (mobj, cMLSqlite3ID);
 
     if (arg)
 	throw (uErrorWrongNumber);
@@ -515,9 +507,9 @@ static ustring  escape_like (const ustring& str) {
 
 */
 //#SFUNC	escape-like	ml_sqlite3_escape_like
-MNode*  ml_sqlite3_escape_like (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_sqlite3_escape_like (MNode* cell, MlEnv* mlenv, MLFunc* mobj) {
     MNode*  arg = cell->cdr ();
-    MLSqlite3*  obj = objref (mlenv);
+    MLSqlite3*  obj = MObjRef<MLSqlite3> (mobj, cMLSqlite3ID);
     ustring  str;
     ustring  ans;
 
diff --git a/modules/ml-sqlite3.h b/modules/ml-sqlite3.h
index 36081e2..f191807 100644
--- a/modules/ml-sqlite3.h
+++ b/modules/ml-sqlite3.h
@@ -67,9 +67,9 @@ class  MLSqlite3: public MLFunc {
 };
 
 MNode*  ml_sqlite3 (MNode* cell, MlEnv* mlenv);
-MNode*  ml_sqlite3_sql (MNode* cell, MlEnv* mlenv);
-MNode*  ml_sqlite3_sql_ary (MNode* cell, MlEnv* mlenv);
-MNode*  ml_sqlite3_rowid (MNode* cell, MlEnv* mlenv);
-MNode*  ml_sqlite3_escape_like (MNode* cell, MlEnv* mlenv);
+MNode*  ml_sqlite3_sql (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_sqlite3_sql_ary (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_sqlite3_rowid (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
+MNode*  ml_sqlite3_escape_like (MNode* cell, MlEnv* mlenv, MLFunc* mobj);
 
 #endif /* ML_SQLITE3_H */