| version 1.1.1.1, 1999/12/03 07:39:11 |
version 1.20, 2015/08/18 02:26:05 |
|
|
| /* $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.19 2015/08/14 13:51:55 fujimoto Exp $ |
| |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "parse.h" |
#include "parse.h" |
| #include "ox.h" |
#include "ox.h" |
| |
#if !defined(VISUAL) && !defined(__MINGW32__) |
| |
#include <ctype.h> |
| |
#endif |
| |
|
| #define ISIZ sizeof(int) |
#define ISIZ sizeof(int) |
| |
|
| int write_cmo_zz(FILE *,int,N); |
int valid_as_cmo(Obj obj) |
| int read_cmo_zz(FILE *,int *,N *); |
{ |
| |
NODE m; |
| |
int nid; |
| |
|
| int valid_as_cmo(obj) |
if ( !obj ) |
| 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_BYTEARRAY: case O_VOID: |
| |
return 1; |
| |
case O_N: |
| |
nid = NID((Num)obj); |
| |
if ( nid == N_Q || nid == N_R || nid == N_B || nid == N_C ) |
| |
return 1; |
| |
else |
| |
return 0; |
| |
case O_LIST: |
| |
for ( m = BDY((LIST)obj); m; m = NEXT(m) ) |
| |
if ( !valid_as_cmo(BDY(m)) ) |
| |
return 0; |
| |
return 1; |
| |
case O_QUOTE: |
| |
return 1; |
| |
default: |
| |
return 0; |
| |
} |
| |
} |
| |
|
| |
void write_cmo(FILE *s,Obj obj) |
| { |
{ |
| NODE m; |
int r; |
| |
char errmsg[BUFSIZ]; |
| |
LIST l; |
| |
|
| if ( !obj ) |
if ( !obj ) { |
| return 1; |
r = CMO_NULL; write_int(s,&r); |
| switch ( OID(obj) ) { |
return; |
| case O_MATHCAP: case O_P: case O_R: case O_DP: case O_STR: |
} |
| case O_ERR: case O_USINT: case O_VOID: |
switch ( OID(obj) ) { |
| return 1; |
case O_N: |
| case O_N: |
switch ( NID((Num)obj) ) { |
| if ( NID((Num)obj) == N_Q ) |
case N_Q: |
| return 1; |
write_cmo_q(s,(Q)obj); |
| else |
break; |
| return 0; |
case N_R: |
| case O_LIST: |
write_cmo_real(s,(Real)obj); |
| for ( m = BDY((LIST)obj); m; m = NEXT(m) ) |
break; |
| if ( !valid_as_cmo(BDY(m)) ) |
case N_B: |
| return 0; |
write_cmo_bf(s,(BF)obj); |
| return 1; |
break; |
| default: |
case N_C: |
| return 0; |
write_cmo_complex(s,(C)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,(P)obj); |
| |
break; |
| |
case O_R: |
| |
write_cmo_r(s,(R)obj); |
| |
break; |
| |
case O_DP: |
| |
write_cmo_dp(s,(DP)obj); |
| |
break; |
| |
case O_LIST: |
| |
write_cmo_list(s,(LIST)obj); |
| |
break; |
| |
case O_STR: |
| |
write_cmo_string(s,(STRING)obj); |
| |
break; |
| |
case O_USINT: |
| |
write_cmo_uint(s,(USINT)obj); |
| |
break; |
| |
case O_MATHCAP: |
| |
write_cmo_mathcap(s,(MATHCAP)obj); |
| |
break; |
| |
case O_ERR: |
| |
write_cmo_error(s,(ERR)obj); |
| |
break; |
| |
case O_BYTEARRAY: |
| |
write_cmo_bytearray(s,(BYTEARRAY)obj); |
| |
break; |
| |
case O_VOID: |
| |
r = ((USINT)obj)->body; write_int(s,&r); |
| |
break; |
| |
case O_QUOTE: |
| |
fnodetotree(BDY((QUOTE)obj),&l); |
| |
write_cmo_tree(s,l); |
| |
break; |
| |
case O_MAT: |
| |
write_cmo_matrix_as_list(s,(MAT)obj); |
| |
break; |
| |
default: |
| |
sprintf(errmsg, "write_cmo : id=%d not implemented.",OID(obj)); |
| |
error(errmsg); |
| |
break; |
| |
} |
| } |
} |
| |
|
| write_cmo(s,obj) |
int cmo_tag(Obj obj,int *tag) |
| FILE *s; |
|
| Obj obj; |
|
| { |
{ |
| int r; |
if ( !valid_as_cmo(obj) ) |
| char errmsg[BUFSIZ]; |
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; |
| |
case N_B: |
| |
*tag = CMO_BIGFLOAT; break; |
| |
case N_C: |
| |
*tag = CMO_COMPLEX; 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; |
| |
} |
| |
|
| if ( !obj ) { |
void write_cmo_mathcap(FILE *s,MATHCAP mc) |
| r = CMO_NULL; write_int(s,&r); |
{ |
| return; |
unsigned int r; |
| } |
|
| switch ( OID(obj) ) { |
r = CMO_MATHCAP; write_int(s,&r); |
| case O_N: |
write_cmo(s,(Obj)BDY(mc)); |
| write_cmo_q(s,obj); |
|
| break; |
|
| case O_P: |
|
| write_cmo_p(s,obj); |
|
| break; |
|
| case O_R: |
|
| write_cmo_r(s,obj); |
|
| break; |
|
| case O_DP: |
|
| write_cmo_dp(s,obj); |
|
| break; |
|
| case O_LIST: |
|
| write_cmo_list(s,obj); |
|
| break; |
|
| case O_STR: |
|
| write_cmo_string(s,obj); |
|
| break; |
|
| case O_USINT: |
|
| write_cmo_uint(s,obj); |
|
| break; |
|
| case O_MATHCAP: |
|
| write_cmo_mathcap(s,obj); |
|
| break; |
|
| case O_ERR: |
|
| write_cmo_error(s,obj); |
|
| break; |
|
| case O_VOID: |
|
| r = ((USINT)obj)->body; write_int(s,&r); |
|
| break; |
|
| default: |
|
| sprintf(errmsg, "write_cmo : id=%d not implemented.",OID(obj)); |
|
| error(errmsg); |
|
| break; |
|
| } |
|
| } |
} |
| |
|
| write_cmo_mathcap(s,mc) |
void write_cmo_uint(FILE *s,USINT ui) |
| FILE *s; |
|
| MATHCAP mc; |
|
| { |
{ |
| unsigned int r; |
unsigned int r; |
| |
|
| r = CMO_MATHCAP; write_int(s,&r); |
r = CMO_INT32; write_int(s,&r); |
| write_cmo(s,BDY(mc)); |
r = ui->body; write_int(s,&r); |
| } |
} |
| |
|
| write_cmo_uint(s,ui) |
void write_cmo_q(FILE *s,Q q) |
| FILE *s; |
|
| USINT ui; |
|
| { |
{ |
| unsigned int r; |
int r; |
| |
|
| r = CMO_INT32; write_int(s,&r); |
if ( q && DN(q) ) { |
| r = ui->body; write_int(s,&r); |
r = CMO_QQ; write_int(s,&r); |
| |
write_cmo_zz(s,SGN(q),NM(q)); |
| |
write_cmo_zz(s,1,DN(q)); |
| |
} else { |
| |
r = CMO_ZZ; write_int(s,&r); |
| |
write_cmo_zz(s,SGN(q),NM(q)); |
| |
} |
| } |
} |
| |
|
| write_cmo_q(s,q) |
void write_cmo_real(FILE *s,Real real) |
| FILE *s; |
|
| Q q; |
|
| { |
{ |
| int r; |
unsigned int r; |
| |
double dbl; |
| |
|
| if ( q && DN(q) ) { |
r = CMO_IEEE_DOUBLE_FLOAT; write_int(s,&r); |
| r = CMO_QQ; write_int(s,&r); |
dbl = real->body; write_double(s,&dbl); |
| write_cmo_zz(s,SGN(q),NM(q)); |
|
| write_cmo_zz(s,1,DN(q)); |
|
| } else { |
|
| r = CMO_ZZ; write_int(s,&r); |
|
| write_cmo_zz(s,SGN(q),NM(q)); |
|
| } |
|
| } |
} |
| |
|
| write_cmo_zz(s,sgn,n) |
void write_cmo_bf(FILE *s,BF bf) |
| FILE *s; |
|
| int sgn; |
|
| N n; |
|
| { |
{ |
| int i,l,bytes; |
unsigned int r,u,l; |
| unsigned int t; |
int len,t,i; |
| unsigned int *b; |
L exp; |
| unsigned char c; |
UL *ptr; |
| |
|
| |
r = CMO_BIGFLOAT; write_int(s,&r); |
| |
write_int(s,&MPFR_SIGN(bf->body)); |
| |
write_int(s,(unsigned int *)&MPFR_PREC(bf->body)); |
| |
exp = MPFR_EXP(bf->body); |
| |
write_int64(s,&exp); |
| |
len = MPFR_LIMB_SIZE(bf->body); |
| |
#if SIZEOF_LONG == 4 |
| |
write_int(s,&len); |
| |
write_intarray(s,(int *)MPFR_MANT(bf->body),len); |
| |
#else /* SIZEOF_LONG == 8 */ |
| |
t = (MPFR_PREC(bf->body)+31)/32; |
| |
write_int(s,&t); |
| |
write_longarray(s,MPFR_MANT(bf->body),t); |
| |
#endif |
| |
} |
| |
|
| |
void write_cmo_zz(FILE *s,int sgn,N n) |
| |
{ |
| |
int l,bytes; |
| |
|
| #if 1 |
#if 1 |
| l = PL(n); |
l = PL(n); |
| bytes = sgn*l; |
bytes = sgn*l; |
| write_int(s,&bytes); |
write_int(s,&bytes); |
| write_intarray(s,BD(n),l); |
write_intarray(s,BD(n),l); |
| #else |
#else |
| l = PL(n); b = (unsigned int *)BD(n); |
l = PL(n); b = (unsigned int *)BD(n); |
| bytes = sgn*4*l; |
bytes = sgn*4*l; |
| write_int(s,&bytes); |
write_int(s,&bytes); |
| for ( i = l-1; i >= 0; i-- ) { |
for ( i = l-1; i >= 0; i-- ) { |
| t = b[i]; |
t = b[i]; |
| c = t>>24; write_char(s,&c); |
c = t>>24; write_char(s,&c); |
| c = (t>>16)&0xff; write_char(s,&c); |
c = (t>>16)&0xff; write_char(s,&c); |
| c = (t>>8)&0xff; write_char(s,&c); |
c = (t>>8)&0xff; write_char(s,&c); |
| c = t&0xff; write_char(s,&c); |
c = t&0xff; write_char(s,&c); |
| } |
} |
| #endif |
#endif |
| } |
} |
| |
|
| write_cmo_p(s,p) |
void write_cmo_p(FILE *s,P p) |
| FILE *s; |
|
| P p; |
|
| { |
{ |
| int r,i; |
int r,i; |
| VL t,vl; |
VL t,vl; |
| char *namestr; |
char *namestr; |
| STRING name; |
STRING name; |
| NODE n0,n; |
|
| |
|
| r = CMO_RECURSIVE_POLYNOMIAL; write_int(s,&r); |
r = CMO_RECURSIVE_POLYNOMIAL; write_int(s,&r); |
| get_vars((Obj)p,&vl); |
get_vars((Obj)p,&vl); |
| |
|
| /* indeterminate list */ |
/* indeterminate list */ |
| r = CMO_LIST; write_int(s,&r); |
r = CMO_LIST; write_int(s,&r); |
| for ( t = vl, i = 0; t; t = NEXT(t), i++ ); |
for ( t = vl, i = 0; t; t = NEXT(t), i++ ); |
| write_int(s,&i); |
write_int(s,&i); |
| r = CMO_INDETERMINATE; |
r = CMO_INDETERMINATE; |
| for ( t = vl; t; t = NEXT(t) ) { |
for ( t = vl; t; t = NEXT(t) ) { |
| write_int(s,&r); |
write_int(s,&r); |
| /* localname_to_cmoname(NAME(t->v),&namestr); */ |
/* localname_to_cmoname(NAME(t->v),&namestr); */ |
| namestr = NAME(t->v); |
namestr = NAME(t->v); |
| MKSTR(name,namestr); |
MKSTR(name,namestr); |
| write_cmo(s,name); |
write_cmo(s,(Obj)name); |
| } |
} |
| |
|
| /* body */ |
/* body */ |
| write_cmo_upoly(s,vl,p); |
write_cmo_upoly(s,vl,p); |
| } |
} |
| |
|
| write_cmo_upoly(s,vl,p) |
void write_cmo_upoly(FILE *s,VL vl,P p) |
| FILE *s; |
|
| VL vl; |
|
| P p; |
|
| { |
{ |
| int r,i; |
int r,i; |
| V v; |
V v; |
| DCP dc,dct; |
DCP dc,dct; |
| VL vlt; |
VL vlt; |
| |
|
| if ( NUM(p) ) |
if ( NUM(p) ) |
| write_cmo(s,p); |
write_cmo(s,(Obj)p); |
| else { |
else { |
| r = CMO_UNIVARIATE_POLYNOMIAL; write_int(s,&r); |
r = CMO_UNIVARIATE_POLYNOMIAL; write_int(s,&r); |
| v = VR(p); |
v = VR(p); |
| dc = DC(p); |
dc = DC(p); |
| for ( i = 0, dct = dc; dct; dct = NEXT(dct), i++ ); |
for ( i = 0, dct = dc; dct; dct = NEXT(dct), i++ ); |
| write_int(s,&i); |
write_int(s,&i); |
| for ( i = 0, vlt = vl; vlt->v != v; vlt = NEXT(vlt), i++ ); |
for ( i = 0, vlt = vl; vlt->v != v; vlt = NEXT(vlt), i++ ); |
| write_int(s,&i); |
write_int(s,&i); |
| for ( dct = dc; dct; dct = NEXT(dct) ) { |
for ( dct = dc; dct; dct = NEXT(dct) ) { |
| i = QTOS(DEG(dct)); write_int(s,&i); |
i = QTOS(DEG(dct)); write_int(s,&i); |
| write_cmo_upoly(s,vl,COEF(dct)); |
write_cmo_upoly(s,vl,COEF(dct)); |
| } |
} |
| } |
} |
| } |
} |
| |
|
| write_cmo_r(s,f) |
void write_cmo_r(FILE *s,R f) |
| FILE *s; |
|
| R f; |
|
| { |
{ |
| int r; |
int r; |
| |
|
| r = CMO_RATIONAL; write_int(s,&r); |
r = CMO_RATIONAL; write_int(s,&r); |
| write_cmo(s,NM(f)); |
write_cmo(s,(Obj)NM(f)); |
| write_cmo(s,DN(f)); |
write_cmo(s,(Obj)DN(f)); |
| } |
} |
| |
|
| write_cmo_dp(s,dp) |
void write_cmo_complex(FILE *s,C f) |
| FILE *s; |
|
| DP dp; |
|
| { |
{ |
| int i,n,nv,r; |
int r; |
| MP m; |
|
| |
|
| for ( n = 0, m = BDY(dp); m; m = NEXT(m), n++ ); |
r = CMO_COMPLEX; write_int(s,&r); |
| r = CMO_DISTRIBUTED_POLYNOMIAL; write_int(s,&r); |
write_cmo(s,(Obj)f->r); |
| r = n; write_int(s,&r); |
write_cmo(s,(Obj)f->i); |
| r = CMO_DMS_GENERIC; write_int(s,&r); |
|
| nv = dp->nv; |
|
| for ( i = 0, m = BDY(dp); i < n; i++, m = NEXT(m) ) |
|
| write_cmo_monomial(s,m,nv); |
|
| } |
} |
| |
|
| write_cmo_monomial(s,m,n) |
void write_cmo_dp(FILE *s,DP dp) |
| FILE *s; |
|
| MP m; |
|
| int n; |
|
| { |
{ |
| int i,r; |
int i,n,nv,r; |
| int *p; |
MP m; |
| |
|
| r = CMO_MONOMIAL32; write_int(s,&r); |
for ( n = 0, m = BDY(dp); m; m = NEXT(m), n++ ); |
| write_int(s,&n); |
r = CMO_DISTRIBUTED_POLYNOMIAL; write_int(s,&r); |
| for ( i = 0, p = m->dl->d; i < n; i++ ) { |
r = n; write_int(s,&r); |
| write_int(s,p++); |
r = CMO_DMS_GENERIC; write_int(s,&r); |
| } |
nv = dp->nv; |
| write_cmo_q(s,m->c); |
for ( i = 0, m = BDY(dp); i < n; i++, m = NEXT(m) ) |
| |
write_cmo_monomial(s,m,nv); |
| } |
} |
| |
|
| write_cmo_list(s,list) |
void write_cmo_monomial(FILE *s,MP m,int n) |
| FILE *s; |
|
| LIST list; |
|
| { |
{ |
| NODE m; |
int i,r; |
| int i,n,r; |
int *p; |
| |
|
| for ( n = 0, m = BDY(list); m; m = NEXT(m), n++ ); |
r = CMO_MONOMIAL32; write_int(s,&r); |
| r = CMO_LIST; write_int(s,&r); |
write_int(s,&n); |
| write_int(s,&n); |
for ( i = 0, p = m->dl->d; i < n; i++ ) { |
| for ( i = 0, m = BDY(list); i < n; i++, m = NEXT(m) ) |
write_int(s,p++); |
| write_cmo(s,BDY(m)); |
} |
| |
write_cmo_q(s,(Q)m->c); |
| } |
} |
| |
|
| write_cmo_string(s,str) |
void write_cmo_list(FILE *s,LIST list) |
| FILE *s; |
|
| STRING str; |
|
| { |
{ |
| int r; |
NODE m; |
| |
int i,n,r; |
| |
|
| r = CMO_STRING; write_int(s,&r); |
for ( n = 0, m = BDY(list); m; m = NEXT(m), n++ ); |
| savestr(s,BDY(str)); |
r = CMO_LIST; write_int(s,&r); |
| |
write_int(s,&n); |
| |
for ( i = 0, m = BDY(list); i < n; i++, m = NEXT(m) ) |
| |
write_cmo(s,BDY(m)); |
| } |
} |
| |
|
| write_cmo_error(s,e) |
void write_cmo_string(FILE *s,STRING str) |
| FILE *s; |
|
| ERR e; |
|
| { |
{ |
| int r; |
int r; |
| |
|
| r = CMO_ERROR2; write_int(s,&r); |
r = CMO_STRING; write_int(s,&r); |
| write_cmo(s,BDY(e)); |
savestr(s,BDY(str)); |
| } |
} |
| |
|
| read_cmo(s,rp) |
void write_cmo_bytearray(FILE *s,BYTEARRAY array) |
| FILE *s; |
|
| Obj *rp; |
|
| { |
{ |
| int id; |
int r; |
| int n,sgn,dummy; |
|
| Q q,qnm,qdn; |
|
| N nm,dn; |
|
| P p,pnm,pdn; |
|
| R r; |
|
| STRING str; |
|
| USINT t; |
|
| DP dp; |
|
| char *b; |
|
| Obj obj; |
|
| ERR e; |
|
| MATHCAP mc; |
|
| |
|
| read_int(s,&id); |
r = CMO_DATUM; write_int(s,&r); |
| switch ( id ) { |
write_int(s,&array->len); |
| /* level 0 objects */ |
write_string(s,array->body,array->len); |
| case CMO_NULL: |
|
| *rp = 0; |
|
| break; |
|
| case CMO_INT32: |
|
| read_cmo_uint(s,rp); |
|
| break; |
|
| case CMO_DATUM: |
|
| case CMO_STRING: |
|
| loadstring(s,&str); *rp = (Obj)str; |
|
| break; |
|
| case CMO_MATHCAP: |
|
| read_cmo(s,&obj); MKMATHCAP(mc,(LIST)obj); |
|
| *rp = (Obj)mc; |
|
| break; |
|
| case CMO_ERROR: |
|
| MKERR(e,0); *rp = (Obj)e; |
|
| break; |
|
| case CMO_ERROR2: |
|
| read_cmo(s,&obj); MKERR(e,obj); *rp = (Obj)e; |
|
| break; |
|
| /* level 1 objects */ |
|
| case CMO_LIST: |
|
| read_cmo_list(s,rp); |
|
| break; |
|
| case CMO_MONOMIAL32: |
|
| read_cmo_monomial(s,rp); |
|
| break; |
|
| case CMO_ZZ: |
|
| read_cmo_zz(s,&sgn,&nm); |
|
| NTOQ(nm,sgn,q); *rp = (Obj)q; |
|
| break; |
|
| case CMO_QQ: |
|
| read_cmo_zz(s,&sgn,&nm); |
|
| read_cmo_zz(s,&dummy,&dn); |
|
| NDTOQ(nm,dn,sgn,q); *rp = (Obj)q; |
|
| break; |
|
| case CMO_DISTRIBUTED_POLYNOMIAL: |
|
| read_cmo_dp(s,&dp); *rp = (Obj)dp; |
|
| break; |
|
| case CMO_RECURSIVE_POLYNOMIAL: |
|
| read_cmo_p(s,&p); *rp = (Obj)p; |
|
| break; |
|
| case CMO_UNIVARIATE_POLYNOMIAL: |
|
| read_cmo_upoly(s,&p); *rp = (Obj)p; |
|
| break; |
|
| case CMO_INDETERMINATE: |
|
| read_cmo(s,&str); *rp = (Obj)str; |
|
| break; |
|
| case CMO_RATIONAL: |
|
| read_cmo(s,&pnm); read_cmo(s,&pdn); |
|
| divr(CO,(Obj)pnm,(Obj)pdn,rp); |
|
| break; |
|
| case CMO_ZERO: |
|
| *rp = 0; |
|
| break; |
|
| case CMO_DMS_OF_N_VARIABLES: |
|
| read_cmo(s,rp); |
|
| break; |
|
| case CMO_RING_BY_NAME: |
|
| read_cmo(s,rp); |
|
| break; |
|
| default: |
|
| MKUSINT(t,id); |
|
| t->id = O_VOID; |
|
| *rp = (Obj)t; |
|
| break; |
|
| } |
|
| } |
} |
| |
|
| read_cmo_uint(s,rp) |
void write_cmo_error(FILE *s,ERR e) |
| FILE *s; |
|
| USINT *rp; |
|
| { |
{ |
| unsigned int body; |
int r; |
| |
|
| read_int(s,&body); |
r = CMO_ERROR2; write_int(s,&r); |
| MKUSINT(*rp,body); |
write_cmo(s,BDY(e)); |
| } |
} |
| |
|
| read_cmo_zz(s,sgn,rp) |
/* XXX */ |
| FILE *s; |
|
| int *sgn; |
/* |
| N *rp; |
* BDY(l) = treenode |
| |
* treenode = [property,(name,)arglist] |
| |
* arglist = list of treenode |
| |
*/ |
| |
|
| |
void write_cmo_tree(FILE *s,LIST l) |
| { |
{ |
| int l,i,words; |
NODE n; |
| N n; |
int r; |
| unsigned int *b; |
STRING prop,name,key; |
| unsigned int h; |
|
| unsigned char c; |
|
| |
|
| read_int(s,&l); |
/* (CMO_TREE (CMO_LIST,n,key1,attr1,...,keyn,attn),(CMO_LIST,m,arg1,...,argm)) */ |
| if ( l == 0 ) { |
n = BDY(l); |
| *sgn = 0; |
prop = (STRING)BDY(n); n = NEXT(n); |
| *rp = 0; |
if ( !strcmp(BDY(prop),"internal") ) { |
| return; |
write_cmo(s,(Obj)BDY(n)); |
| } |
} else { |
| if ( l < 0 ) { |
if ( strcmp(BDY(prop),"list") ) { |
| *sgn = -1; l = -l; |
r = CMO_TREE; write_int(s,&r); |
| } else |
name = (STRING)BDY(n); |
| *sgn = 1; |
n = NEXT(n); |
| |
/* function name */ |
| |
write_cmo(s,(Obj)name); |
| |
|
| |
/* attribute list */ |
| |
r = CMO_LIST; write_int(s,&r); |
| |
r = 2; write_int(s,&r); |
| |
MKSTR(key,"asir"); |
| |
write_cmo(s,(Obj)key); |
| |
write_cmo(s,(Obj)prop); |
| |
} |
| |
|
| |
/* argument list */ |
| |
r = CMO_LIST; write_int(s,&r); |
| |
/* len = number of arguments */ |
| |
r = length(n); write_int(s,&r); |
| |
while ( n ) { |
| |
write_cmo_tree(s,BDY(n)); |
| |
n = NEXT(n); |
| |
} |
| |
} |
| |
} |
| |
|
| |
void write_cmo_matrix_as_list(FILE *s,MAT a) |
| |
{ |
| |
int i,j,r,row,col; |
| |
|
| |
/* CMO_LIST row (CMO_LIST col a[0][0] ... a[0][col-1]) ... (CMO_LIST col a[row-1][0] ... a[row-1][col-1] */ |
| |
row = a->row; col = a->col; |
| |
r = CMO_LIST; |
| |
write_int(s,&r); |
| |
write_int(s,&row); |
| |
for ( i = 0; i < row; i++ ) { |
| |
write_int(s,&r); |
| |
write_int(s,&col); |
| |
for ( j = 0; j < col; j++ ) |
| |
write_cmo(s,a->body[i][j]); |
| |
} |
| |
} |
| |
|
| |
void read_cmo(FILE *s,Obj *rp) |
| |
{ |
| |
int id; |
| |
int sgn,dummy; |
| |
Q q; |
| |
N nm,dn; |
| |
P p,pnm,pdn; |
| |
Real real; |
| |
C c; |
| |
double dbl; |
| |
STRING str; |
| |
USINT t; |
| |
DP dp; |
| |
Obj obj; |
| |
ERR e; |
| |
BF bf; |
| |
MATHCAP mc; |
| |
BYTEARRAY array; |
| |
LIST list; |
| |
|
| |
read_int(s,&id); |
| |
switch ( id ) { |
| |
/* level 0 objects */ |
| |
case CMO_NULL: |
| |
*rp = 0; |
| |
break; |
| |
case CMO_INT32: |
| |
read_cmo_uint(s,&t); *rp = (Obj)t; |
| |
break; |
| |
case CMO_DATUM: |
| |
loadbytearray(s,&array); *rp = (Obj)array; |
| |
break; |
| |
case CMO_STRING: |
| |
loadstring(s,&str); *rp = (Obj)str; |
| |
break; |
| |
case CMO_MATHCAP: |
| |
read_cmo(s,&obj); MKMATHCAP(mc,(LIST)obj); |
| |
*rp = (Obj)mc; |
| |
break; |
| |
case CMO_ERROR: |
| |
MKERR(e,0); *rp = (Obj)e; |
| |
break; |
| |
case CMO_ERROR2: |
| |
read_cmo(s,&obj); MKERR(e,obj); *rp = (Obj)e; |
| |
break; |
| |
/* level 1 objects */ |
| |
case CMO_LIST: |
| |
read_cmo_list(s,rp); |
| |
break; |
| |
case CMO_MONOMIAL32: |
| |
read_cmo_monomial(s,&dp); *rp = (Obj)dp; |
| |
break; |
| |
case CMO_ZZ: |
| |
read_cmo_zz(s,&sgn,&nm); |
| |
NTOQ(nm,sgn,q); *rp = (Obj)q; |
| |
break; |
| |
case CMO_QQ: |
| |
read_cmo_zz(s,&sgn,&nm); |
| |
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_BIGFLOAT: |
| |
read_cmo_bf(s,&bf); *rp = (Obj)bf; |
| |
break; |
| |
case CMO_COMPLEX: |
| |
NEWC(c); |
| |
read_cmo(s,(Obj *)&c->r); |
| |
read_cmo(s,(Obj *)&c->i); |
| |
*rp = (Obj)c; |
| |
break; |
| |
case CMO_DISTRIBUTED_POLYNOMIAL: |
| |
read_cmo_dp(s,&dp); *rp = (Obj)dp; |
| |
break; |
| |
case CMO_RECURSIVE_POLYNOMIAL: |
| |
read_cmo_p(s,&p); *rp = (Obj)p; |
| |
break; |
| |
case CMO_UNIVARIATE_POLYNOMIAL: |
| |
read_cmo_upoly(s,&p); *rp = (Obj)p; |
| |
break; |
| |
case CMO_INDETERMINATE: |
| |
read_cmo(s,rp); |
| |
break; |
| |
case CMO_RATIONAL: |
| |
read_cmo(s,&obj); pnm = (P)obj; |
| |
read_cmo(s,&obj); pdn = (P)obj; |
| |
divr(CO,(Obj)pnm,(Obj)pdn,rp); |
| |
break; |
| |
case CMO_ZERO: |
| |
*rp = 0; |
| |
break; |
| |
case CMO_DMS_OF_N_VARIABLES: |
| |
read_cmo(s,rp); |
| |
break; |
| |
case CMO_RING_BY_NAME: |
| |
read_cmo(s,rp); |
| |
break; |
| |
case CMO_TREE: |
| |
read_cmo_tree_as_list(s,&list); |
| |
#if 0 |
| |
treetofnode(list,&fn); |
| |
MKQUOTE(quote,fn); |
| |
*rp = (Obj)quote; |
| |
#else |
| |
*rp = (Obj)list; |
| |
#endif |
| |
break; |
| |
default: |
| |
MKUSINT(t,id); |
| |
t->id = O_VOID; |
| |
*rp = (Obj)t; |
| |
break; |
| |
} |
| |
} |
| |
|
| |
void read_cmo_uint(FILE *s,USINT *rp) |
| |
{ |
| |
unsigned int body; |
| |
|
| |
read_int(s,&body); |
| |
MKUSINT(*rp,body); |
| |
} |
| |
|
| |
void read_cmo_zz(FILE *s,int *sgn,N *rp) |
| |
{ |
| |
int l; |
| |
N n; |
| |
|
| |
read_int(s,&l); |
| |
if ( l == 0 ) { |
| |
*sgn = 0; |
| |
*rp = 0; |
| |
return; |
| |
} |
| |
if ( l < 0 ) { |
| |
*sgn = -1; l = -l; |
| |
} else |
| |
*sgn = 1; |
| #if 1 |
#if 1 |
| *rp = n = NALLOC(l); PL(n) = l; |
*rp = n = NALLOC(l); PL(n) = l; |
| read_intarray(s,BD(n),l); |
read_intarray(s,BD(n),l); |
| #else |
#else |
| words = (l+3)/4; |
words = (l+3)/4; |
| *rp = n = NALLOC(words); PL(n) = words; b = BD(n); |
*rp = n = NALLOC(words); PL(n) = words; b = BD(n); |
| h = 0; |
h = 0; |
| switch ( l % 4 ) { |
switch ( l % 4 ) { |
| case 0: |
case 0: |
| read_char(s,&c); h = c; |
read_char(s,&c); h = c; |
| case 3: |
case 3: |
| read_char(s,&c); h = (h<<8)|c; |
read_char(s,&c); h = (h<<8)|c; |
| case 2: |
case 2: |
| read_char(s,&c); h = (h<<8)|c; |
read_char(s,&c); h = (h<<8)|c; |
| case 1: |
case 1: |
| read_char(s,&c); h = (h<<8)|c; |
read_char(s,&c); h = (h<<8)|c; |
| } |
} |
| b[words-1] = h; |
b[words-1] = h; |
| for ( i = words-2; i >= 0; i-- ) { |
for ( i = words-2; i >= 0; i-- ) { |
| read_char(s,&c); h = c; |
read_char(s,&c); h = c; |
| read_char(s,&c); h = (h<<8)|c; |
read_char(s,&c); h = (h<<8)|c; |
| read_char(s,&c); h = (h<<8)|c; |
read_char(s,&c); h = (h<<8)|c; |
| read_char(s,&c); h = (h<<8)|c; |
read_char(s,&c); h = (h<<8)|c; |
| b[i] = h; |
b[i] = h; |
| } |
} |
| #endif |
#endif |
| } |
} |
| |
|
| read_cmo_list(s,rp) |
void read_cmo_bf(FILE *s,BF *bf) |
| FILE *s; |
|
| Obj *rp; |
|
| { |
{ |
| int len; |
BF r; |
| Obj *w; |
int sgn,prec,len,i; |
| int i; |
unsigned int u,l; |
| Obj r,r1; |
UL *ptr; |
| NODE n0,n1; |
L exp; |
| LIST list; |
|
| |
|
| read_int(s,&len); |
NEWBF(r); |
| w = (Obj *)ALLOCA(len*sizeof(Obj)); |
read_int(s,&sgn); |
| for ( i = 0; i < len; i++ ) |
read_int(s,&prec); |
| read_cmo(s,&w[i]); |
read_int64(s,&exp); |
| for ( i = len-1, n0 = 0; i >= 0; i-- ) { |
read_int(s,&len); |
| MKNODE(n1,w[i],n0); n0 = n1; |
mpfr_init2(r->body,prec); |
| } |
MPFR_SIGN(r->body) = sgn; |
| MKLIST(list,n0); |
MPFR_EXP(r->body) = exp; |
| *rp = (Obj)list; |
#if SIZEOF_LONG == 4 |
| |
read_intarray(s,(int *)MPFR_MANT(r->body),len); |
| |
#else /* SIZEOF_LONG == 8 */ |
| |
read_longarray(s,MPFR_MANT(r->body),len); |
| |
#endif |
| |
*bf = r; |
| } |
} |
| |
|
| read_cmo_dp(s,rp) |
void read_cmo_list(FILE *s,Obj *rp) |
| FILE *s; |
|
| DP *rp; |
|
| { |
{ |
| int len; |
int len; |
| int i; |
Obj *w; |
| NODE n0,n1; |
int i; |
| MP mp0,mp; |
NODE n0,n1; |
| int nv,d; |
LIST list; |
| DP dp; |
|
| Obj obj; |
|
| |
|
| read_int(s,&len); |
read_int(s,&len); |
| /* skip the ring definition */ |
w = (Obj *)ALLOCA(len*sizeof(Obj)); |
| read_cmo(s,&obj); |
for ( i = 0; i < len; i++ ) |
| for ( mp0 = 0, i = 0, d = 0; i < len; i++ ) { |
read_cmo(s,&w[i]); |
| read_cmo(s,&dp); |
for ( i = len-1, n0 = 0; i >= 0; i-- ) { |
| if ( !mp0 ) { |
MKNODE(n1,w[i],n0); n0 = n1; |
| nv = dp->nv; |
} |
| mp0 = dp->body; |
MKLIST(list,n0); |
| mp = mp0; |
*rp = (Obj)list; |
| } else { |
|
| NEXT(mp) = dp->body; |
|
| mp = NEXT(mp); |
|
| } |
|
| d = MAX(d,dp->sugar); |
|
| } |
|
| MKDP(nv,mp0,dp); |
|
| dp->sugar = d; *rp = dp; |
|
| } |
} |
| |
|
| read_cmo_monomial(s,rp) |
void read_cmo_dp(FILE *s,DP *rp) |
| FILE *s; |
|
| DP *rp; |
|
| { |
{ |
| MP m; |
int len; |
| DP dp; |
int i; |
| int i,sugar,n; |
MP mp0,mp; |
| DL dl; |
int nv,d; |
| |
DP dp; |
| |
Obj obj; |
| |
|
| read_int(s,&n); |
read_int(s,&len); |
| NEWMP(m); NEWDL(dl,n); m->dl = dl; |
/* skip the ring definition */ |
| read_intarray(s,dl->d,n); |
read_cmo(s,&obj); |
| for ( sugar = 0, i = 0; i < n; i++ ) |
for ( mp0 = 0, i = 0, d = 0; i < len; i++ ) { |
| sugar += dl->d[i]; |
read_cmo(s,&obj); dp = (DP)obj; |
| dl->td = sugar; |
if ( !mp0 ) { |
| read_cmo(s,&m->c); |
nv = dp->nv; |
| NEXT(m) = 0; MKDP(n,m,dp); dp->sugar = sugar; *rp = dp; |
mp0 = dp->body; |
| |
mp = mp0; |
| |
} else { |
| |
NEXT(mp) = dp->body; |
| |
mp = NEXT(mp); |
| |
} |
| |
d = MAX(d,dp->sugar); |
| |
} |
| |
MKDP(nv,mp0,dp); |
| |
dp->sugar = d; *rp = dp; |
| } |
} |
| |
|
| |
void read_cmo_monomial(FILE *s,DP *rp) |
| |
{ |
| |
Obj obj; |
| |
MP m; |
| |
DP dp; |
| |
int i,sugar,n; |
| |
DL dl; |
| |
|
| |
read_int(s,&n); |
| |
NEWMP(m); NEWDL(dl,n); m->dl = dl; |
| |
read_intarray(s,dl->d,n); |
| |
for ( sugar = 0, i = 0; i < n; i++ ) |
| |
sugar += dl->d[i]; |
| |
dl->td = sugar; |
| |
read_cmo(s,&obj); m->c = (P)obj; |
| |
NEXT(m) = 0; MKDP(n,m,dp); dp->sugar = sugar; *rp = dp; |
| |
} |
| |
|
| static V *remote_vtab; |
static V *remote_vtab; |
| |
|
| read_cmo_p(s,rp) |
void read_cmo_p(FILE *s,P *rp) |
| |
{ |
| |
Obj obj; |
| |
LIST vlist; |
| |
int nv,i; |
| |
V *vtab; |
| |
V v1,v2; |
| |
NODE t; |
| |
P v,p; |
| |
VL tvl,rvl; |
| |
char *name; |
| |
|
| |
read_cmo(s,&obj); vlist = (LIST)obj; |
| |
nv = length(BDY(vlist)); |
| |
vtab = (V *)ALLOCA(nv*sizeof(V)); |
| |
for ( i = 0, t = BDY(vlist); i < nv; t = NEXT(t), i++ ) { |
| |
/* cmoname_to_localname(BDY((STRING)BDY(t)),&name); */ |
| |
name = BDY((STRING)BDY(t)); |
| |
makevar(name,&v); vtab[i] = VR(v); |
| |
} |
| |
remote_vtab = vtab; |
| |
read_cmo(s,&obj); p = (P)obj; |
| |
for ( i = 0; i < nv-1; i++ ) { |
| |
v1 = vtab[i]; v2 = vtab[i+1]; |
| |
for ( tvl = CO; tvl->v != v1 && tvl->v != v2; tvl = NEXT(tvl) ); |
| |
if ( tvl->v == v2 ) |
| |
break; |
| |
} |
| |
if ( i < nv-1 ) { |
| |
for ( i = nv-1, rvl = 0; i >= 0; i-- ) { |
| |
NEWVL(tvl); tvl->v = vtab[i]; NEXT(tvl) = rvl; rvl = tvl; |
| |
} |
| |
reorderp(CO,rvl,p,rp); |
| |
} else |
| |
*rp = p; |
| |
} |
| |
|
| |
void read_cmo_upoly(FILE *s,P *rp) |
| |
{ |
| |
int n,ind,i,d; |
| |
Obj obj; |
| |
P c; |
| |
Q q; |
| |
DCP dc0,dc; |
| |
|
| |
read_int(s,&n); |
| |
read_int(s,&ind); |
| |
for ( i = 0, dc0 = 0; i < n; i++ ) { |
| |
read_int(s,&d); |
| |
read_cmo(s,&obj); c = (P)obj; |
| |
if ( c ) { |
| |
if ( OID(c) == O_USINT ) { |
| |
UTOQ(((USINT)c)->body,q); c = (P)q; |
| |
} |
| |
NEXTDC(dc0,dc); |
| |
STOQ(d,q); |
| |
dc->c = c; dc->d = q; |
| |
} |
| |
} |
| |
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); |
| |
|
| |
#if 0 |
| |
/* old code */ |
| |
void read_cmo_tree(s,rp) |
| FILE *s; |
FILE *s; |
| P *rp; |
FNODE *rp; |
| { |
{ |
| LIST vlist; |
int r,i,n; |
| int nv,i; |
char *opname; |
| V *vtab; |
STRING name,cd; |
| V v1,v2; |
int op; |
| NODE t; |
pointer *arg; |
| P v,p; |
QUOTE quote; |
| VL tvl,rvl; |
FNODE fn; |
| char *name; |
NODE t,t1; |
| |
fid id; |
| |
Obj expr; |
| |
FUNC func; |
| |
|
| read_cmo(s,&vlist); |
read_cmo(s,&name); |
| nv = length(BDY(vlist)); |
read_cmo(s,&attr); |
| vtab = (V *)ALLOCA(nv*sizeof(V)); |
for ( i = 0; i < optab_len; i++ ) |
| for ( i = 0, t = BDY(vlist); i < nv; t = NEXT(t), i++ ) { |
if ( !strcmp(optab[i].name,BDY(name)) ) |
| /* cmoname_to_localname(BDY((STRING)BDY(t)),&name); */ |
break; |
| name = BDY((STRING)BDY(t)); |
if ( i == optab_len ) { |
| makevar(name,&v); vtab[i] = VR(v); |
/* may be a function name */ |
| } |
n = read_cmo_tree_arg(s,&arg); |
| remote_vtab = vtab; |
for ( i = n-1, t = 0; i >= 0; i-- ) { |
| read_cmo(s,&p); |
MKNODE(t1,arg[i],t); t = t1; |
| for ( i = 0; i < nv-1; i++ ) { |
} |
| v1 = vtab[i]; v2 = vtab[i+1]; |
searchf(sysf,BDY(name),&func); |
| for ( tvl = CO; tvl->v != v1 && tvl->v != v2; tvl = NEXT(tvl) ); |
if ( !func ) |
| if ( tvl->v == v2 ) |
searchf(ubinf,BDY(name),&func); |
| break; |
if ( !func ) |
| } |
searchpf(BDY(name),&func); |
| if ( i < nv-1 ) { |
if ( !func ) |
| for ( i = nv-1, rvl = 0; i >= 0; i-- ) { |
searchf(usrf,BDY(name),&func); |
| NEWVL(tvl); tvl->v = vtab[i]; NEXT(tvl) = rvl; rvl = tvl; |
if ( !func ) |
| } |
appenduf(BDY(name),&func); |
| reorderp(CO,rvl,p,rp); |
*rp = mkfnode(2,I_FUNC,func,mkfnode(1,I_LIST,t)); |
| } else |
} else { |
| *rp = p; |
opname = optab[i].name; |
| |
id = optab[i].id; |
| |
switch ( id ) { |
| |
case I_BOP: |
| |
read_cmo_tree_arg(s,&arg); |
| |
*rp = mkfnode(3,I_BOP,optab[i].arf,arg[0],arg[1]); |
| |
return; |
| |
case I_COP: |
| |
read_cmo_tree_arg(s,&arg); |
| |
*rp = mkfnode(3,I_COP,optab[i].cid,arg[0],arg[0]); |
| |
return; |
| |
case I_AND: |
| |
read_cmo_tree_arg(s,&arg); |
| |
*rp = mkfnode(2,I_AND,arg[0],arg[1]); |
| |
return; |
| |
case I_OR: |
| |
read_cmo_tree_arg(s,&arg); |
| |
*rp = mkfnode(2,I_OR,arg[0],arg[1]); |
| |
return; |
| |
case I_NOT: |
| |
read_cmo_tree_arg(s,&arg); |
| |
*rp = mkfnode(1,I_OR,arg[0]); |
| |
return; |
| |
} |
| |
} |
| } |
} |
| |
|
| read_cmo_upoly(s,rp) |
int read_cmo_tree_arg(s,argp) |
| FILE *s; |
FILE *s; |
| P *rp; |
pointer **argp; |
| { |
{ |
| int n,ind,i,d; |
int id,n,i; |
| P c; |
pointer *ap; |
| Q q; |
Obj t; |
| DCP dc0,dc; |
|
| |
|
| read_int(s,&n); |
read_int(s,&id); /* id = CMO_LIST */ |
| read_int(s,&ind); |
read_int(s,&n); /* n = the number of args */ |
| for ( i = 0, dc0 = 0; i < n; i++ ) { |
*argp = ap = (pointer *) MALLOC(n*sizeof(pointer)); |
| read_int(s,&d); |
for ( i = 0; i < n; i++ ) { |
| read_cmo(s,&c); |
read_cmo(s,&t); |
| if ( c ) { |
if ( !t || (OID(t) != O_QUOTE) ) |
| if ( OID(c) == O_USINT ) { |
ap[i] = mkfnode(1,I_FORMULA,t); |
| UTOQ(((USINT)c)->body,q); c = (P)q; |
else |
| } |
ap[i] = BDY((QUOTE)t); |
| NEXTDC(dc0,dc); |
} |
| STOQ(d,q); |
return n; |
| dc->c = c; dc->d = q; |
|
| } |
|
| } |
|
| if ( dc0 ) |
|
| NEXT(dc) = 0; |
|
| MKP(remote_vtab[ind],dc0,*rp); |
|
| } |
} |
| |
#else |
| |
void read_cmo_tree_as_list(FILE *s,LIST *rp) |
| |
{ |
| |
Obj obj; |
| |
STRING name; |
| |
LIST attr,args; |
| |
NODE t0,t1; |
| |
|
| localname_to_cmoname(a,b) |
read_cmo(s,&obj); name = (STRING)obj; |
| char *a; |
read_cmo(s,&obj); attr = (LIST)obj; |
| char **b; |
read_cmo(s,&obj); args = (LIST)obj; |
| |
MKNODE(t1,name,BDY(args)); |
| |
MKNODE(t0,attr,t1); |
| |
MKLIST(*rp,t0); |
| |
} |
| |
#endif |
| |
|
| |
void localname_to_cmoname(char *a,char **b) |
| { |
{ |
| int l; |
int l; |
| char *t; |
char *t; |
| |
|
| l = strlen(a); |
l = strlen(a); |
| if ( l >= 2 && a[0] == '@' && isupper(a[1]) ) { |
if ( l >= 2 && a[0] == '@' && isupper(a[1]) ) { |
| t = *b = (char *)MALLOC_ATOMIC(l); |
t = *b = (char *)MALLOC_ATOMIC(l); |
| strcpy(t,a+1); |
strcpy(t,a+1); |
| } else { |
} else { |
| t = *b = (char *)MALLOC_ATOMIC(l+1); |
t = *b = (char *)MALLOC_ATOMIC(l+1); |
| strcpy(t,a); |
strcpy(t,a); |
| } |
} |
| } |
} |
| |
|
| cmoname_to_localname(a,b) |
void cmoname_to_localname(char *a,char **b) |
| char *a; |
|
| char **b; |
|
| { |
{ |
| int l; |
int l; |
| char *t; |
char *t; |
| |
|
| l = strlen(a); |
l = strlen(a); |
| if ( isupper(a[0]) ) { |
if ( isupper(a[0]) ) { |
| t = *b = (char *)MALLOC_ATOMIC(l+2); |
t = *b = (char *)MALLOC_ATOMIC(l+2); |
| strcpy(t+1,a); |
strcpy(t+1,a); |
| t[0] = '@'; |
t[0] = '@'; |
| } else { |
} else { |
| t = *b = (char *)MALLOC_ATOMIC(l+1); |
t = *b = (char *)MALLOC_ATOMIC(l+1); |
| strcpy(t,a); |
strcpy(t,a); |
| } |
} |
| } |
} |