1 /*
2 scalar.c -- Functions for scalars.
3
4 Copyright (C) 1994-96 K. Scott Hunziker.
5 Copyright (C) 1990-94 The Boeing Company.
6
7 See the file COPYING for license, warranty, and permission details.
8 */
9
10 static char rcsid[] =
11 "$Id: scalar.c,v 1.3 1996/08/29 06:01:38 ksh Exp $";
12
13 #include "entity.h"
14 #include "scalar.h"
15 #include "vector.h"
16 #include "matrix.h"
17 #include "table.h"
18 #include "get.h"
19 #include "put.h"
20 #include "file_io.h"
21
22 /*
23 * This array describes the members of the
24 * SCALAR structure. The fields are `name',
25 * and `id'. The entries must be in
26 * alphabetical order, and there must be
27 * exactly one entry for each member of the
28 * SCALAR_MEMBER enumeration except END_Scalar.
29 */
30
31 MEMBER_ID scalar_member_names[] =
32 {
33 {"class", ScalarClass},
34 {"type", ScalarType},
35 };
36
37 SCALAR_MEMBER
scalar_member_search(s)38 scalar_member_search (s)
39 char *s;
40 {
41 MEMBER_ID *m;
42
43 assert (s != NULL);
44
45 m = (MEMBER_ID *) bsearch (s, scalar_member_names, END_Scalar,
46 sizeof (MEMBER_ID), member_cmp);
47
48 return ((m == NULL) ? END_Scalar : m->id);
49 }
50
51 ENTITY *
bi_scalar(n,p)52 bi_scalar (n, p)
53 int n;
54 ENTITY *p;
55 {
56 /* Convert to a scalar, or return 0 if `p' is NULL. */
57
58 return p ? scalar_entity (p) : int_to_scalar (0);
59 }
60
61 ENTITY *
scalar_entity(ip)62 scalar_entity (ip)
63 ENTITY *ip;
64 {
65 /*
66 * Convert an entity to scalar class. The `ip' arg must point
67 * to a valid entity.
68 */
69
70 EASSERT (ip, 0, 0);
71
72 switch (ip->class)
73 {
74 case scalar:
75 return ip;
76 case vector:
77 return vector_to_scalar ((VECTOR *) ip);
78 case matrix:
79 return matrix_to_scalar ((MATRIX *) ip);
80 default:
81 fail ("Can't convert a %s entity to a scalar.",
82 class_string[ip->class]);
83 delete_entity (ip);
84 raise_exception ();
85 }
86 }
87
88 ENTITY *
make_scalar(type)89 make_scalar (type)
90 TYPE type;
91 {
92 /*
93 * This routine makes a scalar with the given type. Space for
94 * the value is allocated and initialized with zero.
95 */
96
97 SCALAR *p;
98
99 p = (SCALAR *) CALLOC (1, sizeof (SCALAR));
100 p->entity.ref_count = 1;
101 p->entity.class = scalar;
102 p->type = type;
103 if (type == character)
104 p->v.character = NULL_string;
105 p->stuff = NULL;
106
107 if (debug_level > 1)
108 inform ("Scalar created: %x.", p);
109
110 return ENT (p);
111 }
112
113 ENTITY *
int_to_scalar(i)114 int_to_scalar (i)
115 int i;
116 {
117 /* Turns an int into an integer scalar. */
118
119 SCALAR *op;
120
121 op = (SCALAR *) MALLOC (sizeof (SCALAR));
122 op->entity.ref_count = 1;
123 op->entity.class = scalar;
124 op->type = integer;
125 op->stuff = NULL;
126 op->v.integer = i;
127
128 if (debug_level > 1)
129 inform ("Scalar created: %x.", op);
130
131 return ENT (op);
132 }
133
134 ENTITY *
real_to_scalar(r)135 real_to_scalar (r)
136 REAL r;
137 {
138 /* Turns a real value into a real scalar. */
139
140 SCALAR *op;
141
142 op = (SCALAR *) MALLOC (sizeof (SCALAR));
143 op->entity.ref_count = 1;
144 op->entity.class = scalar;
145 op->type = real;
146 op->v.real = r;
147 op->stuff = NULL;
148
149 if (debug_level > 1)
150 inform ("Scalar created: %x.", op);
151
152 return ENT (op);
153 }
154
155 ENTITY *
complex_to_scalar(c)156 complex_to_scalar (c)
157 COMPLEX c;
158 {
159 /* Turns a complex value into a complex scalar. */
160
161 SCALAR *op;
162
163 op = (SCALAR *) MALLOC (sizeof (SCALAR));
164 op->entity.ref_count = 1;
165 op->entity.class = scalar;
166 op->type = complex;
167 op->v.complex = c;
168 op->stuff = NULL;
169
170 if (debug_level > 1)
171 inform ("Scalar created: %x.", op);
172
173 return (ENT (op));
174 }
175
176 ENTITY *
char_to_scalar(p)177 char_to_scalar (p)
178 char *p;
179 {
180 /*
181 * Turns a string into a character scalar. The string `p' is eaten,
182 * so call `dup_char' on it first if you don't want to lose it.
183 */
184
185 SCALAR *op;
186
187 op = (SCALAR *) MALLOC (sizeof (SCALAR));
188 op->entity.ref_count = 1;
189 op->entity.class = scalar;
190 op->type = character;
191
192 /* Try to point all zero-length strings to same place. */
193
194 if (*p)
195 {
196 op->v.character = p;
197 }
198 else
199 {
200 op->v.character = NULL_string;
201 FREE_CHAR (p);
202 }
203
204 op->stuff = NULL;
205
206 if (debug_level > 1)
207 inform ("Scalar created: %x.", op);
208
209 return ENT (op);
210 }
211
212 ENTITY *
dup_scalar(ips)213 dup_scalar (ips)
214 SCALAR *ips;
215 {
216 SCALAR *ops;
217
218 EASSERT (ips, scalar, 0);
219
220 if (ips->entity.ref_count == 1)
221 return ENT (ips);
222
223 ops = (SCALAR *) dup_mem (ips, sizeof (SCALAR));
224 ops->entity.ref_count = 1;
225 if (ops->type == character)
226 ops->v.character = dup_char (ops->v.character);
227 ops->stuff = NULL;
228
229 if (debug_level > 1)
230 inform ("Scalar created: %x.", ops);
231
232 delete_scalar (ips);
233 return ENT (ops);
234 }
235
236 void
free_scalar(p)237 free_scalar (p)
238 SCALAR *p;
239 {
240 /*
241 * Called by `delete_scalar' to free memory used by a scalar. The
242 * ref_count must be zero.
243 */
244
245 assert (p->entity.ref_count == 0);
246
247 delete_table (p->stuff);
248 if (p->type == character && p->v.character != NULL_string)
249 FREE (p->v.character);
250
251 /* Just to make it harder to use it again inadvertently. */
252 p->entity.class = undefined_class;
253 FREE (p);
254 }
255
256 void
DB_delete_scalar(p,file,line)257 DB_delete_scalar (p, file, line)
258 SCALAR *p;
259 char *file;
260 int line;
261 {
262 /*
263 * This is the DEBUG version of `delete_scalar'. It decrements
264 * the scalar's reference count and frees it if it is unreferenced.
265 * OK to pass a NULL pointer for `p'.
266 */
267
268 if (p)
269 {
270 if (--p->entity.ref_count < 0)
271 {
272 wipeout ("A scalar's \"ref_count\" went below zero: %s, %d.",
273 file, line);
274 }
275
276 if (p->entity.ref_count >= 1000 || debug_level > 1)
277 {
278 inform ("scalar \"ref_count\" decrement: %x, %d, %s, %d.",
279 p, p->entity.ref_count, file, line);
280 }
281
282 if (p->entity.ref_count == 0)
283 free_scalar (p);
284 }
285 }
286
287 int
put_scalar(s,stream,ent_tree)288 put_scalar (s, stream, ent_tree)
289 SCALAR *s;
290 FILE *stream;
291 struct ent_node *ent_tree;
292 {
293 /* Write scalar `s' out in binary form to file `stream'. */
294
295 int i, size;
296
297 EASSERT (s, scalar, 0);
298
299 if (!WRITE_INT (&s->type, stream))
300 goto err;
301
302 switch (s->type)
303 {
304 case integer:
305 if (!WRITE_INT (&s->v.integer, stream))
306 goto err;
307 break;
308
309 case real:
310 if (!WRITE_DOUBLE (&s->v.real, stream))
311 goto err;
312 break;
313
314 case complex:
315 if (!WRITE_DOUBLE (&s->v.complex.real, stream) ||
316 !WRITE_DOUBLE (&s->v.complex.imag, stream))
317 goto err;
318 break;
319
320 case character:
321 size = strlen (s->v.character);
322 if (!WRITE_INT (&size, stream))
323 goto err;
324 if (size > 0 && fwrite (s->v.character, 1, size, stream) <
325 (size_t) size)
326 {
327 WRITE_WARN (stream);
328 goto err;
329 }
330 break;
331
332 default:
333 BAD_TYPE (s->type);
334 delete_scalar (s);
335 raise_exception ();
336 }
337
338 if (s->stuff)
339 {
340 i = 1; /* stuff follows */
341 if (!WRITE_INT (&i, stream) ||
342 !put_entity (copy_table (s->stuff), stream, ent_tree))
343 goto err;
344 }
345 else
346 {
347 i = 0; /* no stuff */
348 if (!WRITE_INT (&i, stream))
349 goto err;
350 }
351
352 delete_scalar (s);
353 return 1;
354
355 err:
356 delete_scalar (s);
357 return 0;
358 }
359
360 ENTITY *
get_scalar(stream,ver)361 get_scalar (stream, ver)
362 FILE *stream;
363 int ver;
364 {
365 /* Read a scalar from the binary file `stream'. */
366
367 SCALAR *s;
368 int i, size;
369
370 s = (SCALAR *) CALLOC (1, sizeof (SCALAR));
371 s->entity.ref_count = 1;
372 s->entity.class = scalar;
373
374 if (!READ_INT (&s->type, stream))
375 {
376 FREE (s);
377 return NULL;
378 }
379
380 switch (s->type)
381 {
382 case integer:
383 if (!READ_INT (&s->v.integer, stream))
384 goto err;
385 break;
386
387 case real:
388 if (!READ_DOUBLE (&s->v.real, stream))
389 goto err;
390 break;
391
392 case complex:
393 if (!READ_DOUBLE (&s->v.complex.real, stream) ||
394 !READ_DOUBLE (&s->v.complex.imag, stream))
395 goto err;
396 break;
397
398 case character:
399 if (!READ_INT (&size, stream))
400 goto err;
401 if (size > 0)
402 {
403 s->v.character = (char *) MALLOC (size + 1);
404 if (fread (s->v.character, 1, size, stream) < (size_t) size)
405 {
406 READ_WARN (stream);
407 goto err;
408 }
409 s->v.character[size] = '\0';
410 }
411 else
412 {
413 s->v.character = NULL_string;
414 }
415 break;
416
417 default:
418 warn ("Invalid scalar type in file.");
419 goto err;
420 }
421
422 if (!READ_INT (&i, stream))
423 goto err; /* stuff follows? */
424 if (i && !(s->stuff = (TABLE *)
425 (ver ? get_entity (stream) : get_table (stream, ver))))
426 goto err;
427
428 if (!ok_entity (ENT (s)))
429 goto err;
430
431 return ENT (s);
432
433 err:
434 delete_scalar (s);
435 return NULL;
436 }
437