void
ifcmd(u_char *command, u_char *args, u_char *subargs)
{
u_char *expr;
u_char *sub;
int flag = 0;
int result;
if (!(expr = next_expr(&args, '(')))
{
yell("Missing CONDITION in IF");
return;
}
sub = parse_inline(expr, subargs ? subargs : empty_string(), &flag);
if (get_int_var(DEBUG_VAR) & DEBUG_EXPANSIONS)
yell("If expression expands to: (%s)", sub);
if (!*sub || *sub == '0')
result = 0;
else
result = 1;
new_free(&sub);
if (!(expr = next_expr(&args, '{')))
{
yell("Missing THEN portion in IF");
return;
}
if (!result && !(expr = next_expr(&args, '{')))
return;
parse_line(NULL, expr, subargs ? subargs : empty_string(), 0, 0, 0);
return;
}
void
fec(u_char *command, u_char *args, u_char *subargs)
{
u_char *pointer;
u_char *list = NULL;
u_char *var = NULL;
u_char stuff[2];
int args_flag = 0;
unsigned display;
u_char *sa, *todo;
list = next_expr(&args, '('); /* ) */
if (list == NULL)
{
yell ("FEC: Missing List for /FEC");
return;
}
sa = subargs ? subargs : empty_string();
list = expand_alias(NULL, list, sa, &args_flag, NULL);
pointer = list;
var = next_arg(args, &args);
args = my_index(args, '{'); /* } */
if ((todo = next_expr(&args, '{')) == NULL)
{
yell ("FE: Missing }");
return;
}
stuff[1] = '\0';
while (*pointer)
{
display = set_display_off();
stuff[0] = *pointer++;
add_alias(VAR_ALIAS, var, stuff);
set_display(display);
parse_line(NULL, todo,
subargs ? subargs : empty_string(), 0, 0, 0);
}
display = set_display_off();
delete_alias(VAR_ALIAS, var);
set_display(display);
new_free(&list);
}
static void add_constraint(int col,int idx,int next_expr(int))
{int i,nextexpr;
for(i=0;idx>=0;i++){
nextexpr=next_expr(i);
xassert(nextexpr==0);
if(entropy_expr.type == ent_Markov){
if(idx>entropy_expr.n-3){ idx -= entropy_expr.n-2; continue; }
int v1,v2,v; int j;
// add idx-th Markov equality
v=v1=v2=0; for(j=0;j<entropy_expr.n;j++){
if(j<idx+1) v1 |= entropy_expr.item[j].var;
else if(j>idx+1) v2 |= entropy_expr.item[j].var;
else v=entropy_expr.item[j].var;
} // (v1,v2|v)=0
row_idx[1]=varidx(v1|v); row_val[1]=1.0;
row_idx[2]=varidx(v2|v); row_val[2]=1.0;
row_idx[3]=varidx(v1|v2|v); row_val[3]=-1.0;
row_idx[4]=varidx(v); row_val[4]=-1.0;
add_column(col,4,GLP_FR);
return;
} else if(idx>0) { idx--; continue; }
else { // add this constraint
int j;
for(j=0;j<entropy_expr.n;j++){
row_idx[j+1]=varidx(entropy_expr.item[j].var);
row_val[j+1]=entropy_expr.item[j].coeff;
}
add_column(col,entropy_expr.n, entropy_expr.type==ent_eq?GLP_FR : GLP_LO);
return;
}
}
xassert(idx!=idx);
}
void
whilecmd(u_char *command, u_char *args, u_char *subargs)
{
u_char *expr = NULL,
*ptr,
*body = NULL,
*newexp = NULL;
int args_used; /* this isn't used here, but is passed
* to expand_alias() */
if ((ptr = next_expr(&args, '(')) == NULL)
{
yell("WHILE: missing boolean expression");
return;
}
malloc_strcpy(&expr, ptr);
if ((ptr = next_expr(&args, '{')) == NULL)
{
say("WHILE: missing expression");
new_free(&expr);
return;
}
malloc_strcpy(&body, ptr);
while (1)
{
malloc_strcpy(&newexp, expr);
ptr = parse_inline(newexp, subargs ? subargs : empty_string(),
&args_used);
if (*ptr && *ptr !='0')
{
new_free(&ptr);
parse_line(NULL, body, subargs ?
subargs : empty_string(), 0, 0, 0);
}
else
break;
}
new_free(&newexp);
new_free(&ptr);
new_free(&expr);
new_free(&body);
}
void
foreach(u_char *command, u_char *args, u_char *subargs)
{
u_char *struc = NULL,
*ptr,
*body = NULL,
*var = NULL;
u_char **sublist;
int total;
int i;
int slen;
if ((ptr = new_next_arg(args, &args)) == NULL)
{
yell("FOREACH: missing structure expression");
return;
}
malloc_strcpy(&struc, ptr);
malloc_strcat(&struc, UP("."));
upper(struc);
if ((var = next_arg(args, &args)) == NULL)
{
new_free(&struc);
yell("FOREACH: missing variable");
return;
}
while (isspace(*args))
args++;
if ((body = next_expr(&args, '{')) == NULL) /* } */
{
new_free(&struc);
yell("FOREACH: missing statement");
return;
}
sublist = match_alias(struc, &total, VAR_ALIAS);
slen = my_strlen(struc);
for (i = 0; i < total; i++)
{
unsigned display;
display = set_display_off();
add_alias(VAR_ALIAS, var, sublist[i]+slen);
set_display(display);
parse_line(NULL, body, subargs ?
subargs : empty_string(), 0, 0, 0);
new_free(&sublist[i]);
}
new_free(&sublist);
new_free(&struc);
}
char *next_code_line(char *ptr) {
ptr = next_expr(ptr, "\\;\r\n");
if (*ptr == ';')
return skip_to_next_line(ptr);
if (*ptr == '\\')
ptr++;
if (*ptr == '\r')
ptr++;
if (*ptr == '\n')
ptr++;
return ptr;
}
/*
* How it works -- if There are no parenthesis, it must be a
* foreach array command. If there are parenthesis, and there are
* exactly two commas, it must be a C-like for command, else it must
* must be an foreach word command
*/
void
foreach_handler(u_char *command, u_char *args, u_char *subargs)
{
u_char *temp = NULL;
u_char *placeholder;
u_char *temp2 = NULL;
malloc_strcpy(&temp, args);
placeholder = temp;
if (*temp == '(')
{
if ((temp2 = next_expr(&temp, '(')) == NULL) {
new_free(&placeholder);
return;
}
if (charcount(temp2, ',') == 2)
forcmd(command, args, subargs);
else
fe(command, args, subargs);
}
else
foreach(command, args, subargs);
new_free(&placeholder);
}
char *call_lp(int next_expr(int))
{int i,constraints; expr_type_t goal_type;
char *retval, *retval2;
/* initially the expression to be checked is in entropy_expr.
determine first the variables */
init_var_assignment(); /* start collecting variables */
add_expr_variables(); /* variables in the expression to be checked */
constraints=0;
for(i=0;next_expr(i)==0;i++){ /* go over all constraints */
constraints++;
// Markov constraints give several cols
if(entropy_expr.type==ent_Markov){
constraints+=entropy_expr.n-3;
}
add_expr_variables();
}
/* figure out final variables, rows, cols, number of Shannon */
if(do_variable_assignment()){ // number of variables is less than 2
return "number of final random variables is less than 2";
}
/* get memory for row and column permutation */
cols += constraints;
rowperm=malloc((rows+1)*sizeof(int));
colperm=malloc((cols+1)*sizeof(int));
if(!rowperm || !colperm){
if(rowperm){ free(rowperm); rowperm=NULL; }
if(colperm){ free(colperm); colperm=NULL; }
return "the problem is too large, not enough memory";
}
for(i=0;i<=rows;i++) rowperm[i]=i; perm_array(rows+1,rowperm);
for(i=0;i<=cols;i++) colperm[i]= i-1; perm_array(cols+1,colperm);
/* the expression to be checked, this will be the goal */
if(constraints) next_expr(-1);
goal_type=entropy_expr.type; // ent_eq, ent_ge
create_glp(); // create a new glp instance
for(i=0;i<entropy_expr.n;i++){
row_idx[i+1]=varidx(entropy_expr.item[i].var);
row_val[i+1]=entropy_expr.item[i].coeff;
}
add_goal(entropy_expr.n); // right hand side value
// go over the columns add them to the lp instance
for(i=1;i<=cols;i++){
int colct=colperm[i];
if(add_shannon(i,colct)){ // this is a constraint
add_constraint(i,colct-(shannon+var_no),next_expr);
}
}
/* call the lp */
init_glp_parameters();
if(parm.presolve!=GLP_ON) // generate the first basis
glp_adv_basis(P,0);
retval=invoke_lp();
// call again with -1.0 when checking for ent_eq
if(goal_type==ent_eq && (retval==EXPR_TRUE || retval==EXPR_FALSE)){
next_expr(-1); // reload the problem
for(i=0;i<entropy_expr.n;i++){
row_idx[i+1]=varidx(entropy_expr.item[i].var);
row_val[i+1]=-entropy_expr.item[i].coeff;
}
add_goal(entropy_expr.n); // right hand side value
retval2=invoke_lp();
if(retval2==EXPR_TRUE){
if(retval==EXPR_FALSE) retval=EQ_LE_ONLY;
} else if(retval2==EXPR_FALSE){
if(retval==EXPR_TRUE) retval=EQ_GE_ONLY;
} else {
retval=retval2;
}
}
/* release allocated memory */
release_glp();
if(rowperm){ free(rowperm); rowperm=NULL; }
if(colperm){ free(colperm); colperm=NULL; }
return retval;
}
/* I suppose someone could make a case that since the
* foreach_handler() routine weeds out any for command that doesnt have
* two commands, that checking for those 2 commas is a waste. I suppose.
*/
void
forcmd(u_char *command, u_char *args, u_char *subargs)
{
u_char *working = NULL;
u_char *commence = NULL;
u_char *evaluation = NULL;
u_char *lameeval = NULL;
u_char *iteration = NULL;
u_char *sa = NULL;
int argsused = 0;
u_char *line = NULL;
u_char *commands = NULL;
/* Get the whole () thing */
if ((working = next_expr(&args, '(')) == NULL) /* ) */
{
yell("FOR: missing closing parenthesis");
return;
}
malloc_strcpy(&commence, working);
/* Find the beginning of the second expression */
evaluation = my_index(commence, ',');
if (!evaluation)
{
yell("FOR: no components!");
new_free(&commence);
return;
}
do
*evaluation++ = '\0';
while (isspace(*evaluation));
/* Find the beginning of the third expression */
iteration = my_index(evaluation, ',');
if (!iteration)
{
yell("FOR: Only two components!");
new_free(&commence);
return;
}
do
{
*iteration++ = '\0';
}
while (isspace(*iteration));
working = args;
while (isspace(*working))
*working++ = '\0';
if ((working = next_expr(&working, '{')) == NULL) /* } */
{
yell("FOR: badly formed commands");
new_free(&commence);
return;
}
malloc_strcpy(&commands, working);
sa = subargs ? subargs : empty_string();
parse_line(NULL, commence, sa, 0, 0, 0);
while (1)
{
malloc_strcpy(&lameeval, evaluation);
line = parse_inline(lameeval, sa, &argsused);
if (*line && *line != '0')
{
new_free(&line);
parse_line(NULL, commands, sa, 0, 0, 0);
parse_line(NULL, iteration, sa, 0, 0, 0);
}
else break;
}
new_free(&line);
new_free(&lameeval);
new_free(&commence);
new_free(&commands);
}
void
fe(u_char *command, u_char *args, u_char *subargs)
{
u_char *list = NULL,
*templist = NULL,
*placeholder,
*oldlist = NULL,
*sa,
*vars,
*var[255],
*word = NULL,
*todo = NULL;
int ind, x, y, count, args_flag;
unsigned display;
for (x = 0; x < 255; var[x++] = NULL)
;
list = next_expr(&args, '('); /* ) */
if (!list)
{
yell ("FE: Missing List for /FE");
return;
}
sa = subargs ? subargs : (u_char *) " ";
malloc_strcpy(&templist, list);
do
{
malloc_strcpy(&oldlist, templist);
new_free(&templist);
templist = expand_alias(NULL, oldlist, sa, &args_flag, NULL);
} while (my_strcmp(templist, oldlist));
new_free(&oldlist);
if (*templist == '\0')
{
new_free(&templist);
return;
}
vars = args;
if (!(args = my_index(args, '{'))) /* } */
{
yell ("FE: Missing commands");
new_free(&templist);
return;
}
*(args-1) = '\0';
ind = 0;
while ((var[ind++] = next_arg(vars, &vars)))
{
if (ind == 255)
{
yell ("FE: Too many variables");
new_free(&templist);
return;
}
}
ind = ind ? ind - 1: 0;
if (!(todo = next_expr(&args, '{'))) /* } { */
{
yell ("FE: Missing }");
new_free(&templist);
return;
}
count = word_count(templist);
display = get_display();
placeholder = templist;
for (x = 0; x < count;)
{
set_display_off();
for (y = 0; y < ind; y++)
{
word = ((x + y) < count)
? next_arg(templist, &templist)
: NULL;
add_alias(VAR_ALIAS, var[y], word);
}
set_display(display);
x += ind;
parse_line(NULL, todo,
subargs ? subargs : empty_string(), 0, 0, 0);
}
set_display_off();
for (y = 0; y < ind; y++) {
delete_alias(VAR_ALIAS, var[y]);
}
set_display(display);
new_free(&placeholder);
}
char *parse_emit_string (const char *ptr, ES_TYPE type, void *echo_target) {
static int level = 0;
char *word = NULL;
int session;
bool fWasParsed;
char *name_end;
level++;
arg_context_t context = ARG_CONTEXT_INITIALIZER;
while ((word = extract_arg_string(&ptr, &context)) != NULL)
{
// handle strings
if (word[0] == '"')
{
char *next = next_expr (word, EXPR_DELIMS);
if (*next != '\0')
goto echo_error;
reduce_string (word);
if (type == ES_ECHO)
{
if (echo_target != NULL)
{
fprintf ((FILE *) echo_target, "%s", word);
}
}
else if (type == ES_FCREATE) {
eb_append((expand_buf_t *) echo_target, word, strlen(word));
} else {
int i;
for (i = 0; word[i]; i++) {
if ((mode & MODE_NORMAL) || (mode & MODE_LIST))
write_out (word[i]);
stats_datasize++;
program_counter++;
}
}
} else {
int value;
session = StartSPASMErrorSession();
fWasParsed = parse_num(word, &value);
if (fWasParsed == true)
{
switch (type)
{
case ES_ECHO:
{
if (echo_target != NULL)
{
fprintf ((FILE *) echo_target, "%d", value);
}
break;
}
#ifdef USE_BUILTIN_FCREATE
case ES_FCREATE:
{
char buffer[256];
sprintf_s(buffer, "%d", value);
eb_append((expand_buf_t *) echo_target, buffer, -1);
break;
}
#endif
case ES_BYTE:
{
write_arg(value, ARG_NUM_8, 0, 0);
stats_datasize++;
program_counter++;
break;
}
case ES_WORD:
{
write_arg(value, ARG_NUM_16, 0, 0);
stats_datasize+=2;
program_counter+=2;
break;
}
case ES_LONG:
{
write_arg(value, ARG_NUM_24, 0, 0);
stats_datasize+=3;
program_counter+=3;
break;
}
}
ReplaySPASMErrorSession(session);
}
else if (IsSPASMErrorSessionFatal(session) == false && type != ES_FCREATE)
{
switch (type)
{
case ES_ECHO:
break;
case ES_BYTE:
{
add_pass_two_expr(word, ARG_NUM_8, 0, 0);
stats_datasize++;
program_counter++;
break;
}
case ES_WORD:
{
add_pass_two_expr(word, ARG_NUM_16, 0, 0);
stats_datasize+=2;
program_counter+=2;
break;
}
case ES_LONG:
{
add_pass_two_expr(word, ARG_NUM_24, 0, 0);
stats_datasize += 3;
program_counter += 3;
break;
}
}
ReplayFatalSPASMErrorSession(session);
}
else
{
char name[256];
char *next;
define_t *define;
name_end = word;
//printf("error occured: %d, forward: %d, value: %d\n", error_occurred, parser_forward_ref_err, value);
read_expr (&name_end, name, "(");
//printf("Looking up %s\n", name);
next = name_end;
read_expr (&next, NULL, ")");
if (*next != '\0')
goto echo_error;
if ((define = search_defines (name))) {
char *expr;
list_t *args = NULL;
//handle defines
if (define->contents == NULL)
{
SetLastSPASMError(SPASM_ERR_ARG_USED_WITHOUT_VALUE, name);
}
if (*(name_end - 1) == '(') name_end--;
name_end = parse_args (name_end, define, &args);
if (!name_end)
return (char *) ptr;
expr = parse_define (define);
if (expr != NULL)
{
arg_context_t nested_context = ARG_CONTEXT_INITIALIZER;
// Is it some kind of argument list?
const char *nested_expr = expr;
extract_arg_string(&nested_expr, &nested_context);
if (extract_arg_string(&nested_expr, &nested_context) != NULL)
{
// if it is, plug it in to the emit string
parse_emit_string(expr, type, echo_target);
}
else
{
if (IsErrorInSPASMErrorSession(session, SPASM_ERR_EXCEEDED_RECURSION_LIMIT) == false)
{
int inner_session = StartSPASMErrorSession();
parse_emit_string(expr, type, echo_target);
if (IsSPASMErrorSessionFatal(inner_session))
{
EndSPASMErrorSession(inner_session);
AddSPASMErrorSessionAnnotation(session, _T("Error during evaluation of macro '%s'"), define->name);
ReplaySPASMErrorSession(session);
}
else
{
EndSPASMErrorSession(inner_session);
}
//ReplaySPASMErrorSession(session);
}
else
{
ReplaySPASMErrorSession(session);
}
}
free (expr);
}
remove_arg_set (args);
}
else
{
echo_error:
switch (type)
{
case ES_ECHO:
{
if (echo_target != NULL)
{
fprintf((FILE *) echo_target, "(error)");
}
break;
}
case ES_FCREATE:
{
SetLastSPASMError(SPASM_ERR_LABEL_NOT_FOUND, word);
eb_append((expand_buf_t *) echo_target, "(error)", -1);
break;
}
}
ReplaySPASMErrorSession(session);
}
}
EndSPASMErrorSession(session);
}
}
if (type == ES_ECHO && level == 1) {
if (echo_target == stdout) putchar ('\n');
else {
if (echo_target != NULL)
{
fclose ((FILE *) echo_target);
}
}
}
level--;
return (char *) ptr;
}
void
gp_initrc(pari_stack *p_A)
{
FILE *file = gprc_get();
Buffer *b;
filtre_t F;
VOLATILE long c = 0;
jmp_buf *env;
pari_stack s_env;
if (!file) return;
b = filtered_buffer(&F);
pari_stack_init(&s_env, sizeof(*env), (void**)&env);
(void)pari_stack_new(&s_env);
for(;;)
{
char *nexts, *s, *t;
if (setjmp(env[s_env.n-1])) err_printf("...skipping line %ld.\n", c);
c++;
if (!get_line_from_file(NULL,&F,file)) break;
s = b->buf;
if (*s == '#')
{ /* preprocessor directive */
int z, NOT = 0;
s++;
if (strncmp(s,"if",2)) err_gprc("unknown directive",s,b->buf);
s += 2;
if (!strncmp(s,"not",3)) { NOT = !NOT; s += 3; }
if (*s == '!') { NOT = !NOT; s++; }
t = s;
z = get_preproc_value(&s);
if (z < 0) err_gprc("unknown preprocessor variable",t,b->buf);
if (NOT) z = !z;
if (!*s)
{ /* make sure at least an expr follows the directive */
if (!get_line_from_file(NULL,&F,file)) break;
s = b->buf;
}
if (!z) continue; /* dump current line */
}
/* parse line */
for ( ; *s; s = nexts)
{
nexts = next_expr(s);
if (!strncmp(s,"read",4) && (s[4] == ' ' || s[4] == '\t' || s[4] == '"'))
{ /* read file */
s += 4;
t = (char*)pari_malloc(strlen(s) + 1);
if (*s == '"') (void)pari_translate_string(s, t, s-4); else strcpy(t,s);
pari_stack_pushp(p_A,t);
}
else
{ /* set default */
parse_key_val(s, &s,&t);
(void)setdefault(s,t,d_INITRC);
}
}
}
pari_stack_delete(&s_env);
pop_buffer();
if (!(GP_DATA->flags & gpd_QUIET)) err_printf("Done.\n\n");
fclose(file);
}
