1 saw 1.1 /*-----------------------------------------------------------------------------
2 * Copyright (c) 1993 Southeastern Universities Research Association,
3 * Continuous Electron Beam Accelerator Facility
4 *
5 * This software was developed under a United States Government license
6 * described in the NOTICE file included as part of this distribution.
7 *
8 * Stephen A. Wood, 12000 Jefferson Ave., Newport News, VA 23606
9 * Email: saw@cebaf.gov Tel: (804) 249-7367 Fax: (804) 249-5800
10 *-----------------------------------------------------------------------------
11 *
12 * Description:
13 * The expression parser and stack executor for the Test Package
14 *
15 * Author: Stephen Wood, CEBAF Hall C
16 *
17 * Revision History:
18 * $Log: thTestParse.c,v $
19 * Revision 1.16 1996/07/31 20:36:56 saw
20 * Support floating point for mod command. Add trig functions.
21 *
22 saw 1.1 * Revision 1.15 1995/08/03 13:56:36 saw
23 * Add single argument functions
24 *
25 * Revision 1.14 1995/04/10 15:51:21 saw
26 * thEvalImed returns INTOVF if double result is to large to convert to int.
27 *
28 * Revision 1.13 1995/02/14 16:53:52 saw
29 * Make compatible with OSF/Alpha (64 bit pointers)
30 *
31 * Revision 1.12 1995/01/09 16:06:11 saw
32 * Fix a short malloc for a string
33 *
34 * Revision 1.11 1994/11/17 18:14:21 saw
35 * Strip out unary + operators when parsing expressions
36 *
37 * Revision 1.10 1994/11/07 14:28:34 saw
38 * Add thevalchk fortran call to check for expressions.
39 * Try to avoid bomb outs for bad expressions
40 *
41 * Revision 1.9 1994/10/03 12:41:22 saw
42 * All "/" (division) has real result. New op "//" has integerized
43 saw 1.1 * result. thEvalImed actually gets a double from thTestExecute.
44 * Added fortran interfaces to thEvalImed (itheval, ftheval, dtheval).
45 *
46 * Revision 1.8 1994/09/12 15:12:31 saw
47 * thGetTok was missing reset of lastop on EOL
48 *
49 * Revision 1.7 1994/08/29 20:08:10 saw
50 * Fix calculation of testscalervarname length
51 *
52 * Revision 1.6 1994/08/26 17:46:18 saw
53 * Register test scaler results
54 *
55 * Revision 1.5 1994/08/26 13:36:46 saw
56 * Add DAVAR_REPOINTOK to some flags
57 *
58 * Revision 1.4 1994/06/03 18:54:29 saw
59 * Replace stderr with STDERR
60 *
61 * Revision 1.3 1993/12/02 21:33:36 saw
62 * Fully allow use of doubles in test expressions
63 *
64 saw 1.1 * Revision 1.2 1993/11/24 21:24:54 saw
65 * thEvalImed now returns double instead of floating result.
66 *
67 * Revision 1.3 1993/09/22 17:51:06 saw
68 * Allow integer constants to be octal or hex.
69 *
70 * Revision 1.2 1993/05/11 18:00:10 saw
71 * Update header
72 *
73 */
74
75 /* thTestParse.c
76
77 Make test result variable that are created take the type of the rhs???
78 Add variable names to stack so that expressions can be recreated.
79 Allow constants to be hex or octal.
80 Agree on a new comment character or syntax since ! is not part
81 of expressions.
82 Add unary operators to executor. Allow + to be a unary operator too.
83
84 Need to build up a linked list of test results used in a block. Don't
85 saw 1.1 duplicate any variables. Print warning when a scaler test result is
86 reused.
87
88 */
89 /*An argument is a variable name, an array, or a number. Numbers are not
90 allowed for test result. Arrays start at 0 if []'s are used and start
91 at 1 if ()'s are used. Arrays may only be used for test results if they
92 are already registered by the analyzer. (May add option to declare them
93 in the test package.)*/
94
95 #include <stdio.h>
96 #include <string.h>
97 #include <math.h>
98 #include <values.h>
99 #include "daVar.h"
100 #include "th.h"
101 #include "thUtils.h"
102 #include "thTestParse.h"
103 #include "thInternal.h"
104 #include "cfortran.h"
105
106 saw 1.1 extern daVarStatus thTestRHandler();
107
108 CODE opstack[100]; /* Operator stack */
109 CODE typstack[100]; /* Result type stack */
110
111 typedef struct
112 {
113 char *ops;
114 int toks[3];
115 } OPTABLE;
116
117 OPTABLE optable[] =
118 {
119 {"(",{OPLP}},
120 {")",{OPRP}},
121 {"[",{OPLINDEXB}},
122 {"]",{OPRP}},
123 {"-",{OPSUB}},
124 {"+",{OPADD}},
125 {"<<=",{OPISLT,OPSHL,OPISLE}},
126 {">>=",{OPISGT,OPSHR,OPISGE}},
127 saw 1.1 {"==",{OPEQUAL,OPISEQUAL}},
128 {"!=",{OPNOT,OPISNOTEQUAL}},
129 {"&&",{OPBITAND,OPLOGAND}},
130 {"||",{OPBITOR,OPLOGOR}},
131 {"^^",{OPBITXOR,OPLOGXOR}},
132 {"*",{OPTIMES}},
133 {"//",{OPDIV,OPIDIV}},
134 {"%",{OPMOD}},
135 {"~",{OPCOMP}},
136 {",",{OPCOMMA}},
137 {0,{0,0,0}}};
138 static char *opchars=0;
139
140 /* For Q like test package format, must be in same order as type
141 types listed in typedef for thTestType. */
142 char *testCodes[tBAD]
143 = {"GA","PA","EQ","BI","AN","IO","EO","MA","US"};
144
145 typedef struct
146 {
147 CODE op;
148 saw 1.1 CODE result[9];
149 } TYPETABLE;
150
151 TYPETABLE typetable[] =
152 {
153 {OPLINDEX,{0,0,0,1,1,1,2,2,2}}, /* Result is same as variable */
154 {OPLINDEXB,{0,0,0,1,1,1,2,2,2}}, /* being indexed */
155 {OPLINDEXP,{0,0,0,1,1,1,2,2,2}}, /* Result is same as variable */
156 {OPLINDEXPB,{0,0,0,1,1,1,2,2,2}}, /* being indexed */
157 {OPEQUAL,{0,0,0,1,1,1,2,2,2}}, /* Set result type to LHS type */
158 {OPLOGOR,{0,0,0,0,0,0,0,0,0}}, /* Result is always integer */
159 {OPLOGXOR,{0,0,0,0,0,0,0,0,0}},
160 {OPLOGAND,{0,0,0,0,0,0,0,0,0}},
161 {OPBITOR,{0,0,0,0,0,0,0,0,0}},
162 {OPBITXOR,{0,0,0,0,0,0,0,0,0}},
163 {OPBITAND,{0,0,0,0,0,0,0,0,0}},
164 {OPISEQUAL,{0,0,0,0,0,0,0,0,0}},
165 {OPISNOTEQUAL,{0,0,0,0,0,0,0,0,0}},
166 {OPISLT,{0,0,0,0,0,0,0,0,0}},
167 {OPISLE,{0,0,0,0,0,0,0,0,0}},
168 {OPISGT,{0,0,0,0,0,0,0,0,0}},
169 saw 1.1 {OPISGE,{0,0,0,0,0,0,0,0,0}},
170 {OPSHL,{0,0,0,0,0,0,0,0,0}},
171 {OPSHR,{0,0,0,0,0,0,0,0,0}},
172 {OPADD,{0,2,2,2,2,2,2,2,2}}, /* Result is double unless both ops int */
173 {OPSUB,{0,2,2,2,2,2,2,2,2}},
174 {OPTIMES,{0,2,2,2,2,2,2,2,2}},
175 {OPDIV,{2,2,2,2,2,2,2,2,2}}, /* Result always double */
176 {OPIDIV,{0,0,0,0,0,0,0,0,0}}, /* Result always integer */
177 {OPMOD,{0,2,2,2,2,2,2,2,2}},
178 {OPNEG,{0,1,2,0,1,2,0,1,2}}, /* No lh operand, type = rh type */
179 {OPNOT,{0,0,0,0,0,0,0,0,0}}, /* No lh operand, type always int */
180 {OPCOMP,{0,0,0,0,0,0,0,0,0}}, /* No lh operand, type always int */
181 {0,{0,0,0,0,0,0,0,0,0}}};
182
183 INTRINSIC_FUNCTIONS intrinsic_functions[] =
184 {
185 {"abs",{0,1,2}},
186 {"sqrt",{2,2,2}},
187 {"exp",{2,2,2}},
188 {"sin",{2,2,2}},
189 {"cos",{2,2,2}},
190 saw 1.1 {"tan",{2,2,2}},
191 {0,{0,0,0}}
192 };
193 char *thGetTok(char *linep, int *tokenid, char **tokstr,
194 CODE *tokval, void **tokptr, int expflag, daVarStructList **vlisthead)
195 /* Pass a pointer to the unscanned portion of the line.
196 Returns An ID code for operators, and an operand type for operands in
197 tokenid.
198 Returns the string for the operand in tokstr. (Null otherwise)
199 Returns the operand value in tokval, or in tokptr if the operand is
200 a pointer.
201 If the operand is a function, then tokenid will be pushfunction, and
202 tokval will be a the fuction id.
203
204 Function returns pointer to remainder of the line.
205
206
207 */
208 {
209 static char string[100];
210 static int lasttoktype=0; /* Last tok was an operator */
211 saw 1.1 static CODE lastop=0;
212
213 char *savelinep;
214 char *stringp;
215 char *ptr,c;
216 int tindex,sindex;
217 daVarStruct *varp;
218 DAFLOAT f;
219
220 /* Build up a list of characters that can start operators */
221 if(opchars == 0){
222 int count=0;
223 int i;
224
225 while(optable[count++].ops != 0) ;
226 opchars = (char *) malloc(count);
227 for(i=0;i<(count-1); i++)
228 opchars[i] = optable[i].ops[0];
229 opchars[count-1] = 0;
230 }
231
232 saw 1.1 *tokstr = 0;
233 *tokval = 0;
234 *tokptr = 0;
235 *tokenid = 0; /* Will signify an undeclared operand */
236
237 if(!(*linep)) {
238 *tokenid = OPEOL;
239 lasttoktype = 0;
240 lastop = 0;
241 return(0);
242 }
243 savelinep = linep;
244 while(*linep == ' ' || *linep == '\t') linep++;
245 if((ptr = strchr(opchars,*linep))) { /* Operator */
246 tindex = ptr - opchars;
247 if(lasttoktype == 0 && *linep == '-') { /* Last thing was an operator */
248 *tokenid = OPNEG; /* So the '-' must be a negative sign */
249 linep++;
250 } else if(lasttoktype == 0 && *linep == '+') { /* Unary plus */
251 linep++;
252 goto operand;
253 saw 1.1 } else if(lasttoktype == 1 && *linep == '(') {
254 *tokenid = OPLINDEX;
255 linep++;
256 } else if(lasttoktype == 3 && *linep == '(') {
257 /* How will we know when the right hand operator is the closing
258 paren of the function? We don't need to know. The RHP only
259 acts to determine precedence. */
260 *tokenid = OPLFARG;
261 linep++;
262 } else {
263 linep++;
264 *tokenid = optable[tindex].toks[0];
265 sindex = 1;
266 if(*linep) { /* Don't search past end of line */
267 while((c = optable[tindex].ops[sindex])) {
268 if(*linep == c) {
269 *tokenid = optable[tindex].toks[sindex];
270 linep++;
271 break;
272 }
273 sindex++;
274 saw 1.1 }
275 }
276 }
277 /* Following two lines were before last }. */
278 if(*tokenid == OPRP) lasttoktype = 2; /* Minus is minus after ) or ] */
279 else lasttoktype = 0;
280 /* For OPLINDEX and OPLINDEXB, need to search ahead for matching ) or ]
281 and check if the next operator is an = not ==). If so, then we
282 need to return OPLINDEXP or OPLINDEXPB. */
283 if(*tokenid == OPLINDEX || *tokenid == OPLINDEXB){
284 char *p; char rc; int ccount=0; int bcount=0;
285 if(*tokenid == OPLINDEXB) rc = ']';
286 else rc = ')';
287 p = linep;
288 while(*p && (*p != rc || bcount || ccount)) {
289 switch(*p++)
290 {
291 case '(': ccount++; break;
292 case ')': ccount--; break;
293 case '[': bcount++; break;
294 case ']': bcount--; break;
295 saw 1.1 default: break;
296 }
297 } /* Only NULL or balanced rc terminates */
298 if(*p++){ /* Search for = */
299 while(*p == ' ' || *p=='\t') p++;
300 if(*p == '=' && *(p+1) != '=') {
301 *tokenid += (OPLINDEXP - OPLINDEX);
302 /* Assumes OPLINDEXBP-OPLINDEXB is the same*/
303 }
304 } else
305 fprintf(STDERR,"thTest: Parenthesis balance problem\n");
306 }
307 lastop = *tokenid;
308 } else { /* Operand */
309 int optype;
310 int isnum;
311 int efound;
312
313 operand:
314 lasttoktype = 1;
315 stringp = string;
316 saw 1.1 /* Scan until operator or whitespace is reached */
317 isnum = 1; efound = 0;
318 /* What a hack to check for scientific notation */
319 while(*linep && *linep!=' ' && *linep!='\t' && !strchr(opchars,*linep)){
320 if(*linep == 'e' || *linep == 'E') {
321 if(efound) {
322 isnum = 0;
323 } else {
324 if(stringp > string) {
325 efound=1;
326 } else {
327 isnum = 0;
328 }
329 }
330 } else if(!isdigit(*linep) && *linep != '.') isnum = 0;
331 *stringp++ = *linep++;
332 }
333 if(isnum && efound) { /* Exponential, scan past last digit */
334 if(*linep == '-' || *linep == '+') *stringp++ = *linep++;
335 while(isdigit(*linep)) {
336 *stringp++ = *linep++;
337 saw 1.1 }
338 }
339 while(*linep == ' ' || *linep == '\t') linep++; /* Skip past whitespace */
340 *stringp = 0;
341 *tokstr = string;
342 /* printf("token=%s\n",string);*/
343 switch(thIDToken(string))
344 {
345 case TOKINT:
346 sscanf(string,"%li",tokval);
347 *tokenid = OPPUSHINT;
348 break;
349 case TOKFLOAT:
350 f = atof(string);
351 *tokval = *(DAINT *)&f; /* Copy floating value */
352 *tokenid = OPPUSHFLOAT;
353 break;
354 case TOKVAR:
355 {
356 char **classlist;
357 thOperandType optype;
358 saw 1.1
359 optype = thGetOperandType(string,linep,lastop,0);
360 classlist = thGetClassList(optype);
361 /* If token is a result variable (and we are in non-immediate mode), and the
362 variable is an integer type, then we need to add this variable to a list
363 of variables for the current block. (Probably add real variable to
364 the list anyway. ) This will allow us to acumulate scalers. The opaque
365 pointer of each variable in the list will point to the scaler array. */
366
367 /* First check if variable is really an intrinsic function */
368 {
369 int ifunc;
370 ifunc = 0;
371 while(intrinsic_functions[ifunc].name) {
372 if(strcasecmp(string,intrinsic_functions[ifunc].name)==0) {
373 *tokenid = OPPUSHFUNCTION;
374 *tokval = ifunc;
375 lasttoktype = 3;
376 break;
377 }
378 ifunc++;
379 saw 1.1 }
380 if(*tokenid) break; /* Hopefully this breaks out of case */
381 }
382 if(daVarLookupPWithClass(string,classlist,&varp) == S_SUCCESS) {
383 /* printf("Found variable %s[%s]\n",string,varp->name);*/
384 if(varp->type == DAVARFLOAT) {/* If next operator is a ( or [ */
385 /* printf("FLOAT ");*/
386 /* then push pointer instead of */
387 #define ISARRAYORLHS(x) (*x=='(' || *x=='[' || (*x=='=' && *(x+1)!='='))
388 *tokenid = ISARRAYORLHS(linep) ? OPPUSHPFLOAT : OPPUSHFLOATP;
389 } else if(varp->type == DAVARDOUBLE){ /* value onto rpn stack */
390 /* printf("DOUBL ");*/
391 *tokenid = ISARRAYORLHS(linep) ? OPPUSHPDOUBLE : OPPUSHDOUBLEP;
392 } else if(varp->type == DAVARINT){ /* value onto rpn stack */
393 /* printf("INT ");*/
394 *tokenid = ISARRAYORLHS(linep) ? OPPUSHPINT : OPPUSHINTP;
395 }
396 else {
397 fprintf(STDERR
398 ,"thTest: Variable %s[%s] must be integer, float or double\n"
399 ,string,varp->name);
400 saw 1.1 }
401 /* *tokval = *(DAINT *)&varp->varptr;*/ /* Get the pointer */
402 *tokptr = varp->varptr;
403 } else if(*linep=='=' && (*(linep+1)!='=')){
404 /* Undefined variable is an unindexed result */
405 /* For now, create an integer variable. Later figure out how
406 to make the variable the same type as the rhs */
407 daVarStruct var;
408 var.name = (char *) malloc(strlen(classlist[0])
409 +strlen(string)+2);
410 strcpy(var.name,classlist[0]);
411 strcat(var.name,".");
412 strcat(var.name,string);
413 var.varptr = (void *) malloc(sizeof(DAINT));
414 var.size = 1;
415 var.opaque = 0;
416 var.rhook = var.whook = 0;
417 var.type = DAVARINT;
418 var.flag = DAVAR_READONLY | DAVAR_REPOINTOK;
419 var.title = savelinep;
420 daVarRegister((int) 0,&var); /* Create test result */
421 saw 1.1 daVarLookupP(var.name,&varp);
422 free(var.name);
423 printf("Created test result %s\n",varp->name);
424 *tokenid = OPPUSHPINT;
425 /* *tokval = *(DAINT *)&varp->varptr;*/
426 *tokptr = varp->varptr;
427 } /* else
428 printf("%s not found\n",string);
429 }*/
430 /* If variable does not exist, caller will note that toktype and
431 tokval have not been set. */
432 if(optype == otRESULT && vlisthead){ /* Don't make scalers for */
433 thAddVarToList(vlisthead,varp); /* Variables created in */
434 if(varp->type == DAVARINT) { /* thEvalImed */
435 DAINT *sarray; int i;
436 if(varp->opaque == 0) { /* No scaler array yet */
437 char *testscalervarname;
438 daVarStruct *svarp; /* Pointer to scaler var struct */
439 testscalervarname = /* Add the "scaler" attribute */
440 (char *) malloc(strlen(varp->name)+strlen(SCALERSTR)+2);
441 strcpy(testscalervarname,varp->name);
442 saw 1.1 strcat(testscalervarname,".");
443 strcat(testscalervarname,SCALERSTR);
444 if(daVarLookupP(testscalervarname,&svarp) != S_SUCCESS) {
445 daVarStruct svar;
446 svar.name = testscalervarname;
447 svar.opaque = 0;
448 svar.rhook = svar.whook = 0;
449 svar.type = DAVARINT;
450 svar.flag = DAVAR_READONLY | DAVAR_REPOINTOK;
451 svar.varptr = (void *) malloc(varp->size*sizeof(DAINT));
452 svar.size = varp->size;
453 /* Actually not OK to repoint, but this says CTP made it */
454 svar.title = varp->name;
455 daVarRegister((int) 0, &svar);
456 daVarLookupP(svar.name,&svarp);
457 }
458 varp->opaque = (DAINT *) svarp->varptr;
459 varp->rhook = thTestRHandler;
460 free(testscalervarname);
461 }
462 sarray = varp->opaque;
463 saw 1.1 for(i=0;i<varp->size;i++)
464 sarray[i] = 0;
465 }
466 }
467 }
468 break;
469 default:
470 fprintf(STDERR,"thTest: Error understanding %s\n",string);
471 break;
472 }
473 /* printf("token = %x\n",*tokenid);*/
474 lastop = 0;
475 }
476 while(*linep == ' ' || *linep == '\t') linep++; /* Skip whitespace */
477 return(linep);
478 }
479
480
481 char **thGetClassList(thOperandType optype)
482 {
483 static char *explist[]={PARMSTR,EVENTSTR,TESTSTR,0}; /* Immediate expressions */
484 saw 1.1 static char *loglist[]={TESTSTR,PARMSTR,EVENTSTR,0}; /* Logical operand */
485 static char *numlist[]={EVENTSTR,PARMSTR,TESTSTR,0}; /* Operand is a value */
486 static char *resultlistp[]={TESTSTR,EVENTSTR,PARMSTR,0}; /* Operand is a result */
487
488 switch(optype)
489 {
490 case otIMMED:
491 return(explist);
492 case otLOGIC:
493 return(loglist);
494 case otVALUE:
495 return(numlist);
496 case otRESULT:
497 return(resultlistp);
498 }
499 }
500
501 thOperandType thGetOperandType(char *soperand, char *rest, CODE lastop,
502 int expflag)
503 {
504 if(expflag)
505 saw 1.1 return(otIMMED);
506 else if(lastop == OPNOT)
507 return(otLOGIC);
508 else if(lastop != 0 && (lastop != OPLOGOR)
509 && (lastop != OPLOGAND) && (lastop != OPLOGXOR)
510 && (lastop != OPEQUAL) && (lastop != OPCOMMA)
511 && (lastop != OPLP))
512 return(otVALUE);
513 else {
514 /* This is really ugly code to determine if the operand
515 is a result, logical operand, or numerical operand from the
516 surrounding operators. The last operator is known, but it must
517 search ahead for the next operator. This code should be burried
518 in a subroutine. */
519
520 char *p;
521 p = rest;
522 if(*p == '(' || *p == '[') {
523 int ccount=0; int bcount=0;
524 if(*p++ == '(') ccount++; else bcount++;
525 while(*p && (bcount || ccount)){
526 saw 1.1 /* printf("%c(%d,%d)\n",*p,ccount,bcount);*/
527 switch(*p++) {
528 case '(': ccount++; break; case ')': ccount--; break;
529 case '[': bcount++; break; case ']': bcount--; break;
530 default: break;
531 }
532 }
533 /* printf("pos=%c, %d %d ",*p,ccount,bcount);*/
534 }
535 while(*p == ' ' || *p =='\t') p++;
536 #define ISLOG(x,y) (*x==y && *(x+1)==y)
537 /* printf(", Nextchar=%c: ",*p);*/
538 if(*p=='=' && *(p+1)!='=') {
539 return(otRESULT);
540 } else if((ISLOG(p,'|') || ISLOG(p,'&') || ISLOG(p,'^')
541 || *p=='\0' || *p==',' || *p == ')'))
542 return(otLOGIC);
543 }
544 return(otVALUE);
545 }
546
547 saw 1.1 CODE thGetResultType(CODE operator, CODE leftoptype, CODE rightoptype)
548 {
549 /* For a given operator, determine the data type of the result a given
550 combination of the types of the lh and rh operands.
551 Assumes that only types 0, 1, or 2 are allowed. */
552
553 int lrindex;
554 int i;
555
556 if(leftoptype < 0 || leftoptype > 2 || rightoptype < 0 || rightoptype > 2) {
557 fprintf(STDERR,"thTest: Illegal operand type %x %x\n",leftoptype,rightoptype);
558 return(0);
559 }
560 lrindex = (leftoptype * 3) + rightoptype;
561 for(i=0; typetable[i].op; i++) { /* Do Linear search for the operator */
562 if(operator == typetable[i].op) {
563 return(typetable[i].result[lrindex]);
564 }
565 }
566 fprintf(STDERR,"Operator %x not found in result type table\n",operator);
567 return(0);
568 saw 1.1 }
569
570 thStatus thEvalImed(char *line, double *d, DAINT *i)
571 /* ImmedOBiately evaluate the expression in line. Will internally evaluate to
572 a float, and then pass back both the float and interized values. */
573 {
574 CODEPTR codehead, codenext, codelimit, codelastop;
575 int codesize;
576 #define RDOUBLE
577 #ifdef RDOUBLE
578 double result;
579 #else
580 float result; /* Should change to double */
581 #endif
582 thStatus retcode;
583
584 /* printf("%s=",line);*/
585 codesize = 10+2*strlen(line);
586 codehead = codenext = (CODEPTR) malloc(sizeof(CODE)*codesize);
587 codelimit = codehead + codesize;
588 #ifdef RDOUBLE
589 saw 1.1 *codenext++ = OPPUSHPDOUBLE;
590 #ifdef USEMEMCPY
591 {
592 void *resultp;
593 resultp = &result;
594 memcpy(((void **)codenext)++, (void *) &resultp, sizeof(void *));
595 }
596 #else
597 *((void **) codenext)++ = (void *) &result;
598 #endif
599 /* printf("%x\n",codenext);*/
600 #else
601 *codenext++ = OPPUSHPFLOAT; /* Should change to double */
602 *((void **) codenext)++ = (void *) &result;
603 #endif
604 retcode = S_SUCCESS;
605 if(thBookaTest(line,&codehead,&codenext,&codelimit,&codelastop,0)!=S_SUCCESS) {
606 fprintf(STDERR,"Failure interpreting expression |%s|\n",line);
607 result = 0.0;
608 retcode = S_FAILURE;
609 } else {
610 saw 1.1 int exptype;
611 CODE lastop;
612 #if 0
613 printf("%x-%x=%d\n",codenext,codehead,codenext-codehead);
614 {
615 CODEPTR code;
616 for(code=codehead;code < codenext; code++)
617 if(code==codelastop) printf("* %x\n",*code);
618 else printf(" %x\n",*code);
619 }
620 #endif
621 codenext = codelastop;
622 exptype = *codenext++ & OPRESTYPEMASK;
623 lastop = *codelastop & OPCODEMASK;
624 if(lastop == OPPUSHPINT || lastop == OPPUSHINTP) {
625 *((DAINT **)codenext)++;
626 } else if(lastop == OPPUSHINT) {
627 if(exptype == OPRDOUBLE) {
628 *((DADOUBLE *)codenext)++;
629 } else { /* Assume ints, floats have size */
630 *((DAINT *)codenext)++;
631 saw 1.1 }
632 }
633 #ifdef RDOUBLE
634 *codenext++ = OPEQUAL | 0x202 | (exptype<<4);
635 #else
636 *codenext++ = OPEQUAL | 0x101 | (exptype<<4);
637 #endif
638 #ifdef RDOUBLE
639 *codenext++ = OPEOL | (OPRDOUBLE<<4);
640 #else
641 *codenext++ = OPEOL;
642 #endif
643 if(thExecuteCode("IMMED",codehead,codenext)!=S_SUCCESS){
644 fprintf(STDERR,"Failure evaluating expression |%s|\n",line);
645 result = 0.0;
646 retcode = S_FAILURE;
647 }
648 }
649 /* printf("%f\n",result);*/
650 free(codehead);
651 if(d) *d = result;
652 saw 1.1 if(i) {
653 if(result>=MAXINT || result <=-MAXINT) {
654 if(retcode==S_SUCCESS)
655 retcode=S_INTOVF;
656 } else {
657 *i = floatToLong(result);
658 }
659 }
660 return(retcode);
661 }
662
663 thStatus thBookaTest(char *line, CODEPTR *codeheadp, CODEPTR *codenextp,
664 CODEPTR *codelimitp, CODEPTR *codelastop, daVarStructList **vlisthead)
665 /* if expflag != 0, still treat as an expression even if there is no
666 equal sign in the line.
667 Return codes:
668 S_SUCCESS = Line OK
669 S_FAILURE = Line not executable
670 */
671 {
672 /* int type;*/
673 saw 1.1 char *args[20];
674 int nargs;
675 thTokenType toktyp;
676 daVarStruct var, *varp;
677 thTestType test_type;
678 int forcefloat;
679 int iarg;
680 char *token;
681 CODEPTR codenext;
682 int index; /* Used for index into arrays */
683 thStatus status;
684 int expflag;
685
686 if(codelastop) expflag = 1; else expflag = 0;
687 status = S_SUCCESS;
688 if(*codenextp + 2*strlen(line) > *codelimitp) {
689 CODEPTR src,dst,newhead;
690 int newsize;
691 /* printf("Increasing the size of the code stack from %d ",
692 *codelimitp-*codeheadp);*/
693 src = *codeheadp;
694 saw 1.1 newsize = max((*codelimitp-*codeheadp)+CODEGROWSIZE
695 ,(*codenextp-*codeheadp)+2*strlen(line));
696 newhead = dst = (CODEPTR) malloc(sizeof(CODE)*newsize);
697 while(src < *codenextp) *dst++ = *src++;
698 if(*codeheadp) free(*codeheadp);
699 *codelimitp = newhead + newsize;
700 *codeheadp = newhead;
701 *codenextp = *codenextp + (dst - src);
702
703 /*printf("to %d, using %d\n",*codelimitp-*codeheadp,*codenextp - *codeheadp);*/
704 }
705 codenext = *codenextp;
706
707 /* printf("Booking \"%s\"\n",line);*/
708 if(strchr(line,'=')||expflag) {
709 char *linep;
710 int TOKEN,TOKCOMP;
711 char *tokstr; CODE tokval;
712 void *tokptr;
713 CODE *osp, *tsp, opcode;
714 CODE rightoptype,leftoptype,resultoptype;
715 saw 1.1
716 osp = opstack; /* Stack of pending operators */
717 *osp = '\0';
718
719 tsp = typstack; /* Stack of Current result type */
720 /* Like the stack in the executor but only */
721 /* contains the data types */
722 linep = line;
723 do {
724 /* Get tokens until there are no more (last token will be OPEOL) */
725 linep = thGetTok(linep,&TOKEN, &tokstr, &tokval, &tokptr, expflag, vlisthead);
726 if(tokstr) { /* Operand */
727 /* printf("Operand %s |",tokstr);*/
728 if(codelastop) *codelastop = codenext; /* HACK for thImmed: Save ptr to last operator */
729 if(TOKEN) {
730 if(tokptr == 0) { /* Value operand - 4 bytes */
731 *codenext++ = TOKEN; /* String not put on stack at moment */
732 *codenext++ = tokval;
733 } else { /* Pointer operand - maybe 8 bytes */
734 *codenext++ = TOKEN;
735 #ifdef USEMEMCPY
736 saw 1.1 memcpy(((void **)codenext)++,&tokptr,sizeof(void *));
737 #else
738 *((void **)codenext)++ = tokptr;
739 #endif
740 }
741 /* If TOKEN is push function, then tokval is an index into a list of
742 functions. We put this index on tsp instead of the result type. */
743 if(TOKEN==OPPUSHFUNCTION) {
744 *tsp++ = tokval;
745 } else {
746 *tsp++ = TOKEN & OPRESTYPEMASK;
747 }
748 } else {
749 fprintf(STDERR,"thTest: Unregistered variable %s\n",tokstr);
750 status = S_TH_UNREG;
751 *codenext++ = OPPUSHINT;
752 *codenext++ = 0;
753 *tsp++ = OPPUSHINT & OPRESTYPEMASK;
754 }
755 } else { /* Operator */
756 switch(TOKEN)
757 saw 1.1 {
758 case 0:
759 fprintf(STDERR,"thTest: Bad token\n");
760 return(S_FAILURE);
761 break;
762 case OPLP:
763 *++osp = TOKEN;
764 break;
765 default:
766 /* printf("OSP:");
767 {CODE *sp; for(sp=opstack;sp<=osp;sp++)
768 printf("%x:",*sp);}
769 printf("\n");
770 */
771 /* Generate code for all operators of equal or higher precedence
772 that are pending on the operator stack. */
773 if((TOKEN & OPGROUPMASK) == OPLINDEXGROUP)
774 TOKCOMP = 0xFFFFFFF; /* Nothing higher in precedence */
775 else
776 TOKCOMP = TOKEN & OPPRECMASK;
777 while((*osp & OPPRECMASK) >= TOKCOMP){
778 saw 1.1 /* if((*osp & OPPRECMASK) == OPLINDEX){*/
779 if((*osp & OPGROUPMASK) == OPLINDEXGROUP){
780 if(TOKEN == OPRP) {
781 if(*osp == OPLFARG) TOKEN = OPRFARG;
782 else TOKEN = OPRINDEX; /* Break from case */
783 }
784 TOKCOMP = 0xFFFFFFF; /* Terminate osp rundown */
785 }
786 rightoptype = *--tsp;
787 leftoptype = ((*osp & OPPRECMASK) == OPUNARY) ? 0 : (*--tsp);
788 /* If the Operator is "evaluate function", we need to find out
789 what the function is so that we can get the correct
790 result type. leftoptype should be an index into
791 "intrinsic_functions". We can use that and rightoptype
792 to look up the resulttype. */
793 if(*osp==OPLFARG) {
794 resultoptype =
795 intrinsic_functions[leftoptype].result[rightoptype];
796 } else {
797 resultoptype = thGetResultType(*osp,leftoptype,rightoptype);
798 }
799 saw 1.1 opcode = *osp--;
800 opcode |= (leftoptype << 8) | (rightoptype << 4)
801 | resultoptype;
802 if(codelastop) if((opcode&&OPCODEMASK) !=OPEOL) *codelastop = codenext; /* HACK for thImmed: Save ptr to last operator */
803 *codenext++ = opcode;
804 *tsp++ = resultoptype; /* Keep a rpn stack of the data type */
805 }
806 if(TOKEN == OPRINDEX || TOKEN == OPRFARG) break; /* No clean up needed */
807
808 if(TOKEN == OPRP) {
809 if(*osp == OPLP) osp--; /* ) removes matching ( */
810 else {
811 fprintf(STDERR,"Right paren not matched by left\n");
812 return(S_FAILURE);
813 }
814 } else if(TOKEN == OPEOL || TOKEN == OPCOMMA) {
815 if(codelastop) if(TOKEN==OPCOMMA) *codelastop = codenext; /* HACK for thImmed: Save ptr to last operator */
816 *codenext++ = TOKEN | (*--tsp) << 4; /* Leave type in Right type field */
817 } else {
818 *++osp = TOKEN;
819 }
820 saw 1.1 break;
821 }
822 }
823 /* Token processed */
824 } while (linep);
825 /* Check that stacks are OK. Need to add some clean up of allocated memory. */
826 if(tsp != typstack) {
827 fprintf(STDERR,"%d items left on type stack\n",tsp-typstack);
828 return(S_FAILURE);
829 }
830 if(osp != opstack) {
831 fprintf(STDERR,"%d items left on operand stack\n",osp-opstack);
832 return(S_FAILURE);
833 }
834 } else { /* Old style test lines */
835 int i;
836 nargs = thCommas(line,args);
837 for(i=0;i<nargs;i++){
838 args[i] = thSpaceStrip(args[i]); /* Remove all space from the argument */
839 }
840
841 saw 1.1 if(nargs <= 1) return(S_FAILURE);
842
843 { /* Interpret the test type. */
844
845 for(test_type=0;test_type<tBAD;test_type++){
846 if(testCodes[test_type][0] == toupper(args[1][0]) &&
847 testCodes[test_type][1] == toupper(args[1][1])) break;
848 }
849 if(test_type == tBAD) return(S_FAILURE);
850 /* printf("%s\n",testCodes[test_type]);*/
851 }
852 if(test_type == tGATE || test_type == tEQ) {
853 forcefloat = 1;
854 } else forcefloat = 0;
855 for(iarg=2;iarg<nargs;iarg++){
856 DAFLOAT f; /* Should do double here */
857 token = args[iarg];
858 toktyp = thIDToken(token);
859 switch((toktyp = thIDToken(token)))
860 {
861 case TOKINT:
862 saw 1.1 *codenext++ = PUSHI;
863 if(forcefloat) {
864 f = atof(token);
865 *codenext++ = *(DAINT *)&f;
866 } else {
867 DAINT i;
868 sscanf(token,"%li",&i);
869 *codenext++ = i;
870 }
871 break;
872 case TOKFLOAT: /* Should Do all floats as doubles */
873 *codenext++ = PUSHI;
874 if(forcefloat) {
875 f = atof(token);
876 *codenext++ = *(DAINT *)&f;
877 } else {
878 *codenext++ = (DAINT) floatToLong(atof(token));
879 }
880 break;
881 case TOKARRAY:
882 case TOKVAR:
883 saw 1.1 {
884 char *p; int index; char leftp;
885 if(toktyp == TOKARRAY) {
886 p = thTokenArray(token,&index);
887 leftp = *p; *p = 0; /* Save ( or [ then null terminate */
888 } else
889 index = 0;
890 if(daVarLookup(token,&var)!=S_SUCCESS) {
891 fprintf(STDERR,"(thTest) %s not registered\n",token);
892 *codenext++ = PUSHI;
893 if(forcefloat) {
894 f = 0.0;
895 *codenext++ = *(DAINT *)&f;
896 } else
897 *codenext++ = 0;
898 } else {
899 if(forcefloat)
900 if(var.type == DAVARINT)
901 *codenext++ = PUSHITOFS; /* Push converting to float and skip */
902 else if(var.type == DAVARFLOAT)
903 *codenext++ = PUSHS;
904 saw 1.1 else
905 *codenext++ = PUSHI; /* Push immediate */
906 else
907 if(var.type == DAVARINT)
908 *codenext++ = PUSHS; /* Push and skip */
909 else if(var.type == DAVARFLOAT)
910 *codenext++ = PUSHFTOIS;
911 else
912 *codenext++ = PUSHI; /* Push immediate */
913 if(toktyp == TOKARRAY)
914 *p = leftp;
915 if(var.type == DAVARINT || var.type == DAVARFLOAT) {
916 *((void **)codenext)++ = ((DAINT *) var.varptr+index);
917 *((void **)codenext) = (void *) malloc(sizeof(token)+1);
918 strcpy((char *) *((void **)codenext)++,token);
919 } else {
920 if(forcefloat) {
921 f = 0.0;
922 *codenext++ = *(DAINT *)&f;
923 } else
924 *codenext++ = 0;
925 saw 1.1 }
926 }
927 }
928 break;
929 }
930 }
931 *codenext++ = test_type; /* Operation to do on pushed args */
932 *codenext++ = nargs-2; /* # of args pushed on stack for this op */
933
934 /* Now push test result on stack */
935 *codenext++ = POPS;
936
937 token = args[0];
938 toktyp = thIDToken(token);
939 index = 0;
940 switch((toktyp = thIDToken(token)))
941 {
942 case TOKINT:
943 case TOKFLOAT:
944 fprintf(STDERR,"(thTest) Test result must be a variable name\n");
945 return(S_FAILURE); /* No test is added to program */
946 saw 1.1 case TOKARRAY:
947 /* First check if variable with index has been already registered
948 perhaps from a previous booking of histograms */
949 if(daVarLookup(token,&var) != S_SUCCESS){
950 char *p; char leftp;
951 p = thTokenArray(token,&index);
952 leftp = *p; *p = 0; /* Save ( or [ then null terminate */
953 if(daVarLookup(token,&var) != S_SUCCESS){
954 fprintf(STDERR,
955 "(thTest) Arrays %s must be registered\n",token);
956 return(S_FAILURE);
957 }
958 *p = leftp; /* Restore the left ( or [ */
959 if(index >= var.size) {
960 fprintf(STDERR,
961 "(thTest) Array size for %s exceeded\n",token);
962 return(S_FAILURE);
963 }
964 if(var.type != DAVARINT) {
965 fprintf(STDERR,
966 "(thTest) Array %s must be of integer*4\n",token);
967 saw 1.1 return(S_FAILURE);
968 }
969 var.varptr = (DAINT *) var.varptr + index;
970 var.name = token;
971 var.opaque = 0;
972 }
973 var.title = token; /* Eventually be the input line */
974 break;
975 case TOKVAR:
976 if(daVarLookup(token,&var)!=S_SUCCESS) {
977 var.name = token;
978 var.varptr = (void *) malloc(sizeof(DAINT));
979 var.opaque = 0;
980 var.rhook = var.whook = 0;
981 var.type = DAVARINT;
982 var.flag = DAVAR_READONLY | DAVAR_REPOINTOK;
983 /* Do I need to set the size to 1 here??? */
984 }
985 var.title = token;
986 break;
987 }
988 saw 1.1 daVarRegister((int) 0, &var); /* Create or replace variable */
989 *((void **)codenext)++ = ((DAINT *) var.varptr);
990 /* Save the token string for future reference */
991 *((void **)codenext) = ((void *) malloc(strlen(token)+1));
992 strcpy((char *) *((void **)codenext)++,token);
993
994 }
995 *codenextp = codenext;
996 return(status);
997
998 }
999 long thevalchk_(char *A1,unsigned C1)
1000 /* Check if an expression is valid. Return's zero if valid */
1001 {
1002 long A0;
1003 char *B1;
1004 thStatus status;
1005
1006 status = thEvalImed((!*(int *)A1)?0:memchr(A1,'\0',C1)?A1:
1007 (memcpy(B1=malloc(C1+1),A1,C1),B1[C1]='\0'
1008 ,kill_trailing(B1,' ')),0,0);
1009 saw 1.1 if(B1) free(B1);
1010 return(status);
1011 }
1012
1013 long itheval_(char *A1,unsigned C1)
1014 {
1015 long A0;
1016 char *B1;
1017 DAINT i;
1018 double d;
1019 thStatus status;
1020
1021 status = thEvalImed((!*(int *)A1)?0:memchr(A1,'\0',C1)?A1:
1022 (memcpy(B1=malloc(C1+1),A1,C1),B1[C1]='\0'
1023 ,kill_trailing(B1,' ')),0,&i);
1024 if(B1) free(B1);
1025 return i;
1026 }
1027 double dtheval_(char *A1,unsigned C1)
1028 {
1029 long A0;
1030 saw 1.1 char *B1;
1031 double d;
1032 thStatus status;
1033
1034 status = thEvalImed((!*(int *)A1)?0:memchr(A1,'\0',C1)?A1:
1035 (memcpy(B1=malloc(C1+1),A1,C1),B1[C1]='\0'
1036 ,kill_trailing(B1,' ')),&d,0);
1037 if(B1) free(B1);
1038 return d;
1039 }
1040 float ftheval_(char *A1,unsigned C1)
1041 {
1042 long A0;
1043 char *B1;
1044 DAINT i;
1045 double d;
1046 float f;
1047 thStatus status;
1048
1049 status = thEvalImed((!*(int *)A1)?0:memchr(A1,'\0',C1)?A1:
1050 (memcpy(B1=malloc(C1+1),A1,C1),B1[C1]='\0'
1051 saw 1.1 ,kill_trailing(B1,' ')),&d,0);
1052 if(B1) free(B1);
1053 f = d;
1054 return f;
1055 }
|
Return to
thTestParse.c
CVS log
Up to [HallC] / Analyzer / CTP