Annotation of OpenXM_contrib2/asir2000/builtin/ctrl.c, Revision 1.1.1.1
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/ctrl.c,v 1.3 1999/11/23 07:14:14 noro Exp $ */
2: #include "ca.h"
3: #include "parse.h"
4:
5: void Pctrl();
6:
7: struct ftab ctrl_tab[] = {
8: {"ctrl",Pctrl,-2},
9: {0,0,0},
10: };
11:
12: extern int prtime,nez,echoback,bigfloat;
13: extern int GC_free_space_numerator,GC_free_space_divisor,debug_up,no_prompt;
14: extern int GC_max_heap_size,Verbose,hideargs,hex_output,do_server_in_X11;
15: extern int do_message;
16: extern int ox_batch,ox_check;
17: extern int f4_nocheck;
18:
19: static struct {
20: char *key;
21: int *val;
22: } ctrls[] = {
23: {"cputime",&prtime},
24: {"nez",&nez},
25: {"echo",&echoback},
26: {"bigfloat",&bigfloat},
27: {"verbose",&Verbose},
28: {"hideargs",&hideargs},
29: {"hex",&hex_output},
30: {"debug_window",&do_server_in_X11},
31: {"message",&do_message},
32: {"debug_up",&debug_up},
33: {"no_prompt",&no_prompt},
34: {"ox_batch",&ox_batch},
35: {"ox_check",&ox_check},
36: {"f4_nocheck",&f4_nocheck},
37: {0,0},
38: };
39:
40: void Pctrl(arg,rp)
41: NODE arg;
42: Q *rp;
43: {
44: int t,i;
45: N num,den;
46: Q c;
47: char *key;
48: char buf[BUFSIZ];
49:
50: if ( !arg ) {
51: *rp = 0;
52: return;
53: }
54: key = BDY((STRING)ARG0(arg));
55: if ( !strcmp(key,"adj") ) {
56: /* special treatment is necessary for "adj" */
57: if ( argc(arg) == 1 ) {
58: UTON(GC_free_space_divisor,num);
59: UTON(GC_free_space_numerator,den);
60: } else {
61: c = (Q)ARG1(arg);
62: if ( !c )
63: error("ctrl : adj : invalid argument");
64: num = NM(c);
65: den = !DN(c)?ONEN:DN(c);
66: GC_free_space_divisor = BD(num)[0];
67: GC_free_space_numerator = BD(den)[0];
68: }
69: NDTOQ(num,den,1,*rp);
70: return;
71: }
72: for ( i = 0; ctrls[i].key; i++ )
73: if ( !strcmp(key,ctrls[i].key) )
74: break;
75: if ( ctrls[i].key ) {
76: if ( argc(arg) == 1 )
77: t = *ctrls[i].val;
78: else
79: *ctrls[i].val = t = QTOS((Q)ARG1(arg));
80: STOQ(t,*rp);
81: } else {
82: sprintf(buf,"ctrl : %s : no such key",key);
83: error(buf);
84: }
85: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>