1 /*
2 Copyright (c) 1991-1999 Thomas T. Wetmore IV
3
4 Permission is hereby granted, free of charge, to any person
5 obtaining a copy of this software and associated documentation
6 files (the "Software"), to deal in the Software without
7 restriction, including without limitation the rights to use, copy,
8 modify, merge, publish, distribute, sublicense, and/or sell copies
9 of the Software, and to permit persons to whom the Software is
10 furnished to do so, subject to the following conditions:
11
12 The above copyright notice and this permission notice shall be
13 included in all copies or substantial portions of the Software.
14
15 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
18 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
19 BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
20 ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
21 CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
22 SOFTWARE.
23 */
24 /* modified 05 Jan 2000 by Paul B. McBride (pmcbride@tiac.net) */
25 /*=============================================================
26 * pvalue.c -- Handle program typed values
27 * Copyright(c) 1991-95 by T.T. Wetmore IV; all rights reserved
28 * pre-SourceForge version information:
29 * 3.0.3 - 03 Jul 96
30 *===========================================================*/
31
32 #include "llstdlib.h"
33 #include "table.h"
34 #include "translat.h"
35 #include "gedcom.h"
36 #include "cache.h"
37 #include "interpi.h"
38 #include "liflines.h"
39 #include "feedback.h"
40 #include "zstr.h"
41 #include "vtable.h"
42 #include "array.h"
43 #include "object.h"
44
45 /*********************************************
46 * local function prototypes
47 *********************************************/
48
49 /* alphabetical */
50 static FLOAT bool_to_float(BOOLEAN);
51 static INT bool_to_int(BOOLEAN);
52 static void clear_pv_indiseq(INDISEQ seq);
53 static PVALUE create_pvalue_from_keynum_impl(INT i, INT ptype);
54 static PVALUE create_pvalue_from_key_impl(CNSTRING key, INT ptype);
55 static PVALUE create_pvalue_from_record(RECORD rec, INT ptype);
56 /* static BOOLEAN eq_pstrings(PVALUE val1, PVALUE val2); */
57 static int float_to_int(float f);
58 static BOOLEAN is_record_pvaltype(INT valtype);
59 static OBJECT pvalue_copy(OBJECT obj, int deep);
60 static void pvalue_destructor(VTABLE *obj);
61 static void release_pvalue_contents(PVALUE val);
62 static void set_pvalue(PVALUE val, INT type, PVALUE_DATA pvd);
63
64 /*********************************************
65 * local variables
66 *********************************************/
67
68 /* These names are offset by the number of their type */
69 /* PFLOAT == 4, so "PFLOAT" must be at array offset 4 */
70 static char *ptypes[] = {
71 "?", "PNULL", "PINT", "PLONG", "PFLOAT", "PBOOL", "PSTRING",
72 "PGNODE", "PINDI", "PFAM", "PSOUR", "PEVEN", "POTHR", "PLIST",
73 "PTABLE", "PSET", "PARRAY"
74 };
75 static struct tag_vtable vtable_for_pvalue = {
76 VTABLE_MAGIC
77 , "pvalue"
78 , &pvalue_destructor
79 , &nonrefcountable_isref
80 , 0
81 , 0
82 , &pvalue_copy /* copy_fnc */
83 , &generic_get_type_name
84 };
85
86
87 /*********************************************
88 * local function definitions
89 * body of module
90 *********************************************/
91
92 /*========================================
93 * create_pvalue -- Create a program value
94 *======================================*/
95 PVALUE
create_pvalue(INT type,PVALUE_DATA pvd)96 create_pvalue (INT type, PVALUE_DATA pvd)
97 {
98 PVALUE val = create_new_pvalue();
99 set_pvalue(val, type, pvd);
100 return val;
101 }
102 /*==================================
103 * set_pvalue -- Set a program value
104 * val: [I/O] pvalue getting new info
105 * type: [IN] new type for pvalue
106 * value: [IN] new value for pvalue
107 *================================*/
108 static void
set_pvalue(PVALUE val,INT type,PVALUE_DATA pvd)109 set_pvalue (PVALUE val, INT type, PVALUE_DATA pvd)
110 {
111 /* for simple types, we can simply assign */
112 /* but for indirect/pointer types, we must beware of self-assignment */
113 if (type == PNULL) {
114 clear_pvalue(val);
115 return;
116 } else if (type == PINT) {
117 clear_pvalue(val);
118 val->type = PINT;
119 val->value.ixd = pvd.ixd;
120 } else if (type == PFLOAT) {
121 clear_pvalue(val);
122 val->type = PFLOAT;
123 val->value.fxd = pvd.fxd;
124 } else if (type == PBOOL) {
125 clear_pvalue(val);
126 val->type = PBOOL;
127 val->value.bxd = pvd.bxd;
128 } else if (type == PSTRING) {
129 STRING str = pvd.sxd;
130 /* strings are always copied, no self-assignment issue */
131 clear_pvalue(val);
132 val->type = PSTRING;
133 if (str)
134 val->value.sxd = strsave(str);
135 else
136 val->value.sxd = 0;
137 } else if (type == PGNODE) {
138 NODE node = pvd.nxd;
139 if (val->type == PGNODE && val->value.nxd == node)
140 return; /* self-assignment */
141 clear_pvalue(val);
142 val->type = PGNODE;
143 val->value.nxd = node;
144 if (node) {
145 ++nrefcnt(node);
146 dolock_node_in_cache(node, TRUE);
147 }
148 } else if (is_record_pvaltype(type)) { /* PINDI, PFAM, PSOUR, PEVEN, POTHR */
149 RECORD rec = pvd.rxd;
150 if (val->type == type && val->value.rxd == rec)
151 return; /* self-assignment */
152 clear_pvalue(val);
153 val->type = type;
154 val->value.rxd = rec;
155 if (rec) {
156 addref_record(rec);
157 }
158 } else if (type == PLIST) {
159 LIST list = pvd.lxd;
160 if (val->type == PLIST && val->value.lxd == list)
161 return; /* self-assignment */
162 clear_pvalue(val);
163 val->type = PLIST;
164 val->value.lxd = list;
165 if (list) {
166 addref_list(list);
167 }
168 } else if (type == PTABLE) {
169 TABLE table = pvd.txd;
170 if (val->type == PTABLE && val->value.txd == table)
171 return; /* self-assignment */
172 clear_pvalue(val);
173 val->type = PTABLE;
174 val->value.txd = table;
175 if (table) {
176 addref_table(table);
177 }
178 } else if (type == PSET) {
179 INDISEQ seq = pvd.qxd;
180 if (val->type == PSET && val->value.qxd == seq)
181 return; /* self-assignment */
182 clear_pvalue(val);
183 val->type = PSET;
184 val->value.qxd = seq;
185 if (seq) {
186 addref_indiseq(seq);
187 }
188 } else if (type == PARRAY) {
189 ARRAY arr = pvd.axd;
190 if (val->type == PARRAY && val->value.axd == arr)
191 return; /* self-assignment */
192 clear_pvalue(val);
193 val->type = PARRAY;
194 val->value.axd = arr;
195 if (arr) {
196 addref_array(arr);
197 }
198 }
199 }
200 /*========================================
201 * dolock_node_in_cache -- Lock/unlock node in cache
202 * (if possible)
203 * Created: 2003-02-04 (Perry Rapp)
204 *======================================*/
205 void
dolock_node_in_cache(NODE node,BOOLEAN lock)206 dolock_node_in_cache (NODE node, BOOLEAN lock)
207 {
208 node = node; /* NOTUSED */
209 lock = lock; /* NOTUSED */
210
211 #if NOT_WORKING_ON_LARGE_DATA_SETS
212 /* This leads to cache overflow, so there is something
213 wrong here - Perry, 2003-03-07 */
214 if (node) {
215 RECORD rec = node->n_rec;
216 if (rec) {
217 CACHEEL cel = rec->cel;
218 if (cel) {
219 if (lock)
220 lock_cache(cel);
221 else
222 unlock_cache(cel);
223 }
224 }
225 }
226 #endif /* NOT_WORKING_ON_LARGE_DATA_SETS */
227 }
228 /*========================================
229 * clear_pvalue -- Set pvalue to null
230 * releasing any contents
231 * Created: 2007/12/19, Perry Rapp
232 *======================================*/
233 void
clear_pvalue(PVALUE val)234 clear_pvalue (PVALUE val)
235 {
236 release_pvalue_contents(val);
237 val->type = PNULL;
238 val->value.pxd = 0;
239 }
240 /*========================================
241 * release_pvalue_contents -- Empty contents of pvalue
242 * This doesn't bother to clear val->value
243 * because caller will do so
244 * Created: 2001/01/20, Perry Rapp
245 *======================================*/
246 static void
release_pvalue_contents(PVALUE val)247 release_pvalue_contents (PVALUE val)
248 {
249 check_pvalue_validity(val);
250 switch (ptype(val)) {
251 /*
252 embedded values have no referenced memory to clear
253 PINT, PBOOLEAN, PFLOAT
254 */
255 /*
256 PNULL is a null value
257 */
258 case PGNODE:
259 {
260 NODE node = pvalue_to_node(val);
261 if (node) {
262 dolock_node_in_cache(node, FALSE);
263 --nrefcnt(node);
264 if (!nrefcnt(node) && is_temp_node(node)) {
265 free_temp_node_tree(node);
266 }
267 }
268 }
269 return;
270 case PSTRING:
271 {
272 STRING str = pvalue_to_string(val);
273 if (str) {
274 stdfree(str);
275 }
276 }
277 return;
278 case PLIST:
279 {
280 LIST list = pvalue_to_list(val);
281 release_list(list);
282 }
283 return;
284 case PTABLE:
285 {
286 TABLE table = pvalue_to_table(val);
287 release_table(table);
288 }
289 return;
290 case PSET:
291 {
292 INDISEQ seq = pvalue_to_seq(val);
293 /* because of getindiset, seq might be NULL */
294 if (seq) {
295 --IRefcnt(seq);
296 if (!IRefcnt(seq)) {
297 clear_pv_indiseq(seq);
298 remove_indiseq(seq);
299 }
300 }
301 }
302 return;
303 /* record nodes handled below (PINDI, PFAM, PSOUR, PEVEN, POTHR) */
304 }
305 if (is_record_pvalue(val)) {
306 RECORD rec = pvalue_to_record(val);
307 release_record(rec);
308 }
309 }
310 /*========================================
311 * clear_pv_indiseq -- Clear PVALUES from indiseq
312 * Created: 2001/03/24, Perry Rapp
313 *======================================*/
314 static void
clear_pv_indiseq(INDISEQ seq)315 clear_pv_indiseq (INDISEQ seq)
316 {
317 PVALUE val=NULL;
318 /* NUL value indiseqs can get into reports via getindiset */
319 ASSERT(IValtype(seq) == ISVAL_PTR || IValtype(seq) == ISVAL_NUL);
320 FORINDISEQ(seq, el, ncount)
321 val = (PVALUE)element_pval(el);
322 if (val) {
323 delete_pvalue(val);
324 set_element_pval(el, NULL);
325 }
326 ENDINDISEQ
327 }
328 /*========================================
329 * table_pvcleaner -- Clean pvalue entries
330 * from table
331 * Created: 2001/03/24, Perry Rapp
332 *======================================*/
333 #ifdef UNUSED
334 static void
table_pvcleaner(CNSTRING key,UNION uval)335 table_pvcleaner (CNSTRING key, UNION uval)
336 {
337 PVALUE val = uval.w;
338 key=key; /* unused */
339 delete_pvalue(val);
340 uval.w = NULL;
341 }
342 #endif
343 /*========================================
344 * delete_vptr_pvalue -- Delete a program value
345 * (passed in as a VPTR)
346 * Created: 2001/03/24, Perry Rapp
347 *======================================*/
348 void
delete_vptr_pvalue(VPTR ptr)349 delete_vptr_pvalue (VPTR ptr)
350 {
351 PVALUE val = (PVALUE)ptr;
352 delete_pvalue(val);
353 }
354 /*========================================
355 * remove_node_and_delete_pvalue -- Remove
356 * node inside pvalue, and delete pvalue
357 *======================================*/
358 NODE
remove_node_and_delete_pvalue(PVALUE * pval)359 remove_node_and_delete_pvalue (PVALUE * pval)
360 {
361 NODE node=0;
362 if (*pval) {
363 PVALUE vl= *pval;
364 node = vl->value.nxd;
365 vl->value.nxd = 0;
366 delete_pvalue(vl);
367 }
368 *pval = 0;
369 return node;
370 }
371 /*========================================
372 * delete_pvalue -- Delete a program value
373 * see create_pvalue - Perry Rapp, 2001/01/19
374 *======================================*/
375 void
delete_pvalue(PVALUE val)376 delete_pvalue (PVALUE val)
377 {
378 if (!val) return;
379 clear_pvalue(val);
380 free_pvalue_memory(val);
381 }
382 /*========================================
383 * delete_pvalue_ptr -- Delete & clear a program value
384 * Created: 2003-01-30 (Perry Rapp)
385 *======================================*/
386 void
delete_pvalue_ptr(PVALUE * valp)387 delete_pvalue_ptr (PVALUE * valp)
388 {
389 if (valp) {
390 delete_pvalue(*valp);
391 *valp = 0;
392 }
393 }
394 /*====================================
395 * copy_pvalue -- Create a new pvalue & copy into it
396 * handles NULL
397 * delegates all the real work to create_pvalue
398 *==================================*/
399 PVALUE
copy_pvalue(PVALUE val)400 copy_pvalue (PVALUE val)
401 {
402 if (!val)
403 return NULL;
404 return create_pvalue(ptype(val), pvalvv(val));
405 }
406 /*=====================================================
407 * create_pvalue_from_indi -- Return indi as pvalue
408 * handles NULL
409 * Created: 2001/03/18, Perry Rapp
410 *===================================================*/
411 PVALUE
create_pvalue_from_indi(NODE indi)412 create_pvalue_from_indi (NODE indi)
413 {
414 if (indi)
415 return create_pvalue_from_indi_key(indi_to_key(indi));
416 else
417 return create_pvalue_of_null_indi();
418 }
419 /*=====================================================
420 * create_pvalue_of_null_indi -- Return pvalue of null indi
421 * That is, a pvalue of INDI type pointing to nothing
422 * Created: 2007/12/19, Perry Rapp
423 *===================================================*/
424 PVALUE
create_pvalue_of_null_indi(void)425 create_pvalue_of_null_indi (void)
426 {
427 PVALUE_DATA pvd;
428 pvd.rxd = 0;
429 return create_pvalue(PINDI, pvd);
430 }
431 /*=====================================================
432 * create_pvalue_of_null_fam -- Return pvalue of null fam
433 * That is, a pvalue of FAM type pointing to nothing
434 * Created: 2007/12/19, Perry Rapp
435 *===================================================*/
436 PVALUE
create_pvalue_of_null_fam(void)437 create_pvalue_of_null_fam (void)
438 {
439 PVALUE_DATA pvd;
440 pvd.rxd = 0;
441 return create_pvalue(PFAM, pvd);
442 }
443 /*=====================================================
444 * create_pvalue_from_indi_key
445 * handles NULL
446 * Created: 2000/12/30, Perry Rapp
447 *===================================================*/
448 PVALUE
create_pvalue_from_indi_key(CNSTRING key)449 create_pvalue_from_indi_key (CNSTRING key)
450 {
451 return create_pvalue_from_key_impl(key, PINDI);
452 }
453 /*=====================================================
454 * create_pvalue_from_fam_key
455 * handles NULL
456 *===================================================*/
457 PVALUE
create_pvalue_from_fam_key(STRING key)458 create_pvalue_from_fam_key (STRING key)
459 {
460 return create_pvalue_from_key_impl(key, PFAM);
461 }
462 /*=====================================================
463 * create_pvalue_from_cel
464 * Created: 2002/02/17, Perry Rapp
465 *===================================================*/
466 PVALUE
create_pvalue_from_cel(INT type,CACHEEL cel)467 create_pvalue_from_cel (INT type, CACHEEL cel)
468 {
469 PVALUE val=0;
470 RECORD rec = cel ? get_record_for_cel(cel) : 0;
471 val = create_pvalue_from_record(rec, type);
472 release_record(rec); /* ownership transferred to pvalue */
473 return val;
474 }
475 /*=====================================================
476 * create_pvalue_from_indi_keynum -- Return indi as pvalue
477 * helper for __firstindi etc
478 * handles i==0
479 * Created: 2000/12/30, Perry Rapp
480 *===================================================*/
481 PVALUE
create_pvalue_from_indi_keynum(INT i)482 create_pvalue_from_indi_keynum (INT i)
483 {
484 return create_pvalue_from_keynum_impl(i, PINDI);
485 }
486 /*=====================================================
487 * create_pvalue_from_fam -- Return fam as pvalue
488 * handles NULL
489 * Created: 2001/03/18, Perry Rapp
490 *===================================================*/
491 PVALUE
create_pvalue_from_fam(NODE fam)492 create_pvalue_from_fam (NODE fam)
493 {
494 if (fam)
495 return create_pvalue_from_fam_key(fam_to_key(fam));
496 else
497 return create_pvalue_of_null_fam();
498 }
499 /*====================================================
500 * create_pvalue_from_fam_keynum -- Return indi as pvalue
501 * helper for __firstfam etc
502 * handles i==0
503 * Created: 2000/12/30, Perry Rapp
504 *==================================================*/
505 PVALUE
create_pvalue_from_fam_keynum(INT i)506 create_pvalue_from_fam_keynum (INT i)
507 {
508 return create_pvalue_from_keynum_impl(i, PFAM);
509 }
510 /*=====================================================
511 * create_pvalue_from_sour_keynum -- Return new pvalue for source
512 * Created: 2001/03/20, Perry Rapp
513 *===================================================*/
514 PVALUE
create_pvalue_from_sour_keynum(INT i)515 create_pvalue_from_sour_keynum (INT i)
516 {
517 return create_pvalue_from_keynum_impl(i, PSOUR);
518 }
519 /*=====================================================
520 * create_pvalue_from_even_keynum -- Return new pvalue for event
521 * Created: 2001/03/23, Perry Rapp
522 *===================================================*/
523 PVALUE
create_pvalue_from_even_keynum(INT i)524 create_pvalue_from_even_keynum (INT i)
525 {
526 return create_pvalue_from_keynum_impl(i, PEVEN);
527 }
528 /*=====================================================
529 * create_pvalue_from_othr_keynum -- Return new pvalue for other
530 * Created: 2001/11/11, Perry Rapp
531 *===================================================*/
532 PVALUE
create_pvalue_from_othr_keynum(INT i)533 create_pvalue_from_othr_keynum (INT i)
534 {
535 return create_pvalue_from_keynum_impl(i, POTHR);
536 }
537 /*=====================================================
538 * create_pvalue_from_record -- Create pvalue from any node
539 * handles NULL
540 * If rec is not null, it is given to new pvalue to own
541 *===================================================*/
542 static PVALUE
create_pvalue_from_record(RECORD rec,INT ptype)543 create_pvalue_from_record (RECORD rec, INT ptype)
544 {
545 PVALUE_DATA pvd;
546 /* record pvalues simply point to their heap-alloc'd record */
547 pvd.rxd = rec;
548 return create_pvalue(ptype, pvd);
549 }
550 /*====================================================
551 * create_pvalue_from_keynum_impl -- Create pvalue for any type
552 * Created: 2001/03/20, Perry Rapp
553 *==================================================*/
554 static PVALUE
create_pvalue_from_keynum_impl(INT i,INT ptype)555 create_pvalue_from_keynum_impl (INT i, INT ptype)
556 {
557 static char key[10];
558 char cptype = 'Q';
559 if (!i)
560 return create_pvalue_from_record(NULL, ptype);
561 switch(ptype) {
562 case PINDI: cptype = 'I'; break;
563 case PFAM: cptype = 'F'; break;
564 case PSOUR: cptype = 'S'; break;
565 case PEVEN: cptype = 'E'; break;
566 case POTHR: cptype = 'X'; break;
567 default: ASSERT(0); break;
568 }
569 sprintf(key, "%c%d", cptype, i);
570 return create_pvalue_from_key_impl(key, ptype);
571 }
572 /*==================================
573 * create_pvalue_from_key_impl -- Create pvalue from any key
574 * Created: 2001/03/20, Perry Rapp
575 *================================*/
576 static PVALUE
create_pvalue_from_key_impl(CNSTRING key,INT ptype)577 create_pvalue_from_key_impl (CNSTRING key, INT ptype)
578 {
579 /* report mode, so may return NULL */
580 RECORD rec = qkey_to_record(key); /* addref'd record */
581 PVALUE val = create_pvalue_from_record(rec, ptype);
582 release_record(rec); /* release our reference, now only pvalue holds */
583 return val;
584 }
585 /*==================================================
586 * is_numeric_pvalue -- See if program value is numeric
587 *================================================*/
588 BOOLEAN
is_numeric_pvalue(PVALUE val)589 is_numeric_pvalue (PVALUE val)
590 {
591 INT type = ptype(val);
592 return type == PINT || type == PFLOAT || type == PNULL;
593 }
594 /*===========================================================
595 * eq_conform_pvalues -- Make the types of two values conform
596 *=========================================================*/
597 void
eq_conform_pvalues(PVALUE val1,PVALUE val2,BOOLEAN * eflg)598 eq_conform_pvalues (PVALUE val1, PVALUE val2, BOOLEAN *eflg)
599 {
600 INT hitype;
601
602 ASSERT(val1);
603 ASSERT(val2);
604 if (ptype(val1) == ptype(val2)) return;
605 if (ptype(val1) == PNULL)
606 ptype(val1) = ptype(val2);
607 if (ptype(val2) == PNULL)
608 ptype(val2) = ptype(val1);
609 if (ptype(val1) == ptype(val2)) return;
610 if (ptype(val1) == PINT && pvalue_to_int(val1) == 0 && !is_numeric_pvalue(val2))
611 ptype(val1) = ptype(val2);
612 if (ptype(val2) == PINT && pvalue_to_int(val2) == 0 && !is_numeric_pvalue(val1))
613 ptype(val2) = ptype(val1);
614 if (ptype(val1) == ptype(val2)) return;
615 if (is_numeric_pvalue(val1) && is_numeric_pvalue(val2)) {
616 hitype = max(ptype(val1), ptype(val2));
617 if (ptype(val1) != hitype) coerce_pvalue(hitype, val1, eflg);
618 if (ptype(val2) != hitype) coerce_pvalue(hitype, val2, eflg);
619 return;
620 }
621 *eflg = TRUE;
622 }
623 /*===========================================================
624 * get_pvalue_as_bool -- Return boolean equivalent of value
625 *=========================================================*/
626 static BOOLEAN
get_pvalue_as_bool(PVALUE val)627 get_pvalue_as_bool (PVALUE val)
628 {
629 switch(val->type)
630 {
631 case PNULL: return FALSE;
632 case PINT: return val->value.ixd != 0;
633 case PFLOAT: return val->value.fxd != 0;
634 case PBOOL: return val->value.bxd;
635 case PSTRING: return val->value.sxd != 0;
636 case PGNODE: return val->value.nxd != 0;
637 case PINDI:
638 case PFAM:
639 case PSOUR:
640 case PEVEN:
641 case POTHR:
642 return val->value.rxd != 0;
643 case PLIST: return pvalue_to_list(val) != 0;
644 case PTABLE: return pvalue_to_table(val) != 0;
645 case PSET: return pvalue_to_seq(val) != 0;
646 case PARRAY: return val->value.axd != 0;
647 }
648 return FALSE;
649 }
650 /*=========================================================
651 * coerce_pvalue -- Convert PVALUE from one type to another
652 * type: [in] type to convert to
653 * val: [in,out] value to convert in place
654 * eflg: [out] error flag (set to TRUE if error)
655 *=======================================================*/
656 void
coerce_pvalue(INT type,PVALUE val,BOOLEAN * eflg)657 coerce_pvalue (INT type, PVALUE val, BOOLEAN *eflg)
658 {
659 if (*eflg) return;
660 ASSERT(is_pvalue(val));
661
662 if (type == ptype(val)) return; /* no coercion needed */
663
664 if (type == PBOOL) {
665 BOOLEAN boo = get_pvalue_as_bool(val);
666 set_pvalue_bool(val, boo);
667 return;
668 }
669 /* Anything is convertible to PNULL */
670 /* Perry, 2002.02.16: This looks suspicious to me, but I
671 don't know how it is used -- it might be used in some
672 eq_conform_pvalues call(s) ? */
673 if (type == PNULL) {
674 ptype(val) = PNULL;
675 return;
676 }
677
678 /* PNULL or PINT with NULL (0) value is convertible to any scalar (1995.07.31) */
679 if (ptype(val) == PNULL || (ptype(val) == PINT && pvalue_to_int(val) == 0)) {
680 if (type == PSET || type == PTABLE || type == PLIST) goto bad;
681 /*
682 INTs convert to FLOATs numerically further down, no special
683 conversion when INT value 0
684 (2003-06-08)
685 */
686 if (type != PFLOAT) {
687 ptype(val) = type;
688 return;
689 }
690 }
691
692 /* Any record is convertible to PGNODE (2002.02.16) */
693 if (type == PGNODE) {
694 if (is_record_pvalue(val) && record_to_node(val)) {
695 return;
696 } else {
697 /* nothing else is convertible to PGNODE */
698 goto bad;
699 }
700 }
701
702 switch (ptype(val)) { /* switch on what we have */
703
704 case PINT:
705 if (type == PFLOAT) {
706 /* PINT is convertible to PFLOAT */
707 float flo = pvalue_to_int(val);
708 set_pvalue_float(val, flo);
709 return;
710 } else {
711 /* PINT isn't convertible to anything else */
712 goto bad;
713 }
714 break;
715 case PFLOAT:
716 if (type == PINT) {
717 /* PFLOAT is convertible to PINT */
718 INT inum = float_to_int(pvalue_to_float(val));
719 set_pvalue_int(val, inum);
720 return;
721 } else {
722 /* PFLOAT isn't convertible to anything else */
723 goto bad;
724 }
725 break;
726 case PBOOL:
727 if (type == PINT) {
728 /* PBOOL is convertible to PINT */
729 INT inum = bool_to_int(pvalue_to_bool(val));
730 set_pvalue_int(val, inum);
731 return;
732 } else if (type == PFLOAT) {
733 /* PBOOL is convertible to PFLOAT */
734 float fnum = bool_to_float(pvalue_to_bool(val));
735 set_pvalue_float(val, fnum);
736 return;
737 } else {
738 /* PBOOL isn't convertible to anything else */
739 goto bad;
740 }
741 break;
742 /* Nothing else is convertible to anything else */
743 /* record types (PINDI...), PNULL, PGNODE */
744 }
745
746 /* fall through to failure */
747
748 bad:
749 *eflg = TRUE;
750 return;
751 }
752 /*========================================
753 * which_pvalue_type -- Return type number
754 *======================================*/
755 INT
which_pvalue_type(PVALUE val)756 which_pvalue_type (PVALUE val)
757 {
758 ASSERT(val);
759 return ptype(val);
760 }
761 /*========================================
762 * is_node_pvalue -- Does pvalue contain PGNODE ?
763 *======================================*/
764 BOOLEAN
is_node_pvalue(PVALUE value)765 is_node_pvalue (PVALUE value)
766 {
767 return ptype(value) == PGNODE;
768 }
769 /*========================================
770 * is_record_pvalue -- Does pvalue contain record ?
771 *======================================*/
772 BOOLEAN
is_record_pvalue(PVALUE value)773 is_record_pvalue (PVALUE value)
774 {
775 return is_record_pvaltype(ptype(value));
776 }
777 /*========================================
778 * is_record_pvaltype -- Does pvalue contain record ?
779 *======================================*/
780 static BOOLEAN
is_record_pvaltype(INT valtype)781 is_record_pvaltype (INT valtype)
782 {
783 switch (valtype) {
784 case PINDI: case PFAM: case PSOUR: case PEVEN: case POTHR:
785 return TRUE;
786 }
787 return FALSE;
788 }
789 /*========================================
790 * Trivial conversions
791 *======================================*/
792 static INT
bool_to_int(BOOLEAN b)793 bool_to_int (BOOLEAN b)
794 {
795 return b ? 1 : 0;
796 }
797 static FLOAT
bool_to_float(BOOLEAN b)798 bool_to_float (BOOLEAN b)
799 {
800 return b ? 1. : 0.;
801 }
802 static int
float_to_int(float f)803 float_to_int (float f)
804 {
805 return (int)f;
806 }
807 /*===================================================================+
808 * eqv_pvalues -- See if two PVALUEs are equal (no change to PVALUEs)
809 *==================================================================*/
810 BOOLEAN
eqv_pvalues(VPTR ptr1,VPTR ptr2)811 eqv_pvalues (VPTR ptr1, VPTR ptr2)
812 {
813 PVALUE val1=ptr1, val2=ptr2;
814 STRING v1, v2;
815 BOOLEAN rel = FALSE;
816 if(val1 && val2 && (ptype(val1) == ptype(val2))) {
817 switch (ptype(val1)) {
818 /* types with value semantics do value comparison */
819 case PSTRING:
820 v1 = pvalue_to_string(val1);
821 v2 = pvalue_to_string(val2);
822 if(v1 && v2) rel = eqstr(v1, v2);
823 else rel = (v1 == v2);
824 break;
825 case PFLOAT:
826 rel = (pvalue_to_float(val1) == pvalue_to_float(val2));
827 break;
828 case PINT:
829 rel = (pvalue_to_int(val1) == pvalue_to_int(val2));
830 break;
831 case PBOOL:
832 rel = (pvalue_to_bool(val1) == pvalue_to_bool(val2));
833 break;
834 case PINDI: case PFAM: case PSOUR: case PEVEN: case POTHR:
835 {
836 RECORD rec1,rec2;
837 rec1 = pvalue_to_record(val1);
838 rec2 = pvalue_to_record(val2);
839 if (rec1 && rec2) rel = eqstrn(nzkey(rec1),nzkey(rec2),MAXKEYWIDTH+1);
840 else rel = (rec1 == rec2);
841 break;
842 }
843 case PLIST:
844 return pvalue_to_list(val1) == pvalue_to_list(val2);
845 case PTABLE:
846 return pvalue_to_table(val1) == pvalue_to_table(val2);
847 case PSET:
848 return pvalue_to_seq(val1) == pvalue_to_seq(val2);
849 case PARRAY:
850 return val1->value.axd == val2->value.axd;
851 }
852 }
853 return rel;
854 }
855 /*===========================================
856 * bad_type_error -- Set error description
857 * for types that cannot be compared
858 * Created: 2003-01-30 (Perry Rapp)
859 *=========================================*/
860 void
bad_type_error(CNSTRING op,ZSTR * zerr,PVALUE val1,PVALUE val2)861 bad_type_error (CNSTRING op, ZSTR *zerr, PVALUE val1, PVALUE val2)
862 {
863 if (zerr) {
864 ZSTR zt1 = describe_pvalue(val1), zt2 = describe_pvalue(val2);
865 ASSERT(!(*zerr));
866 (*zerr) = zs_newf(_("%s: Incomparable types: %s and %s")
867 , op, zs_str(zt1), zs_str(zt2));
868 zs_free(&zt1);
869 zs_free(&zt2);
870 }
871 }
872 /*===============================================
873 * eq_pstrings -- Compare two PSTRINGS
874 * Caller is responsible for ensuring these are PSTRINGS
875 *=============================================*/
876 /* unused
877 static BOOLEAN
878 eq_pstrings (PVALUE val1, PVALUE val2)
879 {
880 STRING str1 = pvalue_to_string(val1);
881 STRING str2 = pvalue_to_string(val2);
882 if (!str1) str1 = "";
883 if (!str2) str2 = "";
884 return eqstr(str1, str2);
885 }
886 unused */
887 /*===========================================
888 * eq_pvalues -- See if two PVALUEs are equal
889 * Result into val1, deletes val2
890 *=========================================*/
891 void
eq_pvalues(PVALUE val1,PVALUE val2,BOOLEAN * eflg,ZSTR * zerr)892 eq_pvalues (PVALUE val1, PVALUE val2, BOOLEAN *eflg, ZSTR * zerr)
893 {
894 BOOLEAN rel;
895
896 if (*eflg) return;
897 eq_conform_pvalues(val1, val2, eflg);
898 if (*eflg) {
899 bad_type_error("eq", zerr, val1, val2);
900 return;
901 }
902 rel = eqv_pvalues(val1, val2);
903
904 /* Now store answer into val1, and delete val2 */
905 set_pvalue_bool(val1, rel);
906 delete_pvalue(val2);
907 }
908 /*===============================================
909 * ne_pvalues -- See if two PVALUEs are not equal
910 * Result into val1, deletes val2
911 *=============================================*/
912 void
ne_pvalues(PVALUE val1,PVALUE val2,BOOLEAN * eflg,ZSTR * zerr)913 ne_pvalues (PVALUE val1, PVALUE val2, BOOLEAN *eflg, ZSTR * zerr)
914 {
915 BOOLEAN rel;
916
917 if (*eflg) return;
918 eq_conform_pvalues(val1, val2, eflg);
919 if (*eflg) {
920 bad_type_error("ne", zerr, val1, val2);
921 return;
922 }
923 rel = !eqv_pvalues(val1, val2);
924
925 /* Now store answer into val1, and delete val2 */
926 set_pvalue_bool(val1, rel);
927 delete_pvalue(val2);
928 }
929 /*=================================================
930 * show_pvalue -- DEBUG routine that shows a PVALUE
931 *===============================================*/
932 void
show_pvalue(PVALUE val)933 show_pvalue (PVALUE val)
934 {
935 ZSTR zstr = describe_pvalue(val);
936 llwprintf(zs_str(zstr));
937 zs_free(&zstr);
938 }
939 /*=================================================
940 * get_pvalue_type_name -- Return static string name of pvalue type
941 * eg, get_pvalue_type_name(PTABLE) => "PTABLE"
942 *===============================================*/
943 CNSTRING
get_pvalue_type_name(INT ptype)944 get_pvalue_type_name (INT ptype)
945 {
946 if (ptype >= 0 && ptype <= ARRSIZE(ptypes)) {
947 return ptypes[ptype];
948 } else {
949 return "INVALID ptype";
950 }
951 }
952 /*======================================================
953 * debug_pvalue_as_string -- DEBUG routine that shows a PVALUE
954 * returns zstring (dynamic string)
955 *====================================================*/
956 ZSTR
describe_pvalue(PVALUE val)957 describe_pvalue (PVALUE val)
958 {
959 INT type;
960 ZSTR zstr = zs_new();
961
962 if (!val) {
963 zs_sets(zstr, _("NOT PVALUE: NULL!"));
964 return zstr;
965 }
966 if (!is_pvalue(val)) {
967 zs_setf(zstr, _("NOT PVALUE: invalid type=%d)!"), ptype(val));
968 return zstr;
969 }
970 type = ptype(val);
971 zs_appc(zstr, '<');
972 zs_apps(zstr, get_pvalue_type_name(type));
973 zs_appc(zstr, ',');
974
975 switch (type) {
976 case PNULL:
977 zs_appf(zstr, "<NULL>");
978 case PINT:
979 zs_appf(zstr, "%d", pvalue_to_int(val));
980 break;
981 case PFLOAT:
982 zs_appf(zstr, "%f", pvalue_to_float(val));
983 break;
984 case PBOOL:
985 zs_apps(zstr, pvalue_to_bool(val) ? _("True") : _("False"));
986 break;
987 case PSTRING:
988 zs_appf(zstr, "\"%s\"", pvalue_to_string(val));
989 break;
990 case PGNODE:
991 {
992 NODE node = pvalue_to_node(val);
993 if (!node)
994 zs_apps(zstr, "NULL");
995 else {
996 STRING tag = ntag(node);
997 if (!tag)
998 zs_apps(zstr, "null tag");
999 else
1000 zs_appf(zstr, "tag='%s'", tag);
1001 }
1002 }
1003 break;
1004 case PINDI:
1005 case PFAM:
1006 case PSOUR:
1007 case PEVEN:
1008 case POTHR:
1009 {
1010 RECORD rec = pvalue_to_record(val);
1011 if (rec)
1012 zs_appf(zstr, nzkey(rec));
1013 else
1014 zs_appf(zstr, "NULL");
1015 }
1016 break;
1017 case PLIST:
1018 {
1019 LIST list = pvalue_to_list(val);
1020 INT n = length_list(list);
1021 zs_appf(zstr, _pl("%d item", "%d items", n), n);
1022 }
1023 break;
1024 case PTABLE:
1025 {
1026 TABLE table = pvalue_to_table(val);
1027 INT n = get_table_count(table);
1028 zs_appf(zstr, _pl("%d entry", "%d entries", n), n);
1029 }
1030 break;
1031 case PSET:
1032 {
1033 INDISEQ seq = pvalue_to_seq(val);
1034 INT n = length_indiseq(seq);
1035 zs_appf(zstr, _pl("%d record", "%d records", n), n);
1036 }
1037 break;
1038 case PARRAY:
1039 {
1040 ARRAY arr = pvalue_to_array(val);
1041 INT n = get_array_size(arr);
1042 zs_appf(zstr, _pl("%d element", "%d elements", n), n);
1043 }
1044 break;
1045 default:
1046 zs_appf(zstr, "%p", pvalvv(val));
1047 break;
1048 }
1049 zs_appc(zstr, '>');
1050 return zstr;
1051 }
1052 /*==================================
1053 * PNULL: pvalue with no content
1054 *================================*/
1055 PVALUE
create_pvalue_any(void)1056 create_pvalue_any (void)
1057 {
1058 PVALUE_DATA pvd;
1059 pvd.pxd = 0;
1060 return create_pvalue(PNULL, pvd);
1061 }
1062 /*==================================
1063 * PINT: pvalue containing an int
1064 *================================*/
1065 PVALUE
create_pvalue_from_int(INT ival)1066 create_pvalue_from_int (INT ival)
1067 {
1068 PVALUE_DATA pvd;
1069 pvd.ixd = ival;
1070 return create_pvalue(PINT, pvd);
1071 }
1072 void
set_pvalue_int(PVALUE val,INT inum)1073 set_pvalue_int (PVALUE val, INT inum)
1074 {
1075 PVALUE_DATA pvd;
1076 pvd.ixd = inum;
1077 set_pvalue(val, PINT, pvd);
1078 }
1079 INT
pvalue_to_int(PVALUE val)1080 pvalue_to_int (PVALUE val)
1081 {
1082 return val->value.ixd;
1083 }
1084 /*==================================
1085 * PFLOAT: pvalue containing a float
1086 * ptag's value is not large enough, so we have to store
1087 * heap pointer.
1088 *================================*/
1089 PVALUE
create_pvalue_from_float(float fval)1090 create_pvalue_from_float (float fval)
1091 {
1092 PVALUE_DATA pvd;
1093 pvd.fxd = fval;
1094 return create_pvalue(PFLOAT, pvd);
1095 }
1096 void
set_pvalue_float(PVALUE val,float fnum)1097 set_pvalue_float (PVALUE val, float fnum)
1098 {
1099 PVALUE_DATA pvd;
1100 pvd.fxd = fnum;
1101 set_pvalue(val, PFLOAT, pvd);
1102 }
1103 float
pvalue_to_float(PVALUE val)1104 pvalue_to_float (PVALUE val)
1105 {
1106 return pvalvv(val).fxd;
1107 }
1108 /*==================================
1109 * PBOOL: pvalue containing a boolean
1110 *================================*/
1111 PVALUE
create_pvalue_from_bool(BOOLEAN bval)1112 create_pvalue_from_bool (BOOLEAN bval)
1113 {
1114 PVALUE_DATA pvd;
1115 pvd.bxd = bval;
1116 return create_pvalue(PBOOL, pvd);
1117 }
1118 void
set_pvalue_bool(PVALUE val,BOOLEAN bnum)1119 set_pvalue_bool (PVALUE val, BOOLEAN bnum)
1120 {
1121 PVALUE_DATA pvd;
1122 pvd.bxd = bnum;
1123 set_pvalue(val, PBOOL, pvd);
1124 }
1125 BOOLEAN
pvalue_to_bool(PVALUE val)1126 pvalue_to_bool (PVALUE val)
1127 {
1128 return pvalvv(val).bxd;
1129 }
1130 /*==================================
1131 * PSTRING: pvalue containing a string
1132 *================================*/
1133 PVALUE
create_pvalue_from_string(CNSTRING str)1134 create_pvalue_from_string (CNSTRING str)
1135 {
1136 PVALUE_DATA pvd;
1137 pvd.sxd = (STRING)str;
1138 return create_pvalue(PSTRING, pvd);
1139 }
1140 PVALUE
create_pvalue_from_zstr(ZSTR * pzstr)1141 create_pvalue_from_zstr (ZSTR * pzstr)
1142 {
1143 PVALUE val = create_pvalue_from_string(zs_str(*pzstr));
1144 zs_free(pzstr);
1145 return val;
1146 }
1147 void
set_pvalue_string(PVALUE val,CNSTRING str)1148 set_pvalue_string (PVALUE val, CNSTRING str)
1149 {
1150 PVALUE_DATA pvd;
1151 pvd.sxd = (STRING)str;
1152 set_pvalue(val, PSTRING, pvd);
1153 }
1154 STRING
pvalue_to_string(PVALUE val)1155 pvalue_to_string (PVALUE val)
1156 {
1157 return pvalvv(val).sxd;
1158 }
1159 /*==================================
1160 * PGNODE: pvalue containing a GEDCOM node
1161 *================================*/
1162 PVALUE
create_pvalue_from_node(NODE node)1163 create_pvalue_from_node (NODE node)
1164 {
1165 PVALUE_DATA pvd;
1166 pvd.nxd = node;
1167 return create_pvalue(PGNODE, pvd);
1168 }
1169 void
set_pvalue_node(PVALUE val,NODE node)1170 set_pvalue_node (PVALUE val, NODE node)
1171 {
1172 PVALUE_DATA pvd;
1173 pvd.nxd = node;
1174 set_pvalue(val, PGNODE, pvd);
1175 }
1176 NODE
pvalue_to_node(PVALUE val)1177 pvalue_to_node (PVALUE val)
1178 {
1179 return pvalvv(val).nxd;
1180 }
1181 /*==================================
1182 * record pvalues (PINDI, PFAM, ...)
1183 *================================*/
1184 RECORD
pvalue_to_record(PVALUE val)1185 pvalue_to_record (PVALUE val)
1186 {
1187 ASSERT(is_record_pvalue(val));
1188 return pvalvv(val).rxd; /* may be NULL */
1189 }
1190 CACHEEL
pvalue_to_cel(PVALUE val)1191 pvalue_to_cel (PVALUE val)
1192 {
1193 RECORD rec = pvalue_to_record(val);
1194 NODE root = nztop(rec); /* force record into cache */
1195 CACHEEL cel = nzcel(rec);
1196 root = root; /* NOTUSED */
1197 return cel;
1198 }
1199 /*==================================
1200 * LIST: pvalue containing a list
1201 *================================*/
1202 PVALUE
create_pvalue_from_list(LIST list)1203 create_pvalue_from_list (LIST list)
1204 {
1205 PVALUE_DATA pvd;
1206 pvd.lxd = list;
1207 return create_pvalue(PLIST, pvd);
1208 }
1209 LIST
pvalue_to_list(PVALUE val)1210 pvalue_to_list (PVALUE val)
1211 {
1212 return pvalvv(val).lxd;
1213 }
1214 /*==================================
1215 * TABLE: pvalue containing a table
1216 *================================*/
1217 PVALUE
create_pvalue_from_table(TABLE tab)1218 create_pvalue_from_table (TABLE tab)
1219 {
1220 PVALUE_DATA pvd;
1221 pvd.txd = tab;
1222 return create_pvalue(PTABLE, pvd);
1223 }
1224 TABLE
pvalue_to_table(PVALUE val)1225 pvalue_to_table (PVALUE val)
1226 {
1227 return pvalvv(val).txd;
1228 }
1229 /*==================================
1230 * PSET: pvalue containing a set (INDISEQ)
1231 *================================*/
1232 PVALUE
create_pvalue_from_seq(INDISEQ seq)1233 create_pvalue_from_seq (INDISEQ seq)
1234 {
1235 PVALUE_DATA pvd;
1236 pvd.qxd = seq;
1237 return create_pvalue(PSET, pvd);
1238 }
1239 void
set_pvalue_seq(PVALUE val,INDISEQ seq)1240 set_pvalue_seq (PVALUE val, INDISEQ seq)
1241 {
1242 PVALUE_DATA pvd;
1243 pvd.qxd = seq;
1244 set_pvalue(val, PSET, pvd);
1245 }
1246 INDISEQ
pvalue_to_seq(PVALUE val)1247 pvalue_to_seq (PVALUE val)
1248 {
1249 return pvalvv(val).qxd;
1250 }
1251 /*==================================
1252 * ARRAY: pvalue containing an array
1253 *================================*/
1254 ARRAY
pvalue_to_array(PVALUE val)1255 pvalue_to_array (PVALUE val)
1256 {
1257 return pvalvv(val).axd;
1258 }
1259 /*========================================
1260 * init_pvalue_vtable -- set vtable (for allocator in pvalalloc.c)
1261 *======================================*/
1262 void
init_pvalue_vtable(PVALUE val)1263 init_pvalue_vtable (PVALUE val)
1264 {
1265 val->vtable = &vtable_for_pvalue;
1266 }
1267 /*=================================================
1268 * pvalue_destructor -- destructor for vtable
1269 *===============================================*/
1270 static void
pvalue_destructor(VTABLE * obj)1271 pvalue_destructor (VTABLE *obj)
1272 {
1273 PVALUE val = (PVALUE)obj;
1274 ASSERT((*obj)->vtable_class == vtable_for_pvalue.vtable_class);
1275 delete_pvalue(val);
1276 }
1277 /*=================================================
1278 * value_copy -- copy for vtable
1279 *===============================================*/
1280 static OBJECT
pvalue_copy(OBJECT obj,int deep)1281 pvalue_copy (OBJECT obj, int deep)
1282 {
1283 PVALUE val = (PVALUE)obj;
1284 ASSERT((*obj)->vtable_class == vtable_for_pvalue.vtable_class);
1285 if (deep) {
1286 /* cannot implement deep copy until all objects implement copy */
1287 ASSERT(0);
1288 } else {
1289 PVALUE newval = copy_pvalue(val);
1290 return (OBJECT)newval;
1291 }
1292 return 0;
1293 }
1294 /*=============================================
1295 * pvalues_collate -- Compare two pvalues for collation
1296 *============================================*/
1297 INT
pvalues_collate(PVALUE val1,PVALUE val2)1298 pvalues_collate (PVALUE val1, PVALUE val2)
1299 {
1300 /* if dissimilar types, we'll use the numerical order of the types */
1301 if (ptype(val1) != ptype(val2))
1302 return ptype(val1) - ptype(val2);
1303
1304 /* ok, they are the same types, how do we compare them ? */
1305 switch(ptype(val1)) {
1306 case PSTRING:
1307 return cmpstrloc(pvalue_to_string(val1), pvalue_to_string(val2));
1308 case PINT:
1309 return pvalue_to_int(val1) - pvalue_to_int(val2);
1310 case PFLOAT:
1311 return pvalue_to_float(val1) - pvalue_to_float(val2);
1312 }
1313 return 0; /* TODO: what about other types ? */
1314 }
1315 /*=============================================
1316 * create_new_pvalue_table -- Create new table inside new pvalue
1317 *============================================*/
1318 PVALUE
create_new_pvalue_table(void)1319 create_new_pvalue_table (void)
1320 {
1321 TABLE tab = create_table_custom_vptr(delete_vptr_pvalue);
1322 PVALUE val = create_pvalue_from_table(tab);
1323 release_table(tab);
1324 return val;
1325 }
1326 /*=============================================
1327 * create_new_pvalue_list -- Create new list inside new pvalue
1328 *============================================*/
1329 PVALUE
create_new_pvalue_list(void)1330 create_new_pvalue_list (void)
1331 {
1332 LIST list = create_list3(delete_vptr_pvalue);
1333 PVALUE val = create_pvalue_from_list(list);
1334 release_list(list); /* release our ref to list */
1335 return val;
1336 }
1337 /*=============================================
1338 * set_pvalue_to_pvalue -- Set val to be same value as src
1339 *============================================*/
1340 void
set_pvalue_to_pvalue(PVALUE val,const PVALUE src)1341 set_pvalue_to_pvalue (PVALUE val, const PVALUE src)
1342 {
1343 set_pvalue(val, ptype(src), pvalvv(src));
1344 }
1345