===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/eval.c,v
retrieving revision 1.61
retrieving revision 1.64
diff -u -p -r1.61 -r1.64
--- OpenXM_contrib2/asir2000/parse/eval.c	2007/11/15 06:24:59	1.61
+++ OpenXM_contrib2/asir2000/parse/eval.c	2008/11/18 20:52:47	1.64
@@ -45,14 +45,16 @@
  * 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.60 2006/02/25 06:33:31 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/parse/eval.c,v 1.63 2008/09/01 06:20:33 noro Exp $ 
 */
 #include <ctype.h>
 #include "ca.h"
 #include "al.h"
 #include "base.h"
 #include "parse.h"
+#if defined(GC7)
 #include "gc.h"
+#endif
 #include <sys/types.h>
 #include <sys/stat.h>
 #if defined(PARI)
@@ -193,7 +195,7 @@ pointer eval(FNODE f)
 		case I_RECMAP:
 			val = eval_rec_mapf((FUNC)FA0(f),(FNODE)FA1(f)); break;
 		case I_IFUNC:
-			val = evalif((FNODE)FA0(f),(FNODE)FA1(f)); break;
+			val = evalif((FNODE)FA0(f),(FNODE)FA1(f),(FNODE)FA2(f)); break;
 #if !defined(VISUAL)
 		case I_TIMER:
 			{
@@ -1215,8 +1217,86 @@ pointer bevalf(FUNC f,NODE a)
 	return val;
 }
 
-pointer evalif(FNODE f,FNODE a)
+pointer bevalf_with_opts(FUNC f,NODE a,NODE opts)
 {
+	pointer val;
+	int i,n;
+	NODE tn,sn;
+	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) ) {
+			sprintf(errbuf,"bevalf : argument mismatch in %s()",NAME(f));
+			error(errbuf);
+		}
+	}
+	switch ( f->id ) {
+		case A_BIN:
+			current_option = opts;
+			if ( !n ) {
+				cur_binf = f;
+				(*f->f.binf)(&val);
+			} else {
+				cur_binf = f;
+				(*f->f.binf)(a,&val);
+			}
+			cur_binf = 0;
+			break;
+		case A_PARI:
+			cur_binf = f;
+			val = evalparif(f,a);
+			cur_binf = 0;
+			break;
+		case A_USR:
+    		pvs = f->f.usrf->pvs;
+    		if ( PVSS )
+        		((VS)BDY(PVSS))->at = evalstatline;
+    		MKNODE(tn,pvs,PVSS); PVSS = tn;
+    		CPVS = (VS)ALLOCA(sizeof(struct oVS)); BDY(PVSS) = (pointer)CPVS;
+    		CPVS->usrf = f; CPVS->n = CPVS->asize = pvs->n;
+			CPVS->opt = opts;
+    		if ( CPVS->n ) {
+        		CPVS->va = (struct oPV *)ALLOCA(CPVS->n*sizeof(struct oPV));
+        		bcopy((char *)pvs->va,(char *)CPVS->va,
+					(int)(pvs->n*sizeof(struct oPV)));
+    		}
+    		if ( nextbp )
+        		nextbplevel++;
+			for ( tn = f->f.usrf->args, sn = a; 
+				sn; tn = NEXT(tn), sn = NEXT(sn) )
+				ASSPV((int)FA0((FNODE)BDY(tn)),BDY(sn));
+			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:
+			val = evalpf(f->f.puref,a,0);
+			break;
+		default:
+			sprintf(errbuf,"bevalf : %s undefined",NAME(f));
+			error(errbuf);
+			break;
+	}
+	return val;
+}
+
+pointer evalif(FNODE f,FNODE a,FNODE opt)
+{
 	Obj g;
 	QUOTE q;
 	FNODE t;
@@ -1224,7 +1304,7 @@ pointer evalif(FNODE f,FNODE a)
 
 	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);
+		return evalf((FUNC)VR((P)g)->priv,a,opt);
 	else if ( g && OID(g) == O_QUOTEARG && ((QUOTEARG)g)->type == A_func ) {
 		t = mkfnode(2,I_FUNC,((QUOTEARG)g)->body,a);
 		MKQUOTE(q,t);