===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/io/cio.c,v
retrieving revision 1.1.1.1
retrieving revision 1.7
diff -u -p -r1.1.1.1 -r1.7
--- OpenXM_contrib2/asir2000/io/cio.c	1999/12/03 07:39:11	1.1.1.1
+++ OpenXM_contrib2/asir2000/io/cio.c	2001/08/03 08:50:19	1.7
@@ -1,4 +1,51 @@
-/* $OpenXM: OpenXM/src/asir99/io/cio.c,v 1.2 1999/11/18 02:24:01 noro Exp $ */
+/*
+ * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED 
+ * All rights reserved.
+ * 
+ * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
+ * non-exclusive and royalty-free license to use, copy, modify and
+ * redistribute, solely for non-commercial and non-profit purposes, the
+ * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
+ * conditions of this Agreement. For the avoidance of doubt, you acquire
+ * only a limited right to use the SOFTWARE hereunder, and FLL or any
+ * third party developer retains all rights, including but not limited to
+ * copyrights, in and to the SOFTWARE.
+ * 
+ * (1) FLL does not grant you a license in any way for commercial
+ * purposes. You may use the SOFTWARE only for non-commercial and
+ * non-profit purposes only, such as academic, research and internal
+ * business use.
+ * (2) The SOFTWARE is protected by the Copyright Law of Japan and
+ * international copyright treaties. If you make copies of the SOFTWARE,
+ * with or without modification, as permitted hereunder, you shall affix
+ * to all such copies of the SOFTWARE the above copyright notice.
+ * (3) An explicit reference to this SOFTWARE and its copyright owner
+ * shall be made on your publication or presentation in any form of the
+ * results obtained by use of the SOFTWARE.
+ * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
+ * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
+ * for such modification or the source code of the modified part of the
+ * SOFTWARE.
+ * 
+ * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
+ * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
+ * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
+ * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
+ * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
+ * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
+ * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
+ * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
+ * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
+ * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
+ * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
+ * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
+ * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
+ * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
+ * 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/cio.c,v 1.6 2000/11/08 08:02:51 noro Exp $ 
+*/
 #include "ca.h"
 #include "parse.h"
 #include "ox.h"
@@ -17,10 +64,10 @@ Obj obj;
 		return 1;
 	switch ( OID(obj) ) {
 		case O_MATHCAP: case O_P: case O_R: case O_DP: case O_STR:
-		case O_ERR: case O_USINT: case O_VOID:
+		case O_ERR: case O_USINT: case O_BYTEARRAY: case O_VOID:
 			return 1;
 		case O_N:
-			if ( NID((Num)obj) == N_Q )
+			if ( NID((Num)obj) == N_Q || NID((Num)obj) == N_R )
 				return 1;
 			else
 				return 0;
@@ -29,6 +76,8 @@ Obj obj;
 				if ( !valid_as_cmo(BDY(m)) )
 					return 0;
 			return 1;
+		case O_QUOTE:
+			return 1;
 		default:
 			return 0;
 	}
@@ -47,7 +96,19 @@ Obj obj;
 	}
 	switch ( OID(obj) ) {
 		case O_N:
-			write_cmo_q(s,obj);
+			switch ( NID((Num)obj) ) {
+				case N_Q:
+					write_cmo_q(s,(Q)obj);
+					break;
+				case N_R:
+					write_cmo_real(s,(Real)obj);
+					break;
+				default:
+					sprintf(errmsg, "write_cmo : number id=%d not implemented.",
+						NID((Num)obj));
+					error(errmsg);
+					break;
+			}
 			break;
 		case O_P:
 			write_cmo_p(s,obj);
@@ -73,9 +134,15 @@ Obj obj;
 		case O_ERR:
 			write_cmo_error(s,obj);
 			break;
+		case O_BYTEARRAY:
+			write_cmo_bytearray(s,obj);
+			break;
 		case O_VOID:
 			r = ((USINT)obj)->body; write_int(s,&r);
 			break;
+		case O_QUOTE:
+			write_cmo_tree(s,(FNODE)(((QUOTE)obj)->body));
+			break;
 		default:
 			sprintf(errmsg, "write_cmo : id=%d not implemented.",OID(obj));
 			error(errmsg);
@@ -83,6 +150,51 @@ Obj obj;
 	}
 }
 
+int cmo_tag(obj,tag)
+Obj obj;
+int *tag;
+{
+	if ( !valid_as_cmo(obj) )
+		return 0;
+	if ( !obj ) {
+		*tag = CMO_NULL;
+		return 1;
+	}
+	switch ( OID(obj) ) {
+		case O_N:
+			switch ( NID((Num)obj) ) {
+				case N_Q:
+					*tag = DN((Q)obj) ? CMO_QQ : CMO_ZZ; break;
+				case N_R:
+					*tag = CMO_IEEE_DOUBLE_FLOAT; break;
+				default:
+					return 0;
+			}
+			break;
+		case O_P:
+			*tag = CMO_RECURSIVE_POLYNOMIAL; break;
+		case O_R:
+			*tag = CMO_RATIONAL; break;
+		case O_DP:
+			*tag = CMO_DISTRIBUTED_POLYNOMIAL; break;
+		case O_LIST:
+			*tag = CMO_LIST; break;
+		case O_STR:
+			*tag = CMO_STRING; break;
+		case O_USINT:
+			*tag = CMO_INT32; break;
+		case O_MATHCAP:
+			*tag = CMO_MATHCAP; break;
+		case O_ERR:
+			*tag = CMO_ERROR2; break;
+		case O_QUOTE:
+			*tag = CMO_TREE; break; break;
+		default:
+			return 0;
+	}
+	return 1;
+}
+
 write_cmo_mathcap(s,mc)
 FILE *s;
 MATHCAP mc;
@@ -119,6 +231,17 @@ Q q;
 	}
 }
 
+write_cmo_real(s,real)
+FILE *s;
+Real real;
+{
+	unsigned int r;
+	double dbl;
+
+	r = CMO_IEEE_DOUBLE_FLOAT; write_int(s,&r);
+	dbl = real->body; write_double(s,&dbl);
+}
+
 write_cmo_zz(s,sgn,n)
 FILE *s;
 int sgn;
@@ -272,6 +395,17 @@ STRING str;
 	savestr(s,BDY(str));	
 }
 
+write_cmo_bytearray(s,array)
+FILE *s;
+BYTEARRAY array;
+{
+	int r;
+
+	r = CMO_DATUM; write_int(s,&r);
+	write_int(s,&array->len);
+	write_string(s,array->body,array->len);
+}
+
 write_cmo_error(s,e)
 FILE *s;
 ERR e;
@@ -282,6 +416,88 @@ ERR e;
 	write_cmo(s,BDY(e));
 }
 
+/* XXX */
+
+write_cmo_tree(s,f)
+FILE *s;
+FNODE f;
+{
+	int r,i,n;
+	char opname[BUFSIZ];
+	NODE args,t;
+	FUNC fspec;
+	struct oSTRING str,nullstr;
+
+	/* null string */
+	nullstr.id = O_STR;
+	nullstr.body = 0;
+
+	/* name string */
+	str.id = O_STR;
+	str.body = opname;
+
+	switch ( f->id ) {
+		case I_BOP: case I_COP:
+		case I_AND: case I_OR:
+			/*
+			 * (CMO_TREE (CMO_STRING,op),(CMO_STRING,0)(CMO_LIST,2,arg1,arg2))
+			 */
+			switch ( f->id ) {
+				case I_BOP:
+					strcpy(opname,((ARF)FA0(f))->name); break;
+				case I_COP:
+					switch( (cid)FA0(f) ) {
+						case C_EQ: strcpy(opname,"=="); break;
+						case C_NE: strcpy(opname,"!="); break;
+						case C_GT: strcpy(opname,">"); break;
+						case C_LT: strcpy(opname,"<"); break;
+						case C_GE: strcpy(opname,">="); break;
+						case C_LE: strcpy(opname,"<="); break;
+					}
+					break;
+				case I_AND:
+					strcpy(opname,"&&"); break;
+				case I_OR:
+					strcpy(opname,"||"); break;
+			}
+			r = CMO_TREE; write_int(s,&r);
+			write_cmo_string(s,&str);	
+			write_cmo_string(s,&nullstr);
+			r = CMO_LIST; write_int(s,&r);
+			n = 2; write_int(s,&n);
+			write_cmo_tree(s,(FNODE)FA1(f));
+			write_cmo_tree(s,(FNODE)FA2(f));
+			break;
+			break;
+		case I_NOT:
+			r = CMO_TREE; write_int(s,&r);
+			strcpy(opname,"!");
+			write_cmo_string(s,&str);;
+			write_cmo_string(s,&nullstr);
+			r = CMO_LIST; write_int(s,&r);
+			n = 1; write_int(s,&n);
+			write_cmo_tree(s,(FNODE)FA1(f));
+			break;
+		case I_FUNC:
+			fspec = (FUNC)FA0(f);
+			strcpy(opname,fspec->name);
+			write_cmo_string(s,&str);	
+			write_cmo_string(s,&nullstr);
+			args = (NODE)FA0((FNODE)FA1(f));
+			r = CMO_LIST; write_int(s,&r);
+			for ( n = 0, t = args; t; t = NEXT(t), n++ );
+			write_int(s,&n);
+			for ( i = 0, t = args; i < n; t = NEXT(t), i++ )
+				write_cmo_tree(s,BDY(t));
+			break;
+		case I_FORMULA:
+			write_cmo(s,FA0(f));
+			break;
+		default:
+			break; /* XXX */
+	}
+}
+
 read_cmo(s,rp)
 FILE *s;
 Obj *rp;
@@ -292,6 +508,8 @@ Obj *rp;
 	N nm,dn;
 	P p,pnm,pdn;
 	R r;
+	Real real;
+	double dbl;
 	STRING str;
 	USINT t;
 	DP dp;
@@ -299,6 +517,7 @@ Obj *rp;
 	Obj obj;
 	ERR e;
 	MATHCAP mc;
+	BYTEARRAY array;
 
 	read_int(s,&id);
 	switch ( id ) {
@@ -310,6 +529,8 @@ Obj *rp;
 			read_cmo_uint(s,rp);
 			break;
 		case CMO_DATUM:
+			loadbytearray(s,&array); *rp = (Obj)array;
+			break;
 		case CMO_STRING:
 			loadstring(s,&str); *rp = (Obj)str;
 			break;
@@ -339,6 +560,9 @@ Obj *rp;
 			read_cmo_zz(s,&dummy,&dn);
 			NDTOQ(nm,dn,sgn,q); *rp = (Obj)q;
 			break;
+		case CMO_IEEE_DOUBLE_FLOAT:
+			read_double(s,&dbl); MKReal(dbl,real); *rp = (Obj)real;
+			break;
 		case CMO_DISTRIBUTED_POLYNOMIAL:
 			read_cmo_dp(s,&dp); *rp = (Obj)dp;
 			break;
@@ -364,6 +588,9 @@ Obj *rp;
 		case CMO_RING_BY_NAME:
 			read_cmo(s,rp);
 			break;
+		case CMO_TREE:
+			read_cmo_tree(s,rp);
+			break;
 		default:
 			MKUSINT(t,id);
 			t->id = O_VOID;
@@ -569,6 +796,98 @@ P *rp;
 	if ( dc0 )
 		NEXT(dc) = 0;
 	MKP(remote_vtab[ind],dc0,*rp);
+}
+
+/* XXX */
+
+extern struct oARF arf[];
+
+struct operator_tab {
+	char *name;
+	fid id;	
+	ARF arf;
+	cid cid;
+};
+
+static struct operator_tab optab[] = {
+	{"+",I_BOP,&arf[0],0}, /* XXX */
+	{"-",I_BOP,&arf[1],0},
+	{"*",I_BOP,&arf[2],0},
+	{"/",I_BOP,&arf[3],0},
+	{"%",I_BOP,&arf[4],0},
+	{"^",I_BOP,&arf[5],0},
+	{"==",I_COP,0,C_EQ},
+	{"!=",I_COP,0,C_NE},
+	{"<",I_COP,0,C_LT},
+	{"<=",I_COP,0,C_LE},
+	{">",I_COP,0,C_GT},
+	{">=",I_COP,0,C_GE},
+	{"&&",I_AND,0,0},
+	{"||",I_OR,0,0},
+	{"!",I_NOT,0,0},
+};
+
+static int optab_len = sizeof(optab)/sizeof(struct operator_tab);
+
+read_cmo_tree(s,rp)
+FILE *s;
+QUOTE *rp;
+{
+	int r,i,n;
+	char *opname;
+	STRING name,cd;
+	int op;
+	LIST alist;
+	NODE arg;
+	QUOTE quote;
+	FNODE fn;
+	fid id;
+
+	read_cmo(s,&name);
+	read_cmo(s,&cd); /* XXX: currently not used */
+	for ( i = 0; i < optab_len; i++ )
+		if ( !strcmp(optab[i].name,BDY(name)) )
+			break;
+	if ( i == optab_len ) {
+		/* may be a function name */
+	} else {
+		opname = optab[i].name;
+		id = optab[i].id;
+		switch ( id ) {
+			case I_BOP:
+				op = opname[0];
+				read_cmo(s,&alist);
+				arg = BDY(alist);
+				fn = mkfnode(3,I_BOP,optab[i].arf,ARG0(arg),ARG1(arg));
+				MKQUOTE(quote,fn);
+				break;
+			case I_COP:
+				read_cmo(s,&alist);
+				arg = BDY(alist);
+				fn = mkfnode(3,I_COP,optab[i].cid,ARG0(arg),ARG1(arg));
+				MKQUOTE(quote,fn);
+				break;
+			case I_AND:
+				read_cmo(s,&alist);
+				arg = BDY(alist);
+				fn = mkfnode(2,I_AND,ARG0(arg),ARG1(arg));
+				MKQUOTE(quote,fn);
+				break;
+			case I_OR:
+				read_cmo(s,&alist);
+				arg = BDY(alist);
+				fn = mkfnode(2,I_OR,ARG0(arg),ARG1(arg));
+				MKQUOTE(quote,fn);
+				break;
+			case I_NOT:
+				read_cmo(s,&alist);
+				arg = BDY(alist);
+				fn = mkfnode(1,I_OR,ARG0(arg));
+				MKQUOTE(quote,fn);
+				break;
+		}
+		*rp = quote;
+	}
 }
 
 localname_to_cmoname(a,b)