![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to compile.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / parse|
Return to compile.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / parse |
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 ! fujimoto 48: * $OpenXM: OpenXM_contrib2/asir2000/parse/compile.c,v 1.5 2003/05/14 06:20:11 noro Exp $
1.2 noro 49: */
1.1 noro 50: #include <ctype.h>
51: #include "ca.h"
52: #include "base.h"
53: #include "parse.h"
54: #if !defined(THINK_C)
55: #include <sys/types.h>
56: #include <sys/stat.h>
57: #endif
58:
59: extern jmp_buf timer_env;
60:
61: pointer bcompilef(), compilemapf();
62:
63: pointer compile(f)
64: FNODE f;
65: {
66: LIST t;
67: STRING str;
68: pointer val = 0;
69: pointer a,a1,a2;
70: NODE tn,ind;
71: R s,u;
72: DP dp;
73: int pv,c;
74: FNODE f1;
75: Obj expired;
76: int interval;
77:
78: if ( !f )
79: return ( 0 );
80: switch ( f->id ) {
81: case I_BOP:
82: a1 = compile((FNODE)FA1(f)); a2 = compile((FNODE)FA2(f));
83: val = emit_bop(((ARF)FA0(f)),a1,a2);
84: break;
85: case I_COP:
86: a1 = compile((FNODE)FA1(f)); a2 = compile((FNODE)FA2(f));
87: val = emit_cop((cid)FA0(f),a1,a2);
88: break;
89: case I_AND:
90: a1 = compile((FNODE)FA0(f)); a2 = compile((FNODE)FA1(f));
91: val = emit_and(a1,a2);
92: break;
93: case I_OR:
94: a1 = compile((FNODE)FA0(f)); a2 = compile((FNODE)FA1(f));
95: val = emit_or(a1,a2);
96: break;
97: case I_NOT:
98: a1 = compile((FNODE)FA0(f));
99: val = emit_not(a1);
100: break;
101: case I_CE:
102: a1 = compile((FNODE)FA0(f)); a2 = compile((FNODE)FA1(f));
103: a3 = compile((FNODE)FA0(f));
104: emit_ce(a1,a2,a3);
105: break;
106: case I_FUNC:
107: val = compilef((FUNC)FA0(f),(FNODE)FA1(f)); break;
108: case I_PVAR:
109: pv = (int)FA0(f); ind = (NODE)FA1(f); GETPV(pv,a);
110: if ( !ind )
111: val = a;
112: else {
113: compilenodebody(ind,&tn); getarray(a,tn,&val);
114: }
115: break;
116: case I_ASSPVAR:
117: f1 = (FNODE)FA0(f);
118: if ( ID(f1) == I_PVAR ) {
119: pv = (int)FA0(f1); ind = (NODE)FA1(f1);
120: if ( !ind ) {
121: val = compile((FNODE)FA1(f)); ASSPV(pv,val);
122: } else {
123: GETPV(pv,a);
124: compilenodebody(ind,&tn);
125: putarray(a,tn,val = compile((FNODE)FA1(f)));
126: }
127: } else
128: val = compilepv(ID(f),(FNODE)FA0(f),FA1(f));
129: break;
130: case I_PRESELF:
131: f1 = (FNODE)FA1(f);
132: if ( ID(f1) == I_PVAR ) {
133: pv = (int)FA0(f1); ind = (NODE)FA1(f1); GETPV(pv,a);
134: if ( !ind ) {
135: (*((ARF)FA0(f))->fp)(CO,a,ONE,&val); ASSPV(pv,val);
136: } else if ( a ) {
137: compilenodebody(ind,&tn); getarray(a,tn,(pointer *)&u);
138: (*((ARF)FA0(f))->fp)(CO,u,ONE,&val); putarray(a,tn,val);
139: }
140: } else
141: val = compilepv(f->id,(FNODE)FA1(f),FA0(f));
142: break;
143: case I_POSTSELF:
144: f1 = (FNODE)FA1(f);
145: if ( ID(f1) == I_PVAR ) {
146: pv = (int)FA0(f1); ind = (NODE)FA1(f1); GETPV(pv,val);
147: if ( !ind ) {
148: (*((ARF)FA0(f))->fp)(CO,val,ONE,&u); ASSPV(pv,u);
149: } else if ( val ) {
150: compilenodebody(ind,&tn); getarray(val,tn,&a);
151: (*((ARF)FA0(f))->fp)(CO,a,ONE,&u); putarray(val,tn,(pointer)u);
152: val = a;
153: }
154: } else
155: val = compilepv(f->id,(FNODE)FA1(f),FA0(f));
156: break;
157: case I_STR:
158: MKSTR(str,FA0(f)); val = (pointer)str; break;
159: case I_FORMULA:
160: val = FA0(f); break;
161: case I_LIST:
162: compilenodebody((NODE)FA0(f),&tn); MKLIST(t,tn); val = (pointer)t; break;
163: case I_INDEX:
164: a = compile((FNODE)FA0(f)); ind = (NODE)FA1(f);
165: compilenodebody(ind,&tn); getarray(a,tn,&val);
166: break;
167: default:
168: fprintf(stderr,"compile: unknown id");
1.6 ! fujimoto 169: #if defined(__MINGW32__) || defined(__MINGW64__)
! 170: fflush(stderr);
! 171: #endif
1.1 noro 172: error("");
173: break;
174: }
175: return ( val );
176: }
177:
178: pointer compilestat(f)
179: SNODE f;
180: {
181: pointer val = 0,t,s,s1,u;
182: NODE tn;
183: int i,ac;
184: V *a;
185: char *buf;
186:
187: if ( !f )
188: return ( 0 );
189: if ( nextbp && nextbplevel <= 0 && f->id != S_CPLX ) {
190: nextbp = 0;
191: bp(f);
192: }
193: compilestatline = f->ln;
194:
195: switch ( f->id ) {
196: case S_BP:
197: if ( !nextbp && (!FA1(f) || compile((FNODE)FA1(f))) ) {
198: if ( (FNODE)FA2(f) ) {
1.4 ohara 199: #if defined(PARI)
1.1 noro 200: extern FILE *outfile;
201: outfile = stderr;
202: #endif
203: asir_out = stderr;
204: printexpr(CO,compile((FNODE)FA2(f)));
205: putc('\n',asir_out); fflush(asir_out);
1.4 ohara 206: #if defined(PARI)
1.1 noro 207: outfile = stdout;
208: #endif
209: asir_out = stdout;
210: } else {
211: nextbp = 1; nextbplevel = 0;
212: }
213: }
214: val = compilestat((SNODE)FA0(f));
215: break;
216: case S_PFDEF:
217: ac = argc(FA1(f)); a = (V *)MALLOC(ac*sizeof(V));
218: s = compile((FNODE)FA2(f));
219: buf = (char *)ALLOCA(BUFSIZ);
220: for ( i = 0, tn = (NODE)FA1(f); tn; tn = NEXT(tn), i++ ) {
221: t = compile((FNODE)tn->body); sprintf(buf,"_%s",NAME(VR((P)t)));
222: makevar(buf,&u); a[i] = VR((P)u);
223: substr(CO,0,(Obj)s,VR((P)t),(Obj)u,(Obj *)&s1); s = s1;
224: }
225: mkpf((char *)FA0(f),(Obj)s,ac,a,0,0,(PF *)&val); val = 0; break;
226: case S_SINGLE:
227: val = compile((FNODE)FA0(f)); break;
228: case S_CPLX:
229: for ( tn = (NODE)FA0(f); tn; tn = NEXT(tn) ) {
230: if ( BDY(tn) )
231: val = compilestat((SNODE)BDY(tn));
232: if ( f_break || f_return || f_continue )
233: break;
234: }
235: break;
236: case S_BREAK:
237: if ( GPVS != CPVS )
238: f_break = 1;
239: break;
240: case S_CONTINUE:
241: if ( GPVS != CPVS )
242: f_continue = 1;
243: break;
244: case S_RETURN:
245: if ( GPVS != CPVS ) {
246: val = compile((FNODE)FA0(f)); f_return = 1;
247: }
248: break;
249: case S_IFELSE:
250: if ( compilenode((NODE)FA1(f)) )
251: val = compilestat((SNODE)FA2(f));
252: else if ( FA3(f) )
253: val = compilestat((SNODE)FA3(f));
254: break;
255: case S_FOR:
256: compilenode((NODE)FA1(f));
257: while ( 1 ) {
258: if ( !compilenode((NODE)FA2(f)) )
259: break;
260: val = compilestat((SNODE)FA4(f));
261: if ( f_break || f_return )
262: break;
263: f_continue = 0;
264: compilenode((NODE)FA3(f));
265: }
266: f_break = 0; break;
267: case S_DO:
268: while ( 1 ) {
269: val = compilestat((SNODE)FA1(f));
270: if ( f_break || f_return )
271: break;
272: f_continue = 0;
273: if ( !compilenode((NODE)FA2(f)) )
274: break;
275: }
276: f_break = 0; break;
277: default:
278: fprintf(stderr,"compilestat: unknown id");
1.6 ! fujimoto 279: #if defined(__MINGW32__) || defined(__MINGW64__)
! 280: fflush(stderr);
! 281: #endif
1.1 noro 282: error("");
283: break;
284: }
285: return ( val );
286: }
287:
288: pointer compilenode(node)
289: NODE node;
290: {
291: NODE tn;
292: pointer val;
293:
294: for ( tn = node, val = 0; tn; tn = NEXT(tn) )
295: if ( BDY(tn) )
296: val = compile((FNODE)BDY(tn));
297: return ( val );
298: }
299:
300: extern FUNC cur_binf;
301: extern NODE PVSS;
302:
303: pointer compilef(f,a)
304: FUNC f;
305: FNODE a;
306: {
307: LIST args;
308: pointer val;
309: int i,n,level;
310: NODE tn,sn;
311: VS pvs;
312:
313: if ( f->id == A_UNDEF ) {
314: fprintf(stderr,"%s undefined",NAME(f));
1.6 ! fujimoto 315: #if defined(__MINGW32__) || defined(__MINGW64__)
! 316: fflush(stderr);
! 317: #endif
1.1 noro 318: error("");
319: }
320: if ( f->id != A_PARI ) {
321: for ( i = 0, tn = a?(NODE)FA0(a):0; tn; i++, tn = NEXT(tn) );
322: if ( ((n = f->argc)>= 0 && i != n) || (n < 0 && i > -n) ) {
323: fprintf(stderr,"argument mismatch in %s()",NAME(f));
1.6 ! fujimoto 324: #if defined(__MINGW32__) || defined(__MINGW64__)
! 325: fflush(stderr);
! 326: #endif
1.1 noro 327: error("");
328: }
329: }
330: switch ( f->id ) {
331: case A_BIN:
332: if ( !n ) {
333: cur_binf = f;
334: (*f->f.binf)(&val);
335: } else {
336: args = (LIST)compile(a);
337: cur_binf = f;
338: (*f->f.binf)(args?BDY(args):0,&val);
339: }
340: cur_binf = 0;
341: break;
342: case A_PARI:
343: args = (LIST)compile(a);
344: cur_binf = f;
345: val = compileparif(f,args?BDY(args):0);
346: cur_binf = 0;
347: break;
348: case A_USR:
349: args = (LIST)compile(a);
350: pvs = f->f.usrf->pvs;
351: if ( PVSS ) {
352: ((VS)BDY(PVSS))->at = compilestatline;
353: level = ((VS)BDY(PVSS))->level+1;
354: } else
355: level = 1;
356: MKNODE(tn,pvs,PVSS); PVSS = tn;
357: CPVS = (VS)ALLOCA(sizeof(struct oVS)); BDY(PVSS) = (pointer)CPVS;
358: CPVS->usrf = f; CPVS->n = CPVS->asize = pvs->n;
359: CPVS->level = level;
360: if ( CPVS->n ) {
361: CPVS->va = (struct oPV *)ALLOCA(CPVS->n*sizeof(struct oPV));
362: bcopy((char *)pvs->va,(char *)CPVS->va,
363: (int)(pvs->n*sizeof(struct oPV)));
364: }
365: if ( nextbp )
366: nextbplevel++;
367: for ( tn = f->f.usrf->args, sn = BDY(args);
368: sn; tn = NEXT(tn), sn = NEXT(sn) )
369: ASSPV((int)FA0((FNODE)BDY(tn)),BDY(sn));
370: val = compilestat((SNODE)BDY(f->f.usrf));
371: f_return = f_break = f_continue = 0; poppvs();
372: break;
373: case A_PURE:
374: val = compilepf(f->f.puref,a); break;
375: default:
376: fprintf(stderr,"%s undefined",NAME(f));
1.6 ! fujimoto 377: #if defined(__MINGW32__) || defined(__MINGW64__)
! 378: fflush(stderr);
! 379: #endif
1.1 noro 380: error("");
381: break;
382: }
383: return val;
384: }
385:
386: pointer compilemapf(f,a)
387: FUNC f;
388: FNODE a;
389: {
390: LIST args;
391: NODE node,rest,t,n,l,r,r0;
392: Obj head;
393: VECT v,rv;
394: MAT m,rm;
395: LIST rl;
396: int len,row,col,i,j;
397: pointer val;
398:
399: args = (LIST)compile(a);
400: node = BDY(args); head = (Obj)BDY(node); rest = NEXT(node);
401: switch ( OID(head) ) {
402: case O_VECT:
403: v = (VECT)head; len = v->len; MKVECT(rv,len);
404: for ( i = 0; i < len; i++ ) {
405: MKNODE(t,BDY(v)[i],rest); BDY(rv)[i] = bcompilef(f,t);
406: }
407: val = (pointer)rv;
408: break;
409: case O_MAT:
410: m = (MAT)head; row = m->row; col = m->col; MKMAT(rm,row,col);
411: for ( i = 0; i < row; i++ )
412: for ( j = 0; j < col; j++ ) {
413: MKNODE(t,BDY(m)[i][j],rest); BDY(rm)[i][j] = bcompilef(f,t);
414: }
415: val = (pointer)rm;
416: break;
417: case O_LIST:
418: n = BDY((LIST)head);
419: for ( r0 = r = 0; n; n = NEXT(n) ) {
420: NEXTNODE(r0,r); MKNODE(t,BDY(n),rest); BDY(r) = bcompilef(f,t);
421: }
422: if ( r0 )
423: NEXT(r) = 0;
424: MKLIST(rl,r0);
425: val = (pointer)rl;
426: break;
427: default:
428: val = bcompilef(f,node);
429: break;
430: }
431: return val;
432: }
433:
434: pointer bcompilef(f,a)
435: FUNC f;
436: NODE a;
437: {
438: LIST args;
439: pointer val;
440: int i,n;
441: NODE tn,sn;
442: VS pvs;
443:
444: if ( f->id == A_UNDEF ) {
445: fprintf(stderr,"%s undefined",NAME(f));
1.6 ! fujimoto 446: #if defined(__MINGW32__) || defined(__MINGW64__)
! 447: fflush(stderr);
! 448: #endif
1.1 noro 449: error("");
450: }
451: if ( f->id != A_PARI ) {
452: for ( i = 0, tn = a; tn; i++, tn = NEXT(tn) );
453: if ( ((n = f->argc)>= 0 && i != n) || (n < 0 && i > -n) ) {
454: fprintf(stderr,"argument mismatch in %s()",NAME(f));
1.6 ! fujimoto 455: #if defined(__MINGW32__) || defined(__MINGW64__)
! 456: fflush(stderr);
! 457: #endif
1.1 noro 458: error("");
459: }
460: }
461: switch ( f->id ) {
462: case A_BIN:
463: if ( !n ) {
464: cur_binf = f;
465: (*f->f.binf)(&val);
466: } else {
467: cur_binf = f;
468: (*f->f.binf)(a,&val);
469: }
470: cur_binf = 0;
471: break;
472: case A_PARI:
473: cur_binf = f;
474: val = compileparif(f,a);
475: cur_binf = 0;
476: break;
477: case A_USR:
478: pvs = f->f.usrf->pvs;
479: if ( PVSS )
480: ((VS)BDY(PVSS))->at = compilestatline;
481: MKNODE(tn,pvs,PVSS); PVSS = tn;
482: CPVS = (VS)ALLOCA(sizeof(struct oVS)); BDY(PVSS) = (pointer)CPVS;
483: CPVS->usrf = f; CPVS->n = CPVS->asize = pvs->n;
484: if ( CPVS->n ) {
485: CPVS->va = (struct oPV *)ALLOCA(CPVS->n*sizeof(struct oPV));
486: bcopy((char *)pvs->va,(char *)CPVS->va,
487: (int)(pvs->n*sizeof(struct oPV)));
488: }
489: if ( nextbp )
490: nextbplevel++;
491: for ( tn = f->f.usrf->args, sn = a;
492: sn; tn = NEXT(tn), sn = NEXT(sn) )
493: ASSPV((int)FA0((FNODE)BDY(tn)),BDY(sn));
494: val = compilestat((SNODE)BDY(f->f.usrf));
495: f_return = f_break = f_continue = 0; poppvs();
496: break;
497: default:
498: fprintf(stderr,"%s undefined",NAME(f));
1.6 ! fujimoto 499: #if defined(__MINGW32__) || defined(__MINGW64__)
! 500: fflush(stderr);
! 501: #endif
1.1 noro 502: error("");
503: break;
504: }
505: return val;
506: }
507:
508: pointer compileif(f,a)
509: FNODE f,a;
510: {
511: Obj g;
512:
513: g = (Obj)compile(f);
514: if ( g && (OID(g) == O_P) && (VR((P)g)->attr == (pointer)V_SR) )
515: return compilef((FUNC)VR((P)g)->priv,a);
516: else {
517: fprintf(stderr,"invalid function pointer");
1.6 ! fujimoto 518: #if defined(__MINGW32__) || defined(__MINGW64__)
! 519: fflush(stderr);
! 520: #endif
1.1 noro 521: error("");
522: }
523: }
524:
525: pointer compilepf(pf,a)
526: PF pf;
527: FNODE a;
528: {
529: LIST args;
530: pointer val;
531: Obj s,s1;
532: int i;
533: NODE node;
534: PFINS ins;
535: PFAD ad;
536:
537: for ( i = 0, node = a?(NODE)FA0(a):0; node; i++, node = NEXT(node) );
538: if ( pf->argc != i ) {
539: fprintf(stderr,"argument mismatch in %s()",NAME(pf));
1.6 ! fujimoto 540: #if defined(__MINGW32__) || defined(__MINGW64__)
! 541: fflush(stderr);
! 542: #endif
1.1 noro 543: error("");
544: }
545: args = (LIST)compile(a);
546: if ( !pf->body ) {
547: ins = (PFINS)CALLOC(1,sizeof(PF)+pf->argc*sizeof(struct oPFAD));
548: ins->pf = pf;
549: for ( i = 0, node = args->body, ad = ins->ad;
550: node; node = NEXT(node), i++ ) {
551: ad[i].d = 0; ad[i].arg = (Obj)node->body;
552: }
553: simplify_ins(ins,&s); return (pointer)s;
554: } else {
555: for ( i = 0, s = pf->body, node = args->body;
556: node; node = NEXT(node), i++ ) {
557: substr(CO,0,s,pf->args[i],(Obj)node->body,&s1); s = s1;
558: }
559: return (pointer)s;
560: }
561: }
562:
563: void compilenodebody(sn,dnp)
564: NODE sn;
565: NODE *dnp;
566: {
567: NODE n,n0,tn;
568: int line;
569:
570: if ( !sn ) {
571: *dnp = 0;
572: return;
573: }
574: line = compilestatline;
575: for ( tn = sn, n0 = 0; tn; tn = NEXT(tn) ) {
576: NEXTNODE(n0,n);
577: BDY(n) = compile((FNODE)BDY(tn));
578: compilestatline = line;
579: }
580: NEXT(n) = 0; *dnp = n0;
581: }
582:
583: void searchf(fn,name,r)
584: NODE fn;
585: char *name;
586: FUNC *r;
587: {
588: NODE tn;
589:
590: for ( tn = fn;
591: tn && strcmp(NAME((FUNC)BDY(tn)),name); tn = NEXT(tn) );
592: if ( tn ) {
593: *r = (FUNC)BDY(tn);
594: return;
595: }
596: *r = 0;
597: }
598:
599: void appenduf(name,r)
600: char *name;
601: FUNC *r;
602: {
603: NODE tn;
604: FUNC f;
605:
606: f=(FUNC)MALLOC(sizeof(struct oFUNC));
607: f->name = name; f->id = A_UNDEF; f->argc = 0; f->f.binf = 0;
608: MKNODE(tn,f,usrf); usrf = tn;
609: *r = f;
610: }
611:
612: void mkparif(name,r)
613: char *name;
614: FUNC *r;
615: {
616: NODE tn;
617: FUNC f;
618:
619: *r = f =(FUNC)MALLOC(sizeof(struct oFUNC));
620: f->name = name; f->id = A_PARI; f->argc = 0; f->f.binf = 0;
621: }
622:
1.5 noro 623: void mkuf(name,fname,args,body,startl,endl,desc,module)
1.1 noro 624: char *name,*fname;
625: NODE args;
626: SNODE body;
627: int startl,endl;
628: char *desc;
1.5 noro 629: MODULE module;
1.1 noro 630: {
631: FUNC f;
632: USRF t;
633: NODE sn,tn;
634: FNODE fn;
635: int argc;
636:
637: searchf(sysf,name,&f);
638: if ( f ) {
639: fprintf(stderr,"def : builtin function %s() cannot be redefined.\n",name);
1.6 ! fujimoto 640: #if defined(__MINGW32__) || defined(__MINGW64__)
! 641: fflush(stderr);
! 642: #endif
1.1 noro 643: CPVS = GPVS; return;
644: }
645: for ( argc = 0, sn = args; sn; argc++, sn = NEXT(sn) ) {
646: fn = (FNODE)BDY(sn);
647: if ( !fn || ID(fn) != I_PVAR ) {
648: fprintf(stderr,"illegal argument in %s()\n",name);
1.6 ! fujimoto 649: #if defined(__MINGW32__) || defined(__MINGW64__)
! 650: fflush(stderr);
! 651: #endif
1.1 noro 652: CPVS = GPVS; return;
653: }
654: }
655: for ( sn = usrf; sn && strcmp(NAME((FUNC)BDY(sn)),name); sn = NEXT(sn) );
656: if ( sn )
657: f = (FUNC)BDY(sn);
658: else {
659: f=(FUNC)MALLOC(sizeof(struct oFUNC));
660: f->name = name;
661: MKNODE(tn,f,usrf); usrf = tn;
662: }
663: if ( Verbose && f->id != A_UNDEF )
664: fprintf(stderr,"Warning : %s() redefined.\n",name);
1.6 ! fujimoto 665: #if defined(__MINGW32__) || defined(__MINGW64__)
! 666: fflush(stderr);
! 667: #endif
1.1 noro 668: /* else
669: fprintf(stderr,"%s() defined.\n",name); */
670: t=(USRF)MALLOC(sizeof(struct oUSRF));
671: t->args=args; BDY(t)=body; t->pvs = CPVS; t->fname = fname;
1.5 noro 672: t->startl = startl; t->endl = endl;
673: t->desc = desc; t->module = module;
1.1 noro 674: f->id = A_USR; f->argc = argc; f->f.usrf = t;
675: CPVS = GPVS;
676: clearbp(f);
677: }