![[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.6 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2000/builtin/miscf.c,v 1.5 2000/03/10 06:42:22 noro Exp $ */
1.1 noro 2: #include "ca.h"
3: #include "parse.h"
4: #if INET && !defined(VISUAL)
5: #include <X11/Xlib.h>
6: #include <X11/cursorfont.h>
7: #endif
8:
9: void Pquit(), Pdebug(), Pnmono(), Pnez(), Popt(), Pshell(), Pheap();
10: void Perror(), Perror3(), Pversion(), Pflist(), Pdelete_history(), Ppause(), Pxpause();
11: void Pr2g(), Pread_cmo(), Pwrite_cmo();
12: void Pgc(),Pbatch(),Psend_progress();
13: void Pnull_command();
14: void Pgetenv();
15:
16: void delete_history(int,int);
17:
18: struct ftab misc_tab[] = {
19: {"null_command",Pnull_command,-99999},
20: {"getenv",Pgetenv,1},
21: {"end",Pquit,0},
22: {"quit",Pquit,0},
23: {"debug",Pdebug,0},
24: {"shell",Pshell,-2},
25: {"heap",Pheap,-1},
26: {"version",Pversion,0},
27: {"nmono",Pnmono,1},
28: {"error",Perror,1},
29: {"error3",Perror3,3},
30: {"nez",Pnez,1},
31: {"flist",Pflist,0},
32: {"delete_history",Pdelete_history,-2},
33: {"pause",Ppause,0},
34: {"gc",Pgc,0},
35: {"batch",Pbatch,2},
36: {"send_progress",Psend_progress,-2},
1.3 noro 37: #if INET && !defined(VISUAL) && DO_PLOT
1.1 noro 38: {"xpause",Pxpause,0},
39: #endif
40: #if 0
41: {"opt",Popt,1},
42: #endif
43: {0,0,0},
44: };
45:
46: void Pgetenv(arg,rp)
47: NODE arg;
48: STRING *rp;
49: {
50: char *e,*f;
51: int len;
52:
53: e = (char *)getenv(BDY((STRING)ARG0(arg)));
54: if ( e ) {
55: len = strlen(e);
56: f = (char *)MALLOC_ATOMIC(len+1);
57: strcpy(f,e);
58: MKSTR(*rp,f);
59: } else
60: *rp = 0;
61: }
62:
63: void Pnull_command(arg,rp)
64: NODE arg;
65: Q *rp;
66: {
67: *rp = 0;
68: }
69:
70: void Pquit(rp)
71: pointer *rp;
72: {
73: if ( !NEXT(asir_infile) )
74: asir_terminate(2);
75: else {
76: closecurrentinput();
1.5 noro 77: if ( !asir_infile->fp && strcmp(asir_infile->name,"string") )
1.1 noro 78: asir_terminate(2);
79: }
80: *rp = 0;
81: }
82:
83: void Pdebug(rp)
84: pointer *rp;
85: {
86: debug(0); *rp = 0;
87: }
88:
89: void Pshell(arg,rp)
90: NODE arg;
91: Q *rp;
92: {
93: char *com = 0;
94: char *pstr = 0;
95: int status;
96:
97: if ( arg ) {
98: asir_assert(ARG0(arg),O_STR,"shell");
99: com = BDY((STRING)ARG0(arg));
100: if ( NEXT(arg) )
101: pstr = BDY((STRING)ARG1(arg));
102: }
103: status = system(com);
104: STOQ(status,*rp);
105: }
106:
107: void Pnmono(arg,rp)
108: NODE arg;
109: Q *rp;
110: {
111: Obj obj;
112: int n;
113:
114: obj = (Obj)ARG0(arg);
115: if ( !obj || OID(obj) > O_R )
116: *rp = 0;
117: else
118: switch (OID(obj)) {
119: case O_N: case O_P:
120: n = nmonop((P)obj); STOQ(n,*rp); break;
121: case O_R:
122: n = nmonop(NM((R)obj)) + nmonop(DN((R)obj));
123: STOQ(n,*rp); break;
124: }
125: }
126:
127: void Pheap(arg,rp)
128: NODE arg;
129: Q *rp;
130: {
131: int h0,h;
132: void GC_expand_hp(int);
133:
134: h0 = get_heapsize();
135: if ( arg ) {
136: h = QTOS((Q)ARG0(arg));
137: if ( h > h0 )
138: GC_expand_hp(h-h0);
139: }
140: h = get_heapsize();
141: STOQ(h,*rp);
142: }
143:
144: unsigned int get_asir_version();
145:
146: void Pversion(rp)
147: Q *rp;
148: {
149: unsigned int version;
150:
151: version = get_asir_version();
152: STOQ(version,*rp);
153: }
154:
155: extern int nez;
156:
157: void Pnez(arg,rp)
158: NODE arg;
159: pointer *rp;
160: {
161: nez = ARG0(arg) ? 1 : 0; *rp = 0;
162: }
163:
164: void Perror(arg,rp)
165: NODE arg;
166: Q *rp;
167: {
168: char *s;
169:
170: if ( !arg || !ARG0(arg) || (OID((Obj)ARG0(arg)) != O_STR) )
171: s = "";
172: else
173: s = BDY((STRING)ARG0(arg));
174: error(s);
175: *rp = 0;
176: }
177:
178: void Perror3(arg,rp)
179: NODE arg;
180: Q *rp;
181: {
182: char s[BUFSIZ];
183: int code;
184: char *reason,*action;
185:
186: asir_assert(ARG0(arg),O_N,"error3");
187: asir_assert(ARG1(arg),O_STR,"error3");
188: asir_assert(ARG2(arg),O_STR,"error3");
189: code = QTOS((Q)ARG0(arg));
190: reason = BDY((STRING)ARG1(arg));
191: action = BDY((STRING)ARG2(arg));
1.3 noro 192: #if defined(VISUAL)
1.1 noro 193: set_error(code,reason,action);
1.3 noro 194: #endif
1.1 noro 195: error("");
196: *rp = 0;
197: }
198:
199: void Pflist(rp)
200: LIST *rp;
201: {
202: char *n;
203: STRING name;
204: NODE t,r,r0;
205: LIST l;
206:
207: for ( t = usrf, r0 = 0; t; t = NEXT(t) )
208: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
209: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
210: MKNODE(r,name,r0); r0 = r;
211: }
212: for ( t = ubinf; t; t = NEXT(t) )
213: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
214: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
215: MKNODE(r,name,r0); r0 = r;
216: }
217: for ( t = sysf; t; t = NEXT(t) )
218: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
219: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
220: MKNODE(r,name,r0); r0 = r;
221: }
222: MKLIST(l,r0); *rp = l;
223: }
224:
225: void Pdelete_history(arg,rp)
226: NODE arg;
227: Q *rp;
228: {
229: switch ( argc(arg) ) {
230: case 0: default:
231: delete_history(0,(int)APVS->n);
232: break;
233: case 1:
234: delete_history(QTOS((Q)ARG0(arg)),1);
235: break;
236: }
237: *rp = 0;
238: }
239:
240: void delete_history(start,n)
241: int start,n;
242: {
243: int i,max;
244:
245: max = APVS->n;
246: if ( start < 0 || start >= max )
247: return;
248: if ( start + n > max )
249: n = max - start;
250: for ( i = 0; i < n; i++ )
251: APVS->va[start+i].priv = 0;
252: }
253:
254: void Ppause(rp)
255: LIST *rp;
256: {
257: char buf[BUFSIZ];
258:
259: fgets(buf,BUFSIZ,stdin);
260: *rp = 0;
261: }
262:
263: void Pgc(rp)
264: LIST *rp;
265: {
266: GC_gcollect();
267: *rp = 0;
268: }
269:
270: int exec_file(char *,char *);
271:
272: void Pbatch(arg,rp)
273: NODE arg;
274: Q *rp;
275: {
276: int ret;
277:
278: ret = exec_file(BDY((STRING)ARG0(arg)),BDY((STRING)ARG1(arg)));
279: STOQ(ret,*rp);
280: }
281:
1.3 noro 282: #if INET && !defined(VISUAL) && DO_PLOT
1.1 noro 283: void Pxpause(rp)
284: Q *rp;
285: {
286: if ( !init_display() )
287: *rp = 0;
288: else {
289: grab_pointer(); *rp = ONE;
290: }
291: }
292:
293: static Display *display;
294: static Window rootwin;
295:
296: init_display()
297: {
298: char *dname;
299: unsigned int tmp;
300: static int initialized;
301: int argc;
302: char *argv[1];
303:
304: if ( initialized )
305: return 1;
306: else
307: initialized = 1;
308: dname = (char *)getenv("DISPLAY");
309:
310: display = XOpenDisplay(dname);
311: if ( !display ) {
312: fprintf(stderr,"Can't open display\n");
313: return 0;
314: }
315: rootwin = RootWindow(display,DefaultScreen(display));
316: }
317:
318: grab_pointer()
319: {
320: XEvent ev;
321: static Cursor cursor;
322:
323: if ( !cursor )
324: cursor = XCreateFontCursor(display,XC_leftbutton);
325: XGrabPointer(display,rootwin,True,ButtonPressMask,GrabModeAsync,GrabModeAsync,None,cursor,CurrentTime);
326: while ( 1 ) {
327: XNextEvent(display,&ev);
328: if ( ev.xany.type == ButtonPress )
329: break;
330: }
331: XUngrabPointer(display,CurrentTime);
332: XSync(display,False);
333: return;
334: }
335: #endif
336:
337: void Psend_progress(NODE arg,Q *rp)
338: {
339: #if defined(VISUAL)
340: short per;
341: char *msg;
342:
343: per = (short)QTOS((Q)BDY(arg)); arg = NEXT(arg);
344: if ( arg )
345: msg = BDY((STRING)BDY(arg));
346: else
347: msg = "";
348: send_progress(per,msg);
349: #endif
350: *rp = 0;
351: }
352:
353: #if 0
354: static int optimize;
355: static struct oN oPSN[1000];
356: static struct oQ oPSZ[1000],oMSZ[1000];
357: static szinit = 0;
358:
359: void Popt(arg,rp)
360: NODE arg;
361: pointer *rp;
362: {
363: optimize = ARG0(arg) ? 1 : 0; *rp = 0;
364: }
365:
366:
367: void sz_init() {
368: int i;
369: Q t;
370:
371: for ( i = 1; i < 1000; i++ ) {
372: oPSN[i].p = 1; oPSN[i].b[0] = i;
373: t = &oPSZ[i];
374: OID(t) = O_N; NID(t) = N_Q; SGN(t) = 1; NM(t) = &oPSN[i]; DN(t) = 0;
375: t = &oMSZ[i];
376: OID(t) = O_N; NID(t) = N_Q; SGN(t) = -1; NM(t) = &oPSN[i]; DN(t) = 0;
377: }
378: szinit = 1;
379: }
380:
381: optobj(p)
382: Obj *p;
383: {
384: Obj t;
385: int n;
386: DCP dc;
387:
388: if ( t = *p )
389: switch ( OID(t) ) {
390: case O_N:
391: if ( (NID(t)==N_Q) && INT(t) && (PL(NM((Q)t))==1) ) {
392: n = QTOS((Q)t);
393: if ( !szinit )
394: sz_init();
395: if ( n < 1000 )
396: *p = (Obj)(SGN((Q)t)>0?&oPSZ[n]:&oMSZ[n]);
397: }
398: break;
399: case O_P:
400: for ( dc = DC((P)t); dc; dc = NEXT(dc) ) {
401: optobj(&DEG(dc)); optobj(&COEF(dc));
402: }
403: break;
404: case O_R:
405: optobj(&NM((R)t)); optobj(&DN((R)t)); break;
406: default:
407: break;
408: }
409: }
410: #endif