===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/eval.c,v
retrieving revision 1.31
retrieving revision 1.43
diff -u -p -r1.31 -r1.43
--- OpenXM_contrib2/asir2000/parse/eval.c	2004/02/09 08:23:30	1.31
+++ OpenXM_contrib2/asir2000/parse/eval.c	2005/09/14 02:48:38	1.43
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.30 2003/11/08 01:12:03 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.42 2005/09/13 06:54:22 noro Exp $ 
 */
 #include <ctype.h>
 #include "ca.h"
@@ -64,6 +64,7 @@ int f_break,f_return,f_continue;
 int evalstatline;
 int recv_intr;
 int show_crossref;
+void gen_searchf_searchonly(char *name,FUNC *r);
 
 pointer eval(FNODE f)
 {
@@ -71,11 +72,11 @@ pointer eval(FNODE f)
 	STRING str;
 	pointer val = 0;
 	pointer a,a1,a2;
-	NODE tn,ind;
+	NODE tn,ind,match;
 	R u;
 	DP dp;
 	unsigned int pv;
-	int c;
+	int c,ret;
 	FNODE f1;
 	UP2 up2;
 	UP up;
@@ -85,6 +86,7 @@ pointer eval(FNODE f)
 	GFPN gfpn;
 	GFSN gfsn;
 	RANGE range;
+	QUOTE expr,pattern;
 
 #if defined(VISUAL)
 	if ( recv_intr ) {
@@ -223,7 +225,9 @@ pointer eval(FNODE f)
 				error("-- : not implemented yet");
 			break;
 		case I_PVAR:
-			pv = (unsigned int)FA0(f); ind = (NODE)FA1(f); GETPV(pv,a); 
+			pv = (unsigned int)FA0(f);
+			ind = (NODE)FA1(f);
+			GETPV(pv,a); 
 			if ( !ind )
 				val = a;
 			else {
@@ -306,8 +310,6 @@ pointer eval(FNODE f)
 				MKLIST(t,NEXT(BDY((LIST)a))); val = (pointer)t;
 			}
 			break;
-		case I_PROC:
-			val = (pointer)FA0(f); break;
 		case I_INDEX:
 			a = eval((FNODE)FA0(f)); ind = (NODE)FA1(f);
 			evalnodebody(ind,&tn); getarray(a,tn,&val); 
@@ -332,14 +334,18 @@ pointer eval(FNODE f)
 	return ( val );
 }
 
+V searchvar(char *name);
+
 pointer evalstat(SNODE f)
 {
 	pointer val = 0,t,s,s1;
 	P u;
 	NODE tn;
 	int i,ac;
+	V v;
 	V *a;
 	char *buf;
+	FUNC func;
 
 	if ( !f )
 		return ( 0 );
@@ -378,7 +384,13 @@ pointer evalstat(SNODE f)
 				makevar(buf,&u); a[i] = VR(u);
 				substr(CO,0,(Obj)s,VR((P)t),(Obj)u,(Obj *)&s1); s = s1;
 			}
-			mkpf((char *)FA0(f),(Obj)s,ac,a,0,0,0,(PF *)&val); val = 0; break;
+			mkpf((char *)FA0(f),(Obj)s,ac,a,0,0,0,(PF *)&val); val = 0;
+			v = searchvar((char *)FA0(f));
+			if ( v ) {
+				searchpf((char *)FA0(f),&func);
+				makesrvar(func,&u);
+			}
+			break;
 		case S_SINGLE:
 			val = eval((FNODE)FA0(f)); break;
 		case S_CPLX:
@@ -430,6 +442,13 @@ pointer evalstat(SNODE f)
 					break;
 			}
 			f_break = 0; break;
+		case S_MODULE:
+			CUR_MODULE = (MODULE)FA0(f);
+			if ( CUR_MODULE )
+					MPVS = CUR_MODULE->pvs;
+			else
+					MPVS = 0;
+			break;
 		default:
 			error("evalstat : unknown id");
 			break;
@@ -454,7 +473,6 @@ extern NODE PVSS;
 pointer evalf(FUNC f,FNODE a,FNODE opt)
 {
 	LIST args;
-	OPTLIST optlist;
 	pointer val;
 	int i,n,level;
 	NODE tn,sn,opts,opt1,dmy;
@@ -462,9 +480,18 @@ pointer evalf(FUNC f,FNODE a,FNODE opt)
 	char errbuf[BUFSIZ];
 	static unsigned int stack_size;
 	static void *stack_base;
+	FUNC f1;
 
 	if ( f->id == A_UNDEF ) {
-		sprintf(errbuf,"evalf : %s undefined",NAME(f));
+		gen_searchf_searchonly(f->fullname,&f1);
+		if ( f1->id == A_UNDEF ) {
+			sprintf(errbuf,"evalf : %s undefined",NAME(f));
+			error(errbuf);
+		} else
+			*f = *f1;
+	}
+	if ( getsecuremode() && !PVSS && !f->secure ) {
+		sprintf(errbuf,"evalf : %s not permitted",NAME(f));
 		error(errbuf);
 	}
 	if ( f->id != A_PARI ) {
@@ -495,11 +522,7 @@ pointer evalf(FUNC f,FNODE a,FNODE opt)
 				(*f->f.binf)(&val);
 			} else {
 				args = (LIST)eval(a);
-				if ( opts ) {
-					NEWOPTLIST(optlist);
-					BDY(optlist) = opts;
-					appendtonode(BDY(args),(pointer)optlist,&dmy);
-				}
+				current_option = opts;
 				cur_binf = f;
 				(*f->f.binf)(args?BDY(args):0,&val);
 			}
@@ -694,13 +717,17 @@ pointer bevalf(FUNC f,NODE a)
 	pointer val;
 	int i,n;
 	NODE tn,sn;
-    VS pvs;
+    VS pvs,prev_mpvs;
 	char errbuf[BUFSIZ];
 
 	if ( f->id == A_UNDEF ) {
 		sprintf(errbuf,"bevalf : %s undefined",NAME(f));
 		error(errbuf);
 	}
+	if ( getsecuremode() && !PVSS && !f->secure ) {
+		sprintf(errbuf,"bevalf : %s not permitted",NAME(f));
+		error(errbuf);
+	}
 	if ( f->id != A_PARI ) {
 		for ( i = 0, tn = a; tn; i++, tn = NEXT(tn) );
 		if ( ((n = f->argc)>= 0 && i != n) || (n < 0 && i > -n) ) {
@@ -742,7 +769,13 @@ pointer bevalf(FUNC f,NODE a)
 			for ( tn = f->f.usrf->args, sn = a; 
 				sn; tn = NEXT(tn), sn = NEXT(sn) )
 				ASSPV((int)FA0((FNODE)BDY(tn)),BDY(sn));
-			val = evalstat((SNODE)BDY(f->f.usrf)); 
+			if ( f->f.usrf->module ) {
+				prev_mpvs = MPVS;
+				MPVS = f->f.usrf->module->pvs;
+				val = evalstat((SNODE)BDY(f->f.usrf)); 
+				MPVS = prev_mpvs;
+			} else
+				val = evalstat((SNODE)BDY(f->f.usrf)); 
 			f_return = f_break = f_continue = 0; poppvs(); 
 			break;
 		case A_PURE:
@@ -759,11 +792,15 @@ pointer bevalf(FUNC f,NODE a)
 pointer evalif(FNODE f,FNODE a)
 {
 	Obj g;
+	FNODE t;
 
 	g = (Obj)eval(f);
 	if ( g && (OID(g) == O_P) && (VR((P)g)->attr == (pointer)V_SR) )
 		return evalf((FUNC)VR((P)g)->priv,a,0);
-	else {
+	else if ( g && OID(g) == O_QUOTEARG && ((QUOTEARG)g)->type == A_func ) {
+		t = mkfnode(2,I_FUNC,((QUOTEARG)g)->body,a);
+		return eval(t);
+	} else {
 		error("invalid function pointer");
 		/* NOTREACHED */
 		return (pointer)-1;
@@ -871,6 +908,27 @@ void gen_searchf(char *name,FUNC *r)
 	*r = val;
 }
 
+void gen_searchf_searchonly(char *name,FUNC *r)
+{
+	FUNC val = 0;
+	int global = 0;
+	if ( *name == ':' ) {
+		global = 1;
+		name += 2;
+	}
+	if ( CUR_MODULE && !global )
+		searchf(CUR_MODULE->usrf_list,name,&val);
+	if ( !val )
+		searchf(sysf,name,&val);
+	if ( !val )
+		searchf(ubinf,name,&val);
+	if ( !val )
+		searchpf(name,&val);
+	if ( !val )
+		searchuf(name,&val);
+	*r = val;
+}
+
 void searchf(NODE fn,char *name,FUNC *r)
 {
 	NODE tn;
@@ -966,6 +1024,9 @@ void mkuf(char *name,char *fname,NODE args,SNODE body,
 	char *longname;
 	int argc;
 
+	if ( getsecuremode() ) {
+		error("defining function is not permitted in the secure mode");
+	}
 	if ( *name == ':' )
 		name += 2;
 	if ( !module ) {