/*===================================== * llrpt_createnode -- Create GEDCOM node * usage: createnode(STRING, STRING) -> NODE * args: (tag, value) *===================================*/ PVALUE llrpt_createnode (PNODE node, SYMTAB stab, BOOLEAN *eflg) { PNODE arg = iargs(node); NODE newnode=0; NODE prnt=NULL; /* parent node for new node */ STRING xref=NULL; /* xref for new node */ PVALUE val1=NULL, val2=NULL; STRING str1=NULL; /* 1st arg, which is tag for new node */ STRING str2=NULL; /* 2nd arg, which is value for new node */ val1 = eval_and_coerce(PSTRING, arg, stab, eflg); if (*eflg) { prog_var_error(node, stab, arg, val1, nonstrx, "createnode", "1"); delete_pvalue(val1); return NULL; } /* 1st arg is tag for new node */ str1 = pvalue_to_string(val1); val2 = eval_and_coerce(PSTRING, arg=inext(arg), stab, eflg); if (*eflg) { prog_var_error(node, stab, arg, val2, nonstrx, "createnode", "2"); delete_pvalue(val2); return NULL; } /* 2nd arg is value for new node */ str2 = pvalue_to_string(val2); newnode = create_temp_node(xref, str1, str2, prnt); return create_pvalue_from_node(newnode); }
/*================================================+ * evaluate_cond -- Evaluate conditional expression *===============================================*/ BOOLEAN evaluate_cond (PNODE node, SYMTAB stab, BOOLEAN *eflg) { PVALUE val; BOOLEAN rc; PNODE var = node, expr = inext(node); if (!expr) { expr = var; var = NULL; } if (var && !iistype(var, IIDENT)) { *eflg = TRUE; prog_error(node, "1st arg in conditional must be variable"); return FALSE; } val = evaluate(expr, stab, eflg); if (*eflg || !val) { *eflg = TRUE; prog_error(node, "error in conditional expression"); return FALSE; } #ifdef DEBUG llwprintf("interp_if: cond = "); show_pvalue(val); wprintf("\n"); #endif if (var) assign_iden(stab, iident(node), copy_pvalue(val)); coerce_pvalue(PBOOL, val, eflg); rc = pvalue_to_bool(val); delete_pvalue(val); return rc; }
/*===============================================+ * llrpt_difference -- Create difference of two INDISEQs * usage: difference(SET, SET) -> SET *==============================================*/ PVALUE llrpt_difference (PNODE node, SYMTAB stab, BOOLEAN *eflg) { PNODE arg1 = builtin_args(node); PNODE arg2 = inext(arg1); INDISEQ op2=0, op1=0; PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg); PVALUE val2=0; if (*eflg) { prog_var_error(node, stab, arg1, val1, nonsetx, "difference", "1"); return NULL; } /* NULL indiseqs are possible, because of getindiset */ op1 = pvalue_to_seq(val1); val2 = eval_and_coerce(PSET, arg2, stab, eflg); if (*eflg) { prog_var_error(node, stab, arg2, val2, nonsetx, "difference", "2"); return NULL; } op2 = pvalue_to_seq(val2); /* do actual difference */ op2 = difference_indiseq(op1, op2); set_pvalue_seq(val1, op2); /* delay to last minute lest it is a temp owning seq, eg, difference(ancestorset(i),ancestorset(j)) */ delete_pvalue(val2); return val1; }
/*============================================ * llrpt_detachnode -- Remove node from GEDCOM tree * usage: detachnode(NODE) -> VOID * (This is the historic deletenode) *==========================================*/ PVALUE llrpt_detachnode (PNODE node, SYMTAB stab, BOOLEAN *eflg) { PNODE arg = iargs(node); NODE dead, prnt; PVALUE val = eval_and_coerce(PGNODE, arg, stab, eflg); if (*eflg) { prog_var_error(node, stab, arg, val, nonnod1, "detachnode"); delete_pvalue(val); return NULL; } dead = pvalue_to_node(val); if ((prnt = nparent(dead))) { NODE prev = NULL, next; NODE curs = nchild(prnt); while (curs && curs != dead) { prev = curs; curs = nsibling(curs); } ASSERT(curs); /* else broken tree: dead was not child of its parent */ next = nsibling(dead); if (prev == NULL) nchild(prnt) = next; else nsibling(prev) = next; } /* unparent node, but ensure its locking is only releative to new parent */ dolock_node_in_cache(dead, FALSE); nparent(dead) = NULL; dolock_node_in_cache(dead, TRUE); nsibling(dead) = NULL; /* we don't actually delete the node, garbage collection must get it */ return NULL; }
/*=====================================+ * pvseq_delete_value -- Delete a PVALUE in an INDISEQ * Created: 2001/03/25, Perry Rapp *====================================*/ static void pvseq_delete_value (UNION uval, INT valtype) { PVALUE val = (PVALUE)uval.w; ASSERT(valtype == ISVAL_PTR || valtype == ISVAL_NUL); ASSERT(is_pvalue(val) || !val); delete_pvalue(val); }
/*===========================================+ * llrpt_deletefromset -- Remove person from INDISEQ * usage: deletefromset(SET, INDI, BOOL) -> VOID *==========================================*/ PVALUE llrpt_deletefromset (PNODE node, SYMTAB stab, BOOLEAN *eflg) { NODE indi; STRING key=0; BOOLEAN all, rc; INDISEQ seq; PNODE arg1 = builtin_args(node), arg2 = inext(arg1), arg3 = inext(arg2); PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg); PVALUE val3=0; if (*eflg) { prog_var_error(node, stab, arg1, val1, nonsetx, "deletefromset", "1"); goto dfs_exit; } ASSERT(seq = pvalue_to_seq(val1)); indi = eval_indi(arg2, stab, eflg, NULL); if (*eflg) { prog_var_error(node, stab, arg2, NULL, nonindx, "deletefromset", "2"); goto dfs_exit; } if (!indi) goto dfs_exit; *eflg = TRUE; if (!(key = strsave(rmvat(nxref(indi))))) { prog_error(node, "major error in deletefromset."); goto dfs_exit; } *eflg = FALSE; val3 = eval_and_coerce(PBOOL, arg3, stab, eflg); if (*eflg) { prog_var_error(node, stab, arg2, NULL, nonboox, "deletefromset", "3"); goto dfs_exit; } all = pvalue_to_bool(val3); delete_pvalue(val3); do { rc = delete_indiseq(seq, key, NULL, 0); } while (rc && all); dfs_exit: /* delay delete of val1 to last minute lest it is a temp owning seq, eg, deletefromset(ancestorset(i),j) */ if (val1) delete_pvalue(val1); if (key) strfree(&key); return NULL; }
/*================================================= * eval_without_coerce -- Generic evaluator * node: [IN] node to coerce * stab: [IN] symbol table * eflg: [OUT] error flag * Created: 2001/12/24, Perry Rapp *===============================================*/ PVALUE eval_without_coerce (PNODE node, SYMTAB stab, BOOLEAN *eflg) { PVALUE val; if (*eflg) return NULL; val = evaluate(node, stab, eflg); if (*eflg || !val) { *eflg = TRUE; if (val) { delete_pvalue(val); val=NULL; } return NULL; } return val; }
/*===================================================+ * llrpt_gengedcomstrong -- Generate GEDCOM output from an INDISEQ * usage: gengedcom(SET) -> VOID * Perry 2000/11/03 *==================================================*/ PVALUE llrpt_gengedcomstrong (PNODE node, SYMTAB stab, BOOLEAN *eflg) { INDISEQ seq=0; PNODE arg1 = builtin_args(node); PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg); if (*eflg) { prog_var_error(node, stab, arg1, val1, nonset1, "gengedcomstrong"); return NULL; } ASSERT(seq = pvalue_to_seq(val1)); gen_gedcom(seq, GENGEDCOM_STRONG_DUMP, eflg); /* delay to last minute lest it is a temp owning seq, eg, gengedcom(ancestorset(i)) */ delete_pvalue(val1); return NULL; }
/*=========================================+ * llrpt_uniqueset -- Eliminate dupes from INDISEQ * usage: uniqueset(SET) -> VOID *========================================*/ PVALUE llrpt_uniqueset (PNODE node, SYMTAB stab, BOOLEAN *eflg) { INDISEQ seq=0; PNODE arg1 = builtin_args(node); PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg); if (*eflg) { prog_var_error(node, stab, arg1, val1, nonset1, "uniqueset"); return NULL; } ASSERT(seq = pvalue_to_seq(val1)); unique_indiseq(seq); /* delay to last minute lest it is a temp owning seq, eg, uniqueset(ancestorset(i) */ delete_pvalue(val1); return NULL; }
/*=================================== * llrpt_valuesort -- Sort INDISEQ by value * usage: valuesort(SET) -> VOID *=================================*/ PVALUE llrpt_valuesort (PNODE node, SYMTAB stab, BOOLEAN *eflg) { INDISEQ seq; PNODE arg1 = builtin_args(node); PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg); if (*eflg) { prog_var_error(node, stab, arg1, val1, nonset1, "valuesort"); return NULL; } ASSERT(seq = pvalue_to_seq(val1)); valuesort_indiseq(seq,eflg); if (*eflg) { prog_error(node, _("missing or incorrect value for sort")); return NULL; } /* delay to last minute lest it is a temp owning seq, eg, valuesort(ancestorset(i) */ delete_pvalue(val1); return NULL; }
/*==================================+ * llrpt_addtoset -- Add person to INDISEQ * usage: addtoset(SET, INDI, ANY) -> VOID *=================================*/ PVALUE llrpt_addtoset (PNODE node, SYMTAB stab, BOOLEAN *eflg) { NODE indi=0; STRING key=0; INDISEQ seq=0; PNODE arg1 = builtin_args(node), arg2 = inext(arg1), arg3 = inext(arg2); PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg); PVALUE val2=0; if (*eflg) { prog_var_error(node, stab, arg1, val1, nonsetx, "addtoset", "1"); return NULL; } ASSERT(seq = pvalue_to_seq(val1)); indi = eval_indi(arg2, stab, eflg, NULL); if (*eflg) { prog_var_error(node, stab, arg2, NULL, nonindx, "addtoset","2"); goto ats_exit; } if (!indi) goto ats_exit; *eflg = TRUE; if (!(key = strsave(rmvat(nxref(indi))))) { prog_error(node, "major error in addtoset."); goto ats_exit; } *eflg = FALSE; val2 = evaluate(arg3, stab, eflg); if (*eflg) { prog_error(node, "3rd arg to addtoset is in error."); goto ats_exit; } append_indiseq_pval(seq, key, NULL, val2, FALSE); ats_exit: if (key) strfree(&key); /* append made its own copy */ /* delay to last minute val1 cleanup lest it is a temp owning seq, eg, addtoset(ancestorset(i),j) */ if (val1) delete_pvalue(val1); return NULL; }
/*====================================+ * llrpt_inset -- See if person is in INDISEQ * usage: inset(SET, INDI) -> BOOL *==========================================*/ PVALUE llrpt_inset (PNODE node, SYMTAB stab, BOOLEAN *eflg) { NODE indi; STRING key=0; INDISEQ seq; BOOLEAN rel; PNODE arg1 = builtin_args(node), arg2 = inext(arg1); PVALUE val1 = eval_and_coerce(PSET, arg1, stab, eflg); PVALUE valr=0; if (*eflg ||!val1 || !(seq = pvalue_to_seq(val1))) { *eflg = TRUE; prog_var_error(node, stab, arg1, val1, nonsetx, "inset", "1"); goto inset_exit; } indi = eval_indi(arg2, stab, eflg, NULL); if (*eflg) { prog_var_error(node, stab, arg2, NULL, nonindx, "inset", "2"); goto inset_exit; } if (!indi) { rel = FALSE; } else { if (!(key = strsave(rmvat(nxref(indi))))) { *eflg = TRUE; prog_error(node, "major error in inset."); goto inset_exit; } rel = in_indiseq(seq, key); } valr = create_pvalue_from_bool(rel); inset_exit: /* delay delete of val1 to last minute lest it is a temp owning seq, eg, inset(ancestorset(i),j) */ if (val1) delete_pvalue(val1); if (key) strfree(&key); return valr; }
/*================================================+ * evaluate_ufunc -- Evaluate user defined function * node: [in] parsed node of function definition * stab: [in] function's symbol table * eflg: [out] error flag *===============================================*/ PVALUE evaluate_ufunc (PNODE node, SYMTAB stab, BOOLEAN *eflg) { STRING procname = (STRING) iname(node); PNODE func, arg, parm; SYMTAB newstab = NULL; PVALUE val=NULL; INTERPTYPE irc; INT count=0; *eflg = TRUE; /* find func in local or global table */ func = get_proc_node(procname, irptinfo(node)->functab, gfunctab, &count); if (!func) { if (!count) prog_error(node, _("Undefined func: %s"), procname); else prog_error(node, _("Ambiguous call to func: %s"), procname); goto ufunc_leave; } newstab = create_symtab_proc(procname, stab); arg = (PNODE) iargs(node); parm = (PNODE) iargs(func); while (arg && parm) { BOOLEAN eflg=TRUE; PVALUE value = evaluate(arg, stab, &eflg); if (eflg) { if (getlloptint("FullReportCallStack", 0) > 0) prog_error(node, "In user function %s()", procname); return INTERROR; } insert_symtab(newstab, iident(parm), value); arg = inext(arg); parm = inext(parm); } if (arg || parm) { prog_error(node, "``%s'': mismatched args and params\n", procname); goto ufunc_leave; } irc = interpret((PNODE) ibody(func), newstab, &val); switch (irc) { case INTRETURN: case INTOKAY: #ifdef DEBUG llwprintf("Successful ufunc call -- val returned was "); show_pvalue(val); llwprintf("\n"); #endif *eflg = FALSE; goto ufunc_leave; case INTBREAK: case INTCONTINUE: case INTERROR: break; } if (getlloptint("FullReportCallStack", 0) > 0) prog_error(node, "In user function %s()", procname); *eflg = TRUE; delete_pvalue(val); val=NULL; ufunc_leave: if (newstab) { remove_symtab(newstab); newstab = NULL; } return val; }
/*======================================= * llrpt_addnode -- Add a node to a GEDCOM tree * usage: addnode(NODE, NODE, NODE) -> VOID * args: (node being added, parent, previous child) *=====================================*/ PVALUE llrpt_addnode (PNODE node, SYMTAB stab, BOOLEAN *eflg) { PNODE arg = iargs(node); NODE newchild, next, prnt, prev; /* first argument, node (must be nonnull) */ PVALUE val = eval_and_coerce(PGNODE, arg, stab, eflg); if (*eflg) { prog_var_error(node, stab, arg, val, nonnodx, "addnode", "1"); delete_pvalue(val); return NULL; } newchild = remove_node_and_delete_pvalue(&val); if (!newchild) { prog_var_error(node, stab, arg, val, nonnodx, "addnode", "1"); return NULL; } /* second argument, parent (must be nonnull) */ val = eval_and_coerce(PGNODE, arg=inext(arg), stab, eflg); if (*eflg) { prog_var_error(node, stab, arg, val, nonnodx, "addnode", "2"); return NULL; } prnt = remove_node_and_delete_pvalue(&val); if (!prnt) { prog_var_error(node, stab, arg, val, nonnodx, "addnode", "2"); return NULL; } /* third argument, prior sibling (may be null) */ val = eval_and_coerce(PGNODE, arg=inext(arg), stab, eflg); if (*eflg) { prog_var_error(node, stab, arg, val, nonnodx, "addnode", "3"); delete_pvalue(val); return NULL; } prev = remove_node_and_delete_pvalue(&val); if (prev) { /* Check that previous sibling actually is child of new parent */ if (prnt != nparent(prev)) { prog_error(node, "2nd arg to addnode must be parent of 3rd arg"); *eflg = 1; return NULL; } } /* reparent node, but ensure its locking is only relative to new parent */ dolock_node_in_cache(newchild, FALSE); nparent(newchild) = prnt; newchild->n_cel = prnt->n_cel; set_temp_node(newchild, is_temp_node(prnt)); dolock_node_in_cache(newchild, TRUE); if (prev == NULL) { next = nchild(prnt); nchild(prnt) = newchild; } else { next = nsibling(prev); nsibling(prev) = newchild; } nsibling(newchild) = next; return NULL; }