Annotation of OpenXM/src/kan96xx/Kan/option.c, Revision 1.2
1.2 ! takayama 1: /* $OpenXM$ */
1.1 maekawa 2: #include <stdio.h>
3: #include "datatype.h"
4: #include "stackm.h"
5: #include "extern.h"
6: #include "gradedset.h"
7: #include "kclass.h"
8: #include "lookup.h"
9: #include <signal.h>
10:
11: extern void ctrlC();
12:
13:
14: struct object KsystemVariable(ob)
15: struct object ob; /* Sarray */
16: {
17: /* Don't forget to write the keys in usage.c */
18: extern int PrintDollar;
19: extern int Wrap;
20: extern struct ring *CurrentRingp;
21: extern int Verbose;
22: extern int UseCriterion1;
23: extern int UseCriterion2B;
24: extern int ReduceLowerTerms;
25: extern int CheckHomogenization;
26: extern int Homogenize;
27: extern int Statistics;
28: extern int Osp;
29: extern struct operandStack StandardStack;
30: extern struct operandStack ErrorStack;
31: extern int ErrorMessageMode;
32: extern int WarningMessageMode;
33: extern int CatchCtrlC;
34: extern int Strict;
35: extern struct context *CurrentContextp;
36: extern struct context *PrimitiveContextp;
37: extern int Strict2;
38: extern int SigIgn;
39: extern int KSPushEnvMode;
40: extern int KanGBmessage;
41: extern int TimerOn;
42: extern int OutputStyle;
43: extern int Sugar;
44: extern int Homogenize_vec;
45: extern int CmoDMSOutputOption;
46: extern int DebugReductionRed; /* hidden option */
47: extern char *VersionString;
48: extern int AvoidTheSameRing;
1.2 ! takayama 49: extern char *LeftBracket;
! 50: extern char *RightBracket;
1.1 maekawa 51:
52: int n,i;
53: struct object ob1,ob2,ob3,ob4;
54: struct object rob = NullObject;
55: switch (getoaSize(ob)) {
56: case 1: /* get the value */
57: ob1 = getoa(ob,0);
58: switch(ob1.tag) {
59: case Sdollar:
60: if (strcmp(ob1.lc.str,"PrintDollar") == 0) {
61: rob = KpoInteger(PrintDollar);
62: }else if (strcmp(ob1.lc.str,"Wrap") == 0) {
63: rob = KpoInteger(Wrap);
64: }else if (strcmp(ob1.lc.str,"P") == 0) {
65: rob = KpoInteger(CurrentRingp->p);
66: }else if (strcmp(ob1.lc.str,"N") == 0) {
67: rob = KpoInteger(CurrentRingp->n);
68: }else if (strcmp(ob1.lc.str,"NN") == 0) {
69: rob = KpoInteger(CurrentRingp->nn);
70: }else if (strcmp(ob1.lc.str,"M") == 0) {
71: rob = KpoInteger(CurrentRingp->m);
72: }else if (strcmp(ob1.lc.str,"MM") == 0) {
73: rob = KpoInteger(CurrentRingp->mm);
74: }else if (strcmp(ob1.lc.str,"L") == 0) {
75: rob = KpoInteger(CurrentRingp->l);
76: }else if (strcmp(ob1.lc.str,"LL") == 0) {
77: rob = KpoInteger(CurrentRingp->ll);
78: }else if (strcmp(ob1.lc.str,"C") == 0) {
79: rob = KpoInteger(CurrentRingp->c);
80: }else if (strcmp(ob1.lc.str,"CC") == 0) {
81: rob = KpoInteger(CurrentRingp->cc);
82: }else if (strcmp(ob1.lc.str,"CurrentRingp") == 0) {
83: rob = KpoRingp(CurrentRingp);
84: }else if (strcmp(ob1.lc.str,"Verbose") == 0) {
85: rob = KpoInteger(Verbose);
86: }else if (strcmp(ob1.lc.str,"UseCriterion1") == 0) {
87: rob = KpoInteger(UseCriterion1);
88: }else if (strcmp(ob1.lc.str,"UseCriterion2B") == 0) {
89: rob = KpoInteger(UseCriterion2B);
90: }else if (strcmp(ob1.lc.str,"ReduceLowerTerms") == 0) {
91: rob = KpoInteger(ReduceLowerTerms);
92: }else if (strcmp(ob1.lc.str,"CheckHomogenization") == 0) {
93: rob = KpoInteger(CheckHomogenization);
94: }else if (strcmp(ob1.lc.str,"Homogenize") == 0) {
95: rob = KpoInteger(Homogenize);
96: }else if (strcmp(ob1.lc.str,"Statistics") == 0) {
97: rob = KpoInteger(Statistics);
98: }else if (strcmp(ob1.lc.str,"StackPointer") == 0) {
99: rob = KpoInteger(Osp);
100: }else if (strcmp(ob1.lc.str,"StandardOperandStack") == 0) {
101: rob.tag = Sclass;
102: rob.lc.ival = CLASSNAME_OPERANDSTACK;
103: rob.rc.voidp = &StandardStack;
104: }else if (strcmp(ob1.lc.str,"ErrorStack") == 0) {
105: rob.tag = Sclass;
106: rob.lc.ival = CLASSNAME_OPERANDSTACK;
107: rob.rc.voidp = &ErrorStack;
108: }else if (strcmp(ob1.lc.str,"ErrorMessageMode") == 0) {
109: rob = KpoInteger(ErrorMessageMode);
110: }else if (strcmp(ob1.lc.str,"WarningMessageMode") == 0) {
111: rob = KpoInteger(WarningMessageMode);
112: }else if (strcmp(ob1.lc.str,"CatchCtrlC") == 0) {
113: rob = KpoInteger(CatchCtrlC);
114: /* If you catch ctrlc in KSexecuteString. */
115: }else if (strcmp(ob1.lc.str,"Strict") == 0) {
116: rob = KpoInteger(Strict);
117: }else if (strcmp(ob1.lc.str,"CurrentContextp") == 0) {
118: rob.tag = Sclass;
119: rob.lc.ival = CLASSNAME_CONTEXT;
120: rob.rc.voidp = CurrentContextp;
121: }else if (strcmp(ob1.lc.str,"PrimitiveContextp") == 0) {
122: rob.tag = Sclass;
123: rob.lc.ival = CLASSNAME_CONTEXT;
124: rob.rc.voidp = PrimitiveContextp;
125: }else if (strcmp(ob1.lc.str,"NullContextp") == 0) {
126: rob.tag = Sclass;
127: rob.lc.ival = CLASSNAME_CONTEXT;
128: rob.rc.voidp = (struct context *)NULL;
129: }else if (strcmp(ob1.lc.str,"Strict2") == 0) {
130: rob = KpoInteger(Strict2);
131: }else if (strcmp(ob1.lc.str,"SigIgn") == 0) {
132: rob = KpoInteger(SigIgn);
133: }else if (strcmp(ob1.lc.str,"KSPushEnvMode") == 0) {
134: rob = KpoInteger(KSPushEnvMode);
135: }else if (strcmp(ob1.lc.str,"KanGBmessage") == 0) {
136: rob = KpoInteger(KanGBmessage);
137: }else if (strcmp(ob1.lc.str,"TimerOn") == 0) {
138: rob = KpoInteger(TimerOn);
139: }else if (strcmp(ob1.lc.str,"orderMatrix") == 0) {
140: rob = KgetOrderMatrixOfCurrentRing();
141: }else if (strcmp(ob1.lc.str,"gbListTower") == 0) {
142: if (CurrentRingp->gbListTower == NULL) rob = NullObject;
143: else rob = *((struct object *)(CurrentRingp->gbListTower));
144: }else if (strcmp(ob1.lc.str,"outputOrder") == 0) {
145: n = CurrentRingp->n;
146: ob1 = newObjectArray(n*2);
147: for (i=0; i<2*n; i++) {
148: putoa(ob1,i,KpoInteger(CurrentRingp->outputOrder[i]));
149: }
150: rob = ob1;
151: }else if (strcmp(ob1.lc.str,"multSymbol") == 0) {
152: rob = KpoInteger(OutputStyle);
153: }else if (strcmp(ob1.lc.str,"Sugar") == 0) {
154: rob = KpoInteger(Sugar);
155: }else if (strcmp(ob1.lc.str,"Homogenize_vec") == 0) {
156: rob = KpoInteger(Homogenize_vec);
157: }else if (strcmp(ob1.lc.str,"Schreyer")==0) {
158: rob = KpoInteger( CurrentRingp->schreyer );
159: }else if (strcmp(ob1.lc.str,"ringName")==0) {
160: rob = KpoString( CurrentRingp->name );
161: }else if (strcmp(ob1.lc.str,"CmoDMSOutputOption")==0) {
162: rob = KpoInteger( CmoDMSOutputOption );
163: }else if (strcmp(ob1.lc.str,"Version")==0) {
164: rob = KpoString(VersionString);
165: }else if (strcmp(ob1.lc.str,"RingStack")==0) {
166: KsetUpRing(NullObject,NullObject,NullObject,NullObject,NullObject);
167: rob = KSpop(); /* This is exceptional style */
168: }else if (strcmp(ob1.lc.str,"AvoidTheSameRing")==0) {
169: rob = KpoInteger(AvoidTheSameRing);
1.2 ! takayama 170: }else if (strcmp(ob1.lc.str,"LeftBracket")==0) {
! 171: rob = KpoString(LeftBracket);
! 172: }else if (strcmp(ob1.lc.str,"RightBracket")==0) {
! 173: rob = KpoString(RightBracket);
1.1 maekawa 174: }else{
175: warningKan("KsystemVariable():Unknown key word.\n");
176: }
177: break;
178: default:
179: warningKan("KsystemVariable():Invalid argument\n");
180: break;
181: }
182: break;
183: case 2: /* set value */
184: ob1 = getoa(ob,0);
185: ob2 = getoa(ob,1);
186: switch (Lookup[ob1.tag][ob2.tag]) {
187: case SdollarSinteger:
188: if (strcmp(ob1.lc.str,"PrintDollar") == 0) {
189: PrintDollar = ob2.lc.ival;
190: rob = KpoInteger(PrintDollar);
191: }else if (strcmp(ob1.lc.str,"Wrap") == 0) {
192: Wrap = ob2.lc.ival;
193: rob = KpoInteger(Wrap);
194: /*}else if (strcmp(ob1.lc.str,"P") == 0) {
195: P = ob2.lc.ival; Q should be set here too.
196: CurrentRingp->p = P;
197: rob = KpoInteger(P); */
198: }else if (strcmp(ob1.lc.str,"NN") == 0) {
199: if (ob2.lc.ival <= CurrentRingp->n && ob2.lc.ival >= CurrentRingp->m) {
200: CurrentRingp->nn = ob2.lc.ival;
201: }else{
202: warningKan("New value of NN is out of bound.");
203: }
204: rob = KpoInteger(ob1.lc.ival);
205: }else if (strcmp(ob1.lc.str,"Verbose") == 0) {
206: Verbose = ob2.lc.ival;
207: rob = KpoInteger(Verbose);
208: }else if (strcmp(ob1.lc.str,"UseCriterion1") == 0) {
209: UseCriterion1 = ob2.lc.ival;
210: rob = KpoInteger(UseCriterion1);
211: }else if (strcmp(ob1.lc.str,"UseCriterion2B") == 0) {
212: UseCriterion2B = ob2.lc.ival;
213: rob = KpoInteger(UseCriterion2B);
214: }else if (strcmp(ob1.lc.str,"ReduceLowerTerms") == 0) {
215: ReduceLowerTerms = ob2.lc.ival;
216: rob = KpoInteger(ReduceLowerTerms);
217: }else if (strcmp(ob1.lc.str,"CheckHomogenization") == 0) {
218: CheckHomogenization = ob2.lc.ival;
219: rob = KpoInteger(CheckHomogenization);
220: }else if (strcmp(ob1.lc.str,"Homogenize") == 0) {
221: Homogenize = ob2.lc.ival;
222: rob = KpoInteger(Homogenize);
223: }else if (strcmp(ob1.lc.str,"Statistics") == 0) {
224: Statistics = ob2.lc.ival;
225: rob = KpoInteger(Statistics);
226: }else if (strcmp(ob1.lc.str,"ErrorMessageMode") == 0) {
227: ErrorMessageMode = ob2.lc.ival;
228: rob = KpoInteger(ErrorMessageMode);
229: }else if (strcmp(ob1.lc.str,"WarningMessageMode") == 0) {
230: WarningMessageMode = ob2.lc.ival;
231: rob = KpoInteger(WarningMessageMode);
232: }else if (strcmp(ob1.lc.str,"CatchCtrlC") == 0) {
233: CatchCtrlC = ob2.lc.ival;
234: rob = KpoInteger(CatchCtrlC);
235: }else if (strcmp(ob1.lc.str,"Strict") == 0) {
236: Strict = ob2.lc.ival;
237: rob = KpoInteger(Strict);
238: }else if (strcmp(ob1.lc.str,"Strict2") == 0) {
239: Strict2 = ob2.lc.ival;
240: rob = KpoInteger(Strict2);
241: }else if (strcmp(ob1.lc.str,"SigIgn") == 0) {
242: SigIgn = ob2.lc.ival;
243: if (SigIgn) signal(SIGINT,SIG_IGN);
244: else signal(SIGINT,ctrlC);
245: rob = KpoInteger(SigIgn);
246: }else if (strcmp(ob1.lc.str,"KSPushEnvMode") == 0) {
247: KSPushEnvMode = ob2.lc.ival;
248: rob = KpoInteger(KSPushEnvMode);
249: }else if (strcmp(ob1.lc.str,"KanGBmessage") == 0) {
250: KanGBmessage = ob2.lc.ival;
251: rob = KpoInteger(KanGBmessage);
252: }else if (strcmp(ob1.lc.str,"TimerOn") == 0) {
253: TimerOn = ob2.lc.ival;
254: rob = KpoInteger(TimerOn);
255: }else if (strcmp(ob1.lc.str,"multSymbol") == 0) {
256: OutputStyle = KopInteger(ob2);
257: rob = KpoInteger(OutputStyle);
258: }else if (strcmp(ob1.lc.str,"Sugar") == 0) {
259: Sugar = KopInteger(ob2);
260: if (Sugar && ReduceLowerTerms) {
261: ReduceLowerTerms = 0;
262: warningKan("ReduceLowerTerms is automatically set to 0, because Sugar = 1.");
263: /* You cannot use both ReduceLowerTerms and sugar.
264: See gb.c, reduction_sugar. */
265: }
266: rob = KpoInteger(Sugar);
267: }else if (strcmp(ob1.lc.str,"Homogenize_vec") == 0) {
268: Homogenize_vec = KopInteger(ob2);
269: rob = KpoInteger(Homogenize_vec);
270: }else if (strcmp(ob1.lc.str,"CmoDMSOutputOption") == 0) {
271: CmoDMSOutputOption = KopInteger(ob2);
272: rob = KpoInteger(CmoDMSOutputOption);
273: }else if (strcmp(ob1.lc.str,"DebugReductionRed") == 0) {
274: DebugReductionRed = KopInteger(ob2);
275: rob = KpoInteger(DebugReductionRed);
276: }else if (strcmp(ob1.lc.str,"AvoidTheSameRing") == 0) {
277: AvoidTheSameRing = KopInteger(ob2);
278: rob = KpoInteger(AvoidTheSameRing);
279: }else{
280: warningKan("KsystemVariable():Unknown key word.\n");
281: }
282: break;
283: case SdollarSdollar:
284: if (strcmp(ob1.lc.str,"ringName") == 0) {
285: CurrentRingp->name = KopString(ob2);
286: rob = KpoString(CurrentRingp->name);
1.2 ! takayama 287: }else if (strcmp(ob1.lc.str,"LeftBracket") == 0) {
! 288: LeftBracket = KopString(ob2);
! 289: rob = KpoString(LeftBracket);
! 290: }else if (strcmp(ob1.lc.str,"RightBracket") == 0) {
! 291: RightBracket = KopString(ob2);
! 292: rob = KpoString(RightBracket);
1.1 maekawa 293: }else{
294: warningKan("KsystemVariable():Unknown key word.\n");
295: }
296: break;
297: case SdollarSring:
298: if (strcmp(ob1.lc.str,"CurrentRingp") == 0) {
299: CurrentRingp = ob2.lc.ringp;
300: rob = KpoRingp(CurrentRingp);
301: }else{
302: warningKan("KsystemVariable():Unknown key word.\n");
303: }
304: break;
305: case SdollarSclass:
306: if (strcmp(ob1.lc.str,"PrimitiveContextp") == 0) {
307: if (ectag(ob2) == CLASSNAME_CONTEXT) {
308: PrimitiveContextp = (struct context *)ob2.rc.voidp;
309: rob = ob2;
310: }else{
311: warningKan("The second argument must be class.context.\n");
312: rob = NullObject;
313: }
314: }else {
315: warningKan("KsystemVariable():Unknown key word.\n");
316: }
317: break;
318: case SdollarSlist:
319: if (strcmp(ob1.lc.str,"gbListTower") == 0) {
320: if (AvoidTheSameRing)
321: warningKan("Changing gbListTower may cause a trouble under AvoidTheSameRing == 1.");
322: CurrentRingp->gbListTower = newObject();
323: *((struct object *)(CurrentRingp->gbListTower)) = ob2;
324: rob = *((struct object *)(CurrentRingp->gbListTower));
325: }else {
326: warningKan("KsystemVariable(): Unknown key word to set value.\n");
327: }
328: break;
329: case SdollarSarray:
330: if (strcmp(ob1.lc.str,"outputOrder") == 0) {
331: rob = KsetOutputOrder(ob2,CurrentRingp);
332: }else if (strcmp(ob1.lc.str,"variableNames") == 0) {
333: rob = KsetVariableNames(ob2,CurrentRingp);
334: }else {
335: warningKan("KsystemVariable(): Unknown key word to set value.\n");
336: }
337: break;
338: default:
339: warningKan("KsystemVariable():Invalid argument.\n");
340: }
341: break;
342: case 3:
343: ob1 = getoa(ob,0); ob2 = getoa(ob,1); ob3 = getoa(ob,2);
344: switch(Lookup[ob1.tag][ob2.tag]) {
345: case SdollarSdollar:
346: if (strcmp(ob2.lc.str,"var") == 0) {
347: if (strcmp(ob1.lc.str,"x")==0) {
348: if (ob3.tag != Sinteger) {
349: warningKan("[$x$ $var$ ? ] The 3rd argument must be integer.");
350: break;
351: }
352: if (ob3.lc.ival >= 0 && ob3.lc.ival < CurrentRingp->n) {
353: rob = KpoString(CurrentRingp->x[ob3.lc.ival]);
354: }else{
355: warningKan("[$x$ $var$ ? ] The 3rd argument is out of range.");
356: break;
357: }
358: }else if (strcmp(ob1.lc.str,"D")==0) {
359: if (ob3.tag != Sinteger) {
360: warningKan("[$D$ $var$ ? ] The 3rd argument must be integer.");
361: break;
362: }
363: if (ob3.lc.ival >= 0 && ob3.lc.ival < CurrentRingp->n) {
364: rob = KpoString(CurrentRingp->D[ob3.lc.ival]);
365: }else{
366: warningKan("[$D$ $var$ ? ] The 3rd argument is out of range.");
367: break;
368: }
369: }
370: }else{
371: warningKan("KsystemVariable(): Invalid argument.\n");
372: }
373: break;
374: default:
375: warningKan("KsystemVariable(): Invalid argument.\n");
376: break;
377: }
378: break;
379: default:
380: warningKan("KsystemVariable():Invalid argument.\n");
381: break;
382: }
383: return(rob);
384: }
385:
386: warningOption(str)
387: char *str;
388: {
389: fprintf(stderr,"Warning(option.c): %s\n",str);
390: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>