1 /*
2    datum.c -- Functions for Algae data.
3 
4    Copyright (C) 1994-2003  K. Scott Hunziker.
5    Copyright (C) 1990-1994  The Boeing Company.
6 
7    See the file COPYING for license, warranty, and permission details.
8  */
9 
10 static char rcsid[] =
11 "$Id: datum.c,v 1.4 2003/08/07 04:48:19 ksh Exp $";
12 
13 #include "ptypes.h"
14 #include "pmem.h"
15 #include "datum.h"
16 #include "algae.h"
17 #include "entity.h"
18 #include "scalar.h"
19 #include "print.h"
20 #include "test.h"
21 #include "get.h"
22 #include "put.h"
23 #include "file_io.h"
24 
25 extern DATUM *num_digits;	/* number of significant digits to print */
26 #define DIGITS datum_to_int (num_digits)
27 
28 extern int whitespace;	/* true prints whitespace */
29 
30 /* TEMP */
31 extern int da_flag;
32 extern int dummy;
33 
34 
35 DATUM the_null;			/* NULL */
36 
37 /* returns DATUM* initialized to D_NULL */
38 DATUM *
new_DATUM()39 new_DATUM ()
40 {
41   DATUM *p = (DATUM *) MALLOC (sizeof (DATUM));
42 
43   p->type = D_NULL;
44   return p;
45 }
46 
47 DATUM *
new_INT(val)48 new_INT (val)
49      int val;
50 {
51   DATUM *p = P_MEM (DATUM);
52 
53   p->type = D_INT;
54   IVAL (p) = val;
55   return p;
56 }
57 
58 
59 DATUM *
new_REAL(val)60 new_REAL (val)
61      double val;
62 {
63   DATUM *p = P_MEM (DATUM);
64 
65   p->type = D_REAL;
66   RVAL (p) = val;
67   return p;
68 }
69 
70 #define WS(w, nw)	(whitespace ? w : nw)
71 
72 void
datum_print(p)73 datum_print (p)
74      register DATUM *p;
75 {
76   assert (p != NULL);
77   switch (p->type)
78     {
79     case D_NULL:
80       printf (WS ("\tNULL\n", "NULL"));
81       break;
82 
83     case D_INT:
84       printf (WS ("\t%d\n", "%d"), p->data.ival);
85       break;
86 
87     case D_REAL:
88       printf (WS ("\t%#.*g\n", "%#.*g"), DIGITS, p->data.rval);
89       break;
90 
91     case D_ENTITY:
92       print_entity (copy_entity (p->data.ptr), stdout);
93       break;
94 
95     default:
96       wipeout ("datum_print");
97     }
98 }
99 
100 DATUM *
copy_datum(target,source)101 copy_datum (target, source)
102      register DATUM *target, *source;
103 {
104   switch (target->type = source->type)
105     {
106     case D_NULL:
107       break;
108 
109     case D_INT:
110       target->data.ival = source->data.ival;
111       break;
112 
113     case D_REAL:
114       target->data.rval = source->data.rval;
115       break;
116 
117     case D_ENTITY:
118       target->data.ptr =
119 	(void *) copy_entity ((ENTITY *) source->data.ptr);
120       break;
121 
122     default:
123       wipeout ("data_copy");
124       break;
125     }
126   return target;
127 }
128 
129 
130 /*
131    make two successive data the same type
132    casting `up'.
133    Returns the common type.
134  */
135 
136 DATUM_TYPE
cast2_datum(p)137 cast2_datum (p)
138      DATUM *p;
139 {
140   DATUM_TYPE retval;
141 
142   switch (TEST2DATUM (p))
143     {
144     CASE_any_NULL:
145       retval = D_NULL;
146       break;
147 
148     case INT_INT:
149       retval = D_INT;
150       break;
151 
152     case INT_REAL:
153       p->data.rval = (double) p->data.ival;
154       retval = p->type = D_REAL;
155       break;
156 
157     case INT_ENTITY:
158       p->data.ptr = int_to_scalar (p->data.ival);
159       retval = p->type = D_ENTITY;
160       break;
161 
162     case REAL_INT:
163       (p + 1)->data.rval = (double) (p + 1)->data.ival;
164       retval = (p + 1)->type = D_REAL;
165       break;
166 
167     case REAL_REAL:
168       retval = D_REAL;
169       break;
170 
171     case REAL_ENTITY:
172       p->data.ptr = real_to_scalar (p->data.rval);
173       retval = p->type = D_ENTITY;
174       break;
175 
176     case ENTITY_INT:
177       (p + 1)->data.ptr = int_to_scalar ((p + 1)->data.ival);
178       retval = (p + 1)->type = D_ENTITY;
179       break;
180 
181     case ENTITY_REAL:
182       (p + 1)->data.ptr = real_to_scalar ((p + 1)->data.rval);
183       retval = (p + 1)->type = D_ENTITY;
184       break;
185 
186     case ENTITY_ENTITY:
187       retval = D_ENTITY;
188       break;
189 
190     default:
191       wipeout ("cast2_datum");
192     }
193 
194   return retval;
195 }
196 
197 /*
198    cast two successive datum to type D_ENTITY
199    return is D_NULL or D_ENTITY
200  */
201 
202 DATUM_TYPE
cast2_to_entity(p)203 cast2_to_entity (p)
204      DATUM *p;
205 {
206   DATUM_TYPE retval = D_ENTITY;
207 
208   /* don't switch type field until successful */
209 
210   switch (TEST2DATUM (p))
211     {
212     CASE_any_NULL:
213       retval = D_NULL;
214       break;
215 
216     case INT_INT:
217       p->data.ptr = int_to_scalar (p->data.ival);
218       p->type = D_ENTITY;
219 
220       (p + 1)->data.ptr = int_to_scalar ((p + 1)->data.ival);
221       (p + 1)->type = D_ENTITY;
222       break;
223 
224     case INT_REAL:
225       p->data.ptr = int_to_scalar (p->data.ival);
226       p->type = D_ENTITY;
227 
228       (p + 1)->data.ptr = real_to_scalar ((p + 1)->data.rval);
229       (p + 1)->type = D_ENTITY;
230       break;
231 
232     case INT_ENTITY:
233       p->data.ptr = int_to_scalar (p->data.ival);
234       p->type = D_ENTITY;
235       break;
236 
237     case REAL_INT:
238       p->data.ptr = real_to_scalar (p->data.rval);
239       p->type = D_ENTITY;
240 
241       (p + 1)->data.ptr = int_to_scalar ((p + 1)->data.ival);
242       (p + 1)->type = D_ENTITY;
243       break;
244 
245     case REAL_REAL:
246       p->data.ptr = real_to_scalar (p->data.rval);
247       p->type = D_ENTITY;
248 
249       (p + 1)->data.ptr = real_to_scalar ((p + 1)->data.rval);
250       (p + 1)->type = D_ENTITY;
251       break;
252 
253     case REAL_ENTITY:
254       p->data.ptr = real_to_scalar (p->data.rval);
255       p->type = D_ENTITY;
256       break;
257 
258     case ENTITY_INT:
259       (p + 1)->data.ptr = int_to_scalar ((p + 1)->data.ival);
260       (p + 1)->type = D_ENTITY;
261       break;
262 
263     case ENTITY_REAL:
264       (p + 1)->data.ptr = real_to_scalar ((p + 1)->data.rval);
265       (p + 1)->type = D_ENTITY;
266       break;
267 
268     case ENTITY_ENTITY:
269       break;
270 
271     default:
272       wipeout ("cast2_to_entity");
273     }
274 
275   return retval;
276 }
277 
278 
279 int
cast1_to_entity(dp)280 cast1_to_entity (dp)
281      DATUM *dp;
282 {
283   switch (dp->type)
284     {
285     case D_NULL:
286       return D_NULL;
287 
288     case D_INT:
289       dp->data.ptr = int_to_scalar (dp->data.ival);
290       break;
291 
292     case D_REAL:
293       dp->data.ptr = real_to_scalar (dp->data.rval);
294       break;
295     }
296   /* change type last in case of exception */
297   return dp->type = D_ENTITY;
298 }
299 
300 
301 int
datum_test(dp)302 datum_test (dp)
303      DATUM *dp;
304 {
305   switch (dp->type)
306     {
307     case D_NULL:
308       return 0;
309 
310     case D_INT:
311       return dp->data.ival != 0;
312 
313     case D_REAL:
314       return dp->data.rval != 0.0;
315 
316     case D_ENTITY:
317       return test_entity (E_PTR (dp));	/* `dp' is deleted. */
318 
319     default:
320       wipeout ("datum_test");
321     }
322 }
323 
324 #if DEBUG
325 
326 void
DB_delete_datum(p)327 DB_delete_datum (p)
328      DATUM *p;
329 {
330   if (p->type == D_ENTITY)
331     delete_entity (E_PTR (p));
332   p->type = D_NULL;
333 }
334 
335 #endif
336 
337 int
datum_to_int(dp)338 datum_to_int (dp)
339      DATUM *dp;
340 {
341   /*
342    * This routine grabs an int from a DATUM.  "I call 'em if I
343    * see 'em, and if I don't see 'em I make 'em up."  If it has
344    * problems, it just returns zero.
345    */
346 
347   switch (dp->type)
348     {
349     case D_NULL:
350       return (0);
351     case D_INT:
352       return (dp->data.ival);
353     case D_REAL:
354       return ((int) floor (dp->data.rval + 0.5));
355     case D_ENTITY:
356       switch (E_PTR (dp)->class)
357 	{
358 	case scalar:
359 	  switch (((SCALAR *) E_PTR (dp))->type)
360 	    {
361 	    case integer:
362 	      return (((SCALAR *) E_PTR (dp))->v.integer);
363 	    case real:
364 	      return ((int) floor (((SCALAR *) E_PTR (dp))->v.real + 0.5));
365 	    case complex:
366 	      return ((int) floor (((SCALAR *) E_PTR (dp))->v.complex.real + 0.5));
367 	    default:
368 	      return (0);
369 	    }
370 	default:
371 	  return (0);
372 	}
373     default:
374       wipeout ("datum_to_int");
375     }
376 }
377 
378 int
put_datum(d,stream,ent_tree)379 put_datum (d, stream, ent_tree)
380      DATUM *d;
381      FILE *stream;
382      struct ent_node *ent_tree;
383 {
384   /*
385    * Write a datum to a binary file.  Returns 0 on error, 1 otherwise.
386    * The DATUM `d' is not deleted.
387    */
388 
389   if (!WRITE_INT (&d->type, stream))
390     return 0;
391 
392   switch (d->type)
393     {
394 
395     case D_NULL:
396       break;
397 
398     case D_INT:
399       if (!WRITE_INT (&d->data.ival, stream))
400 	return 0;
401       break;
402 
403     case D_REAL:
404       if (!WRITE_DOUBLE (&d->data.rval, stream))
405 	return 0;
406       break;
407 
408     default:
409       assert (d->type == D_ENTITY);
410       if (!put_entity (copy_entity (d->data.ptr), stream, ent_tree))
411 	return 0;
412     }
413 
414   return 1;
415 }
416 
417 DATUM *
get_datum(stream)418 get_datum (stream)
419      FILE *stream;
420 {
421   /* Read a datum from a binary file. */
422 
423   DATUM *d = new_DATUM ();
424 
425   if (!READ_INT (&d->type, stream))
426     {
427       FREE (d);
428       return NULL;
429     }
430 
431   switch (d->type)
432     {
433 
434     case D_NULL:
435       break;
436 
437     case D_INT:
438       if (!READ_INT (&d->data.ival, stream))
439 	{
440 	  FREE (d);
441 	  return NULL;
442 	}
443       break;
444 
445     case D_REAL:
446       if (!READ_DOUBLE (&d->data.rval, stream))
447 	{
448 	  FREE (d);
449 	  return NULL;
450 	}
451       break;
452 
453     default:
454       if (d->type != D_ENTITY ||
455 	  !(d->data.ptr = get_entity (stream)))
456 	{
457 	  warn ("Invalid datum in file.");
458 	  FREE (d);
459 	  return NULL;
460 	}
461     }
462 
463   return d;
464 }
465