Annotation of OpenXM_contrib2/asir2000/builtin/miscf.c, Revision 1.1.1.1
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/miscf.c,v 1.1.1.1 1999/11/10 08:12:25 noro Exp $ */
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},
37: #if INET && !defined(VISUAL)
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();
77: if ( !asir_infile->fp )
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));
192: set_error(code,reason,action);
193: error("");
194: *rp = 0;
195: }
196:
197: void Pflist(rp)
198: LIST *rp;
199: {
200: char *n;
201: STRING name;
202: NODE t,r,r0;
203: LIST l;
204:
205: for ( t = usrf, r0 = 0; t; t = NEXT(t) )
206: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
207: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
208: MKNODE(r,name,r0); r0 = r;
209: }
210: for ( t = ubinf; t; t = NEXT(t) )
211: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
212: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
213: MKNODE(r,name,r0); r0 = r;
214: }
215: for ( t = sysf; t; t = NEXT(t) )
216: if ( ((FUNC)BDY(t))->id != A_UNDEF ) {
217: n = NAME((FUNC)BDY(t)); MKSTR(name,n);
218: MKNODE(r,name,r0); r0 = r;
219: }
220: MKLIST(l,r0); *rp = l;
221: }
222:
223: void Pdelete_history(arg,rp)
224: NODE arg;
225: Q *rp;
226: {
227: switch ( argc(arg) ) {
228: case 0: default:
229: delete_history(0,(int)APVS->n);
230: break;
231: case 1:
232: delete_history(QTOS((Q)ARG0(arg)),1);
233: break;
234: }
235: *rp = 0;
236: }
237:
238: void delete_history(start,n)
239: int start,n;
240: {
241: int i,max;
242:
243: max = APVS->n;
244: if ( start < 0 || start >= max )
245: return;
246: if ( start + n > max )
247: n = max - start;
248: for ( i = 0; i < n; i++ )
249: APVS->va[start+i].priv = 0;
250: }
251:
252: void Ppause(rp)
253: LIST *rp;
254: {
255: char buf[BUFSIZ];
256:
257: fgets(buf,BUFSIZ,stdin);
258: *rp = 0;
259: }
260:
261: void Pgc(rp)
262: LIST *rp;
263: {
264: GC_gcollect();
265: *rp = 0;
266: }
267:
268: int exec_file(char *,char *);
269:
270: void Pbatch(arg,rp)
271: NODE arg;
272: Q *rp;
273: {
274: int ret;
275:
276: ret = exec_file(BDY((STRING)ARG0(arg)),BDY((STRING)ARG1(arg)));
277: STOQ(ret,*rp);
278: }
279:
280: #if INET && !defined(VISUAL)
281: void Pxpause(rp)
282: Q *rp;
283: {
284: if ( !init_display() )
285: *rp = 0;
286: else {
287: grab_pointer(); *rp = ONE;
288: }
289: }
290:
291: static Display *display;
292: static Window rootwin;
293:
294: init_display()
295: {
296: char *dname;
297: unsigned int tmp;
298: static int initialized;
299: int argc;
300: char *argv[1];
301:
302: if ( initialized )
303: return 1;
304: else
305: initialized = 1;
306: dname = (char *)getenv("DISPLAY");
307:
308: display = XOpenDisplay(dname);
309: if ( !display ) {
310: fprintf(stderr,"Can't open display\n");
311: return 0;
312: }
313: rootwin = RootWindow(display,DefaultScreen(display));
314: }
315:
316: grab_pointer()
317: {
318: XEvent ev;
319: static Cursor cursor;
320:
321: if ( !cursor )
322: cursor = XCreateFontCursor(display,XC_leftbutton);
323: XGrabPointer(display,rootwin,True,ButtonPressMask,GrabModeAsync,GrabModeAsync,None,cursor,CurrentTime);
324: while ( 1 ) {
325: XNextEvent(display,&ev);
326: if ( ev.xany.type == ButtonPress )
327: break;
328: }
329: XUngrabPointer(display,CurrentTime);
330: XSync(display,False);
331: return;
332: }
333: #endif
334:
335: void Psend_progress(NODE arg,Q *rp)
336: {
337: #if defined(VISUAL)
338: short per;
339: char *msg;
340:
341: per = (short)QTOS((Q)BDY(arg)); arg = NEXT(arg);
342: if ( arg )
343: msg = BDY((STRING)BDY(arg));
344: else
345: msg = "";
346: send_progress(per,msg);
347: #endif
348: *rp = 0;
349: }
350:
351: #if 0
352: static int optimize;
353: static struct oN oPSN[1000];
354: static struct oQ oPSZ[1000],oMSZ[1000];
355: static szinit = 0;
356:
357: void Popt(arg,rp)
358: NODE arg;
359: pointer *rp;
360: {
361: optimize = ARG0(arg) ? 1 : 0; *rp = 0;
362: }
363:
364:
365: void sz_init() {
366: int i;
367: Q t;
368:
369: for ( i = 1; i < 1000; i++ ) {
370: oPSN[i].p = 1; oPSN[i].b[0] = i;
371: t = &oPSZ[i];
372: OID(t) = O_N; NID(t) = N_Q; SGN(t) = 1; NM(t) = &oPSN[i]; DN(t) = 0;
373: t = &oMSZ[i];
374: OID(t) = O_N; NID(t) = N_Q; SGN(t) = -1; NM(t) = &oPSN[i]; DN(t) = 0;
375: }
376: szinit = 1;
377: }
378:
379: optobj(p)
380: Obj *p;
381: {
382: Obj t;
383: int n;
384: DCP dc;
385:
386: if ( t = *p )
387: switch ( OID(t) ) {
388: case O_N:
389: if ( (NID(t)==N_Q) && INT(t) && (PL(NM((Q)t))==1) ) {
390: n = QTOS((Q)t);
391: if ( !szinit )
392: sz_init();
393: if ( n < 1000 )
394: *p = (Obj)(SGN((Q)t)>0?&oPSZ[n]:&oMSZ[n]);
395: }
396: break;
397: case O_P:
398: for ( dc = DC((P)t); dc; dc = NEXT(dc) ) {
399: optobj(&DEG(dc)); optobj(&COEF(dc));
400: }
401: break;
402: case O_R:
403: optobj(&NM((R)t)); optobj(&DN((R)t)); break;
404: default:
405: break;
406: }
407: }
408: #endif
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>