~ubuntu-branches/ubuntu/trusty/lifelines/trusty

« back to all changes in this revision

Viewing changes to src/interp/pvalue.c

  • Committer: Bazaar Package Importer
  • Author(s): Felipe Augusto van de Wiel (faw)
  • Date: 2007-05-23 23:49:53 UTC
  • mfrom: (3.1.3 edgy)
  • Revision ID: james.westby@ubuntu.com-20070523234953-ogno9rnbmth61i7p
Tags: 3.0.50-2etch1
* Changing docs/ll-reportmanual.xml and docs/ll-userguide.xml to fix
  documentation build problems (Closes: #418347).

* lifelines-reports
  - Adding a dependency to lifelines >= 3.0.50 to prevent file conflict.
    (Closes: #405500).

* Updating French translation. Thanks to Bernard Adrian. (Closes: #356671).

Show diffs side-by-side

added added

removed removed

Lines of Context:
40
40
#include "zstr.h"
41
41
#include "vtable.h"
42
42
#include "array.h"
 
43
#include "object.h"
43
44
 
44
45
/*********************************************
45
46
 * local function prototypes
50
51
static INT bool_to_int(BOOLEAN);
51
52
static void clear_pv_indiseq(INDISEQ seq);
52
53
static void clear_pvalue(PVALUE val);
 
54
 
53
55
static PVALUE create_pvalue_from_keynum_impl(INT i, INT ptype);
54
 
static PVALUE create_pvalue_from_key_impl(STRING key, INT ptype);
 
56
static PVALUE create_pvalue_from_key_impl(CNSTRING key, INT ptype);
55
57
static PVALUE create_pvalue_from_record(RECORD rec, INT ptype);
56
 
static BOOLEAN eq_pstrings(PVALUE val1, PVALUE val2);
 
58
/* static BOOLEAN eq_pstrings(PVALUE val1, PVALUE val2); */
57
59
static int float_to_int(float f);
58
60
static void free_float_pvalue(PVALUE val);
 
61
static BOOLEAN is_record_pvaltype(INT valtype);
59
62
static OBJECT pvalue_copy(OBJECT obj, int deep);
60
63
static void pvalue_destructor(VTABLE *obj);
61
 
static void table_pvcleaner(ENTRY ent);
 
64
static void table_pvcleaner(CNSTRING key, UNION uval);
62
65
 
63
66
/*********************************************
64
67
 * local variables
65
68
 *********************************************/
66
69
 
 
70
/* These names are offset by the number of their type */
 
71
/* PFLOAT == 4, so "PFLOAT" must be at array offset 4 */
67
72
static char *ptypes[] = {
68
 
        "PNONE", "PANY", "PINT", "PLONG", "PFLOAT", "PBOOL", "PSTRING",
 
73
        "?", "PNULL", "PINT", "PLONG", "PFLOAT", "PBOOL", "PSTRING",
69
74
        "PGNODE", "PINDI", "PFAM", "PSOUR", "PEVEN", "POTHR", "PLIST",
70
 
        "PTABLE", "PSET"
 
75
        "PTABLE", "PSET", "PARRAY"
71
76
};
72
77
static struct tag_vtable vtable_for_pvalue = {
73
78
        VTABLE_MAGIC
105
110
void
106
111
set_pvalue (PVALUE val, INT type, VPTR value)
107
112
{
108
 
        if (type == ptype(val) && value == pvalue(val)) {
 
113
        if (type == ptype(val) && value == pvalvv(val)) {
109
114
                /* self-assignment */
 
115
                /* already have the value, or hold the pointer & reference */
110
116
                return;
111
117
        }
 
118
 
 
119
        /* record pvalues each have their own RECORD on the heap */
 
120
 
112
121
        clear_pvalue(val);
113
122
 
114
123
        /* sanity check */
115
124
        switch(type) {
116
 
        case PNONE: 
117
 
        case PANY:
 
125
        case PNULL:
118
126
                ASSERT(!value);
119
127
                break;
120
128
        }
121
129
        /* types that don't simply assign pointer */
 
130
        /* old refers to value passed in */
 
131
        /* new refers to newly allocated copy to set */
122
132
        switch(type) {
123
133
        case PSTRING:
124
134
                {
125
 
                /* always copies string so caller doesn't have to */
126
 
                if (value)
127
 
                        value = (VPTR) strsave((STRING) value);
 
135
                        /* always copies string so caller doesn't have to */
 
136
                        if (value) {
 
137
                                STRING strold = (STRING)value;
 
138
                                STRING strnew = strsave(strold);
 
139
                                value = strnew;
 
140
                        }
128
141
                break;
129
142
                }
130
143
        case PFLOAT:
131
144
                {
 
145
                        float valold, *ptrnew;
 
146
                        ASSERT(value);
132
147
                        /* floats don't fit into VPTR, so we're using heap copies */
133
 
                        float *ptr = (float *)stdalloc(sizeof(*ptr));
134
 
                        *ptr = *(float *)value;
135
 
                        value = ptr;
 
148
                        valold = *(float *)value;
 
149
                        /* allocate new pointer & copy float into place */
 
150
                        ptrnew = (float *)stdalloc(sizeof(*ptrnew));
 
151
                        *ptrnew = valold;
 
152
                        value = ptrnew;
136
153
                }
137
154
                break;
138
155
        }
139
156
 
140
157
        ptype(val) = type;
141
 
        pvalue(val) = value;
 
158
        pvalvv(val) = value;
 
159
 
 
160
        if (is_record_pvaltype(type)) {
 
161
                RECORD rec = pvalue_to_record(val);
 
162
                if (rec) {
 
163
                        addref_record(rec);
 
164
                }
 
165
        }
142
166
 
143
167
        /* reference counted types and so forth */
144
168
        switch(type) {
154
178
        case PLIST:
155
179
                {
156
180
                        LIST list = pvalue_to_list(val);
157
 
                        ++lrefcnt(list);
 
181
                        addref_list(list);
158
182
                }
159
183
                break;
160
184
        case PTABLE:
161
185
                {
162
186
                        TABLE table = pvalue_to_table(val);
163
 
                        ++table->refcnt;
 
187
                        addref_table(table);
164
188
                }
165
189
                break;
166
190
        case PSET:
173
197
                }
174
198
                break;
175
199
        }
176
 
        if (is_record_pvalue(val)) {
177
 
                /* instead of reference counting records, we lock them */
178
 
                dosemilock_record_in_cache(pvalue_to_rec(val), TRUE);
179
 
        }
180
 
}
181
 
/*========================================
182
 
 * dosemilock_record_in_cache -- semi-Lock/unlock record
183
 
 *  (if possible)
184
 
 * Created: 2003-02-06 (Perry Rapp)
185
 
 *======================================*/
186
 
void
187
 
dosemilock_record_in_cache (RECORD rec, BOOLEAN lock)
188
 
{
189
 
        if (rec) {
190
 
                CACHEEL cel = rec->cel;
191
 
                if (cel) {
192
 
                                if (lock)
193
 
                                        semilock_cache(cel);
194
 
                                else
195
 
                                        unsemilock_cache(cel);
196
 
                }
197
 
        }
198
200
}
199
201
/*========================================
200
202
 * dolock_node_in_cache -- Lock/unlock node in cache
204
206
void
205
207
dolock_node_in_cache (NODE node, BOOLEAN lock)
206
208
{
 
209
        node = node;    /* NOTUSED */
 
210
        lock = lock;    /* NOTUSED */
 
211
 
207
212
#if NOT_WORKING_ON_LARGE_DATA_SETS
208
213
/* This leads to cache overflow, so there is something
209
214
wrong here - Perry, 2003-03-07 */
234
239
        switch (ptype(val)) {
235
240
        /*
236
241
        embedded values have no referenced memory to clear
237
 
        PINT, PBOOLEAN  (PLONG is unused)
 
242
        PINT, PBOOLEAN 
238
243
        */
239
244
        /*
240
 
        PANY is a null value
 
245
        PNULL is a null value
241
246
        */
242
247
        case PGNODE:
243
248
                {
251
256
                        }
252
257
                }
253
258
                return;
254
 
        /* nodes from cache handled below switch - PINDI, PFAM, PSOUR, PEVEN, POTHR */
255
259
        case PFLOAT:
256
260
                free_float_pvalue(val);
257
261
                return;
266
270
        case PLIST:
267
271
                {
268
272
                        LIST list = pvalue_to_list(val);
269
 
                        --lrefcnt(list);
270
 
                        if (!lrefcnt(list)) {
271
 
                                remove_list(list, delete_vptr_pvalue);
272
 
                        }
 
273
                        release_list(list);
273
274
                }
274
275
                return;
275
276
        case PTABLE:
276
277
                {
277
278
                        TABLE table = pvalue_to_table(val);
278
 
                        --table->refcnt;
279
 
                        if (!table->refcnt) {
280
 
                                /* TODO: this will go away when pvalues go away */
281
 
                                traverse_table(table, table_pvcleaner);
282
 
                                destroy_table(table);
283
 
                        }
 
279
                        release_table(table);
284
280
                }
285
281
                return;
286
282
        case PSET:
296
292
                        }
297
293
                }
298
294
                return;
 
295
        /* record nodes handled below (PINDI, PFAM, PSOUR, PEVEN, POTHR) */
299
296
        }
300
297
        if (is_record_pvalue(val)) {
301
 
                /*
302
 
                unlock any cache elements
303
 
                don't worry about memory - it is owned by cache
304
 
                */
305
 
                dosemilock_record_in_cache(pvalue_to_rec(val), FALSE);
 
298
                RECORD rec = pvalue_to_record(val);
 
299
                release_record(rec);
306
300
        }
307
301
}
308
302
/*========================================
316
310
        /* NUL value indiseqs can get into reports via getindiset */
317
311
        ASSERT(IValtype(seq) == ISVAL_PTR || IValtype(seq) == ISVAL_NUL);
318
312
        FORINDISEQ(seq, el, ncount)
319
 
                val = (PVALUE) sval(el).w;
 
313
                val = (PVALUE)element_pval(el);
320
314
                if (val) {
321
315
                        delete_pvalue(val);
322
 
                        sval(el).w = NULL;
 
316
                        set_element_pval(el, NULL);
323
317
                }
324
318
        ENDINDISEQ
325
319
}
329
323
 * Created: 2001/03/24, Perry Rapp
330
324
 *======================================*/
331
325
static void
332
 
table_pvcleaner (ENTRY ent)
 
326
table_pvcleaner (CNSTRING key, UNION uval)
333
327
{
334
 
        PVALUE val = ent->uval.w;
 
328
        PVALUE val = uval.w;
 
329
        key=key; /* unused */
335
330
        delete_pvalue(val);
336
 
        ent->uval.w = NULL;
 
331
        uval.w = NULL;
337
332
}
338
333
/*========================================
339
334
 * delete_vptr_pvalue -- Delete a program value
347
342
        delete_pvalue(val);
348
343
}
349
344
/*========================================
350
 
 * delete_pvalue_wrapper -- Delete the pvalue
351
 
 * shell, but not the value inside
352
 
 * Created: 2003-02-02 (Perry Rapp)
 
345
 * remove_node_and_delete_pvalue -- Remove
 
346
 *  node inside pvalue, and delete pvalue
353
347
 *======================================*/
354
 
void
355
 
delete_pvalue_wrapper (PVALUE val)
 
348
NODE
 
349
remove_node_and_delete_pvalue (PVALUE * pval)
356
350
{
357
 
        if (!val) return;
358
 
        pvalue(val) = 0; /* remove pointer to payload */
359
 
        delete_pvalue(val);
 
351
        NODE node=0;
 
352
        if (*pval) {
 
353
                PVALUE vl= *pval;
 
354
                node = pvalue_to_node(vl);
 
355
                pvalvv(vl) = 0; /* remove pointer to payload */
 
356
                delete_pvalue(vl);
 
357
        }
 
358
        *pval = 0;
 
359
        return node;
360
360
}
361
361
/*========================================
362
362
 * delete_pvalue -- Delete a program value
384
384
/*====================================
385
385
 * copy_pvalue -- Create a new pvalue & copy into it
386
386
 *  handles NULL
 
387
 * delegates all the real work to create_pvalue
387
388
 *==================================*/
388
389
PVALUE
389
390
copy_pvalue (PVALUE val)
390
391
{
391
392
        if (!val)
392
393
                return NULL;
393
 
        return create_pvalue(ptype(val), pvalue(val));
 
394
        return create_pvalue(ptype(val), pvalvv(val));
394
395
}
395
396
/*=====================================================
396
397
 * create_pvalue_from_indi -- Return indi as pvalue
400
401
PVALUE
401
402
create_pvalue_from_indi (NODE indi)
402
403
{
403
 
        CACHEEL cel = indi ? indi_to_cacheel_old(indi) : NULL;
404
 
        return create_pvalue(PINDI, cel);
 
404
        if (indi)
 
405
                return create_pvalue_from_indi_key(indi_to_key(indi));
 
406
        else
 
407
                return create_pvalue(PINDI, 0);
405
408
}
406
409
/*=====================================================
407
410
 * create_pvalue_from_indi_key
409
412
 * Created: 2000/12/30, Perry Rapp
410
413
 *===================================================*/
411
414
PVALUE
412
 
create_pvalue_from_indi_key (STRING key)
 
415
create_pvalue_from_indi_key (CNSTRING key)
413
416
{
414
417
        return create_pvalue_from_key_impl(key, PINDI);
415
418
}
416
419
/*=====================================================
 
420
 * create_pvalue_from_fam_key
 
421
 *  handles NULL
 
422
 *===================================================*/
 
423
PVALUE
 
424
create_pvalue_from_fam_key (STRING key)
 
425
{
 
426
        return create_pvalue_from_key_impl(key, PFAM);
 
427
}
 
428
/*=====================================================
417
429
 * create_pvalue_from_cel
418
430
 * Created: 2002/02/17, Perry Rapp
419
431
 *===================================================*/
420
432
PVALUE
421
 
create_pvalue_from_cel (CACHEEL cel)
 
433
create_pvalue_from_cel (INT type, CACHEEL cel)
422
434
{
423
 
        return create_pvalue(PINDI, cel);
 
435
        PVALUE val=0;
 
436
        RECORD rec = cel ? get_record_for_cel(cel) : 0;
 
437
        val = create_pvalue(type, rec);
 
438
        release_record(rec); /* ownership transferred to pvalue */
 
439
        return val;
424
440
}
425
441
/*=====================================================
426
442
 * create_pvalue_from_indi_keynum -- Return indi as pvalue
442
458
create_pvalue_from_fam (NODE fam)
443
459
{
444
460
        CACHEEL cel = fam ? fam_to_cacheel_old(fam) : NULL;
445
 
        return create_pvalue(PFAM, cel);
 
461
        return create_pvalue_from_cel(PFAM, cel);
446
462
}
447
463
/*====================================================
448
464
 * create_pvalue_from_fam_keynum -- Return indi as pvalue
485
501
/*=====================================================
486
502
 * create_pvalue_from_record -- Create pvalue from any node
487
503
 *  handles NULL
488
 
 * Created: 2001/03/20, Perry Rapp
 
504
 * If rec is not null, it is given to new pvalue to own
489
505
 *===================================================*/
490
506
static PVALUE
491
507
create_pvalue_from_record (RECORD rec, INT ptype)
492
508
{
493
 
        CACHEEL cel = rec ? record_to_cacheel(rec) : NULL;
494
 
        return create_pvalue(ptype, cel);
 
509
        /* record pvalues simply point to their heap-alloc'd record */
 
510
        return create_pvalue(ptype, rec);
495
511
}
496
512
/*====================================================
497
513
 * create_pvalue_from_keynum_impl -- Create pvalue for any type
523
539
static void
524
540
free_float_pvalue (PVALUE val)
525
541
{
526
 
        float *ptr = (float *)pvalue(val);
 
542
        float *ptr = (float *)pvalvv(val);
527
543
        stdfree(ptr);
528
544
}
529
545
/*==================================
531
547
 * Created: 2001/03/20, Perry Rapp
532
548
 *================================*/
533
549
static PVALUE
534
 
create_pvalue_from_key_impl (STRING key, INT ptype)
 
550
create_pvalue_from_key_impl (CNSTRING key, INT ptype)
535
551
{
536
552
        /* report mode, so may return NULL */
537
 
        RECORD rec = qkey_to_record(key);
 
553
        RECORD rec = qkey_to_record(key); /* addref'd record */
538
554
        PVALUE val = create_pvalue_from_record(rec, ptype);
 
555
        release_record(rec); /* release our reference, now only pvalue holds */
539
556
        return val;
540
557
}
541
558
/*==================================================
545
562
is_numeric_pvalue (PVALUE val)
546
563
{
547
564
        INT type = ptype(val);
548
 
        return type == PINT || type == PFLOAT || type == PANY;
 
565
        return type == PINT || type == PFLOAT || type == PNULL;
549
566
}
550
567
/*===========================================================
551
568
 * eq_conform_pvalues -- Make the types of two values conform
557
574
 
558
575
        ASSERT(val1 && val2);
559
576
        if (ptype(val1) == ptype(val2)) return;
560
 
        if (ptype(val1) == PANY && pvalue(val1) == NULL)
 
577
        if (ptype(val1) == PNULL)
561
578
                ptype(val1) = ptype(val2);
562
 
        if (ptype(val2) == PANY && pvalue(val2) == NULL)
 
579
        if (ptype(val2) == PNULL)
563
580
                ptype(val2) = ptype(val1);
564
581
        if (ptype(val1) == ptype(val2)) return;
565
 
        if (ptype(val1) == PINT && pvalue(val1) == 0 && !is_numeric_pvalue(val2))
 
582
        if (ptype(val1) == PINT && pvalue_to_int(val1) == 0 && !is_numeric_pvalue(val2))
566
583
                ptype(val1) = ptype(val2);
567
 
        if (ptype(val2) == PINT && pvalue(val2) == 0 && !is_numeric_pvalue(val1))
 
584
        if (ptype(val2) == PINT && pvalue_to_int(val2) == 0 && !is_numeric_pvalue(val1))
568
585
                ptype(val2) = ptype(val1);
569
586
        if (ptype(val1) == ptype(val2)) return;
570
587
        if (is_numeric_pvalue(val1) && is_numeric_pvalue(val2)) {
591
608
 
592
609
        if (type == PBOOL) {
593
610
                /* Anything is convertible to PBOOL */
594
 
                BOOLEAN boo = (pvalue(val) != NULL);
 
611
                BOOLEAN boo = (pvalvv(val) != NULL);
595
612
                set_pvalue_bool(val, boo);
596
613
                return;
597
614
        }
598
 
        /* Anything is convertible to PANY */
 
615
        /* Anything is convertible to PNULL */
599
616
        /* Perry, 2002.02.16: This looks suspicious to me, but I 
600
617
        don't know how it is used -- it might be used in some
601
618
        eq_conform_pvalues call(s) ? */
602
 
        if (type == PANY) {
603
 
                ptype(val) = PANY;
 
619
        if (type == PNULL) {
 
620
                ptype(val) = PNULL;
604
621
                return;
605
622
        }
606
623
 
607
 
        /* PANY or PINT with NULL (0) value is convertible to any scalar (1995.07.31) */
608
 
        if ((ptype(val) == PANY || ptype(val) == PINT) && pvalue(val) == NULL) {
 
624
        /* PNULL or PINT with NULL (0) value is convertible to any scalar (1995.07.31) */
 
625
        if (ptype(val) == PNULL || (ptype(val) == PINT && pvalue_to_int(val) == 0)) {
609
626
                if (type == PSET || type == PTABLE || type == PLIST) goto bad;
610
627
                /*
611
628
                  INTs convert to FLOATs numerically further down, no special 
669
686
                }
670
687
                break;
671
688
        /* Nothing else is convertible to anything else */
672
 
        /* record types (PINDI...), PANY, PGNODE */
 
689
        /* record types (PINDI...), PNULL, PGNODE */
673
690
        }
674
691
 
675
692
        /* fall through to failure */
693
710
BOOLEAN
694
711
is_record_pvalue (PVALUE value)
695
712
{
696
 
        switch (ptype(value)) {
 
713
        return is_record_pvaltype(ptype(value));
 
714
}
 
715
/*========================================
 
716
 * is_record_pvaltype -- Does pvalue contain record ?
 
717
 *======================================*/
 
718
static BOOLEAN
 
719
is_record_pvaltype (INT valtype)
 
720
{
 
721
        switch (valtype) {
697
722
        case PINDI: case PFAM: case PSOUR: case PEVEN: case POTHR:
698
723
                return TRUE;
699
724
        }
728
753
        BOOLEAN rel = FALSE;
729
754
        if(val1 && val2 && (ptype(val1) == ptype(val2))) {
730
755
                switch (ptype(val1)) {
 
756
                /* types with value semantics do value comparison */
731
757
                case PSTRING:
732
 
                        v1 = pvalue(val1);
733
 
                        v2 = pvalue(val2);
 
758
                        v1 = pvalue_to_string(val1);
 
759
                        v2 = pvalue_to_string(val2);
734
760
                        if(v1 && v2) rel = eqstr(v1, v2);
735
761
                        else rel = (v1 == v2);
736
762
                        break;
737
763
                case PFLOAT:
738
764
                        rel = (pvalue_to_float(val1) == pvalue_to_float(val2));
739
765
                        break;
 
766
                case PINT:
 
767
                        rel = (pvalue_to_int(val1) == pvalue_to_int(val2));
 
768
                        break;
 
769
                case PBOOL:
 
770
                        rel = (pvalue_to_bool(val1) == pvalue_to_bool(val2));
 
771
                        break;
 
772
                case PINDI: case PFAM: case PSOUR: case PEVEN: case POTHR:
 
773
                {
 
774
                    RECORD rec1,rec2;
 
775
                    rec1 = pvalue_to_record(val1);
 
776
                    rec2 = pvalue_to_record(val2);
 
777
                    if (rec1 && rec2) rel = eqstrn(nzkey(rec1),nzkey(rec2),MAXKEYWIDTH+1);
 
778
                    else rel = (rec1  == rec2);
 
779
                    break;
 
780
                 }
740
781
                /* for everything else, just compare value pointer */
741
782
                default:
742
 
                        rel = (pvalue(val1) == pvalue(val2));
 
783
                        rel = (pvalvv(val1) == pvalvv(val2));
743
784
                        break;
744
785
                }
745
786
        }
766
807
 * eq_pstrings -- Compare two PSTRINGS
767
808
 *  Caller is responsible for ensuring these are PSTRINGS
768
809
 *=============================================*/
 
810
/* unused
769
811
static BOOLEAN
770
812
eq_pstrings (PVALUE val1, PVALUE val2)
771
813
{
772
 
        STRING str1 = pvalue(val1), str2 = pvalue(val2);
 
814
        STRING str1 = pvalue_to_string(val1);
 
815
        STRING str2 = pvalue_to_string(val2);
773
816
        if (!str1) str1 = "";
774
817
        if (!str2) str2 = "";
775
818
        return eqstr(str1, str2);
776
819
}
 
820
unused */
777
821
/*===========================================
778
822
 * eq_pvalues -- See if two PVALUEs are equal
779
823
 * Result into val1, deletes val2
789
833
                bad_type_error("eq", zerr, val1, val2);
790
834
                return;
791
835
        }
792
 
        switch (ptype(val1)) {
793
 
        case PSTRING:
794
 
                rel = eq_pstrings(val1, val2);
795
 
                break;
796
 
        case PFLOAT:
797
 
                rel = (pvalue_to_float(val1) == pvalue_to_float(val2));
798
 
                break;
799
 
                /* for everything else, just compare value pointer */
800
 
        default:
801
 
                rel = (pvalue(val1) == pvalue(val2));
802
 
                break;
803
 
        }
 
836
        rel = eqv_pvalues(val1, val2);
 
837
 
 
838
        /* Now store answer into val1, and delete val2 */
804
839
        set_pvalue_bool(val1, rel);
805
840
        delete_pvalue(val2);
806
841
}
819
854
                bad_type_error("ne", zerr, val1, val2);
820
855
                return;
821
856
        }
822
 
        switch (ptype(val1)) {
823
 
        case PSTRING:
824
 
                rel = !eq_pstrings(val1, val2);
825
 
                break;
826
 
        case PFLOAT:
827
 
                rel = (pvalue_to_float(val1) != pvalue_to_float(val2));
828
 
                break;
829
 
        default:
830
 
                rel = (pvalue(val1) != pvalue(val2));
831
 
                break;
832
 
        }
 
857
        rel = !eqv_pvalues(val1, val2);
 
858
 
 
859
        /* Now store answer into val1, and delete val2 */
833
860
        set_pvalue_bool(val1, rel);
834
861
        delete_pvalue(val2);
835
862
}
843
870
        llwprintf(zs_str(zstr));
844
871
        zs_free(&zstr);
845
872
}
 
873
/*=================================================
 
874
 * get_pvalue_type_name -- Return static string name of pvalue type
 
875
 *  eg, get_pvalue_type_name(PTABLE) => "PTABLE"
 
876
 *===============================================*/
 
877
CNSTRING
 
878
get_pvalue_type_name (INT ptype)
 
879
{
 
880
        if (ptype >= 0 && ptype <= ARRSIZE(ptypes)) {
 
881
                return ptypes[ptype];
 
882
        } else {
 
883
                return "INVALID ptype";
 
884
        }
 
885
}
846
886
/*======================================================
847
887
 * debug_pvalue_as_string -- DEBUG routine that shows a PVALUE
848
888
 *  returns static buffer
863
903
        }
864
904
        type = ptype(val);
865
905
        zs_appc(zstr, '<');
866
 
        zs_apps(zstr, ptypes[type]);
 
906
        zs_apps(zstr, get_pvalue_type_name(type));
867
907
        zs_appc(zstr, ',');
868
 
        if (pvalue(val) == NULL) {
 
908
        if (pvalvv(val) == NULL) {
869
909
                zs_apps(zstr, "NULL>");
870
910
                return zstr;
871
911
        }
880
920
                zs_appf(zstr, "\"%s\"", pvalue_to_string(val));
881
921
                break;
882
922
        case PINDI:
 
923
        case PFAM:
 
924
        case PSOUR:
 
925
        case PEVEN:
 
926
        case POTHR:
883
927
                {
884
 
                        NODE node;
885
 
                        CACHEEL cel = (CACHEEL) pvalue(val);
886
 
                        STRING nam;
887
 
                        if (!cnode(cel))
888
 
                                cel = key_to_indi_cacheel(ckey(cel));
889
 
                node = cnode(cel);
890
 
                        node = NAME(node);
891
 
                        nam = node ? nval(node) : _("{NoName}");
892
 
                        zs_appf(zstr, nam);
 
928
                        RECORD rec = pvalue_to_record(val);
 
929
                        if (rec)
 
930
                                zs_appf(zstr, nzkey(rec));
 
931
                        else
 
932
                                zs_appf(zstr, "NULL");
893
933
                }
894
934
                break;
895
935
        case PLIST:
913
953
                        zs_appf(zstr, _pl("%d record", "%d records", n), n);
914
954
                }
915
955
                break;
 
956
        case PARRAY:
 
957
                {
 
958
                        ARRAY arr = pvalue_to_array(val);
 
959
                        INT n = get_array_size(arr);
 
960
                        zs_appf(zstr, _pl("%d element", "%d elements", n), n);
 
961
                }
 
962
                break;
916
963
        default:
917
 
                zs_appf(zstr, "%p", pvalue(val));
 
964
                zs_appf(zstr, "%p", pvalvv(val));
918
965
                break;
919
966
        }
920
967
        zs_appc(zstr, '>');
921
968
        return zstr;
922
969
}
923
970
/*==================================
924
 
 * PANY: pvalue with no content
 
971
 * PNULL: pvalue with no content
925
972
 *================================*/
926
973
PVALUE
927
974
create_pvalue_any (void)
928
975
{
929
 
        return create_pvalue(PANY, NULL);
 
976
        return create_pvalue(PNULL, NULL);
930
977
}
931
978
/*==================================
932
 
 * PBOOL: pvalue containing a boolean
 
979
 * PINT: pvalue containing an int
933
980
 *================================*/
934
981
PVALUE
935
 
create_pvalue_from_bool (BOOLEAN bval)
 
982
create_pvalue_from_int (INT ival)
936
983
{
937
 
        return create_pvalue_from_int(bval);
 
984
        return create_pvalue(PINT, (VPTR) ival);
938
985
}
939
986
void
940
 
set_pvalue_bool (PVALUE val, BOOLEAN bnum)
 
987
set_pvalue_int (PVALUE val, INT inum)
941
988
{
942
 
        set_pvalue(val, PBOOL, (VPTR)bnum);
 
989
        set_pvalue(val, PINT, (VPTR)inum);
943
990
}
944
 
BOOLEAN
945
 
pvalue_to_bool (PVALUE val)
 
991
INT
 
992
pvalue_to_int (PVALUE val)
946
993
{
947
 
        return (BOOLEAN)pvalue(val);
 
994
        return (INT)pvalvv(val);
948
995
}
949
996
/*==================================
950
997
 * PFLOAT: pvalue containing a float
965
1012
pvalue_to_float (PVALUE val)
966
1013
{
967
1014
        /* TODO: change when ptag goes to UNION */
968
 
        return *(float*)pvalue(val);
969
 
}
970
 
float*
971
 
pvalue_to_pfloat (PVALUE val)
972
 
{
973
 
        /* convenience for math */
974
 
        /* TODO: change when ptag goes to UNION */
975
 
        return (float*)pvalue(val);
 
1015
        return *(float*)pvalvv(val);
 
1016
}
 
1017
/*==================================
 
1018
 * PBOOL: pvalue containing a boolean
 
1019
 *================================*/
 
1020
PVALUE
 
1021
create_pvalue_from_bool (BOOLEAN bval)
 
1022
{
 
1023
        return create_pvalue_from_int(bval);
 
1024
}
 
1025
void
 
1026
set_pvalue_bool (PVALUE val, BOOLEAN bnum)
 
1027
{
 
1028
        set_pvalue(val, PBOOL, (VPTR)bnum);
 
1029
}
 
1030
BOOLEAN
 
1031
pvalue_to_bool (PVALUE val)
 
1032
{
 
1033
        return (BOOLEAN)pvalvv(val);
 
1034
}
 
1035
/*==================================
 
1036
 * PSTRING: pvalue containing a string
 
1037
 *================================*/
 
1038
PVALUE
 
1039
create_pvalue_from_string (CNSTRING str)
 
1040
{
 
1041
        return create_pvalue(PSTRING, (VPTR)str);
 
1042
}
 
1043
void
 
1044
set_pvalue_string (PVALUE val, CNSTRING str)
 
1045
{
 
1046
        set_pvalue(val, PSTRING, (VPTR)str); /* makes new copy of string */
 
1047
}
 
1048
STRING
 
1049
pvalue_to_string (PVALUE val)
 
1050
{
 
1051
        return (STRING)pvalvv(val);
976
1052
}
977
1053
/*==================================
978
1054
 * PGNODE: pvalue containing a GEDCOM node
990
1066
NODE
991
1067
pvalue_to_node (PVALUE val)
992
1068
{
993
 
        return (NODE)pvalue(val);
994
 
}
995
 
/*==================================
996
 
 * PINT: pvalue containing an int
997
 
 *================================*/
998
 
PVALUE
999
 
create_pvalue_from_int (INT ival)
1000
 
{
1001
 
        return create_pvalue(PINT, (VPTR) ival);
1002
 
}
1003
 
void
1004
 
set_pvalue_int (PVALUE val, INT inum)
1005
 
{
1006
 
        set_pvalue(val, PINT, (VPTR)inum);
1007
 
}
1008
 
INT
1009
 
pvalue_to_int (PVALUE val)
1010
 
{
1011
 
        return (INT)pvalue(val);
1012
 
}
1013
 
INT*
1014
 
pvalue_to_pint (PVALUE val)
1015
 
{
1016
 
        /* convenience for math */
1017
 
        return (INT *)&pvalue(val);
1018
 
}
1019
 
/*==================================
1020
 
 * ARRAY: pvalue containing an array
1021
 
 *================================*/
1022
 
ARRAY
1023
 
pvalue_to_array (PVALUE val)
1024
 
{
1025
 
        return (ARRAY)pvalue(val);
1026
 
}
1027
 
/*==================================
1028
 
 * LIST: pvalue containing a list
1029
 
 *================================*/
1030
 
LIST
1031
 
pvalue_to_list (PVALUE val)
1032
 
{
1033
 
        return (LIST)pvalue(val);
 
1069
        return (NODE)pvalvv(val);
1034
1070
}
1035
1071
/*==================================
1036
1072
 * record pvalues (PINDI, PFAM, ...)
1037
1073
 *================================*/
 
1074
RECORD
 
1075
pvalue_to_record (PVALUE val)
 
1076
{
 
1077
        RECORD rec = pvalvv(val); /* may be NULL */
 
1078
        ASSERT(is_record_pvalue(val));
 
1079
        return rec;
 
1080
}
1038
1081
CACHEEL
1039
1082
pvalue_to_cel (PVALUE val)
1040
1083
{
1041
 
        /* also load record into direct cache */
1042
 
        CACHEEL cel = pvalue(val); /* may be NULL */
1043
 
        ASSERT(is_record_pvalue(val));
1044
 
        load_cacheel(cel); /* handles null cel ok */
 
1084
        RECORD rec = pvalue_to_record(val);
 
1085
        NODE root = nztop(rec); /* force record into cache */
 
1086
        CACHEEL cel = nzcel(rec);
 
1087
        root = root;    /* NOTUSED */
1045
1088
        return cel;
1046
1089
}
1047
 
RECORD
1048
 
pvalue_to_rec (PVALUE val)
1049
 
{
1050
 
        CACHEEL cel = pvalue_to_cel(val);
1051
 
        if (!cel) return NULL;
1052
 
        return crecord(cel);
 
1090
/*==================================
 
1091
 * LIST: pvalue containing a list
 
1092
 *================================*/
 
1093
PVALUE
 
1094
create_pvalue_from_list (LIST list)
 
1095
{
 
1096
        return create_pvalue(PLIST, list);
 
1097
}
 
1098
LIST
 
1099
pvalue_to_list (PVALUE val)
 
1100
{
 
1101
        return (LIST)pvalvv(val);
 
1102
}
 
1103
/*==================================
 
1104
 * TABLE: pvalue containing a table
 
1105
 *================================*/
 
1106
PVALUE
 
1107
create_pvalue_from_table (TABLE tab)
 
1108
{
 
1109
        return create_pvalue(PTABLE, tab);
 
1110
}
 
1111
TABLE
 
1112
pvalue_to_table (PVALUE val)
 
1113
{
 
1114
        return (TABLE)pvalvv(val);
1053
1115
}
1054
1116
/*==================================
1055
1117
 * PSET: pvalue containing a set (INDISEQ)
1056
1118
 *================================*/
1057
1119
PVALUE
1058
 
create_pvalue_from_set (INDISEQ seq)
 
1120
create_pvalue_from_seq (INDISEQ seq)
1059
1121
{
1060
1122
        return create_pvalue(PSET, seq);
1061
1123
}
 
1124
void
 
1125
set_pvalue_seq (PVALUE val, INDISEQ seq)
 
1126
{
 
1127
        set_pvalue(val, PSET, (VPTR)seq);
 
1128
}
1062
1129
INDISEQ
1063
1130
pvalue_to_seq (PVALUE val)
1064
1131
{
1065
 
        return (INDISEQ)pvalue(val);
 
1132
        return (INDISEQ)pvalvv(val);
1066
1133
}
1067
1134
/*==================================
1068
 
 * PSTRING: pvalue containing a string
 
1135
 * ARRAY: pvalue containing an array
1069
1136
 *================================*/
1070
 
PVALUE
1071
 
create_pvalue_from_string (CNSTRING str)
1072
 
{
1073
 
        return create_pvalue(PSTRING, (VPTR)str);
1074
 
}
1075
 
void
1076
 
set_pvalue_string (PVALUE val, CNSTRING str)
1077
 
{
1078
 
        set_pvalue(val, PSTRING, (VPTR)str); /* makes new copy of string */
1079
 
}
1080
 
STRING
1081
 
pvalue_to_string (PVALUE val)
1082
 
{
1083
 
        return (STRING)pvalue(val);
1084
 
}
1085
 
TABLE
1086
 
pvalue_to_table (PVALUE val)
1087
 
{
1088
 
        return (TABLE)pvalue(val);
 
1137
ARRAY
 
1138
pvalue_to_array (PVALUE val)
 
1139
{
 
1140
        return (ARRAY)pvalvv(val);
1089
1141
}
1090
1142
/*========================================
1091
1143
 * init_pvalue_vtable -- set vtable (for allocator in pvalalloc.c)
1143
1195
        }
1144
1196
        return 0; /* TODO: what about other types ? */
1145
1197
}
1146
 
 
 
1198
/*=============================================
 
1199
 * create_new_pvalue_table -- Create new table inside new pvalue
 
1200
 *============================================*/
 
1201
PVALUE
 
1202
create_new_pvalue_table (void)
 
1203
{
 
1204
        TABLE tab = create_table_custom_vptr(delete_vptr_pvalue);
 
1205
        PVALUE val = create_pvalue_from_table(tab);
 
1206
        release_table(tab);
 
1207
        return val;
 
1208
}
 
1209
/*=============================================
 
1210
 * create_new_pvalue_list -- Create new list inside new pvalue
 
1211
 *============================================*/
 
1212
PVALUE
 
1213
create_new_pvalue_list (void)
 
1214
{
 
1215
        LIST list = create_list3(delete_vptr_pvalue);
 
1216
        PVALUE val = create_pvalue_from_list(list);
 
1217
        release_list(list); /* release our ref to list */
 
1218
        return val;
 
1219
}
 
1220
/*=============================================
 
1221
 * set_pvalue_to_pvalue -- Set val to be same value as src
 
1222
 *============================================*/
 
1223
void
 
1224
set_pvalue_to_pvalue (PVALUE val, const PVALUE src)
 
1225
{
 
1226
        set_pvalue(val, ptype(src), pvalvv(src));
 
1227
}