/*================================================+
* 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_newfile -- Switch output to new file
* usage: newfile(STRING, BOOL) -> VOID
*=====================================*/
PVALUE
llrpt_newfile (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
PNODE argvar = builtin_args(node);
BOOLEAN aflag=FALSE;
STRING name=0;
PVALUE val = eval_and_coerce(PSTRING, argvar, stab, eflg);
if (*eflg) {
prog_var_error(node, stab, argvar, val, nonstrx, "newfile", "1");
delete_pvalue_ptr(&val);
return NULL;
}
name = pvalue_to_string(val);
if (!name || !name[0]) {
*eflg = TRUE;
prog_var_error(node, stab, argvar, val, "1st arg to newfile must be a nonempty string.");
delete_pvalue_ptr(&val);
return NULL;
}
strupdate(&outfilename, name);
delete_pvalue_ptr(&val);
val = eval_and_coerce(PBOOL, argvar=inext(argvar), stab, eflg);
if (*eflg) {
prog_var_error(node, stab, argvar, val, nonboox, "newfile", "2");
delete_pvalue_ptr(&val);
return NULL;
}
aflag = pvalue_to_bool(val);
delete_pvalue_ptr(&val);
if (!set_output_file(outfilename, aflag)) {
*eflg = TRUE;
prog_var_error(node, stab, argvar, NULL, "Failed to open output file: %s", outfilename);
}
return NULL;
}
/*===============================================+
* 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_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);
}
/*===========================================+
* 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;
}
/*==============================================
* num_params -- Return number of params in list
*============================================*/
INT
num_params (PNODE node)
{
INT np = 0;
while (node) {
np++;
node = inext(node);
}
return np;
}
/*==================================+
* 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_pagemode -- Switch output to page mode
* usage: pagemode(INT, INT) -> VOID
*======================================*/
PVALUE
llrpt_pagemode (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
INT cols=0, rows=0;
PNODE argvar = builtin_args(node);
PVALUE val = eval_and_coerce(PINT, argvar, stab, eflg);
if (*eflg) {
prog_var_error(node, stab, argvar, val, nonintx, "pagemode", "1");
delete_pvalue_ptr(&val);
return NULL;
}
rows = pvalue_to_int(val);
delete_pvalue_ptr(&val);
val = eval_and_coerce(PINT, argvar=inext(argvar), stab, eflg);
if (*eflg) {
prog_var_error(node, stab, argvar, val, nonintx, "pagemode", "2");
delete_pvalue_ptr(&val);
return NULL;
}
cols = pvalue_to_int(val);
delete_pvalue_ptr(&val);
*eflg = TRUE;
if (!(cols >= 1 && cols <= MAXCOLS)) {
*eflg = TRUE;
prog_var_error(node, stab, argvar, val, badargx, "pagemode", "1");
return NULL;
}
if (!(rows >= 1 && rows <= MAXROWS)) {
*eflg = TRUE;
prog_var_error(node, stab, argvar, val, badargx, "pagemode", "2");
return NULL;
}
*eflg = FALSE;
outputmode = PAGEMODE;
__rows = rows;
__cols = cols;
if (pagebuffer) stdfree(pagebuffer);
pagebuffer = (STRING) stdalloc(__rows*__cols);
memset(pagebuffer, ' ', __rows*__cols);
return NULL;
}
/*===============================================+
* llrpt_pos -- Position page output to row and column
* usage: pos(INT, INT) -> VOID
*==============================================*/
PVALUE
llrpt_pos (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
INT col=0, row=0;
PNODE argvar = builtin_args(node);
PVALUE val = eval_and_coerce(PINT, argvar, stab, eflg);
if (*eflg) {
prog_var_error(node, stab, argvar, val, nonintx, "pos", "1");
delete_pvalue_ptr(&val);
return NULL;
}
row = pvalue_to_int(val);
if (row < 1 || row > __rows) {
*eflg = TRUE;
prog_var_error(node, stab, argvar, val, badargx, "pos", "1");
return NULL;
}
delete_pvalue_ptr(&val);
val = eval_and_coerce(PINT, argvar=inext(argvar), stab, eflg);
if (*eflg) {
prog_var_error(node, stab, argvar, val, nonintx, "pos", "2");
delete_pvalue_ptr(&val);
return NULL;
}
col = pvalue_to_int(val);
if (col < 1 || col > __cols) {
*eflg = TRUE;
prog_var_error(node, stab, argvar, val, badargx, "pos", "2");
return NULL;
}
delete_pvalue_ptr(&val);
if (outputmode != PAGEMODE) {
*eflg = TRUE;
prog_var_error(node, stab, NULL, val, "pos only valid in page mode");
return NULL;
}
currow = row;
curcol = col;
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;
}