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 * Book parameters
14 *
15 * Author: Stephen Wood, CEBAF Hall C
16 *
17 * Revision History:
18 * $Log: thParm.c,v $
|
19 jones 1.5 * Revision 1.4.26.1 2011/03/03 20:08:14 jones
20 * Used to be %li and %ld, but that makes 8 byte result stuffed into 4 byte lval .
21 *
22 * Revision 1.4 2003/02/21 20:55:24 saw
23 * Clean up some types and casts to reduce compiler warnings.
24 *
|
25 saw 1.4 * Revision 1.3 1999/11/04 20:34:06 saw
26 * Alpha compatibility.
27 * New RPC call needed for root event display.
28 * Start of code to write ROOT trees (ntuples) from new "tree" block
29 *
|
30 saw 1.3 * Revision 1.16 1999/08/16 16:31:10 saw
31 * Treat numbers that start with "0x" as hex.
|
32 saw 1.2 *
|
33 saw 1.1 * Revision 1.15 1998/09/29 18:28:47 saw
34 * We shouldn't use thIDToken to identify whether the RHS of a parameter
35 * setting line is a simple constant or an expression. So for now all RHS's
36 * will be evaluated. Need some thought about setting the type of new
37 * variables that get created. This eliminates the 1998 CTP bug.
38 *
39 * Revision 1.14 1995/08/03 13:54:22 saw
40 * Add thpset function to single parameter setting lines from code
41 *
42 * Revision 1.13 1995/04/10 15:41:21 saw
43 * Handle ctp file registration (#int, #real, ...)
44 *
45 * Revision 1.12 1995/01/09 15:26:09 saw
46 * On fprintf, indicate block type and well as name
47 *
48 * Revision 1.11 1994/08/26 13:29:37 saw
49 * Add DAVAR_REPOINTOK to created parameter.
50 *
51 * Revision 1.10 1994/07/21 20:35:44 saw
52 * Don't prepend parm. when creating variables that have . in them.
53 *
54 saw 1.1 * Revision 1.9 1994/06/13 13:21:04 saw
55 * Fix up handling of string type CTP variables.
56 *
57 * Revision 1.8 1994/06/03 18:49:54 saw
58 * Replace stderr with STDERR
59 *
60 * Revision 1.7 1994/02/14 20:23:29 saw
61 * Comment out debugging printf's
62 *
63 * Revision 1.6 1994/02/08 21:34:01 saw
64 * Remove debugging statement
65 *
66 * Revision 1.5 1993/12/02 21:34:47 saw
67 * Fully allow doubles on parm left or right hand sides
68 *
69 * Revision 1.4 1993/09/22 17:27:39 saw
70 * Convert integer values with sscanf to allow for octal and hex.
71 *
72 * Revision 1.3 1993/09/13 20:52:34 saw
73 * Dynamically allocated arrays allowed. Dynamic params will automatically
74 * float if needed.
75 saw 1.1 *
76 * Revision 1.2 1993/05/11 17:53:56 saw
77 * Fix header
78 *
79 */
80
81 /* What to do about unregistered variables?
82 Register them as Int's now. Later allow declaring of reals and arrays.
83
84 */
85 #include <stdio.h>
86 #include <string.h>
87 #include <math.h>
88 #include "daVar.h"
89 #include "th.h"
90 #include "thInternal.h"
91 #include "thUtils.h"
92 #include "cfortran.h"
93
94 #define MAXLINELENGTH 512
95 /*#define NULL 0*/
96 saw 1.1
97 /* Global variables */
98 int thParmVarIndex;
99 int thParmVarType;
100 int thParmVarALen;
101 int *thParmVarLP;
102 float *thParmVarFP;
103 double *thParmVarDP;
104 char *thParmVarSP;
105 char *thParmVarName;
106 daVarStruct *thParmVarVarp;
107 int thParmVarDynamic;
108 /**/
109
110 char *classlist[]={PARMSTR,0}; /* Class list for parameter names */
111
112 thStatus thParmLineSet(char *line);
|
113 saw 1.3 /*FCALLSCFUN1(INT,thLoadParameters,LOADPARM,loadparm,STRING)*/
|
114 saw 1.1
115 thStatus thLoadParameters(daVarStruct *var)
116 /* Set the parameters as specified on the title line.
117 When done, replace title line with the parameters without the values??
118 For now, we won't modify the lines. */
119 {
120 char *lines,*eol;
121 int line_count;
122
123 if(*((DAINT *)var->varptr) != 0) /* This block already booked */
124 return(S_SUCCESS);
125 *((DAINT *) var->varptr) = 1;
126 lines = var->title;
127 line_count = 0;
128 while(*lines){
129 char *lcopy;
130
131 line_count++;
132 eol = strchr(lines,'\n');
133 if(!eol) {
134 fprintf(STDERR,"L %d: Last line of parm block %s has no newline\n"
135 saw 1.1 ,line_count,var->name);
136 break;
137 }
138 if(*(eol+1)=='\0'){ /* This is the last line */
139 if(strcasestr(lines,ENDSTR) == 0) {
140 fprintf(STDERR,"L %d: Last line of parm block %s is not an END\n"
141 ,line_count,var->name);
142 }
143 break;
144 }
145 if(line_count == 1)
146 if(strcasestr(lines,BEGINSTR) != 0){
147 /* printf("Is a begin\n");*/
148 lines = eol + 1;
149 continue;
150 } else
151 fprintf(STDERR,"First line of parm block %s is not a BEGIN\n",var->name);
152 /* Ready to book the line, Add continuation lines later */
153 lcopy = (char *) malloc(eol-lines+1);
154 strncpy(lcopy,lines,(eol-lines));
155 *(lcopy + (eol-lines)) = '\0';
156 saw 1.1 /* printf("Passing|%s|\n",lcopy);*/
157 if(!thSpecial(lcopy,PARMSTR)) {
158 if(thParmLineSet(lcopy)!=S_SUCCESS)
159 fprintf(STDERR,"Error saving parameters on line %d\n",line_count);
160 }
161 free(lcopy);
162 lines = eol + 1;
163 }
164 return(S_SUCCESS);
165 }
166 thStatus thParmLineSet(char *line)
167 /* Process a line of a parameter CTP block */
168 {
169 thTokenType toktyp;
170 int vartyp;
171 int vardimen;
172 daVarStruct *varp;
173 int i;
174 char *varnam;
175 int nargs;
176 char *args[50];
177 saw 1.1 char *orgargs; /* Unadulterated arguments line */
178
179 { /* Needs to be fixed to handle strings */
180 char *s;
181 int blank;
182 char quotechar;
183 int instring;
184
185 s = line;
186 blank = 1;
187 instring = 0;
188 while(*s != 0){
189 if(instring && *s == quotechar) {
190 if(*(s+1) == quotechar) s++;
191 else instring = 0;
192 } else {
193 if(*s == QUOTECHAR1 || *s== QUOTECHAR2) {
194 instring = 1;
195 quotechar = *s;
196 blank = 0;
197 } else if(isspace(*s)) {
198 saw 1.1 *s = ' '; /* Remove tabs, ... */
199 } else if(*s == COMCHAR) {
200 *s = 0;
201 break;
202 } else
203 blank = 0;
204 }
205 s++;
206 }
207 if(blank) return(S_SUCCESS);
208 /* Now look for = and figure out what kind of variable is on left.
209 If more than one number is given, left must be array. */
210
211 s = line;
212 orgargs = 0;
213 if((s = strchr(s,'='))){
214 *s++ = '\0';
215 orgargs = (char *) malloc(strlen(s)+1);
216 strcpy(orgargs,s);
217 varnam = thSpaceStrip(line);
218 } else {
219 saw 1.1 s = line;
220 varnam = 0;
221 }
222 nargs = thCommas(s,args);
223 for(i=0;i<nargs;i++){
224 args[i] = thSpaceStrip(args[i]);/* Remove all space from the argument */
225 /* printf("%s ",args[i]);*/
226 }
227 if(nargs > 0) /* If only white space after last comma, */
228 if(args[nargs-1][0] == '\0') /* then don't count it as an argument */
229 nargs--;
230 }
231
232 if(varnam){
233 toktyp = thIDToken(varnam);
234 if(toktyp != TOKVAR && toktyp != TOKARRAY){
235 fprintf(STDERR,"Variable name %s can't be a number\n",varnam);
236 if(orgargs) free(orgargs);
237 return(S_FAILURE);
238 }
239 if(toktyp == TOKARRAY){
240 saw 1.1 char *p;
241 p = thTokenArray(varnam,&thParmVarIndex);
242 *p = 0;
243 } else
244 thParmVarIndex = 0;
245 if(daVarLookupPWithClass(varnam,classlist,&varp) != S_SUCCESS) {
246 /* Variable is not preregistered, we will automatically allocate it.
247 Later, a flag for the block will be added which will disallow
248 auto allocation. We will allocate here an integer array of length
249 thParmVarIndex plus the number of arguments on the line. If there
250 are subsequent lines, the array will automatically be extended below
251 since the code will see the DAVAR_DYNAMIC_PAR flag. If floating
252 point values are found on the lines below, the array will
253 automatically be changed to floating. (Perhaps we should just always
254 make the variables floating point.)
255 The noauto flag will eventually be implimented to disable automatic
256 variable createion. */
257 daVarStruct var;
258 if(strchr(varnam,'.')) { /* Don't prepend parm., if varname has '.'s */
259 var.name = (char *) malloc(strlen(varnam)+1);
260 strcpy(var.name,varnam);
261 saw 1.1 } else {
262 var.name = (char *) malloc(strlen(classlist[0])
263 +strlen(varnam)+2);
264 strcpy(var.name,classlist[0]);
265 strcat(var.name,".");
266 strcat(var.name,varnam);
267 }
268 var.size = thParmVarIndex + nargs;
269 var.varptr = (void *) malloc(var.size*sizeof(DAINT));
270 var.opaque = 0;
|
271 saw 1.4 var.rhook = 0;
272 var.whook = 0;
|
273 saw 1.1 var.type = DAVARINT;
274 var.flag = DAVAR_REPOINTOK | DAVAR_READONLY | DAVAR_DYNAMIC_PAR;
275 var.title = 0;
276 daVarRegister((int) 0,&var); /* parameter */
277 daVarLookupP(var.name,&varp);
278 free(var.name);
279 fprintf(STDERR,"%s not registered, registering as int\n",varnam);
280 }
281 /* vardimen = varp->dimension;
282 if(vardimen==0 && toktyp == TOKARRAY) {
283 fprintf(STDERR,"Variable %s not registered as an array\n",varnam);
284 return(S_FAILURE);
285 }
286 */
287 vartyp = varp->type;
288 thParmVarType = vartyp;
289 thParmVarName = varp->name;
290 thParmVarVarp = varp;
291 thParmVarDynamic = (varp->flag & DAVAR_DYNAMIC_PAR);
292 thParmVarALen = varp->size;
293 switch(vartyp)
294 saw 1.1 {
295 case DAVARINT:
296 thParmVarLP = (int *) varp->varptr;
297 break;
298 case DAVARFLOAT:
299 thParmVarFP = (float *) varp->varptr;
300 break;
301 case DAVARDOUBLE:
302 thParmVarDP = (double *) varp->varptr;
303 break;
304 case DAVARSTRING:
305 case DAVARFSTRING:
306 thParmVarSP = (char *) varp->varptr;
307 break;
308 }
309 }
310 if(thParmVarType == DAVARINT || thParmVarType == DAVARFLOAT
311 || thParmVarType == DAVARDOUBLE) {
312 for(i=0;i<nargs;i++){
313 int lval;
314 double dval;
315 saw 1.1 toktyp = thIDToken(args[i]);
316 if(thParmVarIndex>=thParmVarALen){
317 if(thParmVarDynamic) { /* Automatically up size for dynamic pars */
318 /* printf("i=%d, thParmVarIndex=%d, thParmVarALen=%d\n",i,thParmVarIndex
319 ,thParmVarALen);
320 printf("thParmVarType=%d\n",thParmVarType);*/
321 if(thParmVarType == DAVARINT){
322 int j;
323 int *TMPP;
324
325 thParmVarVarp->size = (thParmVarIndex + (nargs-i));
326 TMPP = (int *) malloc(thParmVarVarp->size*sizeof(DAINT));
327 for(j=0;j<thParmVarALen;j++)
328 TMPP[j] = thParmVarLP[j];
329 free(thParmVarLP);
330 thParmVarLP = TMPP;
331 thParmVarVarp->varptr = thParmVarLP;
332 } else { /*if(thParmVarType == DAVARFLOAT)*/
333 int j;
334 float *TMPP;
335
336 saw 1.1 thParmVarVarp->size = (thParmVarIndex + (nargs-i));
337 TMPP = (float *) malloc(thParmVarVarp->size*sizeof(DAFLOAT));
338 for(j=0;j<thParmVarALen;j++)
339 TMPP[j] = thParmVarFP[j];
340 free(thParmVarFP);
341 thParmVarFP = TMPP;
342 thParmVarVarp->varptr = thParmVarFP;
343 }
344 thParmVarALen = thParmVarVarp->size;
345 } else {
346 fprintf(STDERR,"Tried to fill past end of array %s\n",thParmVarName);
347 if(orgargs) free(orgargs);
348 return(S_FAILURE);
349 }
350 }
351 #define ALWAYSEVAL
352 #ifndef ALWAYSEVAL
353 switch(toktyp)
354 {
355 case TOKINT:
|
356 jones 1.5 /* Used to be %li and %ld, but that makes 8 byte result
357 stuffed into 4 byte lval */
|
358 saw 1.2 if(args[i][0] == '0' && (args[i][1] == 'x' || args[i][1] == 'X')) {
|
359 jones 1.5 sscanf(args[i],"%i",&lval); /* Treat as Hex */
|
360 saw 1.2 } else {
|
361 jones 1.5 sscanf(args[i],"%d",&lval); /* Treat as decimal */
|
362 saw 1.2 }
|
363 saw 1.1 dval = lval;
364 break;
365 case TOKFLOAT:
366 dval = atof(args[i]);
367 lval = floatToLong(dval);
368 break;
369 default:
370 #endif
371 if(thEvalImed(args[i],&dval,&lval) != S_SUCCESS)
372 fprintf(STDERR,"Parm: Error interpreting %s\n");
373 #ifndef ALWAYSEVAL
374 break;
375 }
376 #endif
377 switch(thParmVarType)
378 {
379 case DAVARINT:
380 if(thParmVarDynamic) {
381 /* User must be careful, if an expression evaluated with thEvalImed ends up
382 as integer, then the type of the variable will stay as integer. */
383 if(toktyp == TOKFLOAT || (toktyp != TOKINT && dval != lval)) {
384 saw 1.1 /* Floating point arg found */
385 int j; /* Copy integer arry to float array */
386 thParmVarFP = (float *) malloc(thParmVarALen*sizeof(DAFLOAT));
387 for(j=0;j<thParmVarALen;j++)
388 thParmVarFP[j] = thParmVarLP[j];
389 free(thParmVarLP);
390 thParmVarVarp->varptr = thParmVarFP;
391 thParmVarVarp->type = DAVARFLOAT;
392 thParmVarFP[thParmVarIndex++] = dval;
393 thParmVarType = DAVARFLOAT;
394 break;
395 }
396 }
397 thParmVarLP[thParmVarIndex++] = lval;
398 break;
399 case DAVARFLOAT:
400 thParmVarFP[thParmVarIndex++] = dval;
401 break;
402 case DAVARDOUBLE:
403 thParmVarDP[thParmVarIndex++] = dval;
404 break;
405 saw 1.1 }
406 /* printf("Saved args[%d] %s %d %f\n",i,args[i],lval,dval);*/
407 }
408 } else if(thParmVarType == DAVARSTRING || thParmVarType == DAVARFSTRING) {
409 int maxlen, arglen;
410 char *argptr; char *s;
411
412 maxlen = thParmVarALen - ((thParmVarType == DAVARSTRING) ? 1 : 0);
413 /* Find first non blank character after the = */
414 argptr = orgargs;
415
416 while(isspace(*argptr)) argptr++;
417 if(argptr[0] == QUOTECHAR1 || argptr[0] == QUOTECHAR2){
418 s = argptr+1;
419 while(*s && *s != argptr[0]) s++; /* Search for nul or matching qu
420 e */
421 *s = 0;
422 argptr++; /* Move to char after quote */
423 }
424 arglen = strlen(argptr);
425 if(arglen > maxlen) arglen = maxlen;
426 saw 1.1 strncpy(thParmVarSP, argptr, arglen);
427 if(thParmVarType == DAVARFSTRING) {
428 while(arglen < maxlen)
429 thParmVarSP[arglen++] = ' '; /* Blank pad fortran strings */
430 } else {
431 thParmVarSP[arglen] = 0;
432 }
433 }
434 if(orgargs) free(orgargs);
435 return(S_SUCCESS);
436 }
437 /* Fortran routine to evaluate a line of the form parm = value */
438 #ifdef NOF77extname
|
439 saw 1.3 int thpset
|
440 saw 1.1 #else
|
441 saw 1.3 int thpset_
|
442 saw 1.1 #endif
443 (char *A1,unsigned C1)
444 {
|
445 saw 1.3 int A0;
|
446 saw 1.1 char *B1;
447 thStatus status;
448
449 status = thParmLineSet((!*(int *)A1)?0:memchr(A1,'\0',C1)?A1:
450 (memcpy(B1=malloc(C1+1),A1,C1),B1[C1]='\0'
451 ,kill_trailing(B1,' ')));
452 if(B1) free(B1);
453 return status;
454 }
|