Annotation of OpenXM_contrib2/asir2000/builtin/var.c, Revision 1.6
1.2 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.3 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.2 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
47: *
1.6 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/var.c,v 1.5 2005/10/26 07:33:03 noro Exp $
1.2 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "parse.h"
52:
53: void Pvar(), Pvars(), Puc(), Pvars_recursive();
54:
55: struct ftab var_tab[] = {
56: {"var",Pvar,1},
57: {"vars",Pvars,1},
58: {"vars_recursive",Pvars_recursive,1},
59: {"uc",Puc,0},
60: {0,0,0},
61: };
62:
1.4 noro 63: void Pvar(NODE arg,Obj *rp)
1.1 noro 64: {
65: Obj t;
66: P p;
67: V vn,vd,v;
68: VL vl;
69:
70: if ( !(t = (Obj)ARG0(arg)) )
71: v = 0;
72: else
73: switch ( OID(t) ) {
74: case O_P:
75: v = VR((P)t); break;
76: case O_R:
77: vn = VR(NM((R)t)); vd = VR(DN((R)t));
78: for ( vl = CO; (vl->v != vn) && (vl->v != vd); vl = NEXT(vl) );
79: v = vl->v; break;
80: default:
81: v = 0; break;
82: }
83: if ( v ) {
84: MKV(v,p); *rp = (Obj)p;
85: } else
86: *rp = 0;
87: }
88:
1.4 noro 89: void Pvars(NODE arg,LIST *rp)
1.1 noro 90: {
91: VL vl;
92: NODE n,n0;
93: P p;
94:
95: get_vars((Obj)ARG0(arg),&vl);
96: for ( n0 = 0; vl; vl = NEXT(vl) ) {
97: NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p;
98: }
99: if ( n0 )
100: NEXT(n) = 0;
101: MKLIST(*rp,n0);
102: }
103:
1.4 noro 104: void Pvars_recursive(NODE arg,LIST *rp)
1.1 noro 105: {
106: VL vl;
107: NODE n,n0;
108: P p;
109:
110: get_vars_recursive((Obj)ARG0(arg),&vl);
111: for ( n0 = 0; vl; vl = NEXT(vl) ) {
112: NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p;
113: }
114: if ( n0 )
115: NEXT(n) = 0;
116: MKLIST(*rp,n0);
117: }
118:
1.4 noro 119: void get_vars_recursive(Obj obj,VL *vlp)
1.1 noro 120: {
121: VL vl,vl0,vl1,vl2,t;
122: PFINS ins;
123: int argc,i;
124: PFAD ad;
125:
126: get_vars(obj,&vl);
127: vl0 = 0;
128: for ( t = vl; t; t = NEXT(t) )
129: if ( t->v->attr == (pointer)V_PF ) {
130: ins = (PFINS)t->v->priv;
131: argc = ins->pf->argc;
132: ad = ins->ad;
133: for ( i = 0; i < argc; i++ ) {
134: get_vars_recursive(ad[i].arg,&vl1);
135: mergev(CO,vl0,vl1,&vl2); vl0 = vl2;
136: }
137: }
138: mergev(CO,vl,vl0,vlp);
139: }
140:
1.4 noro 141: void get_vars(Obj t,VL *vlp)
1.1 noro 142: {
143: pointer *vb;
144: pointer **mb;
145: VL vl,vl1,vl2;
146: NODE n;
147: MP mp;
148: int i,j,row,col,len;
149:
150: if ( !t )
151: vl = 0;
152: else
153: switch ( OID(t) ) {
154: case O_P: case O_R:
155: clctvr(CO,t,&vl); break;
156: case O_VECT:
157: len = ((VECT)t)->len; vb = BDY((VECT)t);
158: for ( i = 0, vl = 0; i < len; i++ ) {
159: get_vars((Obj)vb[i],&vl1); mergev(CO,vl,vl1,&vl2);
160: vl = vl2;
161: }
162: break;
163: case O_MAT:
164: row = ((MAT)t)->row; col = ((MAT)t)->col; mb = BDY((MAT)t);
165: for ( i = 0, vl = 0; i < row; i++ )
166: for ( j = 0; j < col; j++ ) {
167: get_vars((Obj)mb[i][j],&vl1); mergev(CO,vl,vl1,&vl2);
168: vl = vl2;
169: }
170: break;
171: case O_LIST:
172: n = BDY((LIST)t);
173: for ( vl = 0; n; n = NEXT(n) ) {
174: get_vars((Obj)BDY(n),&vl1); mergev(CO,vl,vl1,&vl2);
175: vl = vl2;
176: }
177: break;
178: case O_DP:
179: mp = ((DP)t)->body;
180: for ( vl = 0; mp; mp = NEXT(mp) ) {
181: get_vars((Obj)mp->c,&vl1); mergev(CO,vl,vl1,&vl2);
1.6 ! noro 182: vl = vl2;
! 183: }
! 184: break;
! 185: case O_NBP:
! 186: n = BDY((NBP)t);
! 187: for ( vl = 0; n; n = NEXT(n) ) {
! 188: get_vars((Obj)(((NBM)BDY(n))->c),&vl1);
! 189: mergev(CO,vl,vl1,&vl2);
1.1 noro 190: vl = vl2;
191: }
192: break;
193: default:
194: vl = 0; break;
195: }
196: *vlp = vl;
197: }
198:
1.4 noro 199: void Puc(Obj *p)
1.1 noro 200: {
201: VL vl;
202: V v;
203: P t;
204: char buf[BUFSIZ];
1.5 noro 205: char *n,*nv;
1.1 noro 206: static int UCN;
207:
208: NEWV(v); v->attr = (pointer)V_UC;
209: sprintf(buf,"_%d",UCN++);
1.5 noro 210: nv = NAME(v) = (char *)CALLOC(strlen(buf)+1,sizeof(char));
1.1 noro 211: strcpy(NAME(v),buf);
1.5 noro 212: for ( vl = CO; vl; vl = NEXT(vl) )
213: if ( (n=NAME(VR(vl))) && !strcmp(n,nv) ) break;
214: else if ( !NEXT(vl) ) {
215: NEWVL(NEXT(vl)); VR(NEXT(vl)) = v; NEXT(NEXT(vl)) = 0;
216: break;
217: }
1.1 noro 218: MKV(v,t); *p = (Obj)t;
219: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to var.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin