![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to miscf.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin|
Return to miscf.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
1.7 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.8 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.7 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.22 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.21 2004/02/25 06:43:52 ohara Exp $
1.7 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "parse.h"
1.17 noro 52: #if !defined(VISUAL) && defined(DO_PLOT)
1.1 noro 53: #include <X11/Xlib.h>
54: #include <X11/cursorfont.h>
55: #endif
56:
1.12 noro 57: #if defined(VISUAL)
58: #include <stdlib.h>
59: #include <windows.h>
60: #endif
61:
1.1 noro 62: void Pquit(), Pdebug(), Pnmono(), Pnez(), Popt(), Pshell(), Pheap();
1.20 noro 63: void Ptoplevel();
1.21 ohara 64: void Perror(), Perror3(), Pversion(), Pcopyright(), Pflist(), Pdelete_history(), Ppause(), Pxpause();
1.1 noro 65: void Pr2g(), Pread_cmo(), Pwrite_cmo();
66: void Pgc(),Pbatch(),Psend_progress();
67: void Pnull_command();
68: void Pgetenv();
1.9 noro 69: void Pget_addr(),Phex_dump();
70: void Ppeek(),Ppoke();
1.12 noro 71: void Psleep();
1.18 noro 72: void Premove_module();
73: void Pmodule_list();
1.19 takayama 74: void Pmodule_definedp();
1.22 ! noro 75: void Ptest();
1.1 noro 76:
77: void delete_history(int,int);
78:
79: struct ftab misc_tab[] = {
1.18 noro 80: {"module_list",Pmodule_list,0},
81: {"remove_module",Premove_module,1},
1.19 takayama 82: {"module_definedp",Pmodule_definedp,1},
1.12 noro 83: {"sleep",Psleep,1},
1.1 noro 84: {"null_command",Pnull_command,-99999},
85: {"getenv",Pgetenv,1},
86: {"end",Pquit,0},
87: {"quit",Pquit,0},
88: {"debug",Pdebug,0},
89: {"shell",Pshell,-2},
90: {"heap",Pheap,-1},
1.11 noro 91: {"version",Pversion,-99999},
1.21 ohara 92: {"copyright",Pcopyright,0},
1.1 noro 93: {"nmono",Pnmono,1},
1.20 noro 94: {"toplevel",Ptoplevel,-1},
1.1 noro 95: {"error",Perror,1},
96: {"error3",Perror3,3},
97: {"nez",Pnez,1},
1.18 noro 98: {"flist",Pflist,-1},
1.1 noro 99: {"delete_history",Pdelete_history,-2},
100: {"pause",Ppause,0},
101: {"gc",Pgc,0},
102: {"batch",Pbatch,2},
103: {"send_progress",Psend_progress,-2},
1.9 noro 104: {"get_addr",Pget_addr,1},
105: {"hex_dump",Phex_dump,2},
106: {"peek",Ppeek,1},
107: {"poke",Ppoke,2},
1.22 ! noro 108: {"test",Ptest,2},
1.16 noro 109: #if !defined(VISUAL) && defined(DO_PLOT)
1.1 noro 110: {"xpause",Pxpause,0},
111: #endif
112: #if 0
113: {"opt",Popt,1},
114: #endif
115: {0,0,0},
116: };
1.22 ! noro 117:
! 118: void Ptest(arg,rp)
! 119: NODE arg;
! 120: Q *rp;
! 121: {
! 122: int r;
! 123:
! 124: r = equalr(CO,ARG0(arg),ARG1(arg));
! 125: STOQ(r,*rp);
! 126: }
1.12 noro 127:
128: void Psleep(arg,rp)
129: NODE arg;
130: Q *rp;
131: {
132: int ms;
133:
134: ms = QTOS((Q)ARG0(arg));
135: #if defined(VISUAL)
136: Sleep(ms);
137: #else
138: usleep(ms*1000);
139: #endif
140: *rp = ONE;
141: }
1.1 noro 142:
1.18 noro 143: void Pmodule_list(rp)
144: LIST *rp;
145: {
146: char *name;
147: NODE r,r1,m;
148: STRING s;
149:
150: r = 0;
151: for ( m = MODULE_LIST; m; m = NEXT(m) ) {
152: MKSTR(s,((MODULE)BDY(m))->name);
153: MKNODE(r1,s,r); r = r1;
154: }
155: MKLIST(*rp,r);
156: }
157:
158: void Premove_module(arg,rp)
159: NODE arg;
160: Q *rp;
161: {
162: NODE pm,m;
163: char *name;
164:
165: asir_assert(ARG0(arg),O_STR,"remove_module");
166: name = BDY((STRING)ARG0(arg));
167: for ( pm = 0, m = MODULE_LIST; m; pm = m, m = NEXT(m) )
168: if ( !strcmp(name,((MODULE)BDY(m))->name) ) {
169: if ( !pm )
170: MODULE_LIST = NEXT(MODULE_LIST);
171: else
172: NEXT(pm) = NEXT(m);
173: *rp = ONE;
174: return;
1.19 takayama 175: }
176: *rp = 0;
177: }
178:
179: void Pmodule_definedp(arg,rp)
180: NODE arg;
181: Q *rp;
182: {
183: NODE m;
184: char *name;
185:
186: asir_assert(ARG0(arg),O_STR,"module_definedp");
187: name = BDY((STRING)ARG0(arg));
188: /* bug: the linear search is used here. The list of module shoud be sorted
189: and cashed, and binary search should be used. */
190: for (m = MODULE_LIST; m; m = NEXT(m) )
191: if ( !strcmp(name,((MODULE)BDY(m))->name) ) {
192: *rp = ONE;
193: return ;
1.18 noro 194: }
195: *rp = 0;
196: }
197:
1.1 noro 198: void Pgetenv(arg,rp)
199: NODE arg;
200: STRING *rp;
201: {
202: char *e,*f;
203: int len;
204:
205: e = (char *)getenv(BDY((STRING)ARG0(arg)));
206: if ( e ) {
207: len = strlen(e);
208: f = (char *)MALLOC_ATOMIC(len+1);
209: strcpy(f,e);
210: MKSTR(*rp,f);
211: } else
212: *rp = 0;
213: }
214:
215: void Pnull_command(arg,rp)
216: NODE arg;
217: Q *rp;
218: {
219: *rp = 0;
220: }
221:
222: void Pquit(rp)
223: pointer *rp;
224: {
225: if ( !NEXT(asir_infile) )
226: asir_terminate(2);
227: else {
228: closecurrentinput();
1.5 noro 229: if ( !asir_infile->fp && strcmp(asir_infile->name,"string") )
1.1 noro 230: asir_terminate(2);
231: }
232: *rp = 0;
233: }
234:
235: void Pdebug(rp)
236: pointer *rp;
237: {
238: debug(0); *rp = 0;
239: }
240:
241: void Pshell(arg,rp)
242: NODE arg;
243: Q *rp;
244: {
245: char *com = 0;
246: char *pstr = 0;
247: int status;
248:
249: if ( arg ) {
250: asir_assert(ARG0(arg),O_STR,"shell");
251: com = BDY((STRING)ARG0(arg));
252: if ( NEXT(arg) )
253: pstr = BDY((STRING)ARG1(arg));
254: }
255: status = system(com);
256: STOQ(status,*rp);
257: }
258:
259: void Pnmono(arg,rp)
260: NODE arg;
261: Q *rp;
262: {
263: Obj obj;
264: int n;
265:
266: obj = (Obj)ARG0(arg);
267: if ( !obj || OID(obj) > O_R )
268: *rp = 0;
269: else
270: switch (OID(obj)) {
271: case O_N: case O_P:
272: n = nmonop((P)obj); STOQ(n,*rp); break;
273: case O_R:
274: n = nmonop(NM((R)obj)) + nmonop(DN((R)obj));
275: STOQ(n,*rp); break;
276: }
277: }
278:
279: void Pheap(arg,rp)
280: NODE arg;
281: Q *rp;
282: {
283: int h0,h;
284: void GC_expand_hp(int);
285:
286: h0 = get_heapsize();
287: if ( arg ) {
288: h = QTOS((Q)ARG0(arg));
289: if ( h > h0 )
290: GC_expand_hp(h-h0);
291: }
292: h = get_heapsize();
293: STOQ(h,*rp);
294: }
295:
296: unsigned int get_asir_version();
1.11 noro 297: char *get_asir_distribution();
1.1 noro 298:
1.11 noro 299: void Pversion(arg,rp)
300: NODE arg;
301: Obj *rp;
1.1 noro 302: {
303: unsigned int version;
1.11 noro 304: char *distribution;
305: Q q;
306: STRING str;
307: NODE n;
308: LIST l;
1.1 noro 309:
310: version = get_asir_version();
1.11 noro 311: distribution = get_asir_distribution();
1.13 noro 312: UTOQ(version,q);
1.11 noro 313: if ( !argc(arg) )
314: *rp = (Obj)q;
315: else {
316: MKSTR(str,distribution);
317: n = mknode(2,q,str);
318: MKLIST(l,n);
319: *rp = (Obj)l;
320: }
1.21 ohara 321: }
322:
323: char *scopyright();
324:
325: void Pcopyright(rp)
326: STRING *rp;
327: {
328: MKSTR(*rp,scopyright());
1.1 noro 329: }
330:
331: extern int nez;
332:
333: void Pnez(arg,rp)
334: NODE arg;
335: pointer *rp;
336: {
337: nez = ARG0(arg) ? 1 : 0; *rp = 0;
338: }
339:
340: void Perror(arg,rp)
341: NODE arg;
342: Q *rp;
343: {
344: char *s;
345:
346: if ( !arg || !ARG0(arg) || (OID((Obj)ARG0(arg)) != O_STR) )
347: s = "";
348: else
349: s = BDY((STRING)ARG0(arg));
350: error(s);
1.20 noro 351: *rp = 0;
352: }
353:
354: void Ptoplevel(arg,rp)
355: NODE arg;
356: Q *rp;
357: {
358: char *s;
359:
360: if ( !arg || !ARG0(arg) || (OID((Obj)ARG0(arg)) != O_STR) )
361: s = "";
362: else
363: s = BDY((STRING)ARG0(arg));
364: toplevel(s);
1.1 noro 365: *rp = 0;
366: }
367:
368: void Perror3(arg,rp)
369: NODE arg;
370: Q *rp;
371: {
372: int code;
373: char *reason,*action;
374:
375: asir_assert(ARG0(arg),O_N,"error3");
376: asir_assert(ARG1(arg),O_STR,"error3");
377: asir_assert(ARG2(arg),O_STR,"error3");
378: code = QTOS((Q)ARG0(arg));
379: reason = BDY((STRING)ARG1(arg));
380: action = BDY((STRING)ARG2(arg));
1.3 noro 381: #if defined(VISUAL)
1.1 noro 382: set_error(code,reason,action);
1.3 noro 383: #endif
1.1 noro 384: error("");
385: *rp = 0;
386: }
387:
1.18 noro 388: void Pflist(arg,rp)
389: NODE arg;
1.1 noro 390: LIST *rp;
391: {
392: char *n;
393: STRING name;
1.18 noro 394: char *mname;
395: NODE t,r,r0,m;
1.1 noro 396: LIST l;
397:
1.18 noro 398: if ( argc(arg) ) {
399: /* module name is specified */
400: asir_assert(ARG0(arg),O_STR,"flist");
401: mname = BDY((STRING)ARG0(arg));
402: r0 = 0;
403: for ( m = MODULE_LIST; m; m = NEXT(m) ) {
404: if ( !strcmp(mname,((MODULE)BDY(m))->name) ) {
405: t = ((MODULE)BDY(m))->usrf_list;
406: for ( r0 = 0; t; t = NEXT(t) )
407: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
408: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
409: MKNODE(r,name,r0); r0 = r;
410: }
411: }
1.1 noro 412: }
1.18 noro 413: } else {
414: for ( t = usrf, r0 = 0; t; t = NEXT(t) )
415: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
416: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
417: MKNODE(r,name,r0); r0 = r;
418: }
419: for ( t = ubinf; t; t = NEXT(t) )
420: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
421: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
422: MKNODE(r,name,r0); r0 = r;
423: }
424: for ( t = sysf; t; t = NEXT(t) )
425: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
426: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
427: MKNODE(r,name,r0); r0 = r;
428: }
429: }
1.1 noro 430: MKLIST(l,r0); *rp = l;
431: }
432:
433: void Pdelete_history(arg,rp)
434: NODE arg;
435: Q *rp;
436: {
437: switch ( argc(arg) ) {
438: case 0: default:
439: delete_history(0,(int)APVS->n);
440: break;
441: case 1:
442: delete_history(QTOS((Q)ARG0(arg)),1);
443: break;
444: }
445: *rp = 0;
446: }
447:
448: void delete_history(start,n)
449: int start,n;
450: {
451: int i,max;
452:
453: max = APVS->n;
454: if ( start < 0 || start >= max )
455: return;
456: if ( start + n > max )
457: n = max - start;
458: for ( i = 0; i < n; i++ )
459: APVS->va[start+i].priv = 0;
460: }
461:
462: void Ppause(rp)
463: LIST *rp;
464: {
465: char buf[BUFSIZ];
466:
467: fgets(buf,BUFSIZ,stdin);
468: *rp = 0;
469: }
470:
471: void Pgc(rp)
472: LIST *rp;
473: {
474: GC_gcollect();
475: *rp = 0;
476: }
477:
478: int exec_file(char *,char *);
479:
480: void Pbatch(arg,rp)
481: NODE arg;
482: Q *rp;
483: {
484: int ret;
485:
486: ret = exec_file(BDY((STRING)ARG0(arg)),BDY((STRING)ARG1(arg)));
487: STOQ(ret,*rp);
488: }
489:
1.16 noro 490: #if !defined(VISUAL) && defined(DO_PLOT)
1.1 noro 491: void Pxpause(rp)
492: Q *rp;
493: {
494: if ( !init_display() )
495: *rp = 0;
496: else {
497: grab_pointer(); *rp = ONE;
498: }
499: }
500:
501: static Display *display;
502: static Window rootwin;
503:
504: init_display()
505: {
506: char *dname;
507: unsigned int tmp;
508: static int initialized;
509: int argc;
510: char *argv[1];
511:
512: if ( initialized )
513: return 1;
514: else
515: initialized = 1;
516: dname = (char *)getenv("DISPLAY");
517:
518: display = XOpenDisplay(dname);
519: if ( !display ) {
520: fprintf(stderr,"Can't open display\n");
521: return 0;
522: }
523: rootwin = RootWindow(display,DefaultScreen(display));
524: }
525:
526: grab_pointer()
527: {
528: XEvent ev;
529: static Cursor cursor;
530:
531: if ( !cursor )
532: cursor = XCreateFontCursor(display,XC_leftbutton);
533: XGrabPointer(display,rootwin,True,ButtonPressMask,GrabModeAsync,GrabModeAsync,None,cursor,CurrentTime);
534: while ( 1 ) {
535: XNextEvent(display,&ev);
536: if ( ev.xany.type == ButtonPress )
537: break;
538: }
539: XUngrabPointer(display,CurrentTime);
540: XSync(display,False);
541: return;
542: }
543: #endif
544:
545: void Psend_progress(NODE arg,Q *rp)
546: {
547: #if defined(VISUAL)
548: short per;
549: char *msg;
550:
551: per = (short)QTOS((Q)BDY(arg)); arg = NEXT(arg);
552: if ( arg )
553: msg = BDY((STRING)BDY(arg));
554: else
555: msg = "";
556: send_progress(per,msg);
557: #endif
1.9 noro 558: *rp = 0;
559: }
560:
561: void Pget_addr(arg,rp)
562: NODE arg;
563: Q *rp;
564: {
565: pointer obj;
566: unsigned int u,l;
567: N n;
568:
569: obj = ARG0(arg);
570: if ( sizeof(pointer) == sizeof(unsigned int) ) {
571: UTOQ((unsigned int)obj,*rp);
572: } else {
573: /* a pointer must fit in long */
574: u = ((unsigned long)obj)>>32;
575: l = ((unsigned long)obj)&(unsigned long)0xffffffff;
576: if ( u ) {
577: n = NALLOC(2); PL(n) = 2; BD(n)[0] = l; BD(n)[1] = u;
578: NTOQ(n,1,*rp);
579: } else {
580: UTOQ(l,*rp);
581: }
582: }
583: }
584:
585: unsigned char *qtoaddr(q)
586: Q q;
587: {
588: unsigned char *addr;
589: N n;
590:
591: if ( !q )
592: return 0;
593: n = NM(q);
594: if ( (sizeof(pointer) == sizeof(unsigned int)) || (PL(n) == 1) )
595: addr = (char *)BD(n)[0];
596: else {
597: /* a pointer must fit in long */
598: addr = (char *)((((unsigned long)BD(n)[1])<<32)
599: | ((unsigned long)BD(n)[0]));
600: }
601: return addr;
602: }
603:
604: void Phex_dump(arg,rp)
605: NODE arg;
606: Q *rp;
607: {
608: unsigned char *start;
609: int len,i;
610:
611: *rp = 0;
612: start = qtoaddr((Q)ARG0(arg));
613: len = QTOS((Q)ARG1(arg));
614: for ( i = 0; i < len; i++ ) {
615: if ( !(i%16) )
616: fprintf(asir_out,"%08x: ",start+i);
617: fprintf(asir_out,"%02x",start[i]);
618: if ( !((i+1)%16) )
619: fprintf(asir_out,"\n");
620: else if ( !((i+1)%4) )
621: fprintf(asir_out," ");
622: }
623: if ( i%16 )
624: fprintf(asir_out,"\n");
625: }
626:
627: void Ppeek(arg,rp)
628: NODE arg;
629: Q *rp;
630: {
631: unsigned int b;
632: unsigned char *a;
633:
634: a = qtoaddr((Q)ARG0(arg));
635: b = (unsigned int) (*a);
636: UTOQ(b,*rp);
637: }
638:
639: void Ppoke(arg,rp)
640: NODE arg;
641: Q *rp;
642: {
643: unsigned char *addr;
644:
645: addr = qtoaddr((Q)ARG0(arg));
646: *addr = (unsigned char)QTOS((Q)ARG1(arg));
1.1 noro 647: *rp = 0;
648: }
649:
650: #if 0
651: static int optimize;
652: static struct oN oPSN[1000];
653: static struct oQ oPSZ[1000],oMSZ[1000];
654: static szinit = 0;
655:
656: void Popt(arg,rp)
657: NODE arg;
658: pointer *rp;
659: {
660: optimize = ARG0(arg) ? 1 : 0; *rp = 0;
661: }
662:
663:
664: void sz_init() {
665: int i;
666: Q t;
667:
668: for ( i = 1; i < 1000; i++ ) {
669: oPSN[i].p = 1; oPSN[i].b[0] = i;
670: t = &oPSZ[i];
671: OID(t) = O_N; NID(t) = N_Q; SGN(t) = 1; NM(t) = &oPSN[i]; DN(t) = 0;
672: t = &oMSZ[i];
673: OID(t) = O_N; NID(t) = N_Q; SGN(t) = -1; NM(t) = &oPSN[i]; DN(t) = 0;
674: }
675: szinit = 1;
676: }
677:
678: optobj(p)
679: Obj *p;
680: {
681: Obj t;
682: int n;
683: DCP dc;
684:
685: if ( t = *p )
686: switch ( OID(t) ) {
687: case O_N:
688: if ( (NID(t)==N_Q) && INT(t) && (PL(NM((Q)t))==1) ) {
689: n = QTOS((Q)t);
690: if ( !szinit )
691: sz_init();
692: if ( n < 1000 )
693: *p = (Obj)(SGN((Q)t)>0?&oPSZ[n]:&oMSZ[n]);
694: }
695: break;
696: case O_P:
697: for ( dc = DC((P)t); dc; dc = NEXT(dc) ) {
698: optobj(&DEG(dc)); optobj(&COEF(dc));
699: }
700: break;
701: case O_R:
702: optobj(&NM((R)t)); optobj(&DN((R)t)); break;
703: default:
704: break;
705: }
706: }
707: #endif