/*
* print the data returned from JP IS
*/
static void queryresult_print(FILE *out, const struct _jpelem__QueryJobsResponse *in) {
struct jptype__jobRecord *job;
struct jptype__attrValue *attr;
int i, j, k;
#if USE_GMT
setenv("TZ","UTC",1); tzset();
#endif
fprintf(out, "Result %d jobs:\n", in->__sizejobs);
for (j=0; j<in->__sizejobs; j++) {
job = GLITE_SECURITY_GSOAP_LIST_GET(in->jobs, j);
fprintf(out, "\tjobid = %s, owner = %s\n", job->jobid, job->owner);
for (i=0; i<job->__sizeattributes; i++) {
attr = GLITE_SECURITY_GSOAP_LIST_GET(job->attributes, i);
fprintf(out, "\t\t%s\n", attr->name);
fprintf(out, "\t\t\tvalue = ");
value_print(out, attr->value);
fprintf(out, "\n");
for (k = 0; k <= NUMBER_ORIG; k++)
if (origins[k].orig == attr->origin) break;
fprintf(out, "\t\t\torigin = %s", origins[k].name);
if (attr->originDetail) fprintf(out, ", %s\n", attr->originDetail);
else fprintf(out, " (no detail)\n");
if (attr->timestamp != (time_t)0)
fprintf(out, "\t\t\ttime = %s", ctime(&attr->timestamp));
}
}
}
void run_repl()
{
printf("Zeta Read-Eval-Print Loop (REPL). Press Ctrl+C to exit.\n");
printf("\n");
printf("Please note that the Zeta VM is at the early prototype ");
printf("stage, language semantics and implementation details will ");
printf("change often.\n");
printf("\n");
printf("NOTE: the interpreter is currently *very much incomplete*. It will ");
printf("likely crash on you or give cryptic error messages.\n");
printf("\n");
for (;;)
{
printf("z> ");
char* cstr = read_line();
// Evaluate the code string
value_t value = eval_str(cstr);
free(cstr);
// Print the value
value_print(value);
putchar('\n');
}
}
/**
* cloog_domain_print_structure :
* this function is a human-friendly way to display the CloogDomain data
* structure, it includes an indentation level (level) in order to work with
* others print_structure functions.
* - June 16th 2005: first version.
*/
void cloog_block_print_structure(FILE * file, CloogBlock * block, int level)
{ int i ;
/* Go to the right level. */
for (i=0; i<level; i++)
fprintf(file,"|\t") ;
if (block != NULL)
{ fprintf(file,"+-- CloogBlock\n") ;
/* A blank line. */
for (i=0; i<level+2; i++)
fprintf(file,"|\t") ;
fprintf(file,"\n") ;
/* Print statement list. */
cloog_statement_print_structure(file,cloog_block_stmt (block),level+1) ;
/* A blank line. */
for (i=0; i<level+2; i++)
fprintf(file,"|\t") ;
fprintf(file,"\n") ;
/* A blank line. */
for (i=0; i<level+2; i++)
fprintf(file,"|\t") ;
fprintf(file,"\n") ;
/* Print scalar dimensions. */
for (i=0; i<level+1; i++)
fprintf(file,"|\t") ;
if (cloog_block_nb_scaldims (block) == 0)
fprintf(file,"No scalar dimensions\n") ;
else
{
fprintf (file, "Scalar dimensions (%d):", cloog_block_nb_scaldims (block));
for (i = 0; i < cloog_block_nb_scaldims (block); i++)
value_print (file, " "VALUE_FMT, block->scaldims[i]);
fprintf (file, "\n");
}
/* A blank line. */
for (i=0; i<level+2; i++)
fprintf(file,"|\t") ;
fprintf(file,"\n") ;
/* Print depth. */
for (i=0; i<level+1; i++)
fprintf(file,"|\t") ;
fprintf (file, "Depth: %d\n", cloog_block_depth (block));
/* A blank line. */
for (i=0; i<level+1; i++)
fprintf(file,"|\t") ;
fprintf(file,"\n") ;
}
else
fprintf(file,"+-- Null CloogBlock\n") ;
}
/*
* Print the contents of a Vector
*/
void Vector_Print(FILE *Dst, const char *Format, Vector *vector)
{
int i;
Value *p;
unsigned length;
fprintf(Dst, "%d\n", length=vector->Size);
p = vector->p;
for (i=0;i<length;i++) {
if (Format) {
value_print(Dst,Format,*p++);
}
else {
value_print(Dst,P_VALUE_FMT,*p++);
}
}
fprintf(Dst, "\n");
} /* Vector_Print */
void
graphprinter_visit_literal (struct _Visitor *visitor, struct AstNode *node)
{
printf("\tnode_%x -> literal_%x;\n", node->parent, node);
printf("\tliteral_%x [label=\"", node);
value_print(stdout, &node->value, node->type);
printf("\\n<%s>\",style=filled,color="COLOR_FILL_LITERAL"];\n",
node->name, type_get_lexeme(node->type));
ast_node_accept_children(node->children, visitor);
}
static void
dump_stack(struct vm *vm)
{
struct value *si;
int i = 0;
for (si = vm->vstack; si < vm->vstack_ptr; si++) {
printf("sk@%02d: ", i++);
value_print(*si);
printf("\n");
}
}
static void
gen_push_value(struct value *v)
{
#ifdef DEBUG
if (trace_gen) {
printf("#%d: *PUSH_VALUE(", gptr - program);
value_print(v);
printf(")\n");
}
#endif
gen(INSTR_PUSH_VALUE);
*(((struct value **)gptr)++) = v;
}
/*
* print info from the query soap structure
*/
static void query_print(FILE *out, const struct _jpelem__QueryJobs *in) {
struct jptype__indexQuery *cond;
struct jptype__indexQueryRecord *rec;
int i, j, k;
fprintf(out, "Conditions:\n");
for (i = 0; i < in->__sizeconditions; i++) {
cond = GLITE_SECURITY_GSOAP_LIST_GET(in->conditions, i);
fprintf(out, "\t%s\n", cond->attr);
if (cond->origin) {
for (k = 0; k <= NUMBER_ORIG; k++)
if (origins[k].orig == *(cond->origin)) break;
fprintf(out, "\t\torigin == %s\n", origins[k].name);
} else {
fprintf(out, "\t\torigin IS ANY\n");
}
for (j = 0; j < cond->__sizerecord; j++) {
rec = GLITE_SECURITY_GSOAP_LIST_GET(cond->record, j);
for (k = 0; k <= NUMBER_OP; k++)
if (operations[k].op == rec->op) break;
fprintf(out, "\t\tvalue %s", operations[k].name);
if (rec->value) {
fprintf(out, " ");
value_print(out, rec->value);
}
if (rec->value2) {
if (!rec->value) fprintf(out, "-");
fprintf(out, " AND ");
value_print(out, rec->value2);
}
fprintf(out, "\n");
}
}
fprintf(out, "Attributes:\n");
for (i = 0; i < in->__sizeattributes; i++)
fprintf(out, "\t%s\n", in->attributes[i]);
}
/*
* Print the contents of the Matrix 'Mat'
*/
void Matrix_Print(FILE *Dst, const char *Format, Matrix *Mat)
{
Value *p;
int i, j;
unsigned NbRows, NbColumns;
fprintf(Dst,"%d %d\n", NbRows=Mat->NbRows, NbColumns=Mat->NbColumns);
if (NbColumns ==0) {
fprintf(Dst, "\n");
return;
}
for (i=0;i<NbRows;i++) {
p=*(Mat->p+i);
for (j=0;j<NbColumns;j++) {
if (!Format) {
value_print(Dst," "P_VALUE_FMT" ",*p++);
}
else {
value_print(Dst,Format,*p++);
}
}
fprintf(Dst, "\n");
}
} /* Matrix_Print */
void value_print(Value* value)
{
switch (value->type) {
case TYPE_INTEGER:
printf("%i", *(int*)value->data);
break;
case TYPE_SYMBOL:
printf("%s", (char*)value->data);
break;
case TYPE_PROCEDURE:
printf("[PROCEDURE]");
break;
case TYPE_ERROR:
printf("ERROR! %s", (char*)value->data);
break;
case TYPE_LIST:
{
List* lst = (List*)value->data;
Node* current = lst->first;
printf("(");
for (int i = 0; i < lst->length; i++) {
value_print(current->value);
if (i < lst->length - 1)
printf(" ");
current = current->next;
}
printf(")");
break;
}
case TYPE_BINDING: {
printf("%s -> ", ((Binding*)value->data)->symbol);
value_print(((Binding*)value->data)->value); printf("\n");
}
break;
}
}
/**
Print a value to standard output
*/
void value_print(value_t value)
{
switch (value.tag)
{
case TAG_FALSE:
printf("false");
break;
case TAG_TRUE:
printf("true");
break;
case TAG_INT64:
printf("%ld", value.word.int64);
break;
case TAG_FLOAT64:
printf("%lf", value.word.float64);
break;
case TAG_STRING:
{
putchar('"');
string_print((string_t*)value.word.heapptr);
putchar('"');
}
break;
case TAG_ARRAY:
{
array_t* array = (array_t*)value.word.heapptr;
putchar('[');
for (size_t i = 0; i < array->len; ++i)
{
value_print(array_get(array, i));
if (i + 1 < array->len)
printf(", ");
}
putchar(']');
}
break;
default:
printf("unknown value tag");
break;
}
}
void
symbol_print(Symbol *symbol)
{
if (symbol == NULL) {
printf("NULL\n\n");
return;
}
printf("Symbol: %x\n", symbol);
printf("name: %s\n", symbol->name);
printf("type: %d\n", symbol->type);
printf("value:");
value_print(stdout, &symbol->value, symbol->type);
printf("\ndeclaration line: %d\n", symbol->decl_linenum);
printf("next: %x\n\n", symbol->next);
}
void test_eval_equals(char* cstr, value_t expected)
{
printf("%s\n", cstr);
value_t value = eval_string(cstr, "test");
if (!value_equals(value, expected))
{
printf(
"value doesn't match expected for input:\n%s\n",
cstr
);
printf("got value:\n");
value_print(value);
printf("\n");
exit(-1);
}
}
void
process_send(struct process *p, struct value v)
{
struct message *m;
m = bhuna_malloc(sizeof(struct message));
m->next = p->msg_head;
p->msg_head = m;
m->payload = v;
#ifdef DEBUG
if (trace_scheduling) {
printf("send from process #%d to process #%d: ",
current_process->number, p->number);
value_print(v);
printf("\n");
}
#endif
process_awaken(p);
}
void
typecheck_visit_callparam_list (struct _Visitor *visitor, struct AstNode *node)
{
int i;
struct AstNode *child;
node->child_counter = 0;
for (child = node->children; child != NULL; child = child->sibling)
node->child_counter++;
if (node->symbol->params != node->child_counter) {
node->type = ERROR;
return;
}
i = 0;
for (child = node->children; child != NULL; child = child->sibling) {
ast_node_accept(child, visitor);
if (child->type != ERROR &&
child->type != node->symbol->param_types[i]) {
node->type = ERROR;
child->type = node->symbol->param_types[i];
fprintf(stderr, "Error: Call '%s' on line %d, expecting %s "
"on parameter %d (",
node->symbol->name, node->linenum,
type_get_lexeme(node->symbol->param_types[i]),
i + 1);
if (child->children->kind == IDENTIFIER)
fprintf(stderr, "'%s'", child->children->symbol->name);
else
value_print(stderr, &child->value, child->type);
fprintf(stderr, "), received %s.\n", type_get_lexeme(child->type));
}
i++;
}
}
int
main(int argc, char **argv)
{
void *lib_handle;
const char *error_msg;
struct activation *ar;
struct value v, result;
struct builtin *builtins;
int i, j;
if ((lib_handle = dlopen("./io.so", RTLD_LAZY)) == NULL) {
fprintf(stderr, "Error during dlopen(): %s\n", dlerror());
exit(1);
}
builtins = dlsym(lib_handle, "builtins");
if ((error_msg = dlerror()) != NULL) {
fprintf(stderr, "Error locating 'builtins' - %s\n", error_msg);
exit(1);
}
for (i = 0; builtins[i].name != NULL; i++) {
printf("Calling `%s'...\n", builtins[i].name);
ar = activation_new_on_heap(builtins[i].arity, NULL, NULL);
for (j = 0; j < builtins[i].arity; j++) {
v = value_new_integer(76);
activation_set_value(ar, j, 0, v);
}
result = (*builtins[i].fn)(ar);
/*activation_free_from_stack(ar);*/
printf("Done! Result: ");
value_print(result);
printf("\n");
}
dlclose(lib_handle);
return(0);
}
static void
value_mark(struct value v)
{
struct list *l;
if (!(v.type & VALUE_STRUCTURED) || v.v.s->admin & ADMIN_MARKED)
return;
#ifdef DEBUG
if (trace_gc > 1) {
printf("[GC] MARKING VALUE ");
value_print(v);
printf(" AS REACHABLE\n");
}
#endif
v.v.s->admin |= ADMIN_MARKED;
switch (v.type) {
case VALUE_LIST:
for (l = v.v.s->v.l; l != NULL; l = l->next) {
value_mark(l->value);
}
break;
case VALUE_CLOSURE:
activation_mark(v.v.s->v.k->ar);
break;
case VALUE_DICT:
/* XXX for each key in v->v.d, value_mark(d[k]) */
break;
default:
/*
* No need to go through other values as they
* are not containers.
*/
break;
}
}
/*
* Returns 1 if a message was obtained from the mailbox,
* 0 if there were no messages waiting (indicating: go to sleep.)
*/
int
process_recv(struct value *v)
{
struct message *m;
if (current_process->msg_head == NULL)
return(0);
m = current_process->msg_head;
*v = m->payload;
current_process->msg_head = m->next;
bhuna_free(m);
#ifdef DEBUG
if (trace_scheduling) {
printf("received in process #%d: ",
current_process->number);
value_print(*v);
printf("\n");
}
#endif
return(1);
}
/* Standard implementation of print_subexp for use in language_defn
vectors. */
void
print_subexp_standard (struct expression *exp, int *pos,
struct ui_file *stream, enum precedence prec)
{
unsigned tem;
const struct op_print *op_print_tab;
int pc;
unsigned nargs;
char *op_str;
int assign_modify = 0;
enum exp_opcode opcode;
enum precedence myprec = PREC_NULL;
/* Set to 1 for a right-associative operator. */
int assoc = 0;
struct value *val;
char *tempstr = NULL;
op_print_tab = exp->language_defn->la_op_print_tab;
pc = (*pos)++;
opcode = exp->elts[pc].opcode;
switch (opcode)
{
/* Common ops */
case OP_SCOPE:
myprec = PREC_PREFIX;
assoc = 0;
fputs_filtered (type_name_no_tag (exp->elts[pc + 1].type), stream);
fputs_filtered ("::", stream);
nargs = longest_to_int (exp->elts[pc + 2].longconst);
(*pos) += 4 + BYTES_TO_EXP_ELEM (nargs + 1);
fputs_filtered (&exp->elts[pc + 3].string, stream);
return;
case OP_LONG:
(*pos) += 3;
value_print (value_from_longest (exp->elts[pc + 1].type,
exp->elts[pc + 2].longconst),
stream, 0, Val_no_prettyprint);
return;
case OP_DOUBLE:
(*pos) += 3;
value_print (value_from_double (exp->elts[pc + 1].type,
exp->elts[pc + 2].doubleconst),
stream, 0, Val_no_prettyprint);
return;
case OP_VAR_VALUE:
{
struct block *b;
(*pos) += 3;
b = exp->elts[pc + 1].block;
if (b != NULL
&& BLOCK_FUNCTION (b) != NULL
&& SYMBOL_PRINT_NAME (BLOCK_FUNCTION (b)) != NULL)
{
fputs_filtered (SYMBOL_PRINT_NAME (BLOCK_FUNCTION (b)), stream);
fputs_filtered ("::", stream);
}
fputs_filtered (SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol), stream);
}
return;
case OP_LAST:
(*pos) += 2;
fprintf_filtered (stream, "$%d",
longest_to_int (exp->elts[pc + 1].longconst));
return;
case OP_REGISTER:
{
int regnum = longest_to_int (exp->elts[pc + 1].longconst);
const char *name = user_reg_map_regnum_to_name (current_gdbarch,
regnum);
(*pos) += 2;
fprintf_filtered (stream, "$%s", name);
return;
}
case OP_BOOL:
(*pos) += 2;
fprintf_filtered (stream, "%s",
longest_to_int (exp->elts[pc + 1].longconst)
? "TRUE" : "FALSE");
return;
case OP_INTERNALVAR:
(*pos) += 2;
fprintf_filtered (stream, "$%s",
internalvar_name (exp->elts[pc + 1].internalvar));
return;
case OP_FUNCALL:
(*pos) += 2;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (" (", stream);
for (tem = 0; tem < nargs; tem++)
{
if (tem != 0)
fputs_filtered (", ", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
fputs_filtered (")", stream);
return;
case OP_NAME:
case OP_EXPRSTRING:
nargs = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (nargs + 1);
fputs_filtered (&exp->elts[pc + 2].string, stream);
return;
case OP_STRING:
nargs = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (nargs + 1);
/* LA_PRINT_STRING will print using the current repeat count threshold.
If necessary, we can temporarily set it to zero, or pass it as an
additional parameter to LA_PRINT_STRING. -fnf */
LA_PRINT_STRING (stream, &exp->elts[pc + 2].string, nargs, 1, 0);
return;
case OP_BITSTRING:
nargs = longest_to_int (exp->elts[pc + 1].longconst);
(*pos)
+= 3 + BYTES_TO_EXP_ELEM ((nargs + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
fprintf_unfiltered (stream, "B'<unimplemented>'");
return;
case OP_OBJC_NSSTRING: /* Objective-C Foundation Class NSString constant. */
nargs = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (nargs + 1);
fputs_filtered ("@\"", stream);
LA_PRINT_STRING (stream, &exp->elts[pc + 2].string, nargs, 1, 0);
fputs_filtered ("\"", stream);
return;
case OP_OBJC_MSGCALL:
{ /* Objective C message (method) call. */
char *selector;
(*pos) += 3;
nargs = longest_to_int (exp->elts[pc + 2].longconst);
fprintf_unfiltered (stream, "[");
print_subexp (exp, pos, stream, PREC_SUFFIX);
if (0 == target_read_string (exp->elts[pc + 1].longconst,
&selector, 1024, NULL))
{
error (_("bad selector"));
return;
}
if (nargs)
{
char *s, *nextS;
s = alloca (strlen (selector) + 1);
strcpy (s, selector);
for (tem = 0; tem < nargs; tem++)
{
nextS = strchr (s, ':');
*nextS = '\0';
fprintf_unfiltered (stream, " %s: ", s);
s = nextS + 1;
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
}
else
{
fprintf_unfiltered (stream, " %s", selector);
}
fprintf_unfiltered (stream, "]");
/* "selector" was malloc'd by target_read_string. Free it. */
xfree (selector);
return;
}
case OP_ARRAY:
(*pos) += 3;
nargs = longest_to_int (exp->elts[pc + 2].longconst);
nargs -= longest_to_int (exp->elts[pc + 1].longconst);
nargs++;
tem = 0;
if (exp->elts[pc + 4].opcode == OP_LONG
&& exp->elts[pc + 5].type == builtin_type_char
&& exp->language_defn->la_language == language_c)
{
/* Attempt to print C character arrays using string syntax.
Walk through the args, picking up one character from each
of the OP_LONG expression elements. If any array element
does not match our expection of what we should find for
a simple string, revert back to array printing. Note that
the last expression element is an explicit null terminator
byte, which doesn't get printed. */
tempstr = alloca (nargs);
pc += 4;
while (tem < nargs)
{
if (exp->elts[pc].opcode != OP_LONG
|| exp->elts[pc + 1].type != builtin_type_char)
{
/* Not a simple array of char, use regular array printing. */
tem = 0;
break;
}
else
{
tempstr[tem++] =
longest_to_int (exp->elts[pc + 2].longconst);
pc += 4;
}
}
}
if (tem > 0)
{
LA_PRINT_STRING (stream, tempstr, nargs - 1, 1, 0);
(*pos) = pc;
}
else
{
fputs_filtered (" {", stream);
for (tem = 0; tem < nargs; tem++)
{
if (tem != 0)
{
fputs_filtered (", ", stream);
}
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
fputs_filtered ("}", stream);
}
return;
case OP_LABELED:
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
/* Gcc support both these syntaxes. Unsure which is preferred. */
#if 1
fputs_filtered (&exp->elts[pc + 2].string, stream);
fputs_filtered (": ", stream);
#else
fputs_filtered (".", stream);
fputs_filtered (&exp->elts[pc + 2].string, stream);
fputs_filtered ("=", stream);
#endif
print_subexp (exp, pos, stream, PREC_SUFFIX);
return;
case TERNOP_COND:
if ((int) prec > (int) PREC_COMMA)
fputs_filtered ("(", stream);
/* Print the subexpressions, forcing parentheses
around any binary operations within them.
This is more parentheses than are strictly necessary,
but it looks clearer. */
print_subexp (exp, pos, stream, PREC_HYPER);
fputs_filtered (" ? ", stream);
print_subexp (exp, pos, stream, PREC_HYPER);
fputs_filtered (" : ", stream);
print_subexp (exp, pos, stream, PREC_HYPER);
if ((int) prec > (int) PREC_COMMA)
fputs_filtered (")", stream);
return;
case TERNOP_SLICE:
case TERNOP_SLICE_COUNT:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("(", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (opcode == TERNOP_SLICE ? " : " : " UP ", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
case STRUCTOP_STRUCT:
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (".", stream);
fputs_filtered (&exp->elts[pc + 2].string, stream);
return;
/* Will not occur for Modula-2 */
case STRUCTOP_PTR:
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("->", stream);
fputs_filtered (&exp->elts[pc + 2].string, stream);
return;
case BINOP_SUBSCRIPT:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("[", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered ("]", stream);
return;
case UNOP_POSTINCREMENT:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("++", stream);
return;
case UNOP_POSTDECREMENT:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("--", stream);
return;
case UNOP_CAST:
(*pos) += 2;
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered ("(", stream);
fputs_filtered ("(", stream);
type_print (exp->elts[pc + 1].type, "", stream, 0);
fputs_filtered (") ", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered (")", stream);
return;
case UNOP_MEMVAL:
(*pos) += 2;
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered ("(", stream);
if (TYPE_CODE (exp->elts[pc + 1].type) == TYPE_CODE_FUNC &&
exp->elts[pc + 3].opcode == OP_LONG)
{
/* We have a minimal symbol fn, probably. It's encoded
as a UNOP_MEMVAL (function-type) of an OP_LONG (int, address).
Swallow the OP_LONG (including both its opcodes); ignore
its type; print the value in the type of the MEMVAL. */
(*pos) += 4;
val = value_at_lazy (exp->elts[pc + 1].type,
(CORE_ADDR) exp->elts[pc + 5].longconst);
value_print (val, stream, 0, Val_no_prettyprint);
}
else
{
fputs_filtered ("{", stream);
type_print (exp->elts[pc + 1].type, "", stream, 0);
fputs_filtered ("} ", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
}
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered (")", stream);
return;
case BINOP_ASSIGN_MODIFY:
opcode = exp->elts[pc + 1].opcode;
(*pos) += 2;
myprec = PREC_ASSIGN;
assoc = 1;
assign_modify = 1;
op_str = "???";
for (tem = 0; op_print_tab[tem].opcode != OP_NULL; tem++)
if (op_print_tab[tem].opcode == opcode)
{
op_str = op_print_tab[tem].string;
break;
}
if (op_print_tab[tem].opcode != opcode)
/* Not found; don't try to keep going because we don't know how
to interpret further elements. */
error (_("Invalid expression"));
break;
/* C++ ops */
case OP_THIS:
++(*pos);
fputs_filtered ("this", stream);
return;
/* Objective-C ops */
case OP_OBJC_SELF:
++(*pos);
fputs_filtered ("self", stream); /* The ObjC equivalent of "this". */
return;
/* Modula-2 ops */
case MULTI_SUBSCRIPT:
(*pos) += 2;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
print_subexp (exp, pos, stream, PREC_SUFFIX);
fprintf_unfiltered (stream, " [");
for (tem = 0; tem < nargs; tem++)
{
if (tem != 0)
fprintf_unfiltered (stream, ", ");
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
fprintf_unfiltered (stream, "]");
return;
case BINOP_VAL:
(*pos) += 2;
fprintf_unfiltered (stream, "VAL(");
type_print (exp->elts[pc + 1].type, "", stream, 0);
fprintf_unfiltered (stream, ",");
print_subexp (exp, pos, stream, PREC_PREFIX);
fprintf_unfiltered (stream, ")");
return;
case BINOP_INCL:
case BINOP_EXCL:
error (_("print_subexp: Not implemented."));
/* Default ops */
default:
op_str = "???";
for (tem = 0; op_print_tab[tem].opcode != OP_NULL; tem++)
if (op_print_tab[tem].opcode == opcode)
{
op_str = op_print_tab[tem].string;
myprec = op_print_tab[tem].precedence;
assoc = op_print_tab[tem].right_assoc;
break;
}
if (op_print_tab[tem].opcode != opcode)
/* Not found; don't try to keep going because we don't know how
to interpret further elements. For example, this happens
if opcode is OP_TYPE. */
error (_("Invalid expression"));
}
/* Note that PREC_BUILTIN will always emit parentheses. */
if ((int) myprec < (int) prec)
fputs_filtered ("(", stream);
if ((int) opcode > (int) BINOP_END)
{
if (assoc)
{
/* Unary postfix operator. */
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (op_str, stream);
}
else
{
/* Unary prefix operator. */
fputs_filtered (op_str, stream);
if (myprec == PREC_BUILTIN_FUNCTION)
fputs_filtered ("(", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
if (myprec == PREC_BUILTIN_FUNCTION)
fputs_filtered (")", stream);
}
}
else
{
/* Binary operator. */
/* Print left operand.
If operator is right-associative,
increment precedence for this operand. */
print_subexp (exp, pos, stream,
(enum precedence) ((int) myprec + assoc));
/* Print the operator itself. */
if (assign_modify)
fprintf_filtered (stream, " %s= ", op_str);
else if (op_str[0] == ',')
fprintf_filtered (stream, "%s ", op_str);
else
fprintf_filtered (stream, " %s ", op_str);
/* Print right operand.
If operator is left-associative,
increment precedence for this operand. */
print_subexp (exp, pos, stream,
(enum precedence) ((int) myprec + !assoc));
}
if ((int) myprec < (int) prec)
fputs_filtered (")", stream);
}
void
ast_dump(struct ast *a, int indent)
{
#ifdef DEBUG
int i;
if (a == NULL) {
return;
}
for (i = 0; i < indent; i++) printf(" ");
if (a->label != NULL) {
/* XXX
printf("@#%d -> ", a->label - (vm_label_t)program);
*/
printf("@#%08lx -> ", (unsigned long)a->label);
}
printf(ast_name(a));
printf("=");
type_print(stdout, a->datatype);
switch (a->type) {
case AST_LOCAL:
printf("(%d,%d)=", a->u.local.index, a->u.local.upcount);
if (a->u.local.sym != NULL)
symbol_dump(a->u.local.sym, 0);
printf("\n");
break;
case AST_VALUE:
printf("(");
value_print(a->u.value.value);
printf(")\n");
break;
case AST_BUILTIN:
printf("`");
fputsu8(stdout, a->u.builtin.bi->name);
printf("`{\n");
ast_dump(a->u.builtin.right, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
case AST_APPLY:
printf("{\n");
ast_dump(a->u.apply.left, indent + 1);
ast_dump(a->u.apply.right, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
case AST_ARG:
printf("{\n");
ast_dump(a->u.arg.left, indent + 1);
ast_dump(a->u.arg.right, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
case AST_ROUTINE:
printf("{\n");
ast_dump(a->u.routine.body, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
case AST_STATEMENT:
printf("{\n");
ast_dump(a->u.statement.left, indent + 1);
ast_dump(a->u.statement.right, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
case AST_ASSIGNMENT:
printf("(%s){\n", a->u.assignment.defining ?
"definition" : "application");
ast_dump(a->u.assignment.left, indent + 1);
ast_dump(a->u.assignment.right, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
case AST_CONDITIONAL:
printf("{\n");
ast_dump(a->u.conditional.test, indent + 1);
ast_dump(a->u.conditional.yes, indent + 1);
if (a->u.conditional.no != NULL)
ast_dump(a->u.conditional.no, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
case AST_WHILE_LOOP:
printf("{\n");
ast_dump(a->u.while_loop.test, indent + 1);
ast_dump(a->u.while_loop.body, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
case AST_RETR:
printf("{\n");
ast_dump(a->u.retr.body, indent + 1);
for (i = 0; i < indent; i++) printf(" "); printf("}\n");
break;
}
#endif
}
int main(int argc, char **argv)
{
isl_ctx *ctx;
int i, nbPol, nbVec, nbMat, func, j, n;
Polyhedron *A, *B, *C, *D, *E, *F, *G;
char s[128];
struct barvinok_options *options = barvinok_options_new_with_defaults();
argc = barvinok_options_parse(options, argc, argv, ISL_ARG_ALL);
ctx = isl_ctx_alloc_with_options(&barvinok_options_args, options);
nbPol = nbVec = nbMat = 0;
fgets(s, 128, stdin);
while ((*s=='#') ||
((sscanf(s, "D %d", &nbPol) < 1) &&
(sscanf(s, "V %d", &nbVec) < 1) &&
(sscanf(s, "M %d", &nbMat) < 1)))
fgets(s, 128, stdin);
for (i = 0; i < nbPol; ++i) {
Matrix *M = Matrix_Read();
A = Constraints2Polyhedron(M, options->MaxRays);
Matrix_Free(M);
fgets(s, 128, stdin);
while ((*s=='#') || (sscanf(s, "F %d", &func)<1))
fgets(s, 128, stdin);
switch(func) {
case 0: {
Value cb, ck;
value_init(cb);
value_init(ck);
fgets(s, 128, stdin);
/* workaround for apparent bug in older gmps */
*strchr(s, '\n') = '\0';
while ((*s=='#') || (value_read(ck, s) != 0)) {
fgets(s, 128, stdin);
/* workaround for apparent bug in older gmps */
*strchr(s, '\n') = '\0';
}
barvinok_count_with_options(A, &cb, options);
if (value_ne(cb, ck))
return -1;
value_clear(cb);
value_clear(ck);
break;
}
case 1:
Polyhedron_Print(stdout, P_VALUE_FMT, A);
B = Polyhedron_Polar(A, options->MaxRays);
Polyhedron_Print(stdout, P_VALUE_FMT, B);
C = Polyhedron_Polar(B, options->MaxRays);
Polyhedron_Print(stdout, P_VALUE_FMT, C);
Polyhedron_Free(C);
Polyhedron_Free(B);
break;
case 2:
Polyhedron_Print(stdout, P_VALUE_FMT, A);
for (j = 0; j < A->NbRays; ++j) {
B = supporting_cone(A, j);
Polyhedron_Print(stdout, P_VALUE_FMT, B);
Polyhedron_Free(B);
}
break;
case 3:
Polyhedron_Print(stdout, P_VALUE_FMT, A);
C = B = NULL;
barvinok_decompose(A,&B,&C);
puts("Pos:");
Polyhedron_Print(stdout, P_VALUE_FMT, B);
puts("Neg:");
Polyhedron_Print(stdout, P_VALUE_FMT, C);
Domain_Free(B);
Domain_Free(C);
break;
case 4: {
Value cm, cb;
struct tms tms_before, tms_between, tms_after;
value_init(cm);
value_init(cb);
Polyhedron_Print(stdout, P_VALUE_FMT, A);
times(&tms_before);
manual_count(A, &cm);
times(&tms_between);
barvinok_count(A, &cb, 100);
times(&tms_after);
printf("manual: ");
value_print(stdout, P_VALUE_FMT, cm);
puts("");
time_diff(&tms_before, &tms_between);
printf("Barvinok: ");
value_print(stdout, P_VALUE_FMT, cb);
puts("");
time_diff(&tms_between, &tms_after);
value_clear(cm);
value_clear(cb);
break;
}
case 5:
Polyhedron_Print(stdout, P_VALUE_FMT, A);
B = triangulate_cone(A, 100);
Polyhedron_Print(stdout, P_VALUE_FMT, B);
check_triangulization(A, B);
Domain_Free(B);
break;
case 6:
Polyhedron_Print(stdout, P_VALUE_FMT, A);
B = remove_equalities(A, options->MaxRays);
Polyhedron_Print(stdout, P_VALUE_FMT, B);
Polyhedron_Free(B);
break;
case 8: {
evalue *EP;
Matrix *M = Matrix_Read();
const char **param_name;
C = Constraints2Polyhedron(M, options->MaxRays);
Matrix_Free(M);
Polyhedron_Print(stdout, P_VALUE_FMT, A);
Polyhedron_Print(stdout, P_VALUE_FMT, C);
EP = barvinok_enumerate_with_options(A, C, options);
param_name = Read_ParamNames(stdin, C->Dimension);
print_evalue(stdout, EP, (const char**)param_name);
evalue_free(EP);
Polyhedron_Free(C);
}
case 9:
Polyhedron_Print(stdout, P_VALUE_FMT, A);
Polyhedron_Polarize(A);
C = B = NULL;
barvinok_decompose(A,&B,&C);
for (D = B; D; D = D->next)
Polyhedron_Polarize(D);
for (D = C; D; D = D->next)
Polyhedron_Polarize(D);
puts("Pos:");
Polyhedron_Print(stdout, P_VALUE_FMT, B);
puts("Neg:");
Polyhedron_Print(stdout, P_VALUE_FMT, C);
Domain_Free(B);
Domain_Free(C);
break;
case 10: {
evalue *EP;
Value cb, ck;
value_init(cb);
value_init(ck);
fgets(s, 128, stdin);
sscanf(s, "%d", &n);
for (j = 0; j < n; ++j) {
Polyhedron *P;
M = Matrix_Read();
P = Constraints2Polyhedron(M, options->MaxRays);
Matrix_Free(M);
A = DomainConcat(P, A);
}
fgets(s, 128, stdin);
/* workaround for apparent bug in older gmps */
*strchr(s, '\n') = '\0';
while ((*s=='#') || (value_read(ck, s) != 0)) {
fgets(s, 128, stdin);
/* workaround for apparent bug in older gmps */
*strchr(s, '\n') = '\0';
}
C = Universe_Polyhedron(0);
EP = barvinok_enumerate_union(A, C, options->MaxRays);
value_set_double(cb, compute_evalue(EP, &ck)+.25);
if (value_ne(cb, ck))
return -1;
Domain_Free(C);
value_clear(cb);
value_clear(ck);
evalue_free(EP);
break;
}
case 11: {
isl_space *dim;
isl_basic_set *bset;
isl_pw_qpolynomial *expected, *computed;
unsigned nparam;
expected = isl_pw_qpolynomial_read_from_file(ctx, stdin);
nparam = isl_pw_qpolynomial_dim(expected, isl_dim_param);
dim = isl_space_set_alloc(ctx, nparam, A->Dimension - nparam);
bset = isl_basic_set_new_from_polylib(A, dim);
computed = isl_basic_set_lattice_width(bset);
computed = isl_pw_qpolynomial_sub(computed, expected);
if (!isl_pw_qpolynomial_is_zero(computed))
return -1;
isl_pw_qpolynomial_free(computed);
break;
}
case 12: {
Vector *sample;
int has_sample;
fgets(s, 128, stdin);
sscanf(s, "%d", &has_sample);
sample = Polyhedron_Sample(A, options);
if (!sample && has_sample)
return -1;
if (sample && !has_sample)
return -1;
if (sample && !in_domain(A, sample->p))
return -1;
Vector_Free(sample);
}
}
Domain_Free(A);
}
for (i = 0; i < nbVec; ++i) {
int ok;
Vector *V = Vector_Read();
Matrix *M = Matrix_Alloc(V->Size, V->Size);
Vector_Copy(V->p, M->p[0], V->Size);
ok = unimodular_complete(M, 1);
assert(ok);
Matrix_Print(stdout, P_VALUE_FMT, M);
Matrix_Free(M);
Vector_Free(V);
}
for (i = 0; i < nbMat; ++i) {
Matrix *U, *V, *S;
Matrix *M = Matrix_Read();
Smith(M, &U, &V, &S);
Matrix_Print(stdout, P_VALUE_FMT, U);
Matrix_Print(stdout, P_VALUE_FMT, V);
Matrix_Print(stdout, P_VALUE_FMT, S);
Matrix_Free(M);
Matrix_Free(U);
Matrix_Free(V);
Matrix_Free(S);
}
isl_ctx_free(ctx);
return 0;
}
int main(int argc, char **argv)
{
int i;
char str[1024];
Matrix *C1, *P1;
Polyhedron *C, *P;
Enumeration *en;
const char **param_name;
int c, ind = 0;
int hom = 0;
#ifdef EP_EVALUATION
Value *p, *tmp;
int k;
#endif
while ((c = getopt_long(argc, argv, "h", options, &ind)) != -1) {
switch (c) {
case 'h':
hom = 1;
break;
}
}
P1 = Matrix_Read();
C1 = Matrix_Read();
if(C1->NbColumns < 2) {
fprintf( stderr, "Not enough parameters !\n" );
exit(0);
}
if (hom) {
Matrix *C2, *P2;
P2 = AddANullColumn(P1);
Matrix_Free(P1);
P1 = P2;
C2 = AddANullColumn(C1);
Matrix_Free(C1);
C1 = C2;
}
P = Constraints2Polyhedron(P1,WS);
C = Constraints2Polyhedron(C1,WS);
Matrix_Free(P1);
Matrix_Free(C1);
/* Read the name of the parameters */
param_name = Read_ParamNames(stdin,C->Dimension - hom);
if (hom) {
const char **param_name2;
param_name2 = (const char**)malloc(sizeof(char*) * (C->Dimension));
for (i = 0; i < C->Dimension - 1; i++)
param_name2[i] = param_name[i];
param_name2[C->Dimension-1] = "_H";
free(param_name);
param_name=param_name2;
}
en = Polyhedron_Enumerate(P,C,WS,param_name);
if (hom) {
Enumeration *en2;
printf("inhomogeneous form:\n");
dehomogenize_enumeration(en, C->Dimension, WS);
for (en2 = en; en2; en2 = en2->next) {
Print_Domain(stdout, en2->ValidityDomain, param_name);
print_evalue(stdout, &en2->EP, param_name);
}
}
#ifdef EP_EVALUATION
if( isatty(0) && C->Dimension != 0)
{ /* no tty input or no polyhedron -> no evaluation. */
printf("Evaluation of the Ehrhart polynomial :\n");
p = (Value *)malloc(sizeof(Value) * (C->Dimension));
for(i=0;i<C->Dimension;i++)
value_init(p[i]);
FOREVER {
fflush(stdin);
printf("Enter %d parameters : ",C->Dimension);
for(k=0;k<C->Dimension;++k) {
scanf("%s",str);
value_read(p[k],str);
}
fprintf(stdout,"EP( ");
value_print(stdout,VALUE_FMT,p[0]);
for(k=1;k<C->Dimension;++k) {
fprintf(stdout,",");
value_print(stdout,VALUE_FMT,p[k]);
}
fprintf(stdout," ) = ");
value_print(stdout,VALUE_FMT,*(tmp=compute_poly(en,p)));
free(tmp);
fprintf(stdout,"\n");
}
}
int main(int argc,char *argv[]) {
Matrix *C1, *P1;
Polyhedron *C, *P, *S;
Polyhedron *CC, *PP;
Enumeration *en;
Value *p;
int i,j,k;
int m,M;
char str[1024];
Value c;
/******* Read the input *********/
P1 = Matrix_Read();
C1 = Matrix_Read();
if(C1->NbColumns < 2) {
fprintf(stderr,"Not enough parameters !\n");
exit(0);
}
P = Constraints2Polyhedron(P1, MAXRAYS);
C = Constraints2Polyhedron(C1, MAXRAYS);
Matrix_Free(C1);
Matrix_Free(P1);
/******* Compute the true context *******/
CC = align_context(C,P->Dimension,MAXRAYS);
PP = DomainIntersection(P,CC,MAXRAYS);
Domain_Free(CC);
C1 = Matrix_Alloc(C->Dimension+1,P->Dimension+1);
for(i=0;i<C1->NbRows;i++)
for(j=0;j<C1->NbColumns;j++)
if(i==j-P->Dimension+C->Dimension)
value_set_si(C1->p[i][j],1);
else
value_set_si(C1->p[i][j],0);
CC = Polyhedron_Image(PP,C1,MAXRAYS);
Domain_Free(C);
Domain_Free(PP);
Matrix_Free(C1);
C = CC;
/******* Initialize parameters *********/
p = (Value *)malloc(sizeof(Value) * (P->Dimension+2));
for(i=0;i<=P->Dimension;i++) {
value_init(p[i]);
value_set_si(p[i],0);
}
value_init(p[i]);
value_set_si(p[i],1);
/*** S = scanning list of polyhedra ***/
S = Polyhedron_Scan(P,C,MAXRAYS);
value_init(c);
/******* Count now *********/
FOREVER {
fflush(stdin);
printf("Enter %d parameters : ",C->Dimension);
for(k=S->Dimension-C->Dimension+1;k<=S->Dimension;++k) {
scanf(" %s", str);
value_read(p[k],str);
}
printf("EP( ");
value_print(stdout,VALUE_FMT,p[S->Dimension-C->Dimension+1]);
for(k=S->Dimension-C->Dimension+2;k<=S->Dimension;++k) {
printf(", ");
value_print(stdout,VALUE_FMT,p[k]);
}
printf(" ) = ");
count_points(1,S,p,&c);
value_print(stdout,VALUE_FMT,c);
printf("\n");
}
for(i=0;i<=(P->Dimension+1);i++)
value_clear(p[i]);
value_clear(c);
return(0);
} /* main */
int
vm_run(struct vm *vm, int xmax)
{
vm_label_t label;
struct value l, r, v;
struct activation *ar;
struct builtin *ext_bi;
int varity;
int xcount = 0;
struct value zero, one, two;
/*int upcount, index; */
#ifdef DEBUG
if (trace_vm) {
printf("___ virtual machine started ___\n");
}
#endif
zero = value_new_integer(0);
value_deregister(zero);
one = value_new_integer(1);
value_deregister(one);
two = value_new_integer(2);
value_deregister(two);
while (*vm->pc != INSTR_HALT) {
#ifdef DEBUG
if (trace_vm) {
printf("#%d:\n", vm->pc - vm->program);
dump_stack(vm);
}
#endif
if (((++xcount) & 0xff) == 0) {
if (a_count + v_count > gc_target) {
#ifdef DEBUG
if (trace_gc > 0) {
printf("[ARC] GARBAGE COLLECTION STARTED on %d activation records + %d values\n",
a_count, v_count);
/*activation_dump(current_ar, 0);
printf("\n");*/
dump_activation_stack(vm);
}
#endif
gc();
#ifdef DEBUG
if (trace_gc > 0) {
printf("[ARC] GARBAGE COLLECTION FINISHED, now %d activation records + %d values\n",
a_count, v_count);
/*activation_dump(current_ar, 0);
printf("\n");*/
}
#endif
/*
* Slide the target to account for the fact that there
* are now 'a_count' activation records in existence.
* Only GC when there are gc_trigger *more* ar's.
*/
gc_target = a_count + v_count + gc_trigger;
}
/*
* Also, give up control if we've exceeded our timeslice.
*/
if (xcount >= xmax)
return(VM_TIME_EXPIRED);
}
switch (*vm->pc) {
#ifdef INLINE_BUILTINS
case INDEX_BUILTIN_NOT:
POP_VALUE(l);
if (l.type == VALUE_BOOLEAN) {
v = value_new_boolean(!l.v.b);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_AND:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_BOOLEAN && r.type == VALUE_BOOLEAN) {
v = value_new_boolean(l.v.b && r.v.b);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_OR:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_BOOLEAN && r.type == VALUE_BOOLEAN) {
v = value_new_boolean(l.v.b || r.v.b);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_EQU:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_boolean(l.v.i == r.v.i);
} else if (l.type == VALUE_OPAQUE && r.type == VALUE_OPAQUE) {
v = value_new_boolean(l.v.ptr == r.v.ptr);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_NEQ:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_boolean(l.v.i != r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_GT:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_boolean(l.v.i > r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_LT:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_boolean(l.v.i < r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_GTE:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_boolean(l.v.i >= r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_LTE:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_boolean(l.v.i <= r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_ADD:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_integer(l.v.i + r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_MUL:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_integer(l.v.i * r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_SUB:
POP_VALUE(r);
POP_VALUE(l);
/* subs++; */
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
v = value_new_integer(l.v.i - r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_DIV:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
if (r.v.i == 0)
v = value_new_error("division by zero");
else
v = value_new_integer(l.v.i / r.v.i);
} else {
v = value_new_error("type mismatch");
}
PUSH_VALUE(v);
break;
case INDEX_BUILTIN_MOD:
POP_VALUE(r);
POP_VALUE(l);
if (l.type == VALUE_INTEGER && r.type == VALUE_INTEGER) {
if (r.v.i == 0)
v = value_new_error("modulo by zero");
else
v = value_new_integer(l.v.i % r.v.i);
} else {
v = value_new_error("type mismatch"); }
PUSH_VALUE(v);
break;
#endif /* INLINE_BUILTINS */
/*
* This sort of needs to be here even when INLINE_BUILTINS
* isn't used (in practice INLINE_BUILTINS will always be
* used anyway...)
*/
case INDEX_BUILTIN_RECV:
POP_VALUE(l);
r = value_null();
if (l.type == VALUE_INTEGER) {
if (!process_recv(&r)) {
PUSH_VALUE(l);
return(VM_WAITING);
}
} else {
r = value_new_error("type mismatch");
}
PUSH_VALUE(r);
break;
case INSTR_PUSH_VALUE:
l = *(struct value *)(vm->pc + 1);
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_PUSH_VALUE:\n");
value_print(l);
printf("\n");
}
#endif
PUSH_VALUE(l);
vm->pc += sizeof(struct value);
break;
case INSTR_PUSH_ZERO:
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_PUSH_ZERO\n");
}
#endif
PUSH_VALUE(zero);
break;
case INSTR_PUSH_ONE:
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_PUSH_ONE\n");
}
#endif
PUSH_VALUE(one);
break;
case INSTR_PUSH_TWO:
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_PUSH_TWO\n");
}
#endif
PUSH_VALUE(two);
break;
case INSTR_PUSH_LOCAL:
l = activation_get_value(vm->current_ar,
*(vm->pc + 1), *(vm->pc + 2));
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_PUSH_LOCAL:\n");
value_print(l);
printf("\n");
}
#endif
PUSH_VALUE(l);
vm->pc += sizeof(unsigned char) * 2;
break;
case INSTR_POP_LOCAL:
POP_VALUE(l);
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_POP_LOCAL:\n");
value_print(l);
printf("\n");
}
#endif
activation_set_value(vm->current_ar,
*(vm->pc + 1), *(vm->pc + 2), l);
vm->pc += sizeof(unsigned char) * 2;
break;
case INSTR_INIT_LOCAL:
POP_VALUE(l);
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_INIT_LOCAL:\n");
value_print(l);
printf("\n");
}
#endif
activation_initialize_value(vm->current_ar,
*(vm->pc + 1), l);
vm->pc += sizeof(unsigned char) * 2;
break;
case INSTR_JMP:
label = *(vm_label_t *)(vm->pc + 1);
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_JMP -> #%d:\n", label - vm->program);
}
#endif
vm->pc = label - 1;
break;
case INSTR_JZ:
POP_VALUE(l);
label = *(vm_label_t *)(vm->pc + 1);
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_JZ -> ");
value_print(l);
printf(", #%d:\n", label - vm->program);
}
#endif
if (!l.v.b) {
vm->pc = label - 1;
} else {
vm->pc += sizeof(vm_label_t);
}
break;
case INSTR_CALL:
POP_VALUE(l);
label = l.v.s->v.k->label;
if (l.v.s->v.k->cc > 0) {
/*
* Create a new activation record
* on the heap for this call.
*/
ar = activation_new_on_heap(
l.v.s->v.k->arity +
l.v.s->v.k->locals,
vm->current_ar, l.v.s->v.k->ar);
} else {
/*
* Optimize by placing it on a stack.
*/
ar = activation_new_on_stack(
l.v.s->v.k->arity +
l.v.s->v.k->locals,
vm->current_ar, l.v.s->v.k->ar, vm);
}
/*
* Fill out the activation record.
*/
for (i = l.v.s->v.k->arity - 1; i >= 0; i--) {
POP_VALUE(r);
activation_initialize_value(ar, i, r);
}
vm->current_ar = ar;
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_CALL -> #%d:\n", label - vm->program);
}
#endif
/*
printf("%% process %d pushing pc = %d\n",
current_process->number, vm->pc - vm->program);
*/
PUSH_PC(vm->pc + 1); /* + sizeof(vm_label_t)); */
vm->pc = label - 1;
break;
case INSTR_GOTO:
POP_VALUE(l);
label = l.v.s->v.k->label;
/*
* DON'T create a new activation record for this leap
* UNLESS the current activation record isn't large enough.
*/
/*
printf("GOTOing a closure w/arity %d locals %d\n",
l.v.s->v.k->arity, l.v.s->v.k->locals);
printf("current ar size %d\n", current_ar->size);
*/
if (vm->current_ar->size < l.v.s->v.k->arity + l.v.s->v.k->locals) {
/*
* REMOVE the current activation record, if on the stack.
*/
if (vm->current_ar->admin & AR_ADMIN_ON_STACK) {
ar = vm->current_ar->caller;
activation_free_from_stack(vm->current_ar, vm);
vm->current_ar = ar;
} else {
vm->current_ar = vm->current_ar->caller;
}
/*
* Create a NEW activation record... wherever.
*/
if (l.v.s->v.k->cc > 0) {
/*
* Create a new activation record
* on the heap for this call.
*/
vm->current_ar = activation_new_on_heap(
l.v.s->v.k->arity +
l.v.s->v.k->locals,
vm->current_ar, l.v.s->v.k->ar);
} else {
/*
* Optimize by placing it on a stack.
*/
vm->current_ar = activation_new_on_stack(
l.v.s->v.k->arity +
l.v.s->v.k->locals,
vm->current_ar, l.v.s->v.k->ar, vm);
}
}
/*
printf("NOW GOTOing a closure w/arity %d locals %d\n",
l.v.s->v.k->arity, l.v.s->v.k->locals);
printf("NOW current ar size %d\n", current_ar->size);
*/
/*
* Fill out the current activation record.
*/
for (i = l.v.s->v.k->arity - 1; i >= 0; i--) {
POP_VALUE(r);
activation_set_value(vm->current_ar, i, 0, r);
}
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_GOTO -> #%d:\n", label - vm->program);
}
#endif
/*PUSH_PC(pc + 1);*/ /* + sizeof(vm_label_t)); */
vm->pc = label - 1;
break;
case INSTR_RET:
vm->pc = POP_PC() - 1;
/*
printf("%% process %d popped pc = %d\n",
current_process->number, vm->pc - vm->program);
*/
if (vm->current_ar->admin & AR_ADMIN_ON_STACK) {
ar = vm->current_ar->caller;
activation_free_from_stack(vm->current_ar, vm);
vm->current_ar = ar;
} else {
vm->current_ar = vm->current_ar->caller;
}
if (vm->current_ar == NULL)
return(VM_RETURNED);
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_RET -> #%d:\n", vm->pc - vm->program);
}
#endif
break;
case INSTR_SET_ACTIVATION:
POP_VALUE(l);
l.v.s->v.k->ar = vm->current_ar;
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_SET_ACTIVATION #%d\n",
l.v.s->v.k->label - vm->program);
}
#endif
PUSH_VALUE(l);
break;
case INSTR_COW_LOCAL:
l = activation_get_value(vm->current_ar, *(vm->pc + 1), *(vm->pc + 2));
if (l.v.s->refcount > 1) {
/*
printf("deep-copying ");
value_print(l);
printf("...\n");
*/
r = value_dup(l);
activation_set_value(vm->current_ar, *(vm->pc + 1), *(vm->pc + 2), r);
}
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_COW_LOCAL:\n");
value_print(l);
printf("\n");
}
#endif
vm->pc += sizeof(unsigned char) * 2;
break;
case INSTR_EXTERNAL:
ext_bi = *(struct builtin **)(vm->pc + 1);
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_EXTERNAL(");
fputsu8(stdout, ext_bi->name);
printf("):\n");
}
#endif
varity = ext_bi->arity;
if (varity == -1) {
POP_VALUE(l);
varity = l.v.i;
}
ar = activation_new_on_stack(varity, vm->current_ar, NULL, vm);
for (i = varity - 1; i >= 0; i--) {
POP_VALUE(l);
activation_initialize_value(ar, i, l);
}
v = ext_bi->fn(ar);
activation_free_from_stack(ar, vm);
#ifdef DEBUG
if (trace_vm) {
printf("result was:\n");
value_print(v);
printf("\n");
}
#endif
if (ext_bi->retval == 1)
PUSH_VALUE(v);
vm->pc += sizeof(struct builtin *);
break;
default:
/*
* We assume it was a non-inline builtin.
*/
#ifdef DEBUG
if (trace_vm) {
printf("INSTR_BUILTIN(#%d=", *vm->pc);
fputsu8(stdout, builtins[*vm->pc].name);
printf("):\n");
}
#endif
varity = builtins[*vm->pc].arity;
if (varity == -1) {
POP_VALUE(l);
varity = l.v.i;
}
ar = activation_new_on_stack(varity, vm->current_ar, NULL, vm);
for (i = varity - 1; i >= 0; i--) {
POP_VALUE(l);
activation_initialize_value(ar, i, l);
}
v = builtins[*vm->pc].fn(ar);
activation_free_from_stack(ar, vm);
#ifdef DEBUG
if (trace_vm) {
printf("result was:\n");
value_print(v);
printf("\n");
}
#endif
if (builtins[*vm->pc].retval == 1)
PUSH_VALUE(v);
}
vm->pc++;
}
#ifdef DEBUG
if (trace_vm) {
printf("___ virtual machine finished ___\n");
}
/*printf("subs = %d\n", subs);*/
#endif
return(VM_TERMINATED);
}
/**
* Tests Constraints_fullDimensionize by comparing the Ehrhart polynomials
* @param A the input set of constraints
* @param B the corresponding context
* @param the number of samples to generate for the test
* @return 1 if the Ehrhart polynomial had the same value for the
* full-dimensional and non-full-dimensional sets of constraints, for their
* corresponding sample parameters values.
*/
int test_Constraints_fullDimensionize(Matrix * A, Matrix * B,
unsigned int nbSamples) {
Matrix * Eqs= NULL, *ParmEqs=NULL, *VL=NULL;
unsigned int * elimVars=NULL, * elimParms=NULL;
Matrix * sample, * smallerSample=NULL;
Matrix * transfSample=NULL;
Matrix * parmVL=NULL;
unsigned int i, j, r, nbOrigParms, nbParms;
Value div, mod, *origVal=NULL, *fullVal=NULL;
Matrix * VLInv;
Polyhedron * P, *PC;
Matrix * M, *C;
Enumeration * origEP, * fullEP=NULL;
const char **fullNames = NULL;
int isOk = 1; /* holds the result */
/* compute the origial Ehrhart polynomial */
M = Matrix_Copy(A);
C = Matrix_Copy(B);
P = Constraints2Polyhedron(M, maxRays);
PC = Constraints2Polyhedron(C, maxRays);
origEP = Polyhedron_Enumerate(P, PC, maxRays, origNames);
Matrix_Free(M);
Matrix_Free(C);
Polyhedron_Free(P);
Polyhedron_Free(PC);
/* compute the full-dimensional polyhedron corresponding to A and its Ehrhart
polynomial */
M = Matrix_Copy(A);
C = Matrix_Copy(B);
nbOrigParms = B->NbColumns-2;
Constraints_fullDimensionize(&M, &C, &VL, &Eqs, &ParmEqs,
&elimVars, &elimParms, maxRays);
if ((Eqs->NbRows==0) && (ParmEqs->NbRows==0)) {
Matrix_Free(M);
Matrix_Free(C);
Matrix_Free(Eqs);
Matrix_Free(ParmEqs);
free(elimVars);
free(elimParms);
return 1;
}
nbParms = C->NbColumns-2;
P = Constraints2Polyhedron(M, maxRays);
PC = Constraints2Polyhedron(C, maxRays);
namesWithoutElim(origNames, nbOrigParms, elimParms, &fullNames);
fullEP = Polyhedron_Enumerate(P, PC, maxRays, fullNames);
Matrix_Free(M);
Matrix_Free(C);
Polyhedron_Free(P);
Polyhedron_Free(PC);
/* make a set of sample parameter values and compare the corresponding
Ehrhart polnomials */
sample = Matrix_Alloc(1,nbOrigParms);
transfSample = Matrix_Alloc(1, nbParms);
Lattice_extractSubLattice(VL, nbParms, &parmVL);
VLInv = Matrix_Alloc(parmVL->NbRows, parmVL->NbRows+1);
MatInverse(parmVL, VLInv);
if (dbg) {
show_matrix(parmVL);
show_matrix(VLInv);
}
srand(nbSamples);
value_init(mod);
value_init(div);
for (i = 0; i< nbSamples; i++) {
/* create a random sample */
for (j=0; j< nbOrigParms; j++) {
value_set_si(sample->p[0][j], rand()%100);
}
/* compute the corresponding value for the full-dimensional
constraints */
valuesWithoutElim(sample, elimParms, &smallerSample);
/* (N' i' 1)^T = VLinv.(N i 1)^T*/
for (r = 0; r < nbParms; r++) {
Inner_Product(&(VLInv->p[r][0]), smallerSample->p[0], nbParms,
&(transfSample->p[0][r]));
/* add the constant part */
value_addto(transfSample->p[0][r], transfSample->p[0][r],
VLInv->p[r][VLInv->NbColumns-2]);
value_pdivision(div, transfSample->p[0][r],
VLInv->p[r][VLInv->NbColumns-1]);
value_subtract(mod, transfSample->p[0][r], div);
/* if the parameters value does not belong to the validity lattice, the
Ehrhart polynomial is zero. */
if (!value_zero_p(mod)) {
fullEP = Enumeration_zero(nbParms, maxRays);
break;
}
}
/* compare the two forms of the Ehrhart polynomial.*/
if (origEP ==NULL) break; /* NULL has loose semantics for EPs */
origVal = compute_poly(origEP, sample->p[0]);
fullVal = compute_poly(fullEP, transfSample->p[0]);
if (!value_eq(*origVal, *fullVal)) {
isOk = 0;
printf("EPs don't match. \n Original value = ");
value_print(stdout, VALUE_FMT, *origVal);
printf("\n Original sample = [");
for (j=0; j<sample->NbColumns; j++) {
value_print(stdout, VALUE_FMT, sample->p[0][j]);
printf(" ");
}
printf("] \n EP = ");
if(origEP!=NULL) {
print_evalue(stdout, &(origEP->EP), origNames);
}
else {
printf("NULL");
}
printf(" \n Full-dimensional value = ");
value_print(stdout, P_VALUE_FMT, *fullVal);
printf("\n full-dimensional sample = [");
for (j=0; j<sample->NbColumns; j++) {
value_print(stdout, VALUE_FMT, transfSample->p[0][j]);
printf(" ");
}
printf("] \n EP = ");
if(origEP!=NULL) {
print_evalue(stdout, &(origEP->EP), fullNames);
}
else {
printf("NULL");
}
}
if (dbg) {
printf("\nOriginal value = ");
value_print(stdout, VALUE_FMT, *origVal);
printf("\nFull-dimensional value = ");
value_print(stdout, P_VALUE_FMT, *fullVal);
printf("\n");
}
value_clear(*origVal);
value_clear(*fullVal);
}
value_clear(mod);
value_clear(div);
Matrix_Free(sample);
Matrix_Free(smallerSample);
Matrix_Free(transfSample);
Enumeration_Free(origEP);
Enumeration_Free(fullEP);
return isOk;
} /* test_Constraints_fullDimensionize */
int main( int argc, char **argv)
{
int i;
const char **param_name;
Matrix *C1, *P1;
Polyhedron *P, *C;
Enumeration *e, *en;
Matrix * Validity_Lattice;
int nb_parms;
#ifdef EP_EVALUATION
Value *p, *tmp;
int k;
#endif
P1 = Matrix_Read();
C1 = Matrix_Read();
nb_parms = C1->NbColumns-2;
if(nb_parms < 0) {
fprintf( stderr, "Not enough parameters !\n" );
exit(0);
}
/* Read the name of the parameters */
param_name = Read_ParamNames(stdin,nb_parms);
/* inflate the polyhedron, so that the inflated EP approximation will be an
upper bound for the EP's polyhedron. */
mpolyhedron_deflate(P1,nb_parms);
/* compute a polynomial approximation of the Ehrhart polynomial */
e = Ehrhart_Quick_Apx(P1, C1, &Validity_Lattice, 1024);
Matrix_Free(C1);
Matrix_Free(P1);
printf("============ Ehrhart polynomial quick polynomial lower bound ============\n");
show_matrix(Validity_Lattice);
for( en=e ; en ; en=en->next ) {
Print_Domain(stdout,en->ValidityDomain, param_name);
print_evalue(stdout,&en->EP, param_name);
printf( "\n-----------------------------------\n" );
}
#ifdef EP_EVALUATION
if( isatty(0) && nb_parms != 0)
{ /* no tty input or no polyhedron -> no evaluation. */
printf("Evaluation of the Ehrhart polynomial :\n");
p = (Value *)malloc(sizeof(Value) * (nb_parms));
for(i=0;i<nb_parms;i++)
value_init(p[i]);
FOREVER {
fflush(stdin);
printf("Enter %d parameters : ",nb_parms);
for(k=0;k<nb_parms;++k) {
scanf("%s",str);
value_read(p[k],str);
}
fprintf(stdout,"EP( ");
value_print(stdout,VALUE_FMT,p[0]);
for(k=1;k<nb_parms;++k) {
fprintf(stdout,",");
value_print(stdout,VALUE_FMT,p[k]);
}
fprintf(stdout," ) = ");
value_print(stdout,VALUE_FMT,*(tmp=compute_poly(en,p)));
free(tmp);
fprintf(stdout,"\n");
}
}