===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/io/ox_asir.c,v
retrieving revision 1.51
retrieving revision 1.64
diff -u -p -r1.51 -r1.64
--- OpenXM_contrib2/asir2000/io/ox_asir.c	2004/02/13 05:48:36	1.51
+++ OpenXM_contrib2/asir2000/io/ox_asir.c	2006/09/26 05:35:26	1.64
@@ -44,7 +44,7 @@
  * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
- * $OpenXM: OpenXM_contrib2/asir2000/io/ox_asir.c,v 1.50 2003/12/13 08:03:56 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/io/ox_asir.c,v 1.63 2006/06/21 09:46:06 noro Exp $ 
 */
 #include "ca.h"
 #include "parse.h"
@@ -70,11 +70,13 @@ extern JMP_BUF ox_env;
 extern MATHCAP my_mathcap;
 
 extern int little_endian,ox_sock_id;
+extern char LastError[];
+extern LIST LastStackTrace;
 
 int ox_sock_id;
 int lib_ox_need_conv;
 
-void create_error(ERR *,unsigned int ,char *);
+void create_error(ERR *,unsigned int ,char *,LIST trace);
 
 int asir_OperandStackSize;
 Obj *asir_OperandStack;
@@ -147,7 +149,6 @@ void ox_main(int argc,char **argv) {
 	ERR err;
 	unsigned int serial;
 	int ret;
-	extern char LastError[];
 
 	ox_asir_init(argc,argv,"ox_asir");
 	if ( do_message )
@@ -155,6 +156,9 @@ void ox_main(int argc,char **argv) {
 	if ( SETJMP(ox_env) ) {
 		while ( NEXT(asir_infile) )
 			closecurrentinput();
+		resetpvs();
+		reset_engine();
+		reset_io();
 		ox_send_sync(0);
 	}
 	while ( 1 ) {
@@ -183,8 +187,11 @@ void ox_main(int argc,char **argv) {
 					fprintf(stderr," %s\n",name_of_cmd(cmd));
 				if ( ret = SETJMP(main_env) ) {
 					if ( ret == 1 ) {
-						create_error(&err,serial,LastError);
+						create_error(&err,serial,LastError,LastStackTrace);
 						asir_push_one((Obj)err);
+						while ( NEXT(asir_infile) )
+							closecurrentinput();
+						resetpvs();
 					}
 					break;
 				}
@@ -429,7 +436,7 @@ void asir_popCMO(unsigned int serial)
 	if ( valid_as_cmo(obj) )
 		ox_send_data(0,obj);
 	else {
-		create_error(&err,serial,"cannot convert to CMO object");
+		create_error(&err,serial,"cannot convert to CMO object",0);
 		ox_send_data(0,err);
 		asir_push_one(obj);
 	}
@@ -455,7 +462,7 @@ void asir_reduce_102(unsigned int serial)
 	else if ( !strcmp(opname,"*") )
 		func = arf_mul;
 	if ( !func ) {
-		create_error(&err,serial,"Invalid opration in ox_reduce_102");
+		create_error(&err,serial,"Invalid opration in ox_reduce_102",0);
 		asir_push_one(obj);
 	} else
 		ox_reduce_102(root,func);
@@ -508,7 +515,7 @@ void asir_set_rank_102(unsigned int serial)
 	}
 	if ( !stat ) return;
 	else {
-		create_error(&err,serial,"Invalid argument(s) in ox_set_rank_102");
+		create_error(&err,serial,"Invalid argument(s) in ox_set_rank_102",0);
 		asir_push_one(obj);
 	}
 }
@@ -536,7 +543,7 @@ void asir_tcp_accept_102(unsigned int serial)
 	rank = QTOS((Q)r);
 	if ( register_102(s,rank,1) < 0 ) {
 		create_error(&err,serial,
-			"failed to bind or accept in ox_tcp_accept_102");
+			"failed to bind or accept in ox_tcp_accept_102",0);
 		asir_push_one((Obj)err);
 	}
 }
@@ -568,7 +575,7 @@ void asir_tcp_connect_102(unsigned int serial)
 	rank = QTOS((Q)r);
 	if ( register_102(s,rank,1) < 0 ) {
 		create_error(&err,serial,
-			"failed to connect in ox_tcp_connect_102");
+			"failed to connect in ox_tcp_connect_102",0);
 		asir_push_one((Obj)err);
 	}
 }
@@ -585,31 +592,34 @@ void asir_pushCMOtag(unsigned int serial)
 		MKUSINT(ui,tag);
 		asir_push_one((Obj)ui);
 	} else {
-		create_error(&err,serial,"cannot convert to CMO object");
+		create_error(&err,serial,"cannot convert to CMO object",0);
 		asir_push_one((Obj)err);
 	}
 }
 
+void print_to_wfep(Obj obj)
+{
+	asir_push_one(obj);
+	asir_popString();
+}
+
 void asir_popString()
 {
 	Obj val;
-	char *buf,*obuf;
+	char *buf;
 	int l;
 	STRING str;
 
 	val = asir_pop_one();
 	if ( !val )
-		obuf = "0";
+		buf = "0";
 	else {
 		l = estimate_length(CO,val);
 		buf = (char *)ALLOCA(l+1);
 		soutput_init(buf);
 		sprintexpr(CO,val);
-		l = strlen(buf);
-		obuf = (char *)MALLOC(l+1);
-		strcpy(obuf,buf);
 	}
-	MKSTR(str,obuf);
+	MKSTR(str,buf);
 	ox_send_data(0,str);
 }
 
@@ -635,7 +645,7 @@ void asir_setName(unsigned int serial)
 	parse_strp = (char *)ALLOCA(n);
 	sprintf(parse_strp,"%s%s",name,dummy);
 	if ( mainparse(&snode) ) {
-		create_error(&err,serial,"cannot set to variable");
+		create_error(&err,serial,"cannot set to variable",0);
 		asir_push_one((Obj)err);
 	} else {
 		FA1((FNODE)FA0(snode)) = (pointer)mkfnode(1,I_FORMULA,asir_pop_one());
@@ -657,13 +667,27 @@ void asir_evalName(unsigned int serial)
 	parse_strp = (char *)ALLOCA(n);
 	sprintf(parse_strp,"%s;",name);
 	if ( mainparse(&snode) ) {
-		create_error(&err,serial,"no such variable");
+		create_error(&err,serial,"no such variable",0);
 		val = (pointer)err;
 	} else
 		val = evalstat(snode);	
 	asir_push_one(val);
 }
 
+char *augment_backslash(char *s)
+{
+	char *p,*r;
+	int i;
+
+	for ( i = 0, p = s; *p; p++, i++ ) if ( *p == '\\' ) i++;
+	r = (char *)MALLOC_ATOMIC((i+1)*sizeof(char));
+	for ( i = 0, p = s; *p; p++, i++ ) {
+		if ( *p == '\\' ) r[i++] = '\\';
+		r[i] = *p;
+	}
+	return r;
+}
+
 int asir_executeString()
 {
 	SNODE snode;
@@ -680,7 +704,13 @@ int asir_executeString()
 # endif
 #endif
 	cmd = ((STRING)asir_pop_one())->body;
+/* XXX : probably this is useless */
+#if 0
+	parse_strp = augment_backslash(cmd);
+#else
 	parse_strp = cmd;
+#endif
+	asir_infile->ln = 1;
 	if ( mainparse(&snode) ) {
 		return -1;
 	}
@@ -733,6 +763,7 @@ static void asir_executeFunction(int serial)
 	if ( n )
 		NEXT(n1) = 0;
 
+#if 0
 	if ( !strcmp(func,"load") ) {
 		fname = (STRING)BDY(n);
 		if ( OID(fname) == O_STR ) {
@@ -747,6 +778,7 @@ static void asir_executeFunction(int serial)
 		}
 		result = 0;
 	} else {
+#endif
 		searchf(noargsysf,func,&f);
 		if ( !f )
 			searchf(sysf,func,&f); 
@@ -760,12 +792,14 @@ static void asir_executeFunction(int serial)
 		} else {
 			result = (Obj)bevalf(f,n);
 		}
+#if 0
 	}
+#endif
 	asir_push_one(result);
 	return;
 
 error:
-	create_error(&err,serial,buf);
+	create_error(&err,serial,buf,0);
 	result = (Obj)err;
 	asir_push_one(result);
 }
@@ -824,7 +858,6 @@ void ox_asir_init(int argc,char **argv,char *servernam
 {
 	char ifname[BUFSIZ];
 	extern int GC_dont_gc;
-	extern int read_exec_file;
 	extern int do_asirrc;
 	extern int do_server_in_X11;
 	extern char displayname[];
@@ -833,10 +866,12 @@ void ox_asir_init(int argc,char **argv,char *servernam
 	FILE *ifp;
 	char *homedir;
 	char *ptr;
+	int do_server_sav;
 #if !defined(VISUAL)
 	int tmp;
 #endif
 
+	GC_init();
 #if !defined(VISUAL) && !defined(MPI)
 	do_server_in_X11 = 1; /* XXX */
 #endif
@@ -849,7 +884,6 @@ void ox_asir_init(int argc,char **argv,char *servernam
 	rtime_init();
 	env_init();
 	endian_init();
-	GC_init();
 	cppname_init();
 	process_args(--argc,++argv);
 #if defined(__CYGWIN__)
@@ -885,16 +919,19 @@ void ox_asir_init(int argc,char **argv,char *servernam
 		}
 		sprintf(ifname,"%s/.asirrc",homedir);
 	}
+
+	/* the bottom of the input stack */
+	input_init(0,"string");
+
 	if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
-		input_init(ifp,ifname);
-		if ( !SETJMP(main_env) ) {
-			read_exec_file = 1;
-			read_eval_loop();
-			read_exec_file = 0;
-		}
 		fclose(ifp);
+		do_server_sav = do_server_in_X11;
+		do_server_in_X11 = 0;
+		if ( !SETJMP(main_env) )
+			execasirfile(ifname);
+		do_server_in_X11 = do_server_sav;
 	}
-	input_init(0,"string");
+
 /* XXX Windows compatibility */
 	ox_io_init();
 	create_my_mathcap(servername);
@@ -988,7 +1025,7 @@ int asir_ox_pop_cmo(void *cmo, int limit)
 	obj = asir_pop_one();
 	if ( !valid_as_cmo(obj) ) {
 		asir_push_one(obj);
-		create_error(&err,0,"The object at the stack top is invalid as a CMO.");
+		create_error(&err,0,"The object at the stack top is invalid as a CMO.",0);
 		obj = (Obj)err;
 	}
 	len = count_as_cmo(obj);
@@ -1037,7 +1074,7 @@ void asir_ox_push_cmd(int cmd)
 	if ( ret = SETJMP(main_env) ) {
 		asir_reset_handler();
 		if ( ret == 1 ) {
-			create_error(&err,0,LastError); /* XXX */
+			create_error(&err,0,LastError,LastStackTrace); /* XXX */
 			asir_push_one((Obj)err);
 		}
 	} else {
@@ -1064,7 +1101,7 @@ void asir_ox_execute_string(char *s)
 	if ( ret = SETJMP(main_env) ) {
 		asir_reset_handler();
 		if ( ret == 1 ) {
-			create_error(&err,0,LastError); /* XXX */
+			create_error(&err,0,LastError,LastStackTrace); /* XXX */
 			asir_push_one((Obj)err);
 		}
 	} else {
@@ -1119,13 +1156,13 @@ int asir_ox_init(int byteorder)
 	int tmp;
 	char ifname[BUFSIZ];
 	extern int GC_dont_gc;
-	extern int read_exec_file;
 	extern int do_asirrc;
 	extern int do_server_in_X11;
 	char *getenv();
 	static ox_asir_initialized = 0;
 	FILE *ifp;
 
+	GC_init();
 #if !defined(VISUAL) && !defined(MPI)
 	do_server_in_X11 = 0; /* XXX */
 #endif
@@ -1138,7 +1175,6 @@ int asir_ox_init(int byteorder)
 	rtime_init();
 	env_init();
 	endian_init();
-	GC_init();
 /*	process_args(argc,argv); */
 	output_init();
 	arf_init();
@@ -1156,17 +1192,13 @@ int asir_ox_init(int byteorder)
 #if defined(UINIT)
 	reg_sysf();
 #endif
+	input_init(0,"string");
 	sprintf(ifname,"%s/.asirrc",getenv("HOME"));
 	if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
-		input_init(ifp,ifname);
-		if ( !SETJMP(main_env) ) {
-			read_exec_file = 1;
-			read_eval_loop();
-			read_exec_file = 0;
-		}
 		fclose(ifp);
+		if ( !SETJMP(main_env) )
+			execasirfile(ifname);
 	}
-	input_init(0,"string");
 
 	asir_OperandStackSize = BUFSIZ;
 	asir_OperandStack = (Obj *)CALLOC(asir_OperandStackSize,sizeof(Obj));