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