int main(int argc, char *argv[])
{
int a, b, c, d;
a = int_add(-1, 2);
b = int_sub(1, 2);
c = int_mul(3, 4);
d = int_div(4, -2);
return (a + b + c + d) ? 0 : 1;
}
void mod_exp(BIGINT *x, BIGINT *n, BIGINT *q, BIGINT *z)
{
BIGINT N, Y, Z, temp, dummy;
ELEMENT check;
INDEX i;
/* initialize variables */
int_copy (n, &N);
int_null( &Y);
Y.hw[INTMAX] = 1;
int_copy (x, &Z);
/* Main loop divides N by 2 each step. Repeat until N = 0, and return Y as result. */
check = 0;
INTLOOP (i) check |= N.hw[i];
while (check)
{
/* if N is odd, multiply by extra factor of Y */
if (N.hw[INTMAX] & 1)
{
/* Y = (Y * Z) % q; */
int_mul (&Y, &Z, &temp);
int_div (&temp, q, &dummy, &Y);
}
int_div2( &N); /* divide N by 2 */
/* Z = (Z * Z) % q; square Z */
int_mul (&Z, &Z, &temp);
int_div( &temp, q, &dummy, &Z);
check = 0;
INTLOOP (i) check |= N.hw[i];
}
int_copy (&Y, z);
}
void mod_inv(BIGINT *a, BIGINT *b, BIGINT *x)
{
BIGINT m, n, p0, p1, p2, q, r, temp, dummy;
ELEMENT check;
INDEX sw, i;
/* initialize loop variables
sw = 1;
m = b;
n = a;
p0 = 1;
p1 = m/n;
q = p1;
r = m % n;
*/
sw = 1;
int_copy( b, &m);
int_copy( a, &n);
int_null ( &p0);
p0.hw[INTMAX] = 1;
int_div ( &m, &n, &p1, &r);
int_copy ( &p1, &q);
/* main loop, compute continued fraction intermediates */
check = 0;
INTLOOP (i) check |= r.hw[i];
while (check)
{
sw = -sw;
int_copy( &n, &m);
int_copy( &r, &n);
int_div( &m, &n, &q, &r);
/* p2 = (q * p1 + p0) % b; core operation of routine */
int_mul( &q, &p1, &temp);
int_add( &temp, &p0, &temp);
int_div( &temp, b, &dummy, &p2);
int_copy( &p1, &p0);
int_copy( &p2, &p1);
check = 0;
INTLOOP (i) check |= r.hw[i];
}
/* sw keeps track of sign. If sw < 0, add modulus to result */
if (sw < 0) int_sub( b, &p0, x);
else int_copy( &p0, x);
}
void _mul(){
struct atom *a, *b;
a = u_pop_atom();
b = u_pop_atom();
if(a->type != b->type)
error("Addition: Numbers need to be of the same type.");
if(a->type == FLOAT)
float_mul(a,b);
else
int_mul(a,b);
}
void _div(){
struct atom *a, *b;
a = u_pop_atom();
b = u_pop_atom();
if(a->type != b->type)
error("Subtraction: Numbers need to be of the same type.");
if(a->type == FLOAT){
a->data.float_t /= 1;
float_mul(a,b);
}else{
a->data.int_t /= 1;
int_mul(a,b);
}
}
static Const fold_op(Node node) /*;fold_op*/
{
Node opn, arg1, arg2, oplist;
Const result, op1, op2, tryc;
Symbol sym, op_name;
int *uint;
int rm;
Tuple tup;
int res, overflow;
opn = N_AST1(node);
oplist = N_AST2(node);
tup = N_LIST(oplist);
arg1 = (Node) tup[1];
arg2 = (Node) tup[2];
op1 = const_fold(arg1);
op2 = const_fold(arg2);
op_name = N_UNQ(opn);
/* If either operand raises and exception, so does the operation */
if (N_KIND(arg1) == as_raise) {
copy_attributes(arg1, node);
return const_new(CONST_OM);
}
if (N_KIND(arg2) == as_raise
&& op_name != symbol_andthen && op_name != symbol_orelse) {
copy_attributes(arg2, node);
return const_new(CONST_OM);
}
if (is_const_om(op1) || (is_const_om(op2)
&& (op_name != symbol_in || op_name != symbol_notin))) {
return const_new(CONST_OM);
}
sym = op_name;
if ( sym == symbol_addi || sym == symbol_addfl) {
if (sym == symbol_addi) {
res = word_add(INTV(op1), INTV(op2), &overflow);
if (overflow) {
create_raise(node, symbol_constraint_error);
result = const_new(CONST_OM);
}
else result = int_const(res);
}
else
result = real_const(REALV(op1) + REALV(op2));
}
else if ( sym == symbol_addfx) {
const_check(op1, CONST_RAT);
const_check(op2, CONST_RAT);
result= rat_const(rat_add(RATV(op1), RATV(op2)));
}
else if ( sym == symbol_subi) {
if (is_const_int(op1)) {
if (is_const_int(op2)) {
res = word_sub(INTV(op1), INTV(op2), &overflow);
if (overflow) {
create_raise(node, symbol_constraint_error);
result = const_new(CONST_OM);
}
else result = int_const(res);
}
else {
chaos("fold_op: subi operand types");
}
}
}
else if (sym == symbol_subfl) {
result = real_const(REALV(op1) - REALV(op2));
}
else if ( sym == symbol_subfx) {
const_check(op1, CONST_RAT);
const_check(op2, CONST_RAT);
result= rat_const(rat_sub(RATV(op1), RATV(op2)));
}
else if ( sym == symbol_muli) {
#ifdef TBSL
-- need to check for overflow and convert result back to int if not
-- note that low-level setl is missing calls to check_overflow that
-- are present in high-level and should be in low-level as well
result = int_mul(int_fri(op1), int_fri(op2));
#endif
/* until overflow check in */
const_check(op1, CONST_INT);
const_check(op2, CONST_INT);
res = word_mul(INTV(op1), INTV(op2), &overflow);
if (overflow) {
create_raise(node, symbol_constraint_error);
result = const_new(CONST_OM);
}
else result = int_const(res);
}
